aboutsummaryrefslogtreecommitdiff
path: root/pkg/dataio/export/bltins
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/dataio/export/bltins')
-rw-r--r--pkg/dataio/export/bltins/exeps.x537
-rw-r--r--pkg/dataio/export/bltins/exgif.x557
-rw-r--r--pkg/dataio/export/bltins/exiraf.x110
-rw-r--r--pkg/dataio/export/bltins/exmiff.x81
-rw-r--r--pkg/dataio/export/bltins/expgm.x47
-rw-r--r--pkg/dataio/export/bltins/exppm.x49
-rw-r--r--pkg/dataio/export/bltins/exras.x117
-rw-r--r--pkg/dataio/export/bltins/exrgb.x74
-rw-r--r--pkg/dataio/export/bltins/exvicar.x111
-rw-r--r--pkg/dataio/export/bltins/exxwd.x253
-rw-r--r--pkg/dataio/export/bltins/mkpkg20
11 files changed, 1956 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
diff --git a/pkg/dataio/export/bltins/exgif.x b/pkg/dataio/export/bltins/exgif.x
new file mode 100644
index 00000000..462b70e4
--- /dev/null
+++ b/pkg/dataio/export/bltins/exgif.x
@@ -0,0 +1,557 @@
+include <mach.h>
+include <fset.h>
+include <evvexpr.h>
+include "../export.h"
+include "../exbltins.h"
+
+
+define SZ_GIFSTRUCT 30
+
+define GIF_INIT_BITS Memi[$1] # initial number of bits
+define GIF_MAXCODE Memi[$1+1] # max output code
+define GIF_FREE_ENT Memi[$1+2] # first unused entry
+define GIF_OFFSET Memi[$1+3] # offset into output buffer
+define GIF_IN_COUNT Memi[$1+4] # length of input
+define GIF_CUR_BITS Memi[$1+5] # current no. bits in code
+define GIF_N_BITS Memi[$1+6] # no. of max bits
+define GIF_CUR_ACCUM Memi[$1+7] # current accumulator
+define GIF_A_COUNT Memi[$1+8] # no. of chars in 'packet'
+define GIF_CLEAR_CODE Memi[$1+9] # clear hash table code
+define GIF_EOF_CODE Memi[$1+10] # EOF code
+define GIF_CLEAR_FLAG Memi[$1+11] # hash table has been cleared?
+define GIF_CURX Memi[$1+12] # current 'x' position in image
+define GIF_CURY Memi[$1+13] # current 'y' position in image
+define GIF_PASS Memi[$1+14] # interlacing pass number
+define GIF_WIDTH Memi[$1+15] # width of output image
+define GIF_HEIGHT Memi[$1+16] # height of output image
+define GIF_EXPNUM Memi[$1+17] # expression we're evaluating
+define GIF_LNUM Memi[$1+18] # line w/in that expression
+define GIF_NPIX Memi[$1+19] # no. of pixels to process
+define GIF_PERCENT Memi[$1+20] # percent of file completed
+
+define GIF_CDPTR Memi[$1+25] # compressed data (ptr)
+define GIF_HPTR Memi[$1+26] # hash table (ptr)
+define GIF_APTR Memi[$1+27] # packet accumulator (ptr)
+define GIF_DPTR Memi[$1+28] # expression data (ptr)
+define GIF_CPTR Memi[$1+29] # code table (ptr)
+
+define ACCUM Mems[GIF_APTR($1)+$2]
+define HTAB Memi[GIF_HPTR($1)+$2]
+define CODETAB Memi[GIF_CPTR($1)+$2]
+define DATA Mems[GIF_DPTR($1)+$2-1]
+define CDATA Mems[GIF_CDPTR($1)+$2]
+
+define HSIZE 5003 # 80% occupancy
+define USE_INTERLACE true # Write interlaced GIF files?
+
+#----------------------------------------------------------------------------
+define INTERLACE 040X # Image descriptor flags
+define GLOBAL_COLORMAP 080X
+define LOCAL_COLORMAP 080X # (currently unused)
+
+# Define the flags for the GIF89a extension blocks (currently unused).
+define GE_PLAINTEXT 001X # Plain Text Extension
+define GE_APPLICATION 0FFX # Application Extension
+define GE_COMMENT 0FEX # Comment Extension
+define GE_GCONTROL 0F9X # Graphics Control Extension
+
+
+# EX_GIF - Write the output image to a GIF 87a file.
+
+procedure ex_gif (ex)
+
+pointer ex #i task struct pointer
+
+pointer gif
+int nbytes, flags
+
+char ch[2]
+int or()
+
+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))
+ call error (7, "Invalid number of expressions for GIF file.")
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call error (7, "Line storage illegal for GIF file.")
+
+ # Fix the output pixel type to single bytes.
+ call ex_do_outtype (ex, "b1")
+ EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY)
+
+ # Allocate the gif structure.
+ iferr {
+ call calloc (gif, SZ_GIFSTRUCT, TY_STRUCT)
+ call calloc (GIF_APTR(gif), 257, TY_SHORT)
+ call calloc (GIF_HPTR(gif), HSIZE, TY_INT)
+ call calloc (GIF_CPTR(gif), HSIZE, TY_INT)
+ call calloc (GIF_DPTR(gif), max(256,EX_OCOLS(ex)), TY_SHORT)
+ call calloc (GIF_CDPTR(gif), (2*EX_OROWS(ex)*EX_OCOLS(ex)),TY_SHORT)
+ } then
+ call error (0, "Error allocating gif structure.")
+
+ GIF_WIDTH(gif) = EX_OCOLS(ex)
+ GIF_HEIGHT(gif) = EX_OROWS(ex)
+ GIF_NPIX(gif) = EX_OROWS(ex) * EX_OCOLS(ex)
+ GIF_CURX(gif) = 1
+ GIF_CURY(gif) = 0
+ GIF_PASS(gif) = 1
+ GIF_EXPNUM(gif) = EX_NEXPR(ex)
+ GIF_LNUM(gif) = GIF_HEIGHT(gif)
+
+ # Write the header information.
+ call gif_wheader (ex, EX_FD(ex))
+
+ # Start processing the expressions and write compressed image data.
+ call gif_compress (ex, gif, EX_FD(ex))
+
+ # Write the GIF file terminator and dump the whole thing to disk.
+ if (mod(GIF_OFFSET(gif),2) == 1) {
+ CDATA(gif,GIF_OFFSET(gif)) = '\0'
+ GIF_OFFSET(gif) = GIF_OFFSET(gif) + 1
+ ch[1] = ';'
+ ch[2] = ';'
+ nbytes = (GIF_OFFSET(gif) + 1) / SZB_CHAR
+ } else {
+ ch[1] = '\0'
+ ch[2] = ';'
+ nbytes = GIF_OFFSET(gif) / SZB_CHAR
+ }
+ call achtsb (CDATA(gif,0), CDATA(gif,0), GIF_OFFSET(gif))
+ call write (EX_FD(ex), CDATA(gif,0), nbytes)
+ call achtsb (ch, ch, 2)
+ call write (EX_FD(ex), ch, 1)
+
+ # Clean up the pointers.
+ call mfree (GIF_APTR(gif), TY_SHORT)
+ call mfree (GIF_DPTR(gif), TY_SHORT)
+ call mfree (GIF_CDPTR(gif), TY_SHORT)
+ call mfree (GIF_HPTR(gif), TY_INT)
+ call mfree (GIF_CPTR(gif), TY_INT)
+ call mfree (gif, TY_STRUCT)
+end
+
+
+# GIF_WHEADER - Write the GIF header information. This covers not only the
+# global file header but all the preliminary stuff up until the actual image
+# data
+
+procedure gif_wheader (ex, fd)
+
+pointer ex #i tast struct pointer
+int fd #i output file descriptor
+
+char sig[7] # GIF signature
+char lsd[772] # Screen and Color Map information
+short SWidth, SHeight # Screen width and height
+
+short stmp
+int i, j
+
+int shifti(), ori()
+
+define GIF_SIGNATURE "GIF87a"
+
+begin
+ fd = EX_FD(ex)
+
+ # Write the GIF signature. This is technically the "header", following
+ # this are the scene/color/image descriptors.
+ call strcpy (GIF_SIGNATURE, sig, 7)
+ call strpak (sig, sig, 7)
+ call write (fd, sig, 7/SZB_CHAR)
+
+ # Logical Screen Descriptor.
+ SWidth = EX_OCOLS(ex)
+ SHeight = EX_OROWS(ex)
+ call gif_putword (fd, SWidth)
+ call gif_putword (fd, SHeight)
+
+ # Set the 'packed' flags and write it out
+ i = 0
+ i = ori (i, GLOBAL_COLORMAP) # indicate a colormap
+ i = ori (i, (shifti(7, 4))) # color resolution
+ i = ori (i, (8-1)) # bits per pixel
+ lsd[1] = i # packed flags
+ lsd[2] = 0 # background color
+ lsd[3] = 0 # aspect ratio
+ lsd[4] = 0 # filler expansion byte
+
+ # Write out the colormap.
+ if (EX_CMAP(ex) != NULL) {
+ j = 1
+ for (i=4 ; i <= 772; i=i+3) {
+ lsd[i ] = CMAP(EX_CMAP(ex), EX_RED, j)
+ lsd[i+1] = CMAP(EX_CMAP(ex), EX_GREEN, j)
+ lsd[i+2] = CMAP(EX_CMAP(ex), EX_BLUE, j)
+ j = j + 1
+ }
+ } else {
+ j = 0
+ for (i=4 ; i <= 772; i=i+3) {
+ lsd[i ] = j
+ lsd[i+1] = j
+ lsd[i+2] = j
+ j = j + 1
+ }
+ }
+ lsd[772] = ','
+ call achtcb (lsd, lsd, 772)
+ call write (fd, lsd, 772/SZB_CHAR)
+
+ # Write the image header.
+ stmp = 0
+ call gif_putword (fd, stmp)
+ call gif_putword (fd, stmp)
+ call gif_putword (fd, SWidth)
+ call gif_putword (fd, SHeight)
+
+ # Next set the interlace flag and the initial code size in the next
+ # two bytes.
+ if (USE_INTERLACE)
+ stmp = ori (shifti(INTERLACE,8), 8)
+ else
+ stmp = 8
+ if (BYTE_SWAP2 == YES)
+ call bswap2 (stmp, 1, stmp, 1, 2)
+ call write (fd, stmp, 1)
+end
+
+
+# GIF_COMPRESS - Compress the image data using a modified LZW.
+
+procedure gif_compress (ex, gif, fd)
+
+pointer ex #i tast struct pointer
+pointer gif #i gif struct pointer
+int fd #i output file descriptor
+
+long fcode
+int i, c, ent, disp
+int hsize_reg, hshift
+
+short gif_next_pixel()
+int xori(), shifti()
+
+define probe_ 99
+define nomatch_ 98
+
+begin
+ GIF_INIT_BITS(gif) = 9 # initialize
+ GIF_N_BITS(gif) = 9
+ GIF_OFFSET(gif) = 0
+ GIF_CLEAR_FLAG(gif) = NO
+ GIF_IN_COUNT(gif) = 1
+ GIF_MAXCODE(gif) = 511
+ GIF_CLEAR_CODE(gif) = 256
+ GIF_EOF_CODE(gif) = GIF_CLEAR_CODE(gif) + 1
+ GIF_FREE_ENT(gif) = GIF_CLEAR_CODE(gif) + 2
+ GIF_A_COUNT(gif) = 0
+
+ ent = gif_next_pixel (ex, gif)
+ hshift = 0
+ for (fcode = HSIZE; fcode < 65536 ; fcode = fcode * 2)
+ hshift = hshift + 1
+ hshift = 8-hshift # set hash code range bound
+
+ hsize_reg = HSIZE # clear the hash table
+ call amovki (-1, HTAB(gif,0), HSIZE)
+
+ call gif_output (fd, gif, GIF_CLEAR_CODE(gif))
+
+ # Now loop over the pixels.
+ repeat {
+ c = gif_next_pixel (ex, gif)
+ if (c == EOF)
+ break
+ GIF_IN_COUNT(gif) = GIF_IN_COUNT(gif) + 1
+
+ fcode = shifti (c, 12) + ent
+ i = xori (shifti (c, hshift), ent)
+
+ if (HTAB(gif,i) == fcode) {
+ ent = CODETAB(gif,i)
+ next
+ } else if (HTAB(gif,i) < 0) # empty slot
+ goto nomatch_
+ disp = hsize_reg - i # secondary hash (after G. Knott)
+ if (i == 0)
+ disp = 1
+
+probe_ i = i - disp
+ if (i < 0)
+ i = i + hsize_reg
+
+ if (HTAB(gif,i) == fcode) {
+ ent = CODETAB(gif,i)
+ next
+ }
+ if (HTAB(gif,i) >= 0)
+ goto probe_
+
+nomatch_ call gif_output (fd, gif, ent)
+ ent = c
+ if (GIF_FREE_ENT(gif) < 4096) {
+ CODETAB(gif,i) = GIF_FREE_ENT(gif)
+ GIF_FREE_ENT(gif) = GIF_FREE_ENT(gif) + 1
+ HTAB(gif,i) = fcode
+ } else {
+ # Clear out the hash table.
+ call amovki (-1, HTAB(gif,0), HSIZE)
+ GIF_FREE_ENT(gif) = GIF_CLEAR_CODE(gif) + 2
+ GIF_CLEAR_FLAG(gif) = YES
+ call gif_output (fd, gif, GIF_CLEAR_CODE(gif))
+ }
+ }
+
+ # Write out the final code.
+ call gif_output (fd, gif, ent)
+ call gif_output (fd, gif, GIF_EOF_CODE(gif))
+end
+
+
+# GIF_NEXT_PIXEL - Writes a 16-bit integer in GIF order (LSB first).
+
+short procedure gif_next_pixel (ex, gif)
+
+pointer ex #i tast struct pointer
+pointer gif #i gif struct pointer
+
+short pix
+pointer op, out
+pointer ex_chtype(), ex_evaluate()
+
+begin
+ if (GIF_NPIX(gif) == 0)
+ return (EOF)
+
+ # If the current X position is at the start of a line get the new
+ # data, otherwise just return what we already know.
+ pix = 1
+ if (GIF_CURX(gif) == 1) {
+ call ex_getpix (ex, GIF_LNUM(gif))
+ op = ex_evaluate (ex, O_EXPR(ex,GIF_EXPNUM(gif)))
+ out = ex_chtype (ex, op, TY_UBYTE)
+ call aclrs (DATA(gif,1), O_LEN(op))
+ call achtbu (Memc[out], DATA(gif,1), O_LEN(op))
+ call mfree (out, TY_CHAR)
+ call evvfree (op)
+ }
+ pix = DATA(gif,GIF_CURX(gif))
+
+ # Increment the position.
+ if (GIF_CURY(gif) == EX_OROWS(ex)) {
+ GIF_CURX(gif) = min (EX_OCOLS(ex), GIF_CURX(gif) + 1)
+ } else
+ call gif_bump_pixel (ex, gif)
+
+ GIF_NPIX(gif) = GIF_NPIX(gif) - 1
+ return (pix)
+end
+
+
+# GIF_BUMP_PIXEL - Update the current x and y values for interlacing.
+
+procedure gif_bump_pixel (ex, gif)
+
+pointer ex #i tast struct pointer
+pointer gif #i gif struct pointer
+
+int i, row, sum
+
+begin
+ GIF_CURX(gif) = GIF_CURX(gif) + 1
+
+ # If we are at the end of a scan line, set curx back to the beginning
+ # Since we are interlaced, bump the cury to the appropriate spot.
+
+ if (GIF_CURX(gif) > GIF_WIDTH(gif)) {
+ GIF_CURX(gif) = 1
+
+ if (USE_INTERLACE) {
+ switch (GIF_PASS(gif)) {
+ case 1:
+ GIF_CURY(gif) = GIF_CURY(gif) + 8
+ if (GIF_CURY(gif) >= GIF_HEIGHT(gif)) {
+ GIF_PASS(gif) = GIF_PASS(gif) + 1
+ GIF_CURY(gif) = 4
+ }
+ case 2:
+ GIF_CURY(gif) = GIF_CURY(gif) + 8
+ if (GIF_CURY(gif) >= GIF_HEIGHT(gif)) {
+ GIF_PASS(gif) = GIF_PASS(gif) + 1
+ GIF_CURY(gif) = 2
+ }
+ case 3:
+ GIF_CURY(gif) = GIF_CURY(gif) + 4
+ if (GIF_CURY(gif) >= GIF_HEIGHT(gif)) {
+ GIF_PASS(gif) = GIF_PASS(gif) + 1
+ GIF_CURY(gif) = 1
+ }
+ case 4:
+ GIF_CURY(gif) = GIF_CURY(gif) + 2
+ if (GIF_CURY(gif) >= GIF_HEIGHT(gif)) {
+ GIF_EXPNUM(gif) = EX_NEXPR(ex)
+ GIF_LNUM(gif) = EX_OROWS(ex)
+ GIF_CURY(gif) = GIF_HEIGHT(gif)
+ return
+ }
+ }
+
+ # Now figure out where we are in the expressions.
+ i = EX_NEXPR(ex)
+ sum = GIF_HEIGHT(gif)
+ while (sum >= GIF_CURY(gif)) {
+ sum = sum - O_HEIGHT(ex,i)
+ i = i - 1
+ }
+ GIF_EXPNUM(gif) = i + 1
+ GIF_LNUM(gif) = (sum + O_HEIGHT(ex,i+1)) - GIF_CURY(gif) + 1
+
+ row = ((EX_OROWS(ex) * EX_OCOLS(ex)) - GIF_NPIX(gif)) /
+ EX_OCOLS(ex)
+ #if (EX_VERBOSE(ex) == YES)
+ call ex_pstat (ex, row, GIF_PERCENT(gif))
+
+ } else {
+ GIF_CURY(gif) = GIF_CURY(gif) + 1
+
+ # Now figure out where we are in the expressions.
+ i = EX_NEXPR(ex)
+ sum = GIF_HEIGHT(gif)
+ while (sum >= GIF_CURY(gif)) {
+ sum = sum - O_HEIGHT(ex,i)
+ i = i - 1
+ }
+
+ if ((i+1) == GIF_EXPNUM(gif)) {
+ GIF_LNUM(gif) = GIF_LNUM(gif) - 1
+ } else {
+ GIF_EXPNUM(gif) = i + 1
+ GIF_LNUM(gif) = O_HEIGHT(ex,i+1)
+ }
+
+ #if (EX_VERBOSE(ex) == YES)
+ call ex_pstat (ex, GIF_CURY(gif), GIF_PERCENT(gif))
+ }
+ }
+end
+
+
+# GIF_OUTPUT - Output the given code.
+
+procedure gif_output (fd, gif, code)
+
+int fd #i output file descriptor
+pointer gif #i gif struct pointer
+int code #i code to output
+
+long masks[17]
+int i
+
+int ori(), andi(), shifti()
+
+data (masks(i), i=1,5) /00000X, 00001X, 00003X, 00007X, 0000FX/
+data (masks(i), i=6,9) /0001FX, 0003FX, 0007FX, 000FFX/
+data (masks(i), i=10,13) /001FFX, 003FFX, 007FFX, 00FFFX/
+data (masks(i), i=14,17) /01FFFX, 03FFFX, 07FFFX, 0FFFFX/
+
+begin
+ GIF_CUR_ACCUM(gif) = andi(GIF_CUR_ACCUM(gif),masks[GIF_CUR_BITS(gif)+1])
+
+ if (GIF_CUR_BITS(gif) > 0)
+ GIF_CUR_ACCUM(gif) = ori (GIF_CUR_ACCUM(gif),
+ shifti (code, GIF_CUR_BITS(gif)))
+ else
+ GIF_CUR_ACCUM(gif) = code
+ GIF_CUR_BITS(gif) = GIF_CUR_BITS(gif) + GIF_N_BITS(gif)
+
+ while (GIF_CUR_BITS(gif) >= 8) {
+ call char_out (fd, gif, andi (GIF_CUR_ACCUM(gif), 0FFX))
+ GIF_CUR_ACCUM(gif) = shifti (GIF_CUR_ACCUM(gif), -8)
+ GIF_CUR_BITS(gif) = GIF_CUR_BITS(gif) - 8
+ }
+
+ # If the next entry is going to be too big for the code size then
+ # increase it if possible.
+ if (GIF_FREE_ENT(gif) > GIF_MAXCODE(gif) || GIF_CLEAR_FLAG(gif)==YES) {
+ if (GIF_CLEAR_FLAG(gif) == YES) {
+ GIF_MAXCODE(gif) = 511
+ GIF_N_BITS(gif) = 9
+ GIF_CLEAR_FLAG(gif) = NO
+ } else {
+ GIF_N_BITS(gif) = GIF_N_BITS(gif) + 1
+ if (GIF_N_BITS(gif) == 12)
+ GIF_MAXCODE(gif) = 4096
+ else
+ GIF_MAXCODE(gif) = shifti (1, GIF_N_BITS(gif)) - 1
+ }
+ }
+
+ if (code == GIF_EOF_CODE(gif)) {
+ # At EOF, write the rest of the buffer.
+ while (GIF_CUR_BITS(gif) >= 8) {
+ call char_out (fd, gif, andi (GIF_CUR_ACCUM(gif), 0FFX))
+ GIF_CUR_ACCUM(gif) = shifti (GIF_CUR_ACCUM(gif), -8)
+ GIF_CUR_BITS(gif) = GIF_CUR_BITS(gif) - 8
+ }
+
+ call flush_char (gif)
+ call flush (fd)
+ }
+end
+
+
+# GIF_PUTWORD - Writes a 16-bit integer in GIF order (LSB first).
+
+procedure gif_putword (fd, w)
+
+int fd
+short w
+
+short val
+int tmp, shifti()
+
+begin
+ # If this is a MSB-first machine swap the bytes before output.
+ if (BYTE_SWAP2 == NO) {
+ call bitpak (int(w), tmp, 9, 8)
+ call bitpak (shifti(int(w),-8), tmp, 1, 8)
+ val = tmp
+ } else
+ val = w
+
+ call write (fd, val, SZ_SHORT/SZ_CHAR)
+end
+
+
+procedure char_out (fd, gif, c)
+
+int fd #i output file descriptor
+pointer gif #i gif struct pointer
+int c #i char to output
+
+begin
+ ACCUM(gif,GIF_A_COUNT(gif)) = c
+ GIF_A_COUNT(gif) = GIF_A_COUNT(gif) + 1
+ if (GIF_A_COUNT(gif) >= 254)
+ call flush_char (gif)
+end
+
+
+procedure flush_char (gif)
+
+pointer gif #i gif struct pointer
+
+begin
+ if (GIF_A_COUNT(gif) > 0) {
+ CDATA(gif,GIF_OFFSET(gif)) = GIF_A_COUNT(gif)
+ GIF_OFFSET(gif) = GIF_OFFSET(gif) + 1
+ call amovs (ACCUM(gif,0), CDATA(gif,GIF_OFFSET(gif)),
+ GIF_A_COUNT(gif))
+ GIF_OFFSET(gif) = GIF_OFFSET(gif) + GIF_A_COUNT(gif)
+ GIF_A_COUNT(gif) = 0
+ }
+end
diff --git a/pkg/dataio/export/bltins/exiraf.x b/pkg/dataio/export/bltins/exiraf.x
new file mode 100644
index 00000000..282cf383
--- /dev/null
+++ b/pkg/dataio/export/bltins/exiraf.x
@@ -0,0 +1,110 @@
+include <imhdr.h>
+include <mach.h>
+include <evvexpr.h>
+include "../export.h"
+
+
+# EX_IRAF - Write the evaluated expressions back out as an IRAF image.
+
+procedure ex_iraf (ex)
+
+pointer ex #i task struct pointer
+
+pointer sp, imname
+pointer im, op, out
+int i, j, flags
+int line, percent, orow, type
+
+pointer ex_evaluate(), ex_chtype()
+pointer immap()
+pointer impl2s(), impl2i(), impl2l(), impl2r(), impl2d()
+int fnroot()
+
+errchk immap
+
+begin
+ # Check to see that we have the correct number of expressions.
+ flags = EX_OUTFLAGS(ex)
+ if (EX_NEXPR(ex) != 1 && !bitset(flags, OF_BAND))
+ call error (7, "Invalid number of expressions for IRAF image.")
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call error (7, "Line storage illegal for IRAF image.")
+ if (EX_OUTTYPE(ex) == TY_UBYTE)
+ call ex_do_outtype (ex, "u2")
+
+ call smark (sp)
+ call salloc (imname, SZ_FNAME, TY_CHAR)
+ call aclrc (Memc[imname], SZ_FNAME)
+
+ # Since we're writing an image, close the output file descriptor
+ # and instead use an image pointer.
+ call close (EX_FD(ex))
+ call delete (BFNAME(ex))
+ EX_FD(ex) = NULL
+
+ # Generate the image name and map it for processing.
+ if (fnroot (BFNAME(ex), Memc[imname], SZ_FNAME) == 0)
+ call error (0, "Error making image name.")
+ iferr (im = immap (Memc[imname], NEW_IMAGE, 0))
+ call error (0, "Error mapping output image.")
+
+ # Set the minimal header values.
+ IM_LEN(im,1) = EX_OCOLS(ex)
+ IM_LEN(im,2) = EX_OROWS(ex)
+ IM_NDIM(im) = 2
+ IM_PIXTYPE(im) = EX_OUTTYPE(ex)
+
+ # Finally, evaluate the expressions and write the image.
+ type = EX_OUTTYPE(ex)
+ percent = 0
+ orow = 1
+ 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.
+ out = ex_chtype (ex, op, type)
+
+ # Write evaluated pixels.
+ switch (type) {
+ case TY_USHORT, TY_SHORT:
+ call amovs (Mems[out], Mems[impl2s(im,orow)], O_LEN(op))
+ case TY_INT:
+ call amovi (Memi[out], Memi[impl2i(im,orow)], O_LEN(op))
+ case TY_LONG:
+ call amovl (Meml[out], Meml[impl2l(im,orow)], O_LEN(op))
+ case TY_REAL:
+ call amovr (Memr[out], Memr[impl2r(im,orow)], O_LEN(op))
+ case TY_DOUBLE:
+ call amovd (Memd[out], Memd[impl2d(im,orow)], O_LEN(op))
+ default:
+ call error (0, "Illegal output image type.")
+ }
+
+ # Clean up the pointers.
+ call mfree (out, type)
+ call evvfree (op)
+
+ # Print percent done if being verbose
+ orow = orow + 1
+ #if (EX_VERBOSE(ex) == YES)
+ call ex_pstat (ex, orow, percent)
+ }
+ }
+
+ call imunmap (im)
+ call sfree (sp)
+end
diff --git a/pkg/dataio/export/bltins/exmiff.x b/pkg/dataio/export/bltins/exmiff.x
new file mode 100644
index 00000000..9e5756e5
--- /dev/null
+++ b/pkg/dataio/export/bltins/exmiff.x
@@ -0,0 +1,81 @@
+include <mach.h>
+include "../export.h"
+
+
+# EX_MIFF - Write the evaluated expressions as an ImageMagick MIFF format file.
+
+procedure ex_miff (ex)
+
+pointer ex #i task struct pointer
+
+pointer sp, hdr, cmap
+int i, j, flags
+char ncols[6]
+
+int strlen()
+
+begin
+ # Check to see that we have the correct number of expressions to
+ # write this format.
+ flags = EX_OUTFLAGS(ex)
+ if (EX_NEXPR(ex) != 3 && EX_NEXPR(ex) != 1)
+ call error (7, "Invalid number of expressions for MIFF file.")
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call error (7, "Line storage illegal for MIFF file.")
+
+ # Write the header to the file.
+ call smark (sp)
+ call salloc (hdr, SZ_COMMAND, TY_CHAR)
+ call aclrc (Memc[hdr], SZ_COMMAND)
+
+ call sprintf (ncols, 6, "%d")
+ call pargi (EX_NCOLORS(ex))
+ call sprintf (Memc[hdr], SZ_COMMAND,
+ "{\nCreated by IRAF EXPORT Task\n}\nid=ImageMagick\nclass=%s %s%s\ncolumns=%-5d rows=%-5d\n\f\n:\n")
+
+ if (EX_NEXPR(ex) == 3) {
+ call pargstr ("DirectClass")
+ call pargstr ("")
+ call pargstr ("")
+ } else {
+ call pargstr ("PseudoClass")
+ if (bitset (flags,OF_CMAP)) {
+ call pargstr ("colors=")
+ call pargstr (ncols)
+ } else {
+ call pargstr ("")
+ call pargstr ("")
+ }
+ }
+ call pargi (EX_OCOLS(ex))
+ call pargi (EX_OROWS(ex))
+
+ if (mod(strlen(Memc[hdr]),2) == 1)
+ call strcat ("\n", Memc[hdr], SZ_COMMAND)
+ call strpak (Memc[hdr], Memc[hdr], SZ_COMMAND)
+ call write (EX_FD(ex), Memc[hdr], strlen(Memc[hdr])/SZB_CHAR)
+
+ # Finally, evaluate the expressions and write the image.
+ call ex_do_outtype (ex, "b1")
+ EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY)
+
+ if (bitset (flags,OF_CMAP)) {
+ # Write out the colormap.
+ call salloc (cmap, 3*CMAP_SIZE, TY_CHAR)
+ j = 1
+ do i = 0, (3*CMAP_SIZE-1), 3 {
+ Memc[cmap+i+0] = CMAP(EX_CMAP(ex), EX_RED, j)
+ Memc[cmap+i+1] = CMAP(EX_CMAP(ex), EX_GREEN, j)
+ Memc[cmap+i+2] = CMAP(EX_CMAP(ex), EX_BLUE, j)
+ j = j + 1
+ }
+ call achtcb (Memc[cmap], Memc[cmap], (3 * CMAP_SIZE))
+ call write (EX_FD(ex), Memc[cmap], ((3 * CMAP_SIZE) / SZB_CHAR))
+
+ call ex_no_interleave (ex) # write the pixels
+
+ } else
+ call ex_px_interleave (ex)
+
+ call sfree (sp)
+end
diff --git a/pkg/dataio/export/bltins/expgm.x b/pkg/dataio/export/bltins/expgm.x
new file mode 100644
index 00000000..c8a7a1d7
--- /dev/null
+++ b/pkg/dataio/export/bltins/expgm.x
@@ -0,0 +1,47 @@
+include <mach.h>
+include "../export.h"
+
+
+# EX_PGM - Write the evaluated expressions as a PGM format file.
+
+procedure ex_pgm (ex)
+
+pointer ex #i task struct pointer
+
+pointer sp, hdr
+int len, flags
+
+int strlen()
+
+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))
+ call error (7, "Invalid number of expressions for PGM file.")
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call error (7, "Line storage illegal for PGM file.")
+
+ # Write the header to the file.
+ call smark (sp)
+ call salloc (hdr, SZ_LINE, TY_CHAR)
+ call aclrc (Memc[hdr], SZ_LINE)
+
+ call sprintf (Memc[hdr], SZ_LINE, "P5\n%-6d %-6d\n255\n")
+ call pargi (EX_OCOLS(ex) - mod (EX_OCOLS(ex),2))
+ call pargi (EX_OROWS(ex))
+ len = strlen (Memc[hdr])
+ call strpak (Memc[hdr], Memc[hdr], SZ_LINE)
+ call write (EX_FD(ex), Memc[hdr], len/SZB_CHAR)
+ call sfree (sp)
+
+ # Fix the output pixel type to single bytes.
+ call ex_do_outtype (ex, "b1")
+ EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY)
+
+ # Finally, evaluate the expressions and write the image.
+ if (EX_NEXPR(ex) == 1 || bitset (flags, OF_BAND))
+ call ex_no_interleave (ex)
+ else
+ call error (7, "Shouldn't be here.")
+end
diff --git a/pkg/dataio/export/bltins/exppm.x b/pkg/dataio/export/bltins/exppm.x
new file mode 100644
index 00000000..4dab4727
--- /dev/null
+++ b/pkg/dataio/export/bltins/exppm.x
@@ -0,0 +1,49 @@
+include <mach.h>
+include "../export.h"
+
+
+# EX_PPM - Write the evaluated expressions as a PPM format file.
+
+procedure ex_ppm (ex)
+
+pointer ex #i task struct pointer
+
+pointer sp, hdr
+int len, flags
+
+int strlen()
+
+begin
+ # Check to see that we have the correct number of expressions to
+ # write this format.
+ flags = EX_OUTFLAGS(ex)
+ if (EX_NEXPR(ex) != 3)
+ call error (7, "Invalid number of expressions for PPM file.")
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call error (7, "Line storage illegal for PPM file.")
+
+ # Write the header to the file.
+ call smark (sp)
+ call salloc (hdr, SZ_LINE, TY_CHAR)
+ call aclrc (Memc[hdr], SZ_LINE)
+
+ # If we have an odd number of pixels we can't correctly write the
+ # last column to the file, so truncate the column in the output image.
+ if (mod (EX_NCOLS(ex),2) == 1)
+ EX_OCOLS(ex) = EX_OCOLS(ex) - 1
+
+ call sprintf (Memc[hdr], SZ_LINE, "P6\n%-6d %-6d\n255\n")
+ call pargi (EX_OCOLS(ex))
+ call pargi (EX_OROWS(ex))
+ len = strlen (Memc[hdr])
+ call strpak (Memc[hdr], Memc[hdr], SZ_LINE)
+ call write (EX_FD(ex), Memc[hdr], len/SZB_CHAR)
+ call sfree (sp)
+
+ # Fix the output pixel type to single bytes.
+ call ex_do_outtype (ex, "b1")
+ EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY)
+
+ # Finally, evaluate the expressions and write the image.
+ call ex_px_interleave (ex)
+end
diff --git a/pkg/dataio/export/bltins/exras.x b/pkg/dataio/export/bltins/exras.x
new file mode 100644
index 00000000..f24209c6
--- /dev/null
+++ b/pkg/dataio/export/bltins/exras.x
@@ -0,0 +1,117 @@
+include <mach.h>
+include "../export.h"
+
+
+# EXRAS.X - Source file for the EXPORT task rasterfile builtin format.
+
+define SZ_RASHDR 8
+define RAS_MAGIC 1 # Magic number
+define RAS_WIDTH 2 # Image width (pixels per line)
+define RAS_HEIGHT 3 # Image height (number of lines)
+define RAS_DEPTH 4 # Image depth (bits per pixel)
+define RAS_LENGTH 5 # Image length (bytes)
+define RAS_TYPE 6 # File type
+define RAS_MAPTYPE 7 # Colormap type
+define RAS_MAPLENGTH 8 # Colormap length (bytes)
+
+# Rasterfile magic number
+define RAS_MAGIC_NUM 59A66A95X
+define RAS_RLE 80X
+
+# Sun supported ras_types
+define RT_OLD 0 # Raw pixrect image in 68000 byte order
+define RT_STANDARD 1 # Raw pixrect image in 68000 byte order
+define RT_BYTE_ENCODED 2 # Run-length compression of bytes
+define RT_FORMAT_RGB 3 # XRGB or RGB instead of XBGR or BGR
+define RT_FORMAT_TIFF 4 # tiff <-> standard rasterfile
+define RT_FORMAT_IFF 5 # iff (TAAC format) <-> standard rasterfile
+define RT_EXPERIMENTAL 65535 # Reserved for testing
+
+# Sun supported ras_maptypes
+define RMT_NONE 0 # ras_maplength is expected to be 0
+define RMT_EQUAL_RGB 1 # red[ras_maplength/3],green[],blue[]
+define RMT_RAW 2
+
+
+
+# EX_RAS - Write the evaluated expressions as a Sun Rasterfile.
+
+procedure ex_ras (ex)
+
+pointer ex #i task struct pointer
+
+pointer sp, cmap
+long header[SZ_RASHDR]
+int i, flags
+
+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 && EX_NEXPR(ex) != 3 && EX_NEXPR(ex) != 4) {
+ if (!bitset(flags, OF_BAND))
+ call error (7, "Invalid number of expressions for rasterfile.")
+ }
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call error (7, "Line storage illegal for rasterfile.")
+
+ # Fix the output pixel type to single bytes.
+ call ex_do_outtype (ex, "b1")
+ EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY)
+
+ # Make sure the output is padded to the nearest 16-bits.
+ if (mod (O_WIDTH(ex,1),2) != 0) {
+ do i = 1, EX_NEXPR(ex) {
+ call strcat ("//repl(0,1)", O_EXPR(ex,i), SZ_EXPSTR)
+ O_WIDTH(ex,i) = O_WIDTH(ex,i) + 1
+ }
+ EX_OCOLS(ex) = EX_OCOLS(ex) + 1
+ }
+
+ # Set the header values.
+ header[RAS_MAGIC] = RAS_MAGIC_NUM
+ header[RAS_WIDTH] = EX_OCOLS(ex)
+ header[RAS_HEIGHT] = EX_OROWS(ex)
+ header[RAS_TYPE] = RT_STANDARD
+ if (EX_NEXPR(ex) == 1 || bitset (flags, OF_BAND)) {
+ header[RAS_LENGTH] = header[RAS_WIDTH] * header[RAS_HEIGHT]
+ header[RAS_DEPTH] = long (8)
+ } else {
+ header[RAS_LENGTH] = header[RAS_WIDTH] * header[RAS_HEIGHT] * 3
+ header[RAS_DEPTH] = long (24)
+ header[RAS_TYPE] = RT_FORMAT_RGB
+ }
+ if (bitset(flags, OF_CMAP)) {
+ header[RAS_MAPTYPE] = RMT_EQUAL_RGB
+ header[RAS_MAPLENGTH] = long (3*CMAP_SIZE)
+ } else {
+ header[RAS_MAPTYPE] = RMT_NONE
+ header[RAS_MAPLENGTH] = long (0)
+ }
+
+ # Write the header to the file. First swap it to Sun byte order if
+ # needed (although the format doesn't require this), then swap it
+ # if requested by the user.
+ if (BYTE_SWAP4 == YES)
+ call bswap4 (header, 1, header, 1, (SZ_RASHDR * SZ_LONG * SZB_CHAR))
+ if (EX_BSWAP(ex) == S_I4)
+ call bswap4 (header, 1, header, 1, (SZ_RASHDR * SZ_LONG * SZB_CHAR))
+ call write (EX_FD(ex), header, (SZ_RASHDR * SZ_LONG))
+
+ # If we have a colormap write that out now.
+ if (bitset(flags, OF_CMAP)) {
+ call smark (sp)
+ call salloc (cmap, 3*CMAP_SIZE, TY_CHAR)
+
+ call achtcb (Memc[EX_CMAP(ex)], Memc[cmap], (3 * CMAP_SIZE))
+ call write (EX_FD(ex), Memc[cmap], ((3 * CMAP_SIZE) / SZB_CHAR))
+
+ call sfree (sp)
+ }
+
+ # Finally, evaluate the expressions and write the image.
+ if (EX_NEXPR(ex) == 1 || bitset (flags, OF_BAND))
+ call ex_no_interleave (ex)
+ else if (EX_NEXPR(ex) == 3 || EX_NEXPR(ex) == 4)
+ call ex_px_interleave (ex)
+end
diff --git a/pkg/dataio/export/bltins/exrgb.x b/pkg/dataio/export/bltins/exrgb.x
new file mode 100644
index 00000000..119168e6
--- /dev/null
+++ b/pkg/dataio/export/bltins/exrgb.x
@@ -0,0 +1,74 @@
+include <mach.h>
+include "../export.h"
+include "../exbltins.h"
+
+
+define IMAGIC 0732B # SGI magic number
+define BPPMASK 00FFX
+define ITYPE_VERBATIM 0001X
+define ITYPE_RLE 0100X
+
+
+# EX_RGB - Write the output image to an SGI RGB format file.
+
+procedure ex_rgb (ex)
+
+pointer ex #i task struct pointer
+
+int i, fd
+short imagic, type, dim # stuff saved on disk
+short xsize, ysize, zsize, pad
+long min, max
+char name[80]
+
+begin
+ # Check to see that we have the correct number of expressions to
+ # write this format.
+ if (EX_NEXPR(ex) != 3)
+ call error (7, "Invalid number of expressions for SGI RGB.")
+
+ # Fix up the number of output rows.
+ EX_OROWS(ex) = EX_NLINES(ex) * EX_NEXPR(ex)
+
+ # Load the image header values
+ imagic = IMAGIC
+ type = ITYPE_VERBATIM
+ if (EX_NEXPR(ex) >= 3 && !bitset (EX_OUTFLAGS(ex),OF_BAND)) {
+ dim = 3
+ zsize = 3
+ } else {
+ dim = 2
+ zsize = 1
+ }
+ xsize = EX_OCOLS(ex)
+ ysize = EX_NLINES(ex)
+ min = 0
+ max = 255
+ call aclrc (name, 80)
+ call strcpy ("no name", name, 80)
+ call achtcb (name, name, 80)
+
+ # Write the header values to the output file.
+ fd = EX_FD(ex)
+ call write (fd, imagic, SZ_SHORT / SZ_CHAR)
+ call write (fd, type, SZ_SHORT / SZ_CHAR)
+ call write (fd, dim, SZ_SHORT / SZ_CHAR)
+ call write (fd, xsize, SZ_SHORT / SZ_CHAR)
+ call write (fd, ysize, SZ_SHORT / SZ_CHAR)
+ call write (fd, zsize, SZ_SHORT / SZ_CHAR)
+ call write (fd, min, SZ_LONG / SZ_CHAR)
+ call write (fd, max, SZ_LONG / SZ_CHAR)
+ call write (fd, 0, SZ_LONG / SZ_CHAR)
+ call write (fd, name, 8 / SZB_CHAR)
+
+ # Pad to a 512 byte header.
+ pad = 0
+ do i = 1, 240
+ call write (fd, pad, SZ_SHORT / SZ_CHAR)
+
+ # Fix the output parameters.
+ call ex_do_outtype (ex, "b1")
+
+ # Write it out.
+ call ex_no_interleave (ex)
+end
diff --git a/pkg/dataio/export/bltins/exvicar.x b/pkg/dataio/export/bltins/exvicar.x
new file mode 100644
index 00000000..31c8360f
--- /dev/null
+++ b/pkg/dataio/export/bltins/exvicar.x
@@ -0,0 +1,111 @@
+include <mach.h>
+include "../export.h"
+
+
+define SZ_VICHDR 1024
+
+
+# EX_VICAR - Write the evaluated expressions as a VICAR2 format file.
+
+procedure ex_vicar (ex)
+
+pointer ex #i task struct pointer
+
+pointer sp, hdr, user, date, arch
+int i, flags
+char space
+
+int envfind(), strncmp(), strlen()
+long clktime()
+
+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))
+ call error (7, "Invalid number of expressions for VICAR file.")
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call error (7, "Line storage illegal for VICAR file.")
+
+ # Write the header to the file.
+ call smark (sp)
+ call salloc (hdr, SZ_VICHDR, TY_CHAR)
+ call salloc (user, SZ_FNAME, TY_CHAR)
+ call salloc (date, SZ_FNAME, TY_CHAR)
+ call salloc (arch, SZ_FNAME, TY_CHAR)
+
+ space = ' '
+ call amovkc (space, Memc[hdr], SZ_VICHDR)
+ call aclrc (Memc[user], SZ_FNAME)
+ call aclrc (Memc[date], SZ_FNAME)
+ call aclrc (Memc[arch], SZ_FNAME)
+
+ # Header keywords:
+ call getuid (Memc[user], SZ_FNAME)
+ call cnvtime (clktime(long(0)), Memc[date], SZ_FNAME)
+ call sprintf (Memc[hdr], SZ_VICHDR,
+ "LBLSIZE=%d FORMAT='%s' TYPE='IMAGE' BUFSIZ=20480 DIM=3 EOL=0 RECSIZE=%d ORG='%s' NL=%d NS=%d NB=%d N1=%d N2=%d N3=%d N4=0 NBB=0 NLB=0 INTFMT='%s' REALFMT='%s' TASK='EXPORT' USER='%s' DAT_TIM='%s' ")
+
+ call pargi (SZ_VICHDR) # LBLSIZE
+ switch (EX_OUTTYPE(ex)) { # FORMAT
+ case TY_UBYTE: call pargstr ("BYTE")
+ case TY_SHORT: call pargstr ("HALF")
+ case TY_INT: call pargstr ("FULL")
+ case TY_LONG: call pargstr ("FULL")
+ case TY_REAL: call pargstr ("REAL")
+ case TY_DOUBLE: call pargstr ("DOUB")
+ }
+ call pargi (EX_OCOLS(ex)) # RECSIZE
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call pargstr ("BIL") # ORG
+ else
+ call pargstr ("BSQ")
+ call pargi (EX_OROWS(ex)) # NL
+ call pargi (EX_OCOLS(ex)) # NS
+ call pargi (EX_NEXPR(ex)) # NB
+ call pargi (EX_OCOLS(ex)) # N1
+ call pargi (EX_OROWS(ex)) # N2
+ call pargi (EX_NEXPR(ex)) # N3
+ if (BYTE_SWAP2 == NO)
+ call pargstr ("HIGH") # INTFMT
+ else
+ call pargstr ("LOW")
+ if (IEEE_USED == YES) { # REALFMT
+ if (envfind ("arch", Memc[arch], SZ_FNAME) != ERR) {
+ # If this is a DECstation we have a different IEEE.
+ if (strncmp(Memc[arch], ".d", 2) == 0)
+ call pargstr ("RIEEE")
+ else
+ call pargstr ("IEEE")
+ }
+ } else {
+ # Assume it's a VAX.
+ call pargstr ("VAX")
+ }
+ call pargstr (Memc[user]) # USER
+ call pargstr (Memc[date]) # DAT_TIM
+
+ i = SZ_VICHDR
+ while (Memc[hdr+i-1] != EOS && i > 0)
+ i = i - 1
+ Memc[hdr+i-1] = ' '
+
+ call strpak (Memc[hdr], Memc[hdr], SZ_VICHDR)
+ call write (EX_FD(ex), Memc[hdr], strlen(Memc[hdr])/SZB_CHAR)
+ call sfree (sp)
+
+ # Fix the output pixel type to single bytes.
+ switch (EX_OUTTYPE(ex)) {
+ case TY_UBYTE: call ex_do_outtype (ex, "b1")
+ case TY_SHORT: call ex_do_outtype (ex, "i2")
+ case TY_INT: call ex_do_outtype (ex, "i4")
+ case TY_LONG: call ex_do_outtype (ex, "i4")
+ case TY_REAL: call ex_do_outtype (ex, "n4")
+ case TY_DOUBLE: call ex_do_outtype (ex, "n8")
+ }
+ EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY)
+
+ # Finally, evaluate the expressions and write the image.
+ if (EX_NEXPR(ex) == 1 || bitset (flags, OF_BAND))
+ call ex_no_interleave (ex)
+end
diff --git a/pkg/dataio/export/bltins/exxwd.x b/pkg/dataio/export/bltins/exxwd.x
new file mode 100644
index 00000000..08c4609a
--- /dev/null
+++ b/pkg/dataio/export/bltins/exxwd.x
@@ -0,0 +1,253 @@
+include <mach.h>
+include "../export.h"
+include "../exbltins.h"
+
+
+define X11WD_FILE_VERSION 7 # XWD version
+define SZ_XWD 25 # number of header elements
+define SZ_XWDHEADER 100 # size of header record (bytes)
+
+# Define the header structure.
+define X_HEADER_SIZE Meml[$1] # Size of the header (bytes)
+define X_FILE_VERSION Meml[$1+1] # XWD_FILE_VERSION
+define X_PIXMAP_FORMAT Meml[$1+2] # Pixmap format
+define X_PIXMAP_DEPTH Meml[$1+3] # Pixmap depth
+define X_PIXMAP_WIDTH Meml[$1+4] # Pixmap width
+define X_PIXMAP_HEIGHT Meml[$1+5] # Pixmap height
+define X_XOFFSET Meml[$1+6] # Bitmap x offset
+define X_BYTE_ORDER Meml[$1+7] # MSBFirst, LSBFirst
+define X_BITMAP_UNIT Meml[$1+8] # Bitmap unit
+define X_BITMAP_BIT_ORDER Meml[$1+9] # MSBFirst, LSBFirst
+define X_BITMAP_PAD Meml[$1+10] # Bitmap scanline pad
+define X_BITS_PER_PIXEL Meml[$1+11] # Bits per pixel
+define X_BYTES_PER_LINE Meml[$1+12] # Bytes per scanline
+define X_VISUAL_CLASS Meml[$1+13] # Class of colormap
+define X_RED_MASK Meml[$1+14] # Z red mask
+define X_GREEN_MASK Meml[$1+15] # Z green mask
+define X_BLUE_MASK Meml[$1+16] # Z blue mask
+define X_BITS_PER_RGB Meml[$1+17] # Log2 of distinct color values
+define X_COLORMAP_ENTRIES Meml[$1+18] # Number of entries in colormap
+define X_NCOLORS Meml[$1+19] # Number of Color structures
+define X_WINDOW_WIDTH Meml[$1+20] # Window width
+define X_WINDOW_HEIGHT Meml[$1+21] # Window height
+define X_WINDOW_X Meml[$1+22] # Window upper left X coordinate
+define X_WINDOW_Y Meml[$1+23] # Window upper left Y coordinate
+define X_WINDOW_BDRWIDTH Meml[$1+24] # Window border width
+
+define LSBFirst 0 # Byte order flags
+define MSBFirst 1
+
+define XYBitmap 0 # Pixmap types
+define XYPixmap 1
+define ZPixmap 2
+
+define StaticGray 0 # Recognized visuals
+define GrayScale 1
+define StaticColor 2
+define PseudoColor 3
+define TrueColor 4
+define DirectColor 5
+
+define DEBUG false
+
+
+# EX_XWD - Write the output image to an X11 Window Dump file.
+
+procedure ex_xwd (ex)
+
+pointer ex #i task struct pointer
+
+pointer xwd, cmap
+char cflags, fname[SZ_FNAME]
+int i, fd, flags
+long pixel
+short r, g, b, val
+
+int strlen()
+
+begin
+ # Check to see that we have the correct number of expressions to
+ # write this format.
+ flags = EX_OUTFLAGS(ex)
+ fd = EX_FD(ex)
+ if (EX_NEXPR(ex) != 1 && EX_NEXPR(ex) != 3 && EX_NEXPR(ex) != 4) {
+ if (!bitset(flags, OF_BAND))
+ call error (7, "Invalid number of expressions for XWD.")
+ }
+ if (bitset(flags, OF_LINE) || bitset (flags, LINE_STORAGE))
+ call error (7, "Line storage illegal for XWD.")
+
+ # Fix the output pixel type to single bytes.
+ call ex_do_outtype (ex, "b1")
+ EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY)
+
+ # Allocate space for the header.
+ iferr (call calloc (xwd, SZ_XWD, TY_STRUCT))
+ call error (0, "Error allocate XWD structure.")
+
+ # Set up the header values.
+ flags = EX_OUTFLAGS(ex)
+ X_HEADER_SIZE(xwd) = SZ_XWDHEADER + strlen ("xwddump") + 1
+ X_FILE_VERSION(xwd) = X11WD_FILE_VERSION
+ X_PIXMAP_FORMAT(xwd) = ZPixmap
+ X_PIXMAP_WIDTH(xwd) = EX_OCOLS(ex)
+ X_PIXMAP_HEIGHT(xwd) = EX_OROWS(ex)
+ X_XOFFSET(xwd) = 0
+ X_BYTE_ORDER(xwd) = MSBFirst
+ X_BITMAP_BIT_ORDER(xwd) = MSBFirst
+ X_WINDOW_WIDTH(xwd) = EX_OCOLS(ex)
+ X_WINDOW_HEIGHT(xwd) = EX_OROWS(ex)
+ X_WINDOW_X(xwd) = 0
+ X_WINDOW_Y(xwd) = 0
+ X_WINDOW_BDRWIDTH(xwd) = 0
+
+ if (EX_NEXPR(ex) >= 3) {
+ if (DEBUG) call eprintf ("We think this is a DirectColor image.\n")
+ X_PIXMAP_DEPTH(xwd) = 24
+ X_BITMAP_UNIT(xwd) = 32
+ X_BITMAP_PAD(xwd) = 32
+ X_BITS_PER_PIXEL(xwd) = 32
+ X_VISUAL_CLASS(xwd) = DirectColor
+ X_COLORMAP_ENTRIES(xwd) = 256
+ X_NCOLORS(xwd) = 0
+ X_RED_MASK(xwd) = 0FF0000X
+ X_GREEN_MASK(xwd) = 0FF00X
+ X_BLUE_MASK(xwd) = 0FFX
+ X_BYTES_PER_LINE(xwd) = EX_OCOLS(ex) * 4
+ } else if (bitset (flags, OF_CMAP)) {
+ if (DEBUG) call eprintf ("We think this has a colormap.\n")
+ X_PIXMAP_DEPTH(xwd) = 8
+ X_BITS_PER_PIXEL(xwd) = 8
+ X_COLORMAP_ENTRIES(xwd) = EX_NCOLORS(ex)
+ X_NCOLORS(xwd) = EX_NCOLORS(ex)
+ X_BYTES_PER_LINE(xwd) = EX_OCOLS(ex)
+
+ X_BITMAP_UNIT(xwd) = 8
+ X_BITMAP_PAD(xwd) = 8
+ X_VISUAL_CLASS(xwd) = StaticGray
+ X_RED_MASK(xwd) = 0
+ X_GREEN_MASK(xwd) = 0
+ X_BLUE_MASK(xwd) = 0
+ } else {
+ if (DEBUG) call eprintf ("Pseudocolor.\n")
+ X_PIXMAP_DEPTH(xwd) = 8
+ X_BITS_PER_PIXEL(xwd) = 8
+ X_VISUAL_CLASS(xwd) = PseudoColor
+ X_COLORMAP_ENTRIES(xwd) = 255 + 1
+ X_NCOLORS(xwd) = EX_NCOLORS(ex)
+ X_RED_MASK(xwd) = 0
+ X_GREEN_MASK(xwd) = 0
+ X_BLUE_MASK(xwd) = 0
+ X_BYTES_PER_LINE(xwd) = EX_OCOLS(ex)
+ X_BITMAP_UNIT(xwd) = 8
+ X_BITMAP_PAD(xwd) = 8
+ }
+ X_BITS_PER_RGB(xwd) = X_PIXMAP_DEPTH(xwd)
+
+ # See if we need to byte swap in order to get MSB byte ordering.
+ if (BYTE_SWAP4 == YES)
+ call bswap4 (Meml[xwd], 1, Meml[xwd], 1, SZ_XWDHEADER)
+ if (EX_BSWAP(ex) == S_I4)
+ call bswap4 (Meml[xwd], 1, Meml[xwd], 1, SZ_XWDHEADER)
+ call write (fd, Meml[xwd], SZ_XWDHEADER/SZB_CHAR)
+ call strpak ("xwddump\0", fname, 8)
+ call write (fd, fname, 4)
+
+ # If we have a colormap set up the structure and write it out.
+ if (bitset (flags, OF_CMAP)) {
+ cmap = EX_CMAP(ex)
+ cflags = 0
+ do i = 1, EX_NCOLORS(ex) {
+ pixel = i - 1
+ r = CMAP(cmap,EX_RED,i) * 65535 / 256
+ g = CMAP(cmap,EX_GREEN,i) * 65535 / 256
+ b = CMAP(cmap,EX_BLUE,i) * 65535 / 256
+
+ call xwd_putlong (ex, fd, pixel)
+ call xwd_putword (ex, fd, r)
+ call xwd_putword (ex, fd, g)
+ call xwd_putword (ex, fd, b)
+ call xwd_putword (ex, fd, cflags)
+ }
+ } else if (EX_NEXPR(ex) < 3) {
+ do i = 0, 255 {
+ val = i * 65535 / 256
+ call xwd_putlong (ex, fd, long(i))
+ call xwd_putword (ex, fd, val)
+ call xwd_putword (ex, fd, val)
+ call xwd_putword (ex, fd, val)
+ val = 0 #shifti (7, 8)
+ call xwd_putword (ex, fd, val)
+ }
+ }
+
+ # Finally, evaluate the expressions and write the image.
+ if (EX_NEXPR(ex) == 1 || bitset (flags, OF_BAND))
+ call ex_no_interleave (ex)
+ else if (EX_NEXPR(ex) == 3) {
+ # If all they gave were the RGB values we need to patch the
+ # outbands expressions to stick in an alpha channel. Patch it
+ # up here.
+
+ call ex_alloc_outbands (OBANDS(ex,4))
+ do i = 4, 2, -1 {
+ call strcpy (O_EXPR(ex,i-1), O_EXPR(ex,i), SZ_EXPSTR)
+ O_WIDTH(ex,i) = O_WIDTH(ex,i-1)
+ O_HEIGHT(ex,i) = O_HEIGHT(ex,i-1)
+ }
+ call strcpy ("0", O_EXPR(ex,1), SZ_EXPSTR)
+ EX_NEXPR(ex) = 4
+ call ex_px_interleave (ex)
+
+ } else if (EX_NEXPR(ex) >= 3)
+ call ex_px_interleave (ex)
+
+ # Clean up.
+ call mfree (xwd, TY_STRUCT)
+end
+
+
+# XWD_PUTWORD - Writes a 16-bit integer in XWD order (MSB first).
+
+procedure xwd_putword (ex, fd, w)
+
+pointer ex #i task struct pointer
+int fd
+short w
+
+short val
+
+begin
+ # If this is a MSB-first machine swap the bytes before output.
+ if (BYTE_SWAP2 == YES)
+ call bswap2 (w, 1, val, 1, (SZ_SHORT * SZB_CHAR))
+ else
+ val = w
+ if (EX_BSWAP(ex) == S_I2)
+ call bswap2 (val, 1, val, 1, (SZ_SHORT * SZB_CHAR))
+
+ call write (fd, val, SZ_SHORT/SZ_CHAR)
+end
+
+
+# XWD_PUTLONG - Writes a 32-bit integer in XWD order (MSB first).
+
+procedure xwd_putlong (ex, fd, w)
+
+pointer ex #i task struct pointer
+int fd
+long w
+
+long val
+
+begin
+ # If this is a MSB-first machine swap the bytes before output.
+ if (BYTE_SWAP4 == YES)
+ call bswap4 (w, 1, val, 1, (SZ_LONG * SZB_CHAR))
+ else
+ val = w
+ if (EX_BSWAP(ex) == S_I4)
+ call bswap4 (val, 1, val, 1, (SZ_LONG * SZB_CHAR))
+
+ call write (fd, val, SZ_LONG/SZ_CHAR)
+end
diff --git a/pkg/dataio/export/bltins/mkpkg b/pkg/dataio/export/bltins/mkpkg
new file mode 100644
index 00000000..14e6b8d4
--- /dev/null
+++ b/pkg/dataio/export/bltins/mkpkg
@@ -0,0 +1,20 @@
+# Mkpkg file for building the EXPORT task builtin formats.
+
+$checkout libpkg.a ../
+$update libpkg.a
+$checkin libpkg.a ../
+$exit
+
+libpkg.a:
+ exeps.x ../exbltins.h ../export.h \
+ <evvexpr.h> <fset.h> <imhdr.h> <mach.h>
+ exgif.x ../exbltins.h ../export.h <evvexpr.h> <fset.h> <mach.h>
+ exiraf.x ../export.h <evvexpr.h> <imhdr.h> <mach.h>
+ exmiff.x ../export.h <mach.h>
+ expgm.x ../export.h <mach.h>
+ exppm.x ../export.h <mach.h>
+ exras.x ../export.h <mach.h>
+ exrgb.x ../exbltins.h ../export.h <mach.h>
+ exvicar.x ../export.h <mach.h>
+ exxwd.x ../exbltins.h ../export.h <mach.h>
+ ;
generated by cgit (git 2.34.1) at 2025-09-20 07:10:30 -0400