aboutsummaryrefslogtreecommitdiff
path: root/pkg/dataio/export/bltins/exeps.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/dataio/export/bltins/exeps.x')
-rw-r--r--pkg/dataio/export/bltins/exeps.x537
1 files changed, 537 insertions, 0 deletions
diff --git a/pkg/dataio/export/bltins/exeps.x b/pkg/dataio/export/bltins/exeps.x
new file mode 100644
index 00000000..b7189896
--- /dev/null
+++ b/pkg/dataio/export/bltins/exeps.x
@@ -0,0 +1,537 @@
+include <evvexpr.h>
+include <imhdr.h>
+include <mach.h>
+include <fset.h>
+include "../export.h"
+include "../exbltins.h"
+
+
+define SZ_EPSSTRUCT 5
+define EPS_ITEMSPERLINE Memi[$1] # no. of items per line
+define EPS_HPTR Memi[$1+1] # ptr to hex digit string
+define EPS_BPTR Memi[$1+2] # ptr to output buffer
+define EPS_BCNT Memi[$1+3] # index into output buffer
+define HEXSTR Memc[EPS_HPTR($1)+$2]
+define BUF Memc[EPS_BPTR($1)+$2-1]
+
+define LINEWID 36 # hexstr pixels per line
+define HEXITS "0123456789abcdef" # hex digits
+define MARGIN 0.95 # defaults for 300 dpi
+define PAGEWID 612
+define PAGEHGT 762
+define SZ_EPSBUF 8192
+define SZ_TRAILER 31
+
+
+# EX_EPS - Write the output image to an Encasulated PostScript file.
+
+procedure ex_eps (ex)
+
+pointer ex #i task struct pointer
+
+pointer eps
+pointer bptr
+int fd, len, flags
+
+int strlen()
+bool streq()
+
+begin
+ # Check to see that we have the correct number of expressions to
+ # write this format.
+ flags = EX_OUTFLAGS(ex)
+ if ((EX_NEXPR(ex) != 1 && !bitset(flags, OF_BAND)) && EX_NEXPR(ex) != 3)
+ call error (7, "Invalid number of expressions for EPS file.")
+
+ # Set some of the output parameters.
+ call ex_do_outtype (ex, "b1")
+ EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY)
+
+ # Allocate the EPS structure.
+ iferr (call calloc (eps, SZ_EPSSTRUCT, TY_STRUCT))
+ call error (0, "Error allocating eps structure.")
+ call calloc (EPS_HPTR(eps), 17, TY_CHAR)
+ call calloc (EPS_BPTR(eps), SZ_EPSBUF+SZ_TRAILER, TY_CHAR)
+ call strcpy (HEXITS, Memc[EPS_HPTR(eps)], 17)
+ EPS_BCNT(eps) = 1
+
+ # Now write out the header and image data.
+ fd = EX_FD(ex)
+ call fseti (fd, F_ADVICE, SEQUENTIAL)
+ if (bitset (flags, OF_CMAP)) {
+ if (streq (CMAPFILE(ex),"grayscale") ||
+ streq (CMAPFILE(ex),"greyscale")) {
+ call eps_header (ex, eps, NO)
+ call eps_gray (ex, eps, fd, false, true)
+ } else {
+ call eps_header (ex, eps, YES)
+ call eps_gray (ex, eps, fd, true, false)
+ }
+
+ } else if (EX_NEXPR(ex) == 1 || bitset (flags, OF_BAND)) {
+ call eps_header (ex, eps, NO)
+ call eps_gray (ex, eps, fd, false, false)
+
+ } else if (EX_NEXPR(ex) == 3) {
+ call eps_header (ex, eps, YES)
+ call eps_rgb (ex, eps, fd)
+ }
+
+ # Flush the remaining pixels in the buffer.
+ call calloc (bptr, SZ_EPSBUF, TY_CHAR)
+
+ if (mod (EPS_BCNT(eps),2) == 0) {
+ call amovc ("\ngrestore showpage\n%%Trailer\n\0",
+ BUF(eps,EPS_BCNT(eps)), SZ_TRAILER)
+ } else {
+ call amovc ("\ngrestore showpage\n%%Trailer\n",
+ BUF(eps,EPS_BCNT(eps)), SZ_TRAILER)
+ }
+ len = strlen (BUF(eps,1))
+ call strpak (BUF(eps,1), Memc[bptr], len)
+ call write (fd, Memc[bptr], len / SZB_CHAR)
+ call flush (fd)
+
+ # Write the EPS trailer and clean up the pointers.
+ call mfree (EPS_HPTR(eps), TY_CHAR)
+ call mfree (EPS_BPTR(eps), TY_CHAR)
+ call mfree (eps, TY_STRUCT)
+ call mfree (bptr, TY_CHAR)
+end
+
+
+# EPS_GRAY - Write a grayscale EPS file.
+
+procedure eps_gray (ex, eps, fd, use_cmap, is_gray)
+
+pointer ex #i task struct pointer
+pointer eps #i postscript struct pointer
+int fd #i output file descriptor
+bool use_cmap #i write a false color image?
+bool is_gray #i is this a grayscale cmap?
+
+pointer op, bop, out, cm
+int i, j, k, line, percent
+int len, orow, type
+
+pointer ex_evaluate(), ex_chtype()
+
+begin
+ # Now process the expressions and write the image.
+ type = EX_OUTTYPE(ex)
+ percent = 0
+ orow = 0
+ cm = EX_CMAP(ex)
+ call malloc (out, EX_OCOLS(ex)+2, TY_SHORT)
+ do i = 1, EX_NEXPR(ex) {
+
+ # Process each line in the image.
+ do j = 1, O_HEIGHT(ex,i) {
+
+ # See if we're flipping the image.
+ if (bitset (EX_OUTFLAGS(ex), OF_FLIPY))
+ line = EX_NLINES(ex) - j + 1
+ else
+ line = j
+
+ # Get pixels from image(s).
+ call ex_getpix (ex, line)
+
+ # Evaluate expression.
+ op = ex_evaluate (ex, O_EXPR(ex,i))
+
+ # Convert to the output pixel type.
+ bop = ex_chtype (ex, op, type)
+
+ # Write evaluated pixels.
+ call achtbs (Memc[bop], Mems[out], O_LEN(op))
+ len = O_LEN(op) - 1
+ if (is_gray) {
+ # Write a single color index as the grayscale value.
+ do k = 0, len
+ call eps_putval (eps, fd, CMAP(cm,EX_RED,Mems[out+k]+1))
+ } else if (use_cmap) {
+ # Write index values as RGB triplets.
+ do k = 0, len {
+ call eps_putval (eps, fd,
+ CMAP(cm,EX_RED, Mems[out+k]+1))
+ call eps_putval (eps, fd,
+ CMAP(cm,EX_GREEN,Mems[out+k]+1))
+ call eps_putval (eps, fd,
+ CMAP(cm,EX_BLUE, Mems[out+k]+1))
+ }
+ } else {
+ do k = 0, len
+ call eps_putval (eps, fd, Mems[out+k])
+ }
+
+ # Clean up the pointers.
+ call mfree (bop, TY_CHAR)
+ call evvfree (op)
+
+ # Print percent done if being verbose
+ orow = orow + 1
+ #if (EX_VERBOSE(ex) == YES)
+ call ex_pstat (ex, orow, percent)
+ }
+ }
+ call mfree (out, TY_SHORT)
+end
+
+
+# EPS_RGB - Write a RGB true color EPS file.
+
+procedure eps_rgb (ex, eps, fd)
+
+pointer ex #i task struct pointer
+pointer eps #i postscript struct pointer
+int fd #i output file descriptor
+
+pointer op, bop, out
+int i, j, k, line, percent, orow, type
+
+pointer ex_evaluate(), ex_chtype()
+
+begin
+ # Now process the expressions and write the image.
+ type = EX_OUTTYPE(ex)
+ percent = 0
+ orow = 0
+ call malloc (out, EX_OCOLS(ex)+2, TY_SHORT)
+ do j = 1, EX_NLINES(ex) {
+
+ # See if we're flipping the image.
+ if (bitset (EX_OUTFLAGS(ex), OF_FLIPY))
+ line = EX_NLINES(ex) - j + 1
+ else
+ line = j
+
+ # Get pixels from image(s).
+ call ex_getpix (ex, line)
+
+ # Process each line in the image.
+ do i = 1, EX_NEXPR(ex) {
+
+ # Evaluate expression.
+ op = ex_evaluate (ex, O_EXPR(ex,i))
+
+ # Convert to the output pixel type.
+ bop = ex_chtype (ex, op, type)
+
+ # Write evaluated pixels.
+ call achtbs (Memc[bop], Mems[out], O_LEN(op))
+ do k = 1, O_LEN(op)
+ call eps_putval (eps, fd, Mems[out+k-1])
+
+ # Clean up the pointers.
+ call mfree (bop, TY_CHAR)
+ call evvfree (op)
+ }
+
+ # Print percent done if being verbose
+ orow = orow + 1
+ #if (EX_VERBOSE(ex) == YES)
+ call ex_pstat (ex, orow, percent)
+ }
+ call mfree (out, TY_SHORT)
+end
+
+
+# EPS_HEADER - Write the EPS header block.
+
+procedure eps_header (ex, eps, color)
+
+pointer ex #i task struct pointer
+pointer eps #i EPS struct pointer
+int color #i is this a color image?
+
+int bp, fd, cols, rows, dpi, len
+int icols, irows, devpix, turnflag
+real scale, pixfac, scols, srows, llx, lly
+
+int strlen(), stropen()
+
+begin
+ fd = EX_FD(ex)
+ turnflag = NO
+ dpi = EX_PSDPI(ex)
+ scale = EX_PSSCALE(ex)
+ cols = EX_OCOLS(ex)
+ rows = EX_OROWS(ex)
+
+ # Open the buffer as a string file and print to it.
+ bp = stropen (BUF(eps,1), SZ_EPSBUF, TEXT_FILE)
+
+ # See if we need to rotate the image to fit on the page.
+ icols = cols
+ irows = rows
+ if (cols > rows && (scale * cols) > int (PAGEWID * MARGIN)) {
+ turnflag = YES
+ cols = irows
+ rows = icols
+ }
+
+ # Figure out size.
+ devpix = dpi / 72.0 + 0.5 # device pixels per unit, approx
+ pixfac = 72.0 / dpi * devpix # 1, approx.
+ scols = scale * cols * pixfac
+ srows = scale * rows * pixfac
+
+ if ( scols > PAGEWID * MARGIN || srows > PAGEHGT * MARGIN ) {
+ if ( scols > PAGEWID * MARGIN ) {
+ scale = scale * PAGEWID / scols * MARGIN
+ scols = scale * cols * pixfac
+ srows = scale * rows * pixfac
+ }
+ if ( srows > PAGEHGT * MARGIN ) {
+ scale = scale * PAGEHGT / srows * MARGIN
+ scols = scale * cols * pixfac
+ srows = scale * rows * pixfac
+ }
+ if (EX_VERBOSE(ex) == YES) {
+ call printf ("\tImage too large for page, rescaled to %g\n")
+ call pargr (scale)
+ call flush (STDOUT)
+ }
+ }
+
+ # Center it on the page.
+ llx = (PAGEWID - scols) / 2
+ lly = (PAGEHGT - srows) / 2
+
+ call fprintf (bp, "%%!PS-Adobe-2.0 EPSF-2.0\n")
+ call fprintf (bp, "%%%%Creator: IRAF EXPORT task\n")
+ call fprintf (bp, "%%%%Title: %s\n")
+ call pargstr (BFNAME(ex))
+ call fprintf (bp, "%%%%Pages: 1\n")
+ call fprintf (bp, "%%%%BoundingBox: %d %d %d %d\n")
+ call pargi (int (llx + 0.5))
+ call pargi (int (lly + 0.5))
+ call pargi (int (llx + scols))
+ call pargi (int (lly + srows))
+ call fprintf (bp, "%%%%EndComments\n")
+
+ call fprintf (bp, "/readstring {\n") # s -- s
+ call fprintf (bp, " currentfile exch readhexstring pop\n")
+ call fprintf (bp, "} bind def\n")
+
+ if (color == YES && !bitset (EX_OUTFLAGS(ex),OF_CMAP)) {
+ call eps_defcol (bp, icols)
+
+ call fprintf (bp, "/rpicstr %d string def\n")
+ call pargi (icols)
+ call fprintf (bp, "/gpicstr %d string def\n")
+ call pargi (icols)
+ call fprintf (bp, "/bpicstr %d string def\n")
+ call pargi (icols)
+
+ } else if (color == YES && bitset (EX_OUTFLAGS(ex),OF_CMAP)) {
+ call eps_defcol (bp, icols)
+
+ } else {
+ call fprintf (bp, "/picstr %d string def\n")
+ call pargi (icols)
+ }
+
+ call fprintf (bp, "%%%%EndProlog\n")
+ call fprintf (bp, "%%%%Page: 1 1\n")
+ call fprintf (bp, "gsave\n")
+ call fprintf (bp, "%g %g translate\n")
+ call pargr (llx)
+ call pargr (lly)
+ call fprintf (bp, "%g %g scale\n")
+ call pargr (scols)
+ call pargr (srows)
+
+ if (turnflag == YES) {
+ call fprintf (bp,
+ "0.5 0.5 translate 90 rotate -0.5 -0.5 translate\n")
+ }
+
+ call fprintf (bp, "%d %d 8\n")
+ call pargi (icols)
+ call pargi (irows)
+ call fprintf (bp, "[ %d 0 0 -%d 0 %d ]\n")
+ call pargi (icols)
+ call pargi (irows)
+ call pargi (irows)
+ if (color == YES) {
+ if (bitset (EX_OUTFLAGS(ex), OF_CMAP)) {
+ call fprintf (bp, "{currentfile pix readhexstring pop}\n")
+ call fprintf (bp, "false 3 colorimage")
+ } else {
+ call fprintf (bp, "{ rpicstr readstring }\n")
+ call fprintf (bp, "{ gpicstr readstring }\n")
+ call fprintf (bp, "{ bpicstr readstring }\n")
+ call fprintf (bp, "true 3 colorimage")
+ }
+ } else {
+ call fprintf (bp, "{ picstr readstring }\n")
+ call fprintf (bp, "image")
+ }
+ call flush (bp)
+ call strclose (bp)
+
+ # See if we need to pad the string to write it out correctly.
+ len = strlen(BUF(eps,1))
+ if (mod(len,2) == 1) {
+ BUF(eps,len+1) = '\n'
+ } else {
+ BUF(eps,len+1) = ' '
+ BUF(eps,len+2) = '\n'
+ }
+
+ # Now write the contents of the string buffer to the output file.
+ len = strlen(BUF(eps,1))
+ call strpak (BUF(eps,1), BUF(eps,1), len)
+ call write (fd, BUF(eps,1), len / SZB_CHAR)
+ call aclrc (BUF(eps,1), SZ_EPSBUF)
+ EPS_ITEMSPERLINE(eps) = 0
+end
+
+
+# EPS_DEFCOL - Write out code that checks if the PostScript device in question
+# knows about the 'colorimage' operator. If it doesn't, it defines
+# 'colorimage' in terms of image (ie, generates a greyscale image from
+# RGB data).
+
+procedure eps_defcol (fd, len)
+
+int fd #i output file descriptor
+int len #i length of a scanline
+
+begin
+ call fprintf (fd, "%% build a temporary dictionary\n")
+ call fprintf (fd, "20 dict begin\n\n")
+ call fprintf (fd,
+ "%% define string to hold a scanline's worth of data\n")
+ call fprintf (fd, "/pix %d string def\n\n")
+ call pargi (len)
+
+ call fprintf (fd, "\n")
+ call fprintf (fd, "%% define 'colorimage' if it isn't defined\n")
+ call fprintf (fd,
+ "/colorimage where %% do we know about 'colorimage'?\n")
+ call fprintf (fd,
+ " { pop } %% yes: pop off the 'dict' returned\n")
+ call fprintf (fd, " { %% no: define one\n")
+ call fprintf (fd, " /colortogray { %% define an RGB->I function\n")
+ call fprintf (fd,
+ " /rgbdata exch store %% call input 'rgbdata'\n")
+ call fprintf (fd, " rgbdata length 3 idiv\n")
+ call fprintf (fd, " /npixls exch store\n")
+ call fprintf (fd, " /rgbindx 0 store\n")
+ call fprintf (fd,
+ " /grays npixls string store %% str to hold the result\n")
+ call fprintf (fd, " 0 1 npixls 1 sub {\n")
+ call fprintf (fd, " grays exch\n")
+ call fprintf (fd,
+ " rgbdata rgbindx get 20 mul %% Red\n")
+ call fprintf (fd,
+ " rgbdata rgbindx 1 add get 32 mul %% Green\n")
+ call fprintf (fd,
+ " rgbdata rgbindx 2 add get 12 mul %% Blue\n")
+ call fprintf (fd,
+ " add add 64 idiv %% I = .5G + .31R + .18B\n")
+ call fprintf (fd, " put\n")
+ call fprintf (fd, " /rgbindx rgbindx 3 add store\n")
+ call fprintf (fd, " } for\n")
+ call fprintf (fd, " grays\n")
+ call fprintf (fd, " } bind def\n\n")
+
+ call fprintf (fd, " %% Utility procedure for colorimage operator.\n")
+ call fprintf (fd,
+ " %% This procedure takes two procedures off the\n")
+ call fprintf (fd,
+ " %% stack and merges them into a single procedure.\n\n")
+
+ call fprintf (fd, " /mergeprocs { %% def\n")
+ call fprintf (fd, " dup length\n")
+ call fprintf (fd, " 3 -1 roll\n")
+ call fprintf (fd, " dup\n")
+ call fprintf (fd, " length\n")
+ call fprintf (fd, " dup\n")
+ call fprintf (fd, " 5 1 roll\n")
+ call fprintf (fd, " 3 -1 roll\n")
+ call fprintf (fd, " add\n")
+ call fprintf (fd, " array cvx\n")
+ call fprintf (fd, " dup\n")
+ call fprintf (fd, " 3 -1 roll\n")
+ call fprintf (fd, " 0 exch\n")
+ call fprintf (fd, " putinterval\n")
+ call fprintf (fd, " dup\n")
+ call fprintf (fd, " 4 2 roll\n")
+ call fprintf (fd, " putinterval\n")
+ call fprintf (fd, " } bind def\n\n")
+
+ call fprintf (fd, " /colorimage { %% def\n")
+ call fprintf (fd, " pop pop %% remove 'false 3' operands\n")
+ call fprintf (fd, " {colortogray} mergeprocs\n")
+ call fprintf (fd, " image\n")
+ call fprintf (fd, " } bind def\n")
+ call fprintf (fd, " } ifelse %% end of 'false' case\n")
+ call fprintf (fd, "\n\n")
+ call flush (fd)
+end
+
+
+# EPS_PUTVAL - Put a pixel value to the output file.
+
+procedure eps_putval (eps, fd, sval)
+
+pointer eps #i EPS struct pointer
+int fd #i output file descriptor
+short sval #i value to write
+
+int val, index
+char ch, nl, sp
+int shifti()
+
+begin
+ # Force value to 8-bit range.
+ #val = max (0, min (255, sval))
+ val = sval
+
+ if (EPS_ITEMSPERLINE(eps) >= LINEWID) {
+ sp = ' '
+ call eps_putc (eps, fd, sp)
+ nl = '\n'
+ call eps_putc (eps, fd, nl)
+ EPS_ITEMSPERLINE(eps) = 0
+ }
+
+ # Get the hex string equivalent of the byte.
+ index = shifti (val, -4) # get left 4 bits
+ ch = HEXSTR(eps,index)
+ call eps_putc (eps, fd, ch)
+
+ index = and (val, 0FX) # get right 4 bits
+ ch = HEXSTR(eps,index)
+ call eps_putc (eps, fd, ch)
+
+ EPS_ITEMSPERLINE(eps) = EPS_ITEMSPERLINE(eps) + 1
+end
+
+
+# EPS_PUTC - Put a character to the buffer. This routine also flushes the
+# accumulated buffer to disk once it fills.
+
+procedure eps_putc (eps, fd, ch)
+
+pointer eps #i EPS struct pointer
+int fd #i file descriptor
+char ch #i character to 'write'
+
+begin
+ BUF(eps,EPS_BCNT(eps)) = ch
+ EPS_BCNT(eps) = EPS_BCNT(eps) + 1
+
+ # If we're getting close to a full buffer, write it out.
+ # Leave some space at the end for the epilogue.
+ if (EPS_BCNT(eps) > SZ_EPSBUF-64) {
+ call strpak (BUF(eps,1), BUF(eps,1), EPS_BCNT(eps))
+ call write (fd, BUF(eps,1), EPS_BCNT(eps) / SZB_CHAR)
+ #call aclrc (BUF(eps,1), SZ_EPSBUF)
+ EPS_BCNT(eps) = 1
+ }
+end
generated by cgit (git 2.34.1) at 2025-09-20 07:08:36 -0400