From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/dataio/export/Notes | 37 ++ pkg/dataio/export/bltins/exeps.x | 537 ++++++++++++++++ pkg/dataio/export/bltins/exgif.x | 557 ++++++++++++++++ pkg/dataio/export/bltins/exiraf.x | 110 ++++ pkg/dataio/export/bltins/exmiff.x | 81 +++ pkg/dataio/export/bltins/expgm.x | 47 ++ pkg/dataio/export/bltins/exppm.x | 49 ++ pkg/dataio/export/bltins/exras.x | 117 ++++ pkg/dataio/export/bltins/exrgb.x | 74 +++ pkg/dataio/export/bltins/exvicar.x | 111 ++++ pkg/dataio/export/bltins/exxwd.x | 253 ++++++++ pkg/dataio/export/bltins/mkpkg | 20 + pkg/dataio/export/cmaps.inc | 534 ++++++++++++++++ pkg/dataio/export/exbltins.h | 28 + pkg/dataio/export/exbltins.x | 243 +++++++ pkg/dataio/export/excmap.x | 258 ++++++++ pkg/dataio/export/exfcn.h | 25 + pkg/dataio/export/exhdr.x | 207 ++++++ pkg/dataio/export/exobands.gx | 390 ++++++++++++ pkg/dataio/export/export.h | 155 +++++ pkg/dataio/export/expreproc.x | 352 +++++++++++ pkg/dataio/export/exraster.gx | 621 ++++++++++++++++++ pkg/dataio/export/exrgb8.x | 994 +++++++++++++++++++++++++++++ pkg/dataio/export/exzscale.x | 755 ++++++++++++++++++++++ pkg/dataio/export/generic/exobands.x | 489 ++++++++++++++ pkg/dataio/export/generic/exraster.x | 709 +++++++++++++++++++++ pkg/dataio/export/generic/mkpkg | 12 + pkg/dataio/export/mkpkg | 36 ++ pkg/dataio/export/t_export.x | 1160 ++++++++++++++++++++++++++++++++++ pkg/dataio/export/zzedbg.x | 157 +++++ 30 files changed, 9118 insertions(+) create mode 100644 pkg/dataio/export/Notes create mode 100644 pkg/dataio/export/bltins/exeps.x create mode 100644 pkg/dataio/export/bltins/exgif.x create mode 100644 pkg/dataio/export/bltins/exiraf.x create mode 100644 pkg/dataio/export/bltins/exmiff.x create mode 100644 pkg/dataio/export/bltins/expgm.x create mode 100644 pkg/dataio/export/bltins/exppm.x create mode 100644 pkg/dataio/export/bltins/exras.x create mode 100644 pkg/dataio/export/bltins/exrgb.x create mode 100644 pkg/dataio/export/bltins/exvicar.x create mode 100644 pkg/dataio/export/bltins/exxwd.x create mode 100644 pkg/dataio/export/bltins/mkpkg create mode 100644 pkg/dataio/export/cmaps.inc create mode 100644 pkg/dataio/export/exbltins.h create mode 100644 pkg/dataio/export/exbltins.x create mode 100644 pkg/dataio/export/excmap.x create mode 100644 pkg/dataio/export/exfcn.h create mode 100644 pkg/dataio/export/exhdr.x create mode 100644 pkg/dataio/export/exobands.gx create mode 100644 pkg/dataio/export/export.h create mode 100644 pkg/dataio/export/expreproc.x create mode 100644 pkg/dataio/export/exraster.gx create mode 100644 pkg/dataio/export/exrgb8.x create mode 100644 pkg/dataio/export/exzscale.x create mode 100644 pkg/dataio/export/generic/exobands.x create mode 100644 pkg/dataio/export/generic/exraster.x create mode 100644 pkg/dataio/export/generic/mkpkg create mode 100644 pkg/dataio/export/mkpkg create mode 100644 pkg/dataio/export/t_export.x create mode 100644 pkg/dataio/export/zzedbg.x (limited to 'pkg/dataio/export') diff --git a/pkg/dataio/export/Notes b/pkg/dataio/export/Notes new file mode 100644 index 00000000..5e60b65a --- /dev/null +++ b/pkg/dataio/export/Notes @@ -0,0 +1,37 @@ +Things to Do: +------------- + + Help Page: +done - examples showing image operand usage +done - examples of zscale/grey/bscale/gamma funcs in complex exprs + +done - clean up output header description +done - verbose is used as terminal output and raw header flag - change +done - define 'composite' in interleave description + - format=raw for >3-D images, more detail +done? - clean up description of image list handling for large groups of + images - perhaps multiple params for operands +done - format should be a query param +??? - should 'outbands' be 'outexpr' +??? - should there be an 'append' param to append existing files +done - what happens if 3-D image passes in for builtin conversion +done - Dave's typos/comments + - note that grouping exprs in function may affect the number of + perceived expressions, e.g. "psdpi ( (b1, b2, b3), 150.0)" +done - add block() function to help page +done - add setcmap() function - this is what's currently defined as the + setlut() function. +??? - Clear up confusion about LUT and colormaps in the help page + + Source: +done - block() function fills full height of expression, not just that + height specified +done - remove constraint on image sizes all being equal +done - @param and tag.param operators need to be implemented +done - text output still needs work +done - remove xvv_initop() calls - interface violation +done - finish header output +done - is zscale() mapping the pixels NOT in the range 0-255 for gif??? +done - need to implement XWD + - need to patch xwd expr for RGB to add alpha channel + - optimize image reads from 3D images 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 +include +include +include +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 +include +include +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 +include +include +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 +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 +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 +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 +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 +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 +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 +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 \ + + exgif.x ../exbltins.h ../export.h + exiraf.x ../export.h + exmiff.x ../export.h + expgm.x ../export.h + exppm.x ../export.h + exras.x ../export.h + exrgb.x ../exbltins.h ../export.h + exvicar.x ../export.h + exxwd.x ../exbltins.h ../export.h + ; diff --git a/pkg/dataio/export/cmaps.inc b/pkg/dataio/export/cmaps.inc new file mode 100644 index 00000000..91707e68 --- /dev/null +++ b/pkg/dataio/export/cmaps.inc @@ -0,0 +1,534 @@ +short aips0[768] +data (aips0(i),i= 1, 12) / 0, 0, 0, 50, 50, 50, 50, 50, 50, 50, 50, 50/ +data (aips0(i),i= 13, 24) / 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50/ +data (aips0(i),i= 25, 36) / 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50/ +data (aips0(i),i= 37, 48) / 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50/ +data (aips0(i),i= 49, 60) / 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50/ +data (aips0(i),i= 61, 72) / 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50/ +data (aips0(i),i= 73, 84) / 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50/ +data (aips0(i),i= 85, 96) / 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50/ +data (aips0(i),i= 97,108) /121, 0,154,121, 0,154,121, 0,154,121, 0,154/ +data (aips0(i),i=109,120) /121, 0,154,121, 0,154,121, 0,154,121, 0,154/ +data (aips0(i),i=121,132) /121, 0,154,121, 0,154,121, 0,154,121, 0,154/ +data (aips0(i),i=133,144) /121, 0,154,121, 0,154,121, 0,154,121, 0,154/ +data (aips0(i),i=145,156) /121, 0,154,121, 0,154,121, 0,154,121, 0,154/ +data (aips0(i),i=157,168) /121, 0,154,121, 0,154,121, 0,154,121, 0,154/ +data (aips0(i),i=169,180) /121, 0,154,121, 0,154,121, 0,154,121, 0,154/ +data (aips0(i),i=181,192) / 0, 0,199, 0, 0,199, 0, 0,199, 0, 0,199/ +data (aips0(i),i=193,204) / 0, 0,199, 0, 0,199, 0, 0,199, 0, 0,199/ +data (aips0(i),i=205,216) / 0, 0,199, 0, 0,199, 0, 0,199, 0, 0,199/ +data (aips0(i),i=217,228) / 0, 0,199, 0, 0,199, 0, 0,199, 0, 0,199/ +data (aips0(i),i=229,240) / 0, 0,199, 0, 0,199, 0, 0,199, 0, 0,199/ +data (aips0(i),i=241,252) / 0, 0,199, 0, 0,199, 0, 0,199, 0, 0,199/ +data (aips0(i),i=253,264) / 0, 0,199, 0, 0,199, 0, 0,199, 0, 0,199/ +data (aips0(i),i=265,276) / 95,166,235, 95,166,235, 95,166,235, 95,166,235/ +data (aips0(i),i=277,288) / 95,166,235, 95,166,235, 95,166,235, 95,166,235/ +data (aips0(i),i=289,300) / 95,166,235, 95,166,235, 95,166,235, 95,166,235/ +data (aips0(i),i=301,312) / 95,166,235, 95,166,235, 95,166,235, 95,166,235/ +data (aips0(i),i=313,324) / 95,166,235, 95,166,235, 95,166,235, 95,166,235/ +data (aips0(i),i=325,336) / 95,166,235, 95,166,235, 95,166,235, 95,166,235/ +data (aips0(i),i=337,348) / 95,166,235, 95,166,235, 95,166,235, 95,166,235/ +data (aips0(i),i=349,360) / 0,145, 0, 0,145, 0, 0,145, 0, 0,145, 0/ +data (aips0(i),i=361,372) / 0,145, 0, 0,145, 0, 0,145, 0, 0,145, 0/ +data (aips0(i),i=373,384) / 0,145, 0, 0,145, 0, 0,145, 0, 0,145, 0/ +data (aips0(i),i=385,396) / 0,145, 0, 0,145, 0, 0,145, 0, 0,145, 0/ +data (aips0(i),i=397,408) / 0,145, 0, 0,145, 0, 0,145, 0, 0,145, 0/ +data (aips0(i),i=409,420) / 0,145, 0, 0,145, 0, 0,145, 0, 0,145, 0/ +data (aips0(i),i=421,432) / 0,145, 0, 0,145, 0, 0,145, 0, 0,145, 0/ +data (aips0(i),i=433,444) / 0,246, 0, 0,246, 0, 0,246, 0, 0,246, 0/ +data (aips0(i),i=445,456) / 0,246, 0, 0,246, 0, 0,246, 0, 0,246, 0/ +data (aips0(i),i=457,468) / 0,246, 0, 0,246, 0, 0,246, 0, 0,246, 0/ +data (aips0(i),i=469,480) / 0,246, 0, 0,246, 0, 0,246, 0, 0,246, 0/ +data (aips0(i),i=481,492) / 0,246, 0, 0,246, 0, 0,246, 0, 0,246, 0/ +data (aips0(i),i=493,504) / 0,246, 0, 0,246, 0, 0,246, 0, 0,246, 0/ +data (aips0(i),i=505,516) / 0,246, 0, 0,246, 0, 0,246, 0, 0,246, 0/ +data (aips0(i),i=517,528) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (aips0(i),i=529,540) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (aips0(i),i=541,552) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (aips0(i),i=553,564) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (aips0(i),i=565,576) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (aips0(i),i=577,588) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (aips0(i),i=589,600) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (aips0(i),i=601,612) /255,177, 0,255,177, 0,255,177, 0,255,177, 0/ +data (aips0(i),i=613,624) /255,177, 0,255,177, 0,255,177, 0,255,177, 0/ +data (aips0(i),i=625,636) /255,177, 0,255,177, 0,255,177, 0,255,177, 0/ +data (aips0(i),i=637,648) /255,177, 0,255,177, 0,255,177, 0,255,177, 0/ +data (aips0(i),i=649,660) /255,177, 0,255,177, 0,255,177, 0,255,177, 0/ +data (aips0(i),i=661,672) /255,177, 0,255,177, 0,255,177, 0,255,177, 0/ +data (aips0(i),i=673,684) /255,177, 0,255,177, 0,255,177, 0,255,177, 0/ +data (aips0(i),i=685,696) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (aips0(i),i=697,708) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (aips0(i),i=709,720) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (aips0(i),i=721,732) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (aips0(i),i=733,744) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (aips0(i),i=745,756) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (aips0(i),i=757,768) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ + + +short color[768] +data (color(i),i= 1, 12) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (color(i),i= 13, 24) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (color(i),i= 25, 36) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (color(i),i= 37, 48) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (color(i),i= 49, 60) / 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46/ +data (color(i),i= 61, 72) / 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46/ +data (color(i),i= 73, 84) / 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46/ +data (color(i),i= 85, 96) / 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46/ +data (color(i),i= 97,108) / 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95/ +data (color(i),i=109,120) / 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95/ +data (color(i),i=121,132) / 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95/ +data (color(i),i=133,144) / 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95/ +data (color(i),i=145,156) /142,142,142,142,142,142,142,142,142,142,142,142/ +data (color(i),i=157,168) /142,142,142,142,142,142,142,142,142,142,142,142/ +data (color(i),i=169,180) /142,142,142,142,142,142,142,142,142,142,142,142/ +data (color(i),i=181,192) /142,142,142,142,142,142,142,142,142,142,142,142/ +data (color(i),i=193,204) /191,191,191,191,191,191,191,191,191,191,191,191/ +data (color(i),i=205,216) /191,191,191,191,191,191,191,191,191,191,191,191/ +data (color(i),i=217,228) /191,191,191,191,191,191,191,191,191,191,191,191/ +data (color(i),i=229,240) /191,191,191,191,191,191,191,191,191,191,191,191/ +data (color(i),i=241,252) /238,238,238,238,238,238,238,238,238,238,238,238/ +data (color(i),i=253,264) /238,238,238,238,238,238,238,238,238,238,238,238/ +data (color(i),i=265,276) /238,238,238,238,238,238,238,238,238,238,238,238/ +data (color(i),i=277,288) /238,238,238,238,238,238,238,238,238,238,238,238/ +data (color(i),i=289,300) / 0, 46,238, 0, 46,238, 0, 46,238, 0, 46,238/ +data (color(i),i=301,312) / 0, 46,238, 0, 46,238, 0, 46,238, 0, 46,238/ +data (color(i),i=313,324) / 0, 46,238, 0, 46,238, 0, 46,238, 0, 46,238/ +data (color(i),i=325,336) / 0, 46,238, 0, 46,238, 0, 46,238, 0, 46,238/ +data (color(i),i=337,348) / 0, 95,191, 0, 95,191, 0, 95,191, 0, 95,191/ +data (color(i),i=349,360) / 0, 95,191, 0, 95,191, 0, 95,191, 0, 95,191/ +data (color(i),i=361,372) / 0, 95,191, 0, 95,191, 0, 95,191, 0, 95,191/ +data (color(i),i=373,384) / 0, 95,191, 0, 95,191, 0, 95,191, 0, 95,191/ +data (color(i),i=385,396) / 0,127,127, 0,127,127, 0,127,127, 0,127,127/ +data (color(i),i=397,408) / 0,127,127, 0,127,127, 0,127,127, 0,127,127/ +data (color(i),i=409,420) / 0,127,127, 0,127,127, 0,127,127, 0,127,127/ +data (color(i),i=421,432) / 0,127,127, 0,127,127, 0,127,127, 0,127,127/ +data (color(i),i=433,444) / 0,191, 78, 0,191, 78, 0,191, 78, 0,191, 78/ +data (color(i),i=445,456) / 0,191, 78, 0,191, 78, 0,191, 78, 0,191, 78/ +data (color(i),i=457,468) / 0,191, 78, 0,191, 78, 0,191, 78, 0,191, 78/ +data (color(i),i=469,480) / 0,191, 78, 0,191, 78, 0,191, 78, 0,191, 78/ +data (color(i),i=481,492) / 0,238, 0, 0,238, 0, 0,238, 0, 0,238, 0/ +data (color(i),i=493,504) / 0,238, 0, 0,238, 0, 0,238, 0, 0,238, 0/ +data (color(i),i=505,516) / 0,238, 0, 0,238, 0, 0,238, 0, 0,238, 0/ +data (color(i),i=517,528) / 0,238, 0, 0,238, 0, 0,238, 0, 0,238, 0/ +data (color(i),i=529,540) / 78,159, 0, 78,159, 0, 78,159, 0, 78,159, 0/ +data (color(i),i=541,552) / 78,159, 0, 78,159, 0, 78,159, 0, 78,159, 0/ +data (color(i),i=553,564) / 78,159, 0, 78,159, 0, 78,159, 0, 78,159, 0/ +data (color(i),i=565,576) / 78,159, 0, 78,159, 0, 78,159, 0, 78,159, 0/ +data (color(i),i=577,588) /127,127, 0,127,127, 0,127,127, 0,127,127, 0/ +data (color(i),i=589,600) /127,127, 0,127,127, 0,127,127, 0,127,127, 0/ +data (color(i),i=601,612) /127,127, 0,127,127, 0,127,127, 0,127,127, 0/ +data (color(i),i=613,624) /127,127, 0,127,127, 0,127,127, 0,127,127, 0/ +data (color(i),i=625,636) /159, 78, 0,159, 78, 0,159, 78, 0,159, 78, 0/ +data (color(i),i=637,648) /159, 78, 0,159, 78, 0,159, 78, 0,159, 78, 0/ +data (color(i),i=649,660) /159, 78, 0,159, 78, 0,159, 78, 0,159, 78, 0/ +data (color(i),i=661,672) /159, 78, 0,159, 78, 0,159, 78, 0,159, 78, 0/ +data (color(i),i=673,684) /238, 0, 0,238, 0, 0,238, 0, 0,238, 0, 0/ +data (color(i),i=685,696) /238, 0, 0,238, 0, 0,238, 0, 0,238, 0, 0/ +data (color(i),i=697,708) /238, 0, 0,238, 0, 0,238, 0, 0,238, 0, 0/ +data (color(i),i=709,720) /238, 0, 0,238, 0, 0,238, 0, 0,238, 0, 0/ +data (color(i),i=721,732) /191, 0, 78,191, 0, 78,191, 0, 78,191, 0, 78/ +data (color(i),i=733,744) /191, 0, 78,191, 0, 78,191, 0, 78,191, 0, 78/ +data (color(i),i=745,756) /191, 0, 78,191, 0, 78,191, 0, 78,191, 0, 78/ +data (color(i),i=757,768) /191, 0, 78,191, 0, 78,191, 0, 78,191, 0, 78/ + + +short halley[768] +data (halley(i),i= 1, 12) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,179/ +data (halley(i),i= 13, 24) / 0, 0,179, 0, 0,220, 0, 0,220,120, 0,220/ +data (halley(i),i= 25, 36) /120, 0,220,120, 0,220,179, 0,229,179, 0,229/ +data (halley(i),i= 37, 48) /255, 0,255,255, 0,255,255, 0,179,255, 0,179/ +data (halley(i),i= 49, 60) /255, 0,132,255, 0, 0,255, 0, 0,255,120, 0/ +data (halley(i),i= 61, 72) /255,120, 0,252,184, 0,252,184, 0,250,206, 0/ +data (halley(i),i= 73, 84) /250,216, 0,250,216, 0,255,255, 0,255,255, 0/ +data (halley(i),i= 85, 96) /179,255, 0,179,255, 0, 0,255, 0, 0,255, 0/ +data (halley(i),i= 97,108) / 0,255, 0, 0,255,179, 0,255,179, 0,255,255/ +data (halley(i),i=109,120) / 0,255,255,120,199,255,120,199,255,120,199,255/ +data (halley(i),i=121,132) /159,159,255,159,159,255,199,120,255,199,120,255/ +data (halley(i),i=133,144) /255,179,255,255,179,255,255,196,255,255,220,255/ +data (halley(i),i=145,156) /255,220,255,255,255,255,255,255,255,255,255,255/ +data (halley(i),i=157,168) /255,255,255,255,229,255,255,220,255,255,220,255/ +data (halley(i),i=169,180) /255,220,255, 0,255, 0, 0,255, 0, 0,255, 0/ +data (halley(i),i=181,192) / 0,255, 0, 0,255, 0, 0,255, 0, 0,255, 0/ +data (halley(i),i=193,204) / 0,255, 0, 0,255, 0, 0,255, 0, 0,255, 0/ +data (halley(i),i=205,216) / 0,255, 0, 0,255, 0, 0,255, 0, 0,255, 0/ +data (halley(i),i=217,228) /235,158,255,199,120,255,199,120,255,199,120,255/ +data (halley(i),i=229,240) /199,120,255,199,120,255,199,120,255,199,120,255/ +data (halley(i),i=241,252) /199,120,255,199,120,255,167,152,255,159,159,255/ +data (halley(i),i=253,264) /159,159,255, 0, 0,255, 0, 0,255, 0, 0,255/ +data (halley(i),i=265,276) / 0, 0,255, 0, 0,255, 0, 0,255, 0, 0,255/ +data (halley(i),i=277,288) / 0, 0,255, 0, 0,255,255, 0, 0,255, 0, 0/ +data (halley(i),i=289,300) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (halley(i),i=301,312) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (halley(i),i=313,324) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (halley(i),i=325,336) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (halley(i),i=337,348) /255, 0, 0,255, 0, 0, 0,255,179, 0,255,179/ +data (halley(i),i=349,360) / 0,255,179, 0,255,179, 0,255,179, 0,255,179/ +data (halley(i),i=361,372) / 0,255,166, 0,255, 0, 0,255, 0, 0,255, 0/ +data (halley(i),i=373,384) / 0,255, 0, 0,255, 0, 0,255, 0, 0,255, 0/ +data (halley(i),i=385,396) / 0,255, 0, 0,255, 0, 91,255, 0,179,255, 0/ +data (halley(i),i=397,408) /179,255, 0,179,255, 0,179,255, 0,179,255, 0/ +data (halley(i),i=409,420) /179,255, 0,179,255, 0,179,255, 0,179,255, 0/ +data (halley(i),i=421,432) /250,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (halley(i),i=433,444) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (halley(i),i=445,456) /255,255, 0,254,248, 0,250,216, 0,250,216, 0/ +data (halley(i),i=457,468) /250,216, 0,250,216, 0,250,216, 0,250,216, 0/ +data (halley(i),i=469,480) /250,216, 0,250,216, 0,250,216, 0,252,197, 0/ +data (halley(i),i=481,492) /252,184, 0,252,184, 0,252,184, 0,252,184, 0/ +data (halley(i),i=493,504) /252,184, 0,252,184, 0,252,184, 0,252,184, 0/ +data (halley(i),i=505,516) /252,184, 0,255,120, 0,255,120, 0,255,120, 0/ +data (halley(i),i=517,528) /255,120, 0,255,120, 0,255,120, 0,255,120, 0/ +data (halley(i),i=529,540) /255,120, 0,255,120, 0,255, 94, 0,255, 0, 0/ +data (halley(i),i=541,552) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (halley(i),i=553,564) /255, 0, 0,255, 0, 0,255, 0, 0,255, 0, 0/ +data (halley(i),i=565,576) /255, 0,119,255, 0,179,255, 0,179,255, 0,179/ +data (halley(i),i=577,588) /255, 0,179,255, 0,179,255, 0,179,255, 0,179/ +data (halley(i),i=589,600) /255, 0,179,255, 0,179,255, 0,255,255, 0,255/ +data (halley(i),i=601,612) /255, 0,255,255, 0,255,255, 0,255,255, 0,255/ +data (halley(i),i=613,624) /255, 0,255,255, 0,255,255, 0,255,233, 0,248/ +data (halley(i),i=625,636) /179, 0,229,179, 0,229,179, 0,229,179, 0,229/ +data (halley(i),i=637,648) /179, 0,229,179, 0,229,179, 0,229,179, 0,229/ +data (halley(i),i=649,660) /179, 0,229,135, 0,223,120, 0,220,120, 0,220/ +data (halley(i),i=661,672) /120, 0,220,120, 0,220,120, 0,220,120, 0,220/ +data (halley(i),i=673,684) /120, 0,220,120, 0,220,120, 0,220,255,255,255/ +data (halley(i),i=685,696) /255,255,255,255,255,255,255,255,255,255,255,255/ +data (halley(i),i=697,708) / 0, 0,220, 0, 0,220, 0, 0,220, 0, 0,220/ +data (halley(i),i=709,720) / 0, 0,204, 0, 0,179, 0, 0,179, 0, 0,179/ +data (halley(i),i=721,732) / 0, 0,179, 0, 0,179, 0, 0,179, 0, 0,179/ +data (halley(i),i=733,744) / 0, 0,179, 0, 0,179, 0, 0, 34, 0, 0, 0/ +data (halley(i),i=745,756) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (halley(i),i=757,768) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ + + +short heat[768] +data (heat(i),i= 1, 12) / 0, 0, 0, 2, 0, 0, 6, 1, 0, 8, 2, 0/ +data (heat(i),i= 13, 24) / 12, 4, 0, 14, 5, 0, 18, 6, 0, 20, 6, 0/ +data (heat(i),i= 25, 36) / 24, 7, 0, 26, 8, 0, 30, 10, 0, 32, 11, 0/ +data (heat(i),i= 37, 48) / 36, 12, 0, 38, 12, 0, 42, 13, 0, 44, 14, 0/ +data (heat(i),i= 49, 60) / 48, 16, 0, 51, 17, 0, 53, 18, 0, 57, 19, 0/ +data (heat(i),i= 61, 72) / 59, 19, 0, 63, 20, 0, 65, 21, 0, 69, 23, 0/ +data (heat(i),i= 73, 84) / 71, 24, 0, 75, 25, 0, 77, 25, 0, 81, 26, 0/ +data (heat(i),i= 85, 96) / 83, 27, 0, 87, 29, 0, 89, 30, 0, 93, 31, 0/ +data (heat(i),i= 97,108) / 95, 31, 0, 99, 32, 0,102, 33, 0,104, 34, 0/ +data (heat(i),i=109,120) /108, 36, 0,110, 37, 0,114, 38, 0,116, 38, 0/ +data (heat(i),i=121,132) /120, 39, 0,122, 40, 0,126, 42, 0,128, 43, 0/ +data (heat(i),i=133,144) /132, 44, 0,134, 44, 0,138, 45, 0,140, 46, 0/ +data (heat(i),i=145,156) /144, 48, 0,146, 49, 0,150, 50, 0,153, 51, 0/ +data (heat(i),i=157,168) /155, 51, 0,159, 52, 0,161, 53, 0,165, 55, 0/ +data (heat(i),i=169,180) /167, 56, 0,171, 57, 0,173, 57, 0,177, 58, 0/ +data (heat(i),i=181,192) /179, 59, 0,183, 61, 0,185, 62, 0,189, 63, 0/ +data (heat(i),i=193,204) /191, 63, 0,195, 64, 0,197, 65, 0,201, 67, 0/ +data (heat(i),i=205,216) /204, 68, 0,206, 69, 0,210, 70, 0,212, 70, 0/ +data (heat(i),i=217,228) /216, 71, 0,218, 72, 0,222, 74, 0,224, 75, 0/ +data (heat(i),i=229,240) /228, 76, 0,230, 76, 0,234, 77, 0,236, 78, 0/ +data (heat(i),i=241,252) /240, 80, 0,242, 81, 0,246, 82, 0,248, 82, 0/ +data (heat(i),i=253,264) /252, 83, 0,255, 84, 0,255, 85, 0,255, 87, 0/ +data (heat(i),i=265,276) /255, 88, 0,255, 89, 0,255, 89, 0,255, 90, 0/ +data (heat(i),i=277,288) /255, 91, 0,255, 93, 0,255, 94, 0,255, 95, 0/ +data (heat(i),i=289,300) /255, 95, 0,255, 96, 0,255, 97, 0,255, 99, 0/ +data (heat(i),i=301,312) /255,100, 0,255,101, 0,255,102, 0,255,102, 0/ +data (heat(i),i=313,324) /255,103, 0,255,104, 0,255,106, 0,255,107, 0/ +data (heat(i),i=325,336) /255,108, 0,255,108, 0,255,109, 0,255,110, 0/ +data (heat(i),i=337,348) /255,112, 0,255,113, 0,255,114, 0,255,114, 0/ +data (heat(i),i=349,360) /255,115, 0,255,116, 0,255,118, 0,255,119, 0/ +data (heat(i),i=361,372) /255,120, 0,255,121, 0,255,121, 0,255,122, 0/ +data (heat(i),i=373,384) /255,123, 0,255,125, 0,255,126, 0,255,127, 0/ +data (heat(i),i=385,396) /255,127, 0,255,128, 0,255,129, 0,255,131, 0/ +data (heat(i),i=397,408) /255,132, 0,255,133, 0,255,133, 0,255,134, 0/ +data (heat(i),i=409,420) /255,135, 0,255,136, 0,255,138, 0,255,139, 0/ +data (heat(i),i=421,432) /255,140, 0,255,140, 0,255,141, 0,255,142, 0/ +data (heat(i),i=433,444) /255,144, 0,255,145, 0,255,146, 0,255,146, 0/ +data (heat(i),i=445,456) /255,147, 0,255,148, 0,255,150, 0,255,151, 0/ +data (heat(i),i=457,468) /255,152, 0,255,153, 0,255,153, 0,255,154, 0/ +data (heat(i),i=469,480) /255,155, 0,255,157, 0,255,158, 0,255,159, 0/ +data (heat(i),i=481,492) /255,159, 0,255,160, 0,255,161, 0,255,163, 0/ +data (heat(i),i=493,504) /255,164, 0,255,165, 0,255,165, 2,255,166, 6/ +data (heat(i),i=505,516) /255,167, 8,255,169, 12,255,170, 14,255,171, 18/ +data (heat(i),i=517,528) /255,172, 20,255,172, 24,255,173, 26,255,174, 30/ +data (heat(i),i=529,540) /255,176, 32,255,177, 36,255,178, 38,255,178, 42/ +data (heat(i),i=541,552) /255,179, 44,255,180, 48,255,182, 51,255,183, 53/ +data (heat(i),i=553,564) /255,184, 57,255,184, 59,255,185, 63,255,186, 65/ +data (heat(i),i=565,576) /255,187, 69,255,189, 71,255,190, 75,255,191, 77/ +data (heat(i),i=577,588) /255,191, 81,255,192, 83,255,193, 87,255,195, 89/ +data (heat(i),i=589,600) /255,196, 93,255,197, 95,255,197, 99,255,198,102/ +data (heat(i),i=601,612) /255,199,104,255,201,108,255,202,110,255,203,114/ +data (heat(i),i=613,624) /255,204,116,255,204,120,255,205,122,255,206,126/ +data (heat(i),i=625,636) /255,208,128,255,209,132,255,210,134,255,210,138/ +data (heat(i),i=637,648) /255,211,140,255,212,144,255,214,146,255,215,150/ +data (heat(i),i=649,660) /255,216,153,255,216,155,255,217,159,255,218,161/ +data (heat(i),i=661,672) /255,220,165,255,221,167,255,222,171,255,223,173/ +data (heat(i),i=673,684) /255,223,177,255,224,179,255,225,183,255,227,185/ +data (heat(i),i=685,696) /255,228,189,255,229,191,255,229,195,255,230,197/ +data (heat(i),i=697,708) /255,231,201,255,233,204,255,234,206,255,235,210/ +data (heat(i),i=709,720) /255,235,212,255,236,216,255,237,218,255,238,222/ +data (heat(i),i=721,732) /255,240,224,255,241,228,255,242,230,255,242,234/ +data (heat(i),i=733,744) /255,243,236,255,244,240,255,246,242,255,247,246/ +data (heat(i),i=745,756) /255,248,248,255,248,252,255,249,255,255,250,255/ +data (heat(i),i=757,768) /255,252,255,255,253,255,255,254,255,255,255,255/ + + +short rainbow[768] +data (rainbow(i),i= 1, 12) / 0, 0, 42, 6, 0, 46, 14, 0, 51, 21, 0, 56/ +data (rainbow(i),i= 13, 24) / 29, 0, 61, 37, 0, 65, 44, 0, 70, 51, 0, 76/ +data (rainbow(i),i= 25, 36) / 58, 0, 81, 67, 0, 85, 75, 0, 90, 82, 0, 95/ +data (rainbow(i),i= 37, 48) / 89, 0,101, 96, 0,106,104, 0,110,112, 0,115/ +data (rainbow(i),i= 49, 60) /120, 0,121,127, 0,126,134, 0,131,141, 0,136/ +data (rainbow(i),i= 61, 72) /150, 0,141,141, 0,146,134, 0,152,127, 0,157/ +data (rainbow(i),i= 73, 84) /120, 0,163,112, 0,167,104, 0,172, 96, 0,178/ +data (rainbow(i),i= 85, 96) / 89, 0,184, 82, 0,189, 75, 0,195, 67, 0,199/ +data (rainbow(i),i= 97,108) / 58, 0,204, 51, 0,210, 44, 0,216, 37, 0,222/ +data (rainbow(i),i=109,120) / 29, 0,227, 21, 0,233, 14, 0,237, 6, 0,243/ +data (rainbow(i),i=121,132) / 0, 0,248, 0, 0,255, 0, 6,248, 0, 12,243/ +data (rainbow(i),i=133,144) / 0, 16,237, 0, 20,233, 0, 25,227, 0, 29,222/ +data (rainbow(i),i=145,156) / 0, 32,216, 0, 36,210, 0, 39,204, 0, 43,199/ +data (rainbow(i),i=157,168) / 0, 46,195, 0, 50,189, 0, 53,184, 0, 57,178/ +data (rainbow(i),i=169,180) / 0, 59,172, 0, 63,167, 0, 67,163, 0, 70,157/ +data (rainbow(i),i=181,192) / 0, 72,152, 0, 76,146, 0, 78,141, 0, 82,136/ +data (rainbow(i),i=193,204) / 0, 84,131, 0, 88,126, 0, 90,121, 0, 94,115/ +data (rainbow(i),i=205,216) / 0, 96,110, 0,100,106, 0,102,101, 0,104, 95/ +data (rainbow(i),i=217,228) / 0,108, 90, 0,110, 85, 0,114, 81, 0,116, 76/ +data (rainbow(i),i=229,240) / 0,119, 70, 0,121, 65, 0,125, 61, 0,127, 56/ +data (rainbow(i),i=241,252) / 0,129, 51, 0,133, 46, 0,134, 42, 0,138, 37/ +data (rainbow(i),i=253,264) / 0,140, 32, 0,142, 27, 0,146, 24, 0,148, 19/ +data (rainbow(i),i=265,276) / 0,151, 14, 0,153, 11, 0,155, 6, 0,159, 2/ +data (rainbow(i),i=277,288) / 0,160, 0, 0,164, 0, 0,165, 0, 0,169, 0/ +data (rainbow(i),i=289,300) / 0,171, 0, 0,173, 0, 0,176, 0, 0,178, 0/ +data (rainbow(i),i=301,312) / 0,180, 0, 0,184, 0, 0,185, 0, 0,189, 0/ +data (rainbow(i),i=313,324) / 0,191, 0, 0,193, 0, 0,196, 0, 0,197, 0/ +data (rainbow(i),i=325,336) / 0,201, 0, 0,203, 0, 0,205, 0, 0,208, 0/ +data (rainbow(i),i=337,348) / 0,210, 0, 0,212, 0, 0,215, 0, 0,217, 0/ +data (rainbow(i),i=349,360) / 0,220, 0, 0,222, 0, 0,224, 0, 0,227, 0/ +data (rainbow(i),i=361,372) / 0,229, 0, 0,231, 0, 0,234, 0, 0,235, 0/ +data (rainbow(i),i=373,384) / 0,238, 0, 0,241, 0, 0,242, 0, 0,244, 0/ +data (rainbow(i),i=385,396) / 0,248, 0, 0,249, 0, 0,252, 0, 0,255, 0/ +data (rainbow(i),i=397,408) / 0,252, 0, 0,249, 0, 0,248, 0, 0,244, 0/ +data (rainbow(i),i=409,420) / 0,242, 0, 0,241, 0, 0,238, 0, 0,235, 0/ +data (rainbow(i),i=421,432) / 0,234, 0, 0,231, 0, 0,229, 0, 0,227, 0/ +data (rainbow(i),i=433,444) / 0,224, 0, 0,222, 0, 0,220, 0, 0,217, 0/ +data (rainbow(i),i=445,456) / 0,215, 0, 0,212, 0, 0,210, 0, 0,208, 0/ +data (rainbow(i),i=457,468) / 0,205, 0, 0,203, 0, 0,201, 0, 0,197, 0/ +data (rainbow(i),i=469,480) / 1,196, 0, 8,197, 0, 17,201, 0, 25,204, 0/ +data (rainbow(i),i=481,492) / 32,206, 0, 42,210, 0, 51,215, 0, 59,218, 0/ +data (rainbow(i),i=493,504) / 68,222, 0, 77,227, 0, 87,229, 0, 95,235, 0/ +data (rainbow(i),i=505,516) /104,237, 0,114,242, 0,123,247, 0,133,252, 0/ +data (rainbow(i),i=517,528) /142,255, 0,152,255, 0,161,255, 0,171,255, 0/ +data (rainbow(i),i=529,540) /180,255, 0,191,255, 0,199,255, 0,210,255, 0/ +data (rainbow(i),i=541,552) /218,255, 0,229,255, 0,237,255, 0,248,255, 0/ +data (rainbow(i),i=553,564) /255,255, 0,255,255, 0,255,255, 0,255,255, 0/ +data (rainbow(i),i=565,576) /255,255, 0,255,255, 0,255,255, 0,254,255, 0/ +data (rainbow(i),i=577,588) /249,255, 0,244,248, 0,241,238, 0,235,229, 0/ +data (rainbow(i),i=589,600) /231,218, 0,228,209, 0,223,198, 0,218,189, 0/ +data (rainbow(i),i=601,612) /214,178, 0,210,169, 0,204,159, 0,201,148, 0/ +data (rainbow(i),i=613,624) /196,139, 0,192,129, 0,189,119, 0,184,109, 0/ +data (rainbow(i),i=625,636) /180,100, 0,177, 89, 0,173, 81, 0,169, 70, 0/ +data (rainbow(i),i=637,648) /165, 61, 0,161, 51, 0,159, 43, 0,157, 32, 0/ +data (rainbow(i),i=649,660) /154, 25, 0,158, 20, 0,159, 16, 0,163, 12, 0/ +data (rainbow(i),i=661,672) /165, 6, 0,167, 0, 0,170, 0, 0,172, 0, 0/ +data (rainbow(i),i=673,684) /174, 0, 0,178, 0, 0,180, 0, 0,183, 0, 0/ +data (rainbow(i),i=685,696) /185, 0, 0,187, 0, 0,191, 0, 0,192, 0, 0/ +data (rainbow(i),i=697,708) /196, 0, 0,197, 0, 0,201, 0, 0,204, 1, 1/ +data (rainbow(i),i=709,720) /205, 6, 6,209, 12, 12,210, 20, 20,214, 29, 29/ +data (rainbow(i),i=721,732) /216, 38, 38,218, 49, 49,221, 58, 58,223, 70, 70/ +data (rainbow(i),i=733,744) /225, 82, 82,229, 95, 95,231,109,109,234,123,123/ +data (rainbow(i),i=745,756) /236,138,138,238,153,153,242,169,169,243,184,184/ +data (rainbow(i),i=757,768) /247,202,202,248,218,218,252,236,236,255,255,255/ + + +short staircase[768] +data (staircase(i),i= 1, 12) / 0, 0, 80, 1, 1, 80, 2, 2, 80, 4, 4, 80/ +data (staircase(i),i= 13, 24) / 5, 5, 80, 6, 6, 80, 6, 6, 80, 7, 7, 80/ +data (staircase(i),i= 25, 36) / 8, 8, 80, 10, 10, 80, 11, 11, 80, 12, 12, 80/ +data (staircase(i),i= 37, 48) / 12, 12, 80, 13, 13, 80, 14, 14, 80, 16, 16, 80/ +data (staircase(i),i= 49, 60) / 17, 17,120, 18, 18,120, 19, 19,120, 19, 19,120/ +data (staircase(i),i= 61, 72) / 20, 20,120, 21, 21,120, 23, 23,120, 24, 24,120/ +data (staircase(i),i= 73, 84) / 25, 25,120, 25, 25,120, 26, 26,120, 27, 27,120/ +data (staircase(i),i= 85, 96) / 29, 29,120, 30, 30,120, 31, 31,120, 31, 31,120/ +data (staircase(i),i= 97,108) / 32, 32,159, 33, 33,159, 34, 34,159, 36, 36,159/ +data (staircase(i),i=109,120) / 37, 37,159, 38, 38,159, 38, 38,159, 39, 39,159/ +data (staircase(i),i=121,132) / 40, 40,159, 42, 42,159, 43, 43,159, 44, 44,159/ +data (staircase(i),i=133,144) / 44, 44,159, 45, 45,159, 46, 46,159, 48, 48,159/ +data (staircase(i),i=145,156) / 49, 49,199, 50, 50,199, 51, 51,199, 51, 51,199/ +data (staircase(i),i=157,168) / 52, 52,199, 53, 53,199, 55, 55,199, 56, 56,199/ +data (staircase(i),i=169,180) / 57, 57,199, 57, 57,199, 58, 58,199, 59, 59,199/ +data (staircase(i),i=181,192) / 61, 61,199, 62, 62,199, 63, 63,199, 63, 63,199/ +data (staircase(i),i=193,204) / 64, 64,240, 65, 65,240, 67, 67,240, 68, 68,240/ +data (staircase(i),i=205,216) / 69, 69,240, 70, 70,240, 70, 70,240, 71, 71,240/ +data (staircase(i),i=217,228) / 72, 72,240, 74, 74,240, 75, 75,240, 76, 76,240/ +data (staircase(i),i=229,240) / 76, 76,240, 77, 77,240, 78, 78,240, 80, 80,240/ +data (staircase(i),i=241,252) / 81, 81,242, 82, 82,246, 82, 82,248, 83, 83,252/ +data (staircase(i),i=253,264) / 84, 84,255, 0, 80, 0, 1, 80, 1, 2, 80, 2/ +data (staircase(i),i=265,276) / 4, 80, 4, 5, 80, 5, 6, 80, 6, 6, 80, 6/ +data (staircase(i),i=277,288) / 7, 80, 7, 8, 80, 8, 10, 80, 10, 11, 80, 11/ +data (staircase(i),i=289,300) / 12, 80, 12, 12, 80, 12, 13, 80, 13, 14, 80, 14/ +data (staircase(i),i=301,312) / 16, 80, 16, 17,120, 17, 18,120, 18, 19,120, 19/ +data (staircase(i),i=313,324) / 19,120, 19, 20,120, 20, 21,120, 21, 23,120, 23/ +data (staircase(i),i=325,336) / 24,120, 24, 25,120, 25, 25,120, 25, 26,120, 26/ +data (staircase(i),i=337,348) / 27,120, 27, 29,120, 29, 30,120, 30, 31,120, 31/ +data (staircase(i),i=349,360) / 31,120, 31, 32,159, 32, 33,159, 33, 34,159, 34/ +data (staircase(i),i=361,372) / 36,159, 36, 37,159, 37, 38,159, 38, 38,159, 38/ +data (staircase(i),i=373,384) / 39,159, 39, 40,159, 40, 42,159, 42, 43,159, 43/ +data (staircase(i),i=385,396) / 44,159, 44, 44,159, 44, 45,159, 45, 46,159, 46/ +data (staircase(i),i=397,408) / 48,159, 48, 49,199, 49, 50,199, 50, 51,199, 51/ +data (staircase(i),i=409,420) / 51,199, 51, 52,199, 52, 53,199, 53, 55,199, 55/ +data (staircase(i),i=421,432) / 56,199, 56, 57,199, 57, 57,199, 57, 58,199, 58/ +data (staircase(i),i=433,444) / 59,199, 59, 61,199, 61, 62,199, 62, 63,199, 63/ +data (staircase(i),i=445,456) / 63,199, 63, 64,240, 64, 65,240, 65, 67,240, 67/ +data (staircase(i),i=457,468) / 68,240, 68, 69,240, 69, 70,240, 70, 70,240, 70/ +data (staircase(i),i=469,480) / 71,240, 71, 72,240, 72, 74,240, 74, 75,240, 75/ +data (staircase(i),i=481,492) / 76,240, 76, 76,240, 76, 77,240, 77, 78,240, 78/ +data (staircase(i),i=493,504) / 80,240, 80, 81,242, 81, 82,246, 82, 82,248, 82/ +data (staircase(i),i=505,516) / 83,252, 83, 84,255, 84, 80, 0, 0, 80, 1, 1/ +data (staircase(i),i=517,528) / 80, 2, 2, 80, 4, 4, 80, 5, 5, 80, 6, 6/ +data (staircase(i),i=529,540) / 80, 6, 6, 80, 7, 7, 80, 8, 8, 80, 10, 10/ +data (staircase(i),i=541,552) / 80, 11, 11, 80, 12, 12, 80, 12, 12, 80, 13, 13/ +data (staircase(i),i=553,564) / 80, 14, 14, 80, 16, 16,120, 17, 17,120, 18, 18/ +data (staircase(i),i=565,576) /120, 19, 19,120, 19, 19,120, 20, 20,120, 21, 21/ +data (staircase(i),i=577,588) /120, 23, 23,120, 24, 24,120, 25, 25,120, 25, 25/ +data (staircase(i),i=589,600) /120, 26, 26,120, 27, 27,120, 29, 29,120, 30, 30/ +data (staircase(i),i=601,612) /120, 31, 31,120, 31, 31,159, 32, 32,159, 33, 33/ +data (staircase(i),i=613,624) /159, 34, 34,159, 36, 36,159, 37, 37,159, 38, 38/ +data (staircase(i),i=625,636) /159, 38, 38,159, 39, 39,159, 40, 40,159, 42, 42/ +data (staircase(i),i=637,648) /159, 43, 43,159, 44, 44,159, 44, 44,159, 45, 45/ +data (staircase(i),i=649,660) /159, 46, 46,159, 48, 48,199, 49, 49,199, 50, 50/ +data (staircase(i),i=661,672) /199, 51, 51,199, 51, 51,199, 52, 52,199, 53, 53/ +data (staircase(i),i=673,684) /199, 55, 55,199, 56, 56,199, 57, 57,199, 57, 57/ +data (staircase(i),i=685,696) /199, 58, 58,199, 59, 59,199, 61, 61,199, 62, 62/ +data (staircase(i),i=697,708) /199, 63, 63,199, 63, 63,240, 64, 64,240, 65, 65/ +data (staircase(i),i=709,720) /240, 67, 67,240, 68, 68,240, 69, 69,240, 70, 70/ +data (staircase(i),i=721,732) /240, 70, 70,240, 71, 71,240, 72, 72,240, 74, 74/ +data (staircase(i),i=733,744) /240, 75, 75,240, 76, 76,240, 76, 76,240, 77, 77/ +data (staircase(i),i=745,756) /240, 78, 78,240, 80, 80,242,100,100,244,134,134/ +data (staircase(i),i=757,768) /248,170,170,250,204,204,253,204,204,255,255,255/ + + +short standard[768] +data (standard(i),i= 1, 12) / 0, 0, 84, 1, 1, 87, 2, 2, 89, 4, 4, 90/ +data (standard(i),i= 13, 24) / 5, 5, 93, 6, 6, 95, 6, 6, 96, 7, 7, 99/ +data (standard(i),i= 25, 36) / 8, 8,101, 10, 10,102, 11, 11,104, 12, 12,107/ +data (standard(i),i= 37, 48) / 12, 12,108, 13, 13,110, 14, 14,113, 16, 16,114/ +data (standard(i),i= 49, 60) / 17, 17,116, 18, 18,119, 19, 19,121, 19, 19,122/ +data (standard(i),i= 61, 72) / 20, 20,125, 21, 21,127, 23, 23,128, 24, 24,131/ +data (standard(i),i= 73, 84) / 25, 25,133, 25, 25,134, 26, 26,136, 27, 27,139/ +data (standard(i),i= 85, 96) / 29, 29,140, 30, 30,142, 31, 31,145, 31, 31,146/ +data (standard(i),i= 97,108) / 32, 32,148, 33, 33,150, 34, 34,153, 36, 36,154/ +data (standard(i),i=109,120) / 37, 37,157, 38, 38,159, 38, 38,160, 39, 39,163/ +data (standard(i),i=121,132) / 40, 40,165, 42, 42,166, 43, 43,169, 44, 44,171/ +data (standard(i),i=133,144) / 44, 44,172, 45, 45,174, 46, 46,177, 48, 48,178/ +data (standard(i),i=145,156) / 49, 49,180, 50, 50,183, 51, 51,184, 51, 51,186/ +data (standard(i),i=157,168) / 52, 52,189, 53, 53,191, 55, 55,192, 56, 56,195/ +data (standard(i),i=169,180) / 57, 57,197, 57, 57,198, 58, 58,201, 59, 59,203/ +data (standard(i),i=181,192) / 61, 61,204, 62, 62,206, 63, 63,209, 63, 63,210/ +data (standard(i),i=193,204) / 64, 64,212, 65, 65,215, 67, 67,216, 68, 68,218/ +data (standard(i),i=205,216) / 69, 69,221, 70, 70,223, 70, 70,224, 71, 71,227/ +data (standard(i),i=217,228) / 72, 72,229, 74, 74,230, 75, 75,233, 76, 76,235/ +data (standard(i),i=229,240) / 76, 76,236, 77, 77,238, 78, 78,241, 80, 80,242/ +data (standard(i),i=241,252) / 81, 81,244, 82, 82,247, 82, 82,248, 83, 83,250/ +data (standard(i),i=253,264) / 84, 84,253, 0, 84, 0, 1, 87, 1, 2, 89, 2/ +data (standard(i),i=265,276) / 4, 90, 4, 5, 93, 5, 6, 95, 6, 6, 96, 6/ +data (standard(i),i=277,288) / 7, 99, 7, 8,101, 8, 10,102, 10, 11,104, 11/ +data (standard(i),i=289,300) / 12,107, 12, 12,108, 12, 13,110, 13, 14,113, 14/ +data (standard(i),i=301,312) / 16,114, 16, 17,116, 17, 18,119, 18, 19,121, 19/ +data (standard(i),i=313,324) / 19,122, 19, 20,125, 20, 21,127, 21, 23,128, 23/ +data (standard(i),i=325,336) / 24,131, 24, 25,133, 25, 25,134, 25, 26,136, 26/ +data (standard(i),i=337,348) / 27,139, 27, 29,140, 29, 30,142, 30, 31,145, 31/ +data (standard(i),i=349,360) / 31,146, 31, 32,148, 32, 33,150, 33, 34,153, 34/ +data (standard(i),i=361,372) / 36,154, 36, 37,157, 37, 38,159, 38, 38,160, 38/ +data (standard(i),i=373,384) / 39,163, 39, 40,165, 40, 42,166, 42, 43,169, 43/ +data (standard(i),i=385,396) / 44,171, 44, 44,172, 44, 45,174, 45, 46,177, 46/ +data (standard(i),i=397,408) / 48,178, 48, 49,180, 49, 50,183, 50, 51,184, 51/ +data (standard(i),i=409,420) / 51,186, 51, 52,189, 52, 53,191, 53, 55,192, 55/ +data (standard(i),i=421,432) / 56,195, 56, 57,197, 57, 57,198, 57, 58,201, 58/ +data (standard(i),i=433,444) / 59,203, 59, 61,204, 61, 62,206, 62, 63,209, 63/ +data (standard(i),i=445,456) / 63,210, 63, 64,212, 64, 65,215, 65, 67,216, 67/ +data (standard(i),i=457,468) / 68,218, 68, 69,221, 69, 70,223, 70, 70,224, 70/ +data (standard(i),i=469,480) / 71,227, 71, 72,229, 72, 74,230, 74, 75,233, 75/ +data (standard(i),i=481,492) / 76,235, 76, 76,236, 76, 77,238, 77, 78,241, 78/ +data (standard(i),i=493,504) / 80,242, 80, 81,244, 81, 82,247, 82, 82,248, 82/ +data (standard(i),i=505,516) / 83,250, 83, 84,253, 84, 84, 0, 0, 87, 1, 1/ +data (standard(i),i=517,528) / 89, 2, 2, 90, 4, 4, 93, 5, 5, 95, 6, 6/ +data (standard(i),i=529,540) / 96, 6, 6, 99, 7, 7,101, 8, 8,102, 10, 10/ +data (standard(i),i=541,552) /104, 11, 11,107, 12, 12,108, 12, 12,110, 13, 13/ +data (standard(i),i=553,564) /113, 14, 14,114, 16, 16,116, 17, 17,119, 18, 18/ +data (standard(i),i=565,576) /121, 19, 19,122, 19, 19,125, 20, 20,127, 21, 21/ +data (standard(i),i=577,588) /128, 23, 23,131, 24, 24,133, 25, 25,134, 25, 25/ +data (standard(i),i=589,600) /136, 26, 26,139, 27, 27,140, 29, 29,142, 30, 30/ +data (standard(i),i=601,612) /145, 31, 31,146, 31, 31,148, 32, 32,150, 33, 33/ +data (standard(i),i=613,624) /153, 34, 34,154, 36, 36,157, 37, 37,159, 38, 38/ +data (standard(i),i=625,636) /160, 38, 38,163, 39, 39,165, 40, 40,166, 42, 42/ +data (standard(i),i=637,648) /169, 43, 43,171, 44, 44,172, 44, 44,174, 45, 45/ +data (standard(i),i=649,660) /177, 46, 46,178, 48, 48,180, 49, 49,183, 50, 50/ +data (standard(i),i=661,672) /184, 51, 51,186, 51, 51,189, 52, 52,191, 53, 53/ +data (standard(i),i=673,684) /192, 55, 55,195, 56, 56,197, 57, 57,198, 57, 57/ +data (standard(i),i=685,696) /201, 58, 58,203, 59, 59,204, 61, 61,206, 62, 62/ +data (standard(i),i=697,708) /209, 63, 63,210, 63, 63,212, 64, 64,215, 65, 65/ +data (standard(i),i=709,720) /216, 67, 67,218, 68, 68,221, 69, 69,223, 70, 70/ +data (standard(i),i=721,732) /224, 70, 70,227, 71, 71,229, 72, 72,230, 74, 74/ +data (standard(i),i=733,744) /233, 75, 75,235, 76, 76,236, 76, 76,238, 77, 77/ +data (standard(i),i=745,756) /241, 78, 78,242, 80, 80,244, 81, 81,247, 82, 82/ +data (standard(i),i=757,768) /248, 82, 82,250, 83, 83,253, 84, 84,255, 85, 85/ + + +short overlay[768] +data (overlay(i),i= 1, 12) / 0, 0, 0, 1, 1, 1, 3, 3, 3, 4, 4, 4/ +data (overlay(i),i= 13, 24) / 5, 5, 5, 6, 6, 6, 8, 8, 8, 9, 9, 9/ +data (overlay(i),i= 25, 36) / 10, 10, 10, 11, 11, 11, 13, 13, 13, 14, 14, 14/ +data (overlay(i),i= 37, 48) / 15, 15, 15, 17, 17, 17, 18, 18, 18, 19, 19, 19/ +data (overlay(i),i= 49, 60) / 20, 20, 20, 22, 22, 22, 23, 23, 23, 24, 24, 24/ +data (overlay(i),i= 61, 72) / 26, 26, 26, 27, 27, 27, 28, 28, 28, 29, 29, 29/ +data (overlay(i),i= 73, 84) / 31, 31, 31, 32, 32, 32, 33, 33, 33, 34, 34, 34/ +data (overlay(i),i= 85, 96) / 36, 36, 36, 37, 37, 37, 38, 38, 38, 40, 40, 40/ +data (overlay(i),i= 97,108) / 41, 41, 41, 42, 42, 42, 43, 43, 43, 45, 45, 45/ +data (overlay(i),i=109,120) / 46, 46, 46, 47, 47, 47, 48, 48, 48, 50, 50, 50/ +data (overlay(i),i=121,132) / 51, 51, 51, 52, 52, 52, 54, 54, 54, 55, 55, 55/ +data (overlay(i),i=133,144) / 56, 56, 56, 57, 57, 57, 59, 59, 59, 60, 60, 60/ +data (overlay(i),i=145,156) / 61, 61, 61, 62, 62, 62, 64, 64, 64, 65, 65, 65/ +data (overlay(i),i=157,168) / 66, 66, 66, 68, 68, 68, 69, 69, 69, 70, 70, 70/ +data (overlay(i),i=169,180) / 71, 71, 71, 73, 73, 73, 74, 74, 74, 75, 75, 75/ +data (overlay(i),i=181,192) / 77, 77, 77, 78, 78, 78, 79, 79, 79, 80, 80, 80/ +data (overlay(i),i=193,204) / 82, 82, 82, 83, 83, 83, 84, 84, 84, 85, 85, 85/ +data (overlay(i),i=205,216) / 87, 87, 87, 88, 88, 88, 89, 89, 89, 91, 91, 91/ +data (overlay(i),i=217,228) / 92, 92, 92, 93, 93, 93, 94, 94, 94, 96, 96, 96/ +data (overlay(i),i=229,240) / 97, 97, 97, 98, 98, 98, 99, 99, 99,101,101,101/ +data (overlay(i),i=241,252) /102,102,102,103,103,103,105,105,105,106,106,106/ +data (overlay(i),i=253,264) /107,107,107,108,108,108,110,110,110,111,111,111/ +data (overlay(i),i=265,276) /112,112,112,113,113,113,115,115,115,116,116,116/ +data (overlay(i),i=277,288) /117,117,117,119,119,119,120,120,120,121,121,121/ +data (overlay(i),i=289,300) /122,122,122,124,124,124,125,125,125,126,126,126/ +data (overlay(i),i=301,312) /128,128,128,129,129,129,130,130,130,131,131,131/ +data (overlay(i),i=313,324) /133,133,133,134,134,134,135,135,135,136,136,136/ +data (overlay(i),i=325,336) /138,138,138,139,139,139,140,140,140,142,142,142/ +data (overlay(i),i=337,348) /143,143,143,144,144,144,145,145,145,147,147,147/ +data (overlay(i),i=349,360) /148,148,148,149,149,149,150,150,150,152,152,152/ +data (overlay(i),i=361,372) /153,153,153,154,154,154,156,156,156,157,157,157/ +data (overlay(i),i=373,384) /158,158,158,159,159,159,161,161,161,162,162,162/ +data (overlay(i),i=385,396) /163,163,163,164,164,164,166,166,166,167,167,167/ +data (overlay(i),i=397,408) /168,168,168,170,170,170,171,171,171,172,172,172/ +data (overlay(i),i=409,420) /173,173,173,175,175,175,176,176,176,177,177,177/ +data (overlay(i),i=421,432) /179,179,179,180,180,180,181,181,181,182,182,182/ +data (overlay(i),i=433,444) /184,184,184,185,185,185,186,186,186,187,187,187/ +data (overlay(i),i=445,456) /189,189,189,190,190,190,191,191,191,193,193,193/ +data (overlay(i),i=457,468) /194,194,194,195,195,195,196,196,196,198,198,198/ +data (overlay(i),i=469,480) /199,199,199,200,200,200,201,201,201,203,203,203/ +data (overlay(i),i=481,492) /204,204,204,205,205,205,207,207,207,208,208,208/ +data (overlay(i),i=493,504) /209,209,209,210,210,210,212,212,212,213,213,213/ +data (overlay(i),i=505,516) /214,214,214,215,215,215,217,217,217,218,218,218/ +data (overlay(i),i=517,528) /219,219,219,221,221,221,222,222,222,223,223,223/ +data (overlay(i),i=529,540) /224,224,224,226,226,226,227,227,227,228,228,228/ +data (overlay(i),i=541,552) /230,230,230,231,231,231,232,232,232,233,233,233/ +data (overlay(i),i=553,564) /235,235,235,236,236,236,237,237,237,238,238,238/ +data (overlay(i),i=565,576) /240,240,240,241,241,241,242,242,242,244,244,244/ +data (overlay(i),i=577,588) /245,245,245,246,246,246,247,247,247,249,249,249/ +data (overlay(i),i=589,600) /250,250,250,251,251,251,252,252,252,254,254,254/ +data (overlay(i),i=601,612) /255,255,255, 0, 0, 0,255,255,255,255, 0, 0/ +data (overlay(i),i=613,624) / 0,255, 0, 0, 0,255,255,255, 0, 0,255,255/ +data (overlay(i),i=625,636) /255, 0,255,255,127, 80,176, 48, 96,255,165, 0/ +data (overlay(i),i=637,648) /255,246,143,218,112,214, 0,245,255,238,130,238/ +data (overlay(i),i=649,660) /255,231,186, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=661,672) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=673,684) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=685,696) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=697,708) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=709,720) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=721,732) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=733,744) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=745,756) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ +data (overlay(i),i=757,768) / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ diff --git a/pkg/dataio/export/exbltins.h b/pkg/dataio/export/exbltins.h new file mode 100644 index 00000000..0723cdb2 --- /dev/null +++ b/pkg/dataio/export/exbltins.h @@ -0,0 +1,28 @@ +# EXBLTINS.H -- Macro definitions for builtin formats. + +define EX_FORMATS "|eps|epsi|epi|epsf|gif|giff|iraf|imh|miff|pgm|ppm|\ + |ps|ras|sun|sunras|rgb|sgi|irix|xwd|x11|vicar2|" + +define EPS 1 # Encapsulated PostScript +define EPSI 2 # Encapsulated PostScript (alias) +define EPI 3 # Encapsulated PostScript (alias) +define EPSF 4 # Encapsulated PostScript (alias) +define GIF 5 # Compuserve GIF format +define GIFF 6 # Compuserve GIF format (alias) +define IRAF 7 # IRAF OIF format (hidden) +define IMH 8 # IRAF OIF format (alias) +define MIFF 9 # ImageMagick MIFF format +define PGM 10 # PBMplus PGM grayscale format +define PPM 11 # PBMplus PPM color format +#newline +define PS 13 # Sun rasterfile format +define RAS 14 # Sun rasterfile format +define SUN 15 # Sun rasterfile format (alias) +define SUNRAS 16 # Sun rasterfile format (alias) +define RGB 17 # Silicon Graphics RGB format +define SGI 18 # Silicon Graphics RGB format (alias) +define IRIS 19 # Silicon Graphics RGB format (alias) +define XWD 20 # X11 Window dump +define X11 21 # X11 Window dump (alias) +define VICAR 22 # VICAR2 format + diff --git a/pkg/dataio/export/exbltins.x b/pkg/dataio/export/exbltins.x new file mode 100644 index 00000000..bb0152dd --- /dev/null +++ b/pkg/dataio/export/exbltins.x @@ -0,0 +1,243 @@ +include +include "export.h" +include "exbltins.h" + + +# EXb_BUILTIN - Process a builtin format. + +procedure exb_process_image (ex) + +pointer ex #i task struct pointer + +begin + # Branch to the appropriate procedure for processing. + switch (EX_BLTIN(ex)) { + case EPS: # Encapsulated PostScript + call ex_eps (ex) + case GIF: # GIF + call ex_gif (ex) + case IMH: # IRAF OIF + call ex_iraf (ex) + case MIFF: # ImageMagick MIFF file + call ex_miff (ex) + case PGM: # PBMplus PGM (grayscale) file + call ex_pgm (ex) + case PPM: # PBMplus PPM (RGB) file + call ex_ppm (ex) + case RAS: # Sun rasterfile + call ex_ras (ex) + case RGB: # SGI RGB format file + call ex_rgb (ex) + case XWD: # X11 Window Dump + call ex_xwd (ex) + case VICAR: # JPL VICAR2 format image + call ex_vicar (ex) + default: + call error (0, "Unrecognized format") + } +end + + +# EXB_CHKPARS - Check the parameters for the builtin parameters. + +int procedure exb_chkpars (ex) + +pointer ex #i task struct pointer + +int legal, fmt + +begin + # Do a quick check that the number of expressions is valid for + # the requested format. + legal = NO + fmt = EX_BLTIN(ex) + switch (EX_NEXPR(ex)) { + case 1: + # PPM is the only format required to have 3 expressions. + if (fmt != PPM) + legal = YES + case 3: + if (fmt == PPM || fmt == RAS || fmt == RGB || + fmt == XWD || fmt == EPS || fmt == MIFF) + legal = YES + case 4: + if (fmt == RAS || fmt == XWD) + legal = YES + case EX_UNDEFINED: # let it slide for now.... + legal = YES + default: + if (bitset (EX_OUTFLAGS(ex), OF_BAND)) + legal = YES + } + if (legal == NO) { + call error (1, "Wrong no. of expressions for requested format") + return (ERR) + } + + # Check the bswap param. If it's set but ignored by a given format + # warn the user. + if (EX_BSWAP(ex) != S_NONE && (fmt != RAS && fmt != XWD)) { + call eprintf ("Warning: `bswap' parameter will be ignored") + return (ERR) + } + + return (OK) +end + + +# EXB_DO_FORMAT - Process a builtin task format parameter and set appropriate +# flags. + +procedure exb_do_format (ex, format) + +pointer ex #i task struct pointer +char format[ARB] #i format parameter value + +char fmt[SZ_FNAME] +int strdic() + +begin + switch (strdic (format, fmt, SZ_FNAME, EX_FORMATS)) { + case EPS, EPSI, EPI, EPSF, PS: + EX_BLTIN(ex) = EPS + EX_COLOR(ex) = YES + case GIF, GIFF: + EX_BLTIN(ex) = GIF + EX_COLOR(ex) = YES + case IMH, IRAF: + EX_BLTIN(ex) = IMH + EX_COLOR(ex) = NO + case MIFF: + EX_BLTIN(ex) = MIFF + EX_COLOR(ex) = YES + case PGM: + EX_BLTIN(ex) = PGM + EX_COLOR(ex) = NO + case PPM: + EX_BLTIN(ex) = PPM + EX_COLOR(ex) = NO + case RAS, SUN, SUNRAS: + EX_BLTIN(ex) = RAS + EX_COLOR(ex) = YES + case RGB, SGI, IRIS: + EX_BLTIN(ex) = RGB + EX_COLOR(ex) = NO + case XWD, X11: + EX_BLTIN(ex) = XWD + EX_COLOR(ex) = YES + case VICAR: + EX_BLTIN(ex) = VICAR + EX_COLOR(ex) = NO + default: + call error (2, "Unknown format.") + } +end + + +# EXB_PNAME - Print verbose name of the format. + +procedure exb_pname (ex) + +pointer ex #i task struct pointer + +begin + switch (EX_BLTIN(ex)) { + case EPS: + call pargstr ("Encapsulated PostScript") + case GIF: + call pargstr ("GIF") + case MIFF: + call pargstr ("ImageMagick MIFF") + case PGM: + call pargstr ("PGM") + case PPM: + call pargstr ("PPM") + case RAS: + call pargstr ("Sun Rasterfile") + case RGB: + call pargstr ("SGI RGB") + case XWD: + call pargstr ("X11 Window Dump") + case VICAR: + call pargstr ("JPL VICAR2 Image") + default: + call pargstr ("") + } +end + + +# EXB_PENDIAN - Print byte order of the format. + +procedure exb_pendian (ex) + +pointer ex #i task struct pointer + +begin + switch (EX_BLTIN(ex)) { + case GIF: + call pargstr ("Least Significant Byte First") + default: + if (EX_BSWAP(ex) == 0 && (BYTE_SWAP2==NO || BYTE_SWAP4==NO)) + call pargstr ("Most Significant Byte First") + else + call pargstr ("Least Significant Byte First") + } +end + + +# EXB_PSTORAGE - Print pixel storage type of the format. + +procedure exb_pstorage (ex) + +pointer ex #i task struct pointer + +int flags + +begin + switch (EX_BLTIN(ex)) { + case GIF: + call pargstr ("LZW compressed bytes") + case RGB: + call pargstr ("Band interleaved") + default: + flags = EX_OUTFLAGS(ex) + if (bitset(flags, OF_BAND) || bitset(flags,BAND_STORAGE)) + call pargstr ("Band Interleaved") + else if (bitset(flags, OF_LINE) || bitset(flags,LINE_STORAGE)) + call pargstr ("Line Interleaved") + else if (bitset(flags,PIXEL_STORAGE)) + call pargstr ("Pixel Interleaved") + else + call pargstr ("Unknown") + } +end + + +# EXB_FMT_EXT - Print the name of the builtin format. The returned pointer +# must be freed by the calling procedure. + +pointer procedure exb_fmt_ext (ex) + +pointer ex #i task struct pointer + +pointer suf + +begin + call malloc (suf, SZ_FNAME, TY_CHAR) + + switch (EX_BLTIN(ex)) { + case EPS: call strcpy (".eps", Memc[suf], SZ_FNAME) + case GIF: call strcpy (".gif", Memc[suf], SZ_FNAME) + case IMH: call strcpy (".imh", Memc[suf], SZ_FNAME) + case MIFF: call strcpy (".miff", Memc[suf], SZ_FNAME) + case PGM: call strcpy (".pgm", Memc[suf], SZ_FNAME) + case PPM: call strcpy (".ppm", Memc[suf], SZ_FNAME) + case RAS: call strcpy (".ras", Memc[suf], SZ_FNAME) + case RGB: call strcpy (".rgb", Memc[suf], SZ_FNAME) + case XWD: call strcpy (".xwd", Memc[suf], SZ_FNAME) + case VICAR: call strcpy (".vic", Memc[suf], SZ_FNAME) + default: Memc[suf] = EOS + } + + return (suf) +end diff --git a/pkg/dataio/export/excmap.x b/pkg/dataio/export/excmap.x new file mode 100644 index 00000000..486813ef --- /dev/null +++ b/pkg/dataio/export/excmap.x @@ -0,0 +1,258 @@ +include +include "export.h" + + +define EX_COLORMAPS "|aips0|blue|color|grayscale|greyscale|green|halley\ + |heat|rainbow|red|staircase|standard|overlay|" + +define AIPS0 1 # builtin colormaps +define BLUE 2 +define COLOR 3 +define GRAYSCALE 4 +define GREYSCALE 5 +define GREEN 6 +define HALLEY 7 +define HEAT 8 +define RAINBOW 9 +define RED 10 +define STAIRCASE 11 +define STANDARD 12 +define OVERLAY 13 + + +# EX_READ_CMAP - Read a colormap into the colormap structure. We assume the +# colormap is either a normalized CLT of RGB values between zero and one, or +# RGB integer values between 0 and 255. The format of the file is three +# values per line given as a red, green, and blue color. If the first line +# contains a single number assume it's the number of colors. A maximum of +# 256 colors will be read, if fewer values are read the remaining colors will +# be filled with zeros. + +procedure ex_read_cmap (ex, cmname) + +pointer ex #i colormap pointer +char cmname[ARB] #i colormap file name + +pointer cmap +pointer sp, line +real r, g, b, scale +int i, stat, fd, type, ncolors + +int open(), fscan(), nscan() +int getline(), lexnum(), strdic() +errchk open + +define rdmap_ 99 + +begin + # See if this is a builtin colormap request. + if (strdic(cmname,cmname,SZ_LINE,EX_COLORMAPS) > 0) { + call ex_bltin_cmap (ex, cmname) + return + } + + # Open the colormap filename. + iferr (fd = open (cmname, READ_ONLY, TEXT_FILE)) + call error (0, "Cannot open requested colormap file.") + + # Check the first line to see if it's the number of colors or a + # CLT entry. + stat = fscan (fd) + call gargr (r) + call gargr (g) + call gargr (b) + if (nscan() == 1) { + ncolors = r + goto rdmap_ + } else if (nscan() == 3) { + call seek (fd, BOF) +rdmap_ call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + stat = getline (fd, Memc[line]) + i = 1 + ncolors = 256 + type = lexnum (Memc[line], i, stat) + + if (type == LEX_REAL) + scale = 255.0 + else if (type == LEX_DECIMAL) + scale = 1.0 + else + call error (0, "Colormap file has an unknown format.") + + call sfree (sp) + } else + call error (1, "Colormap file has an unknown format.") + + # Read in a normalize colormap file. + cmap = EX_CMAP(ex) + for (i=1; fscan(fd) != EOF && i <= ncolors; i=i+1) { + call gargr (r) + call gargr (g) + call gargr (b) + + CMAP(cmap,EX_RED,i) = max (0, min (255, int (r * scale + 0.5))) + CMAP(cmap,EX_GREEN,i) = max (0, min (255, int (g * scale + 0.5))) + CMAP(cmap,EX_BLUE,i) = max (0, min (255, int (b * scale + 0.5))) + } + ncolors = i + EX_NCOLORS(ex) = ncolors + + # Close the file. + call close (fd) +end + + +# EX_SCALE_CMAP - Scale the colormap with the requested brightness and +# contrast values. + +procedure ex_scale_cmap (cmap, ncolors, brightness, contrast) + +pointer cmap #i colormap pointer +int ncolors #i number of colors in map +real brightness #i brightness offset +real contrast #i contrast scale + +pointer sp, ctmp +int i, c1, c2 +short r, g, b +real x, y, z, frac, slope, offset + +begin + call smark (sp) + call salloc (ctmp, 3*CMAP_SIZE, TY_CHAR) + call aclrc (Memc[ctmp], 3*CMAP_SIZE) + + slope = max (-7.0, min (7.0, contrast)) + offset = max (0.0, min (1.0, brightness)) + + # Compute the scaled colormap. + do i = 1, ncolors { + x = real (i) / real (ncolors) + y = (x - offset) * slope + 0.5 + + if (y <= 0.0) { + r = CMAP(cmap,EX_RED, 1) + g = CMAP(cmap,EX_GREEN,1) + b = CMAP(cmap,EX_BLUE, 1) + } else if (y >= 1.0) { + r = CMAP(cmap,EX_RED, ncolors) + g = CMAP(cmap,EX_GREEN,ncolors) + b = CMAP(cmap,EX_BLUE, ncolors) + } else { + z = y * (ncolors - 1) + c1 = max (1, int (z)) + c2 = min (ncolors-1, c1 + 1) + frac = z - c1 + r = CMAP(cmap,EX_RED,c1) * (1.0 - frac) + + CMAP(cmap,EX_RED,c2) * frac + g = CMAP(cmap,EX_GREEN,c1) * (1.0 - frac) + + CMAP(cmap,EX_GREEN,c2) * frac + b = CMAP(cmap,EX_BLUE,c1) * (1.0 - frac) + + CMAP(cmap,EX_BLUE,c2) * frac + } + + CMAP(ctmp,EX_RED, i) = r + CMAP(ctmp,EX_GREEN,i) = g + CMAP(ctmp,EX_BLUE, i) = b + } + call amovc (Memc[ctmp], Memc[cmap], 3*CMAP_SIZE) + + call sfree (sp) +end + + +# EX_BLTIN_CMAP - Load a predefined colormap. + +procedure ex_bltin_cmap (ex, cmname) + +pointer ex #i task struct pointer +char cmname[ARB] #i colormap name + +pointer cmap +int i, j, strdic() + +include "cmaps.inc" + +begin + j = 1 + cmap = EX_CMAP(ex) + EX_NCOLORS(ex) = CMAP_SIZE + + switch (strdic (cmname, cmname, SZ_LINE, EX_COLORMAPS)) { + case AIPS0: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = aips0[j] + CMAP(cmap,EX_GREEN,i) = aips0[j+1] + CMAP(cmap,EX_BLUE,i) = aips0[j+2] + j = j + 3 + } + case BLUE: + call aclrs (Mems[cmap], 3*CMAP_SIZE) + do i = 1, 256 + CMAP(cmap,EX_BLUE,i) = i - 1 + case COLOR: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = color[j] + CMAP(cmap,EX_GREEN,i) = color[j+1] + CMAP(cmap,EX_BLUE,i) = color[j+2] + j = j + 3 + } + case GRAYSCALE, GREYSCALE: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = i - 1 + CMAP(cmap,EX_GREEN,i) = i - 1 + CMAP(cmap,EX_BLUE,i) = i - 1 + } + case GREEN: + call aclrs (Mems[cmap], 3*CMAP_SIZE) + do i = 1, 256 + CMAP(cmap,EX_GREEN,i) = i - 1 + case HALLEY: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = halley[j] + CMAP(cmap,EX_GREEN,i) = halley[j+1] + CMAP(cmap,EX_BLUE,i) = halley[j+2] + j = j + 3 + } + case HEAT: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = heat[j] + CMAP(cmap,EX_GREEN,i) = heat[j+1] + CMAP(cmap,EX_BLUE,i) = heat[j+2] + j = j + 3 + } + case RAINBOW: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = rainbow[j] + CMAP(cmap,EX_GREEN,i) = rainbow[j+1] + CMAP(cmap,EX_BLUE,i) = rainbow[j+2] + j = j + 3 + } + case RED: + call aclrs (Mems[cmap], 3*CMAP_SIZE) + do i = 1, 256 + CMAP(cmap,EX_RED,i) = i - 1 + case STAIRCASE: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = staircase[j] + CMAP(cmap,EX_GREEN,i) = staircase[j+1] + CMAP(cmap,EX_BLUE,i) = staircase[j+2] + j = j + 3 + } + case STANDARD: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = standard[j] + CMAP(cmap,EX_GREEN,i) = standard[j+1] + CMAP(cmap,EX_BLUE,i) = standard[j+2] + j = j + 3 + } + case OVERLAY: + do i = 1, 256 { + CMAP(cmap,EX_RED,i) = overlay[j] + CMAP(cmap,EX_GREEN,i) = overlay[j+1] + CMAP(cmap,EX_BLUE,i) = overlay[j+2] + j = j + 3 + } + } +end diff --git a/pkg/dataio/export/exfcn.h b/pkg/dataio/export/exfcn.h new file mode 100644 index 00000000..7a9c61b3 --- /dev/null +++ b/pkg/dataio/export/exfcn.h @@ -0,0 +1,25 @@ +# EXFCN.H - Include file for the special functions supported by the EXPORT task. + +# Outbands expressions functions. +define OB_FUNCTIONS "|band|line|flipx|flipy|\ + |cmap|setcmap|psdpi|psscale|\ + |zscale|grey|gray|bscale|gamma|\ + |block|" + +define BAND 1 # force band-interleaved storage +define LINE 2 # force line-interleaved storage +define FLIPX 3 # flip image left-to-right +define FLIPY 4 # flip image top-to-bottom +#newline +define CMAP 6 # create 8-bit colormap +define SETCMAP 7 # apply a colormap +define PSDPI 8 # set dpi for output +define PSSCALE 9 # set scale of PS output +#newline +define ZSCALE 11 # scale to a fixed number of bins +define GREY 12 # RGB to greyscale conversion +define GRAY 13 # " " " " +define BSCALE 14 # linearly transform intensity scale +define GAMMA 15 # apply a gamma correction +#newline +define BLOCK 17 # floodfill a block w/ a constant diff --git a/pkg/dataio/export/exhdr.x b/pkg/dataio/export/exhdr.x new file mode 100644 index 00000000..9ba56a99 --- /dev/null +++ b/pkg/dataio/export/exhdr.x @@ -0,0 +1,207 @@ +include +include +include +include +include +include +include "export.h" + + +# EX_WHEADER - Write the output file header information. + +procedure ex_wheader (ex, outfile) + +pointer ex #i task struct pointer +char outfile[ARB] #i output file name + +pointer sp, tfile, buf, cbuf +int file_type, nchars + +int fd, open(), access(), strlen() +long fsize, fstatl() + +errchk open, access + +begin + if (EX_HEADER(ex) == HDR_SHORT || EX_HEADER(ex) == HDR_LONG) { + + call smark (sp) + call salloc (tfile, SZ_PATHNAME, TY_CHAR) + call salloc (buf, SZ_LINE, TY_CHAR) + call salloc (cbuf, SZ_LINE, TY_CHAR) + call aclrc (Memc[buf], SZ_LINE) + call aclrc (Memc[cbuf], SZ_LINE) + + # Write the generic header. + call mktemp ("tmp$ex", Memc[tfile], SZ_PATHNAME) + fd = open (Memc[tfile], NEW_FILE, TEXT_FILE) + call ex_mkheader (ex, fd) + call close (fd) + + if (EX_FORMAT(ex) != FMT_LIST) + fd = open (Memc[tfile], READ_ONLY, BINARY_FILE) + else + fd = open (Memc[tfile], READ_ONLY, TEXT_FILE) + fsize = fstatl (fd, F_FILESIZE) * SZB_CHAR + nchars = fsize + 27 #+ fsize/10 + call sprintf (Memc[buf], SZ_LINE, "format = EXPORT\nhdrsize = %d\n") + call pargi (nchars) + nchars = strlen (Memc[buf]) + if (EX_FD(ex) != STDOUT && EX_FORMAT(ex) != FMT_LIST) { + call strpak (Memc[buf], Memc[cbuf], nchars) + call write (EX_FD(ex), Memc[cbuf], nchars/SZB_CHAR) + call fcopyo (fd, EX_FD(ex)) + call close (fd) + } else { + call fprintf (EX_FD(ex), "%s") + call pargstr (Memc[buf]) + if (EX_FORMAT(ex) == FMT_LIST) + call fcopyo (fd, EX_FD(ex)) + else + call fcopy (Memc[tfile], "STDOUT") + + call close (fd) + } + + call delete (Memc[tfile]) + call sfree (sp) + + } else if (EX_HEADER(ex) == HDR_USER) { + # Copy user file to output. + iferr { + # If the user header is a text file we need to reopen the + # output file so the copy is done correctly. Afterwards + # we'll reopen it as a binary file. + if (access (HDRFILE(ex), 0, TEXT_FILE) == YES) { + file_type = TEXT_FILE + call close (EX_FD(ex)) + EX_FD(ex) = open (outfile, APPEND, file_type) + } else + file_type = BINARY_FILE + + fd = open (HDRFILE(ex), READ_ONLY, file_type) + call fcopyo (fd, EX_FD(ex)) + if (EX_FD(ex) != STDOUT) + call close (fd) + + if (file_type == TEXT_FILE) { + if (EX_FD(ex) != STDOUT) + call close (EX_FD(ex)) + if (EX_FORMAT(ex) != FMT_LIST) + EX_FD(ex) = open (outfile, APPEND, BINARY_FILE) + } + } then + call error (2, "Error writing user header.") + } +end + + +# EX_MKHEADER - Write the generic binary file header. Since we need to +# output the size we'll write out just the trailer part to the temp file +# and copy it to the real output file later. + +procedure ex_mkheader (ex, fd) + +pointer ex #i task struct pointer +int fd #i temp file descriptor + +long clktime() # seconds since 00:00:00 10-Jan-80 +int tm[LEN_TMSTRUCT] # broken down time structure + +begin + # Write the time stamp string. + call brktime (clktime(0), tm) + call fprintf (fd, "date = '%d/%d/%d'\n") + call pargi (TM_MDAY(tm)) + call pargi (TM_MONTH(tm)) + call pargi (TM_YEAR(tm)) + + # ... and the rest of the header + call fprintf (fd, "ncols = %d\n") # image dimensions + call pargi (EX_OCOLS(ex)) + call fprintf (fd, "nrows = %d\n") + call pargi (EX_OROWS(ex)) + call fprintf (fd, "nbands = %d\n") + call pargi (EX_NEXPR(ex)) + + call fprintf (fd, "datatype = '%s'\n") # pixel type + call pargstr (Memc[EX_OTPTR(ex)]) + + call fprintf (fd, "outbands = '%s'\n") # outbands expressions + call pargstr (Memc[EX_OBPTR(ex)]) + + call fprintf (fd, "interleave = %d\n") # pixel interleave type + call pargi (EX_INTERLEAVE(ex)) + + call fprintf (fd, "bswap = %s\n") # byte swapping flag + switch (EX_BSWAP(ex)) { + case S_NONE: call pargstr ("none") + case S_ALL: call pargstr ("all") + case S_I2: call pargstr ("i2") + case S_I4: call pargstr ("i4") + } + + if (EX_HEADER(ex) == HDR_LONG) + call ex_wimhdr (ex, fd) # write image headers + + # Terminate header. + call fprintf (fd, "end\n") +end + + +# EX_WIMHDR - Write the image header information. Include the headers if this +# is a verbose output. + +procedure ex_wimhdr (ex, fd) + +pointer ex #i task struct pointer +int fd #i temp file descriptor + +pointer sp, lbuf, ip, im +int i, in, ncols, min_lenuserarea +int stropen(), getline(), envgeti() + +define USER_AREA Memc[($1+IMU-1)*SZ_STRUCT + 1] +define LMARGIN 4 + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + do i = 1, EX_NIMAGES(ex) { + + im = IO_IMPTR(IMOP(ex,i)) + call fprintf (fd, "image%d = '%s'\n") + call pargi (i) + call pargstr (IM_HDRFILE(im)) + call fprintf (fd, "header%d {\n") + call pargi (i) + + # Open user area in header. + min_lenuserarea = (LEN_IMDES+IM_LENHDRMEM(im)-IMU) * SZ_STRUCT - 1 + in = stropen (USER_AREA(im), min_lenuserarea, READ_ONLY) + ncols = envgeti ("ttyncols") - LMARGIN + + # Copy header records to the output, stripping any trailing + # whitespace and clipping at the right margin. + + while (getline (in, Memc[lbuf]) != EOF) { + for (ip=lbuf; Memc[ip] != EOS && Memc[ip] != '\n'; ip=ip+1) + ; + while (ip > lbuf && Memc[ip-1] == ' ') + ip = ip - 1 + if (ip - lbuf > ncols) + ip = lbuf + ncols + Memc[ip] = '\n' + Memc[ip+1] = EOS + + call putline (fd, " ") + call putline (fd, Memc[lbuf]) + } + + call fprintf (fd, "}\n") + } + + call close (in) + call sfree (sp) +end diff --git a/pkg/dataio/export/exobands.gx b/pkg/dataio/export/exobands.gx new file mode 100644 index 00000000..cd7313a3 --- /dev/null +++ b/pkg/dataio/export/exobands.gx @@ -0,0 +1,390 @@ +include +include +include +include +include +include "../export.h" +include "../exfcn.h" + +define DEBUG false +define VDEBUG false + + +# EX_EVALUATE -- Evaluate the outbands expression. + +pointer procedure ex_evaluate (ex, expr) + +pointer ex #i task struct pointer +char expr[ARB] #i expression to be evaluated + +pointer o # operand pointer to result + +int locpr() +pointer evvexpr() +extern ex_getop(), ex_obfcn() +errchk evvexpr + +begin + if (DEBUG) { call eprintf("ex_eval: expr='%s'\n") ; call pargstr(expr) } + + # Evaluate the expression. + iferr { + o = evvexpr (expr, locpr(ex_getop), ex, locpr(ex_obfcn), ex, + EV_RNGCHK) + } then + call erract (EA_FATAL) + + return (o) +end + + +# EX_GETOP -- Called by evvexpr to get an operand. + +procedure ex_getop (ex, opname, o) + +pointer ex #i task struct pointer +char opname[ARB] #i operand name to retrieve +pointer o #o output operand pointer + +int i, nops, found, optype, imnum +pointer sp, buf +pointer op, param, emsg +pointer im + +#int ex_ptype() +int imgeti(), imgftype(), btoi(), ctoi() +bool streq(), imgetb() +double imgetd() + +define getpar_ 99 + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call salloc (param, SZ_FNAME, TY_CHAR) + call salloc (emsg, SZ_LINE, TY_CHAR) + call aclrc (Memc[buf], SZ_LINE) + call aclrc (Memc[param], SZ_FNAME) + call aclrc (Memc[emsg], SZ_LINE) + + if (VDEBUG) { call eprintf ("getop: opname=%s ");call pargstr(opname)} + + # First see if it's one of the special image operands that was + # referenced in an "@param" call. + + if (((opname[1] != 'i' && opname[1] != 'b') && !IS_DIGIT(opname[2])) || + (opname[1] == 'i' && opname[2] == '_')) { + call strcpy (opname, Memc[param], SZ_FNAME) + im = IO_IMPTR(IMOP(ex,1)) +getpar_ O_LEN(o) = 0 + switch (imgftype (im, Memc[param])) { + case TY_BOOL: + O_TYPE(o) = TY_BOOL + O_VALI(o) = btoi (imgetb (im, Memc[param])) + case TY_CHAR: + O_TYPE(o) = TY_CHAR + O_LEN(o) = SZ_LINE + call malloc (O_VALP(o), SZ_LINE, TY_CHAR) + call imgstr (im, Memc[param], O_VALC(o), SZ_LINE) + case TY_INT: + O_TYPE(o) = TY_INT + O_VALI(o) = imgeti (im, Memc[param]) + case TY_REAL: + O_TYPE(o) = TY_DOUBLE + O_VALD(o) = imgetd (im, Memc[param]) + default: + call sprintf (Memc[emsg], SZ_LINE, "param %s not found\n") + call pargstr (Memc[param]) + call error (6, Memc[emsg]) + } + + call sfree (sp) + return + + } else if (IS_LOWER(opname[1]) && opname[3] == '.') { + # This is a tag.param operand. Break out the image tag name and + # get the image pointer for it, then get the parameter + if (opname[1] == 'b') { # band of 3-D image, only 1 ptr + imnum = 1 + } else if (opname[1] == 'i') { # image descriptor + i = 2 + if (ctoi (opname, i, imnum) == 0) + call error (6, "can't parse operand") + } else { + call sprintf (Memc[buf], SZ_LINE, + "Unknown outbands operand `%s'\n") + call pargstr(opname) + call error (1, Memc[buf]) + } + + # Get the parameter value. + im = IO_IMPTR(IMOP(ex,imnum)) + call strcpy (opname[4], Memc[param], SZ_FNAME) + goto getpar_ + } + + nops = EX_NIMOPS(ex) + found = NO + do i = 1, nops { + # Search for operand name which matches requested value. + op = IMOP(ex,i) + if (streq (Memc[IO_TAG(op)],opname)) { + found = YES + break + } + } + + if (VDEBUG && found == YES) { + call eprintf (" tag=%s found=%d ") + call pargstr(Memc[IO_TAG(op)]) ; call pargi(found) + call zze_prop (op) + } + + if (found == YES) { + # Copy operand descriptor to 'o' + #optype = ex_ptype (IO_TYPE(op), IO_NBYTES(op)) + optype = IO_TYPE(op) + switch (optype) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + O_LEN(o) = IO_NPIX(op) + O_TYPE(o) = TY_SHORT + call malloc (O_VALP(o), IO_NPIX(op), TY_SHORT) + call amovs (Mems[IO_DATA(op)], Mems[O_VALP(o)], IO_NPIX(op)) + $for (ilrd) + case TY_PIXEL: + O_LEN(o) = IO_NPIX(op) + O_TYPE(o) = TY_PIXEL + call malloc (O_VALP(o), IO_NPIX(op), TY_PIXEL) + call amov$t (Mem$t[IO_DATA(op)], Mem$t[O_VALP(o)], IO_NPIX(op)) + $endfor + } + + } else { + call sprintf (Memc[buf], SZ_LINE, "Unknown outbands operand `%s'\n") + call pargstr(opname) + call error (1, Memc[buf]) + } + + call sfree (sp) +end + + +# EX_OBFCN -- Called by evvexpr to execute import outbands special functions. + +procedure ex_obfcn (ex, fcn, args, nargs, o) + +pointer ex #i package pointer +char fcn[ARB] #i function to be executed +pointer args[ARB] #i argument list +int nargs #i number of arguments +pointer o #o operand pointer + +pointer sp, buf +pointer r, g, b, gray +pointer scaled, data +int i, len, v_nargs, func, nbins +short sz1, sz2, sb1, sb2, zero +real gamma, bscale, bzero, scale, pix +real z1, z2 + +int strdic() +bool fp_equalr(), strne() + +define setop_ 99 + +begin + call smark (sp) + call salloc (buf, SZ_FNAME, TY_CHAR) + + # Lookup function in dictionary. + func = strdic (fcn, Memc[buf], SZ_LINE, OB_FUNCTIONS) + if (func > 0 && strne(fcn,Memc[buf])) + func = 0 + + # Abort if the function is not known. + if (func <= 0) + call xev_error1 ("unknown function `%s' called", fcn) + + # Verify the correct number of arguments, negative value means a + # variable number of args, handle it in the evaluation. + switch (func) { + case GRAY, GREY: + v_nargs = 3 + case ZSCALE: + v_nargs = -1 + case BSCALE: + v_nargs = 3 + case GAMMA: + v_nargs = -1 + case BLOCK: + v_nargs = 3 + } + if (v_nargs > 0 && nargs != v_nargs) + call xev_error2 ("function `%s' requires %d arguments", + fcn, v_nargs) + else if (v_nargs < 0 && nargs < abs(v_nargs)) + call xev_error2 ("function `%s' requires at least %d arguments", + fcn, abs(v_nargs)) + + if (DEBUG) { + call eprintf ("obfcn: nargs=%d func=%d\n") + call pargi (nargs) ; call pargi (func) + do i = 1, nargs { call eprintf ("\t") ; call zze_pevop (args[i]) } + call flush (STDERR) + } + + # Evaluate the function. + zero = 0 + switch (func) { + case GRAY, GREY: + # evaluate expression for NTSC grayscale. + r = O_VALP(args[1]) + g = O_VALP(args[2]) + b = O_VALP(args[3]) + len = O_LEN(args[1]) - 1 + O_LEN(o) = len + 1 + O_TYPE(o) = TY_REAL + call malloc (O_VALP(o), len+1, TY_REAL) + gray = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + do i = 0, len { + Memr[gray+i] = R_COEFF * Mems[r+i] + + G_COEFF * Mems[g+i] + + B_COEFF * Mems[b+i] + } + $for (ilrd) + case TY_PIXEL: + do i = 0, len { + Memr[gray+i] = R_COEFF * Mem$t[r+i] + + G_COEFF * Mem$t[g+i] + + B_COEFF * Mem$t[b+i] + } + $endfor + } + + case ZSCALE: + data = O_VALP(args[1]) + switch (O_TYPE(args[2])) { + case TY_SHORT: z1 = O_VALS(args[2]) + case TY_INT: z1 = O_VALI(args[2]) + case TY_LONG: z1 = O_VALL(args[2]) + case TY_REAL: z1 = O_VALR(args[2]) + case TY_DOUBLE: z1 = O_VALD(args[2]) + } + switch (O_TYPE(args[3])) { + case TY_SHORT: z2 = O_VALS(args[3]) + case TY_INT: z2 = O_VALI(args[3]) + case TY_LONG: z2 = O_VALL(args[3]) + case TY_REAL: z2 = O_VALR(args[3]) + case TY_DOUBLE: z2 = O_VALD(args[3]) + } + if (nargs < 4) + nbins = 256 + else + nbins = O_VALI(args[4]) + len = O_LEN(args[1]) + O_LEN(o) = len + O_TYPE(o) = O_TYPE(args[1]) + call malloc (O_VALP(o), len, O_TYPE(args[1])) + scaled = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + sz1 = z1 + sz2 = z2 + sb1 = 0 + sb2 = nbins - 1 + if (abs(sz2-sz1) > 1.0e-5) + call amaps (Mems[data], Mems[scaled], len, sz1, sz2, + sb1, sb2) + else + call amovks (0, Mems[scaled], len) + $for (ilrd) + case TY_PIXEL: + if (abs(z2-z1) > 1.0e-5) + call amap$t (Mem$t[data], Mem$t[scaled], len, PIXEL (z1), + PIXEL(z2), PIXEL (0), PIXEL (nbins-1)) + else + call amovk$t (PIXEL (0), Mem$t[scaled], len) + $endfor + } + + case BSCALE: + data = O_VALP(args[1]) + bzero = O_VALR(args[2]) + bscale = O_VALR(args[3]) + len = O_LEN(args[1]) - 1 + O_LEN(o) = len + 1 + O_TYPE(o) = TY_REAL + call malloc (O_VALP(o), len+1, TY_REAL) + scaled = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + if (!fp_equalr (0.0, bscale)) { + do i = 0, len + Memr[scaled+i] = (Mems[data+i] - bzero) / bscale + } else + call amovks (zero, Mems[scaled], len) + $for (ilrd) + case TY_PIXEL: + if (!fp_equalr (0.0, bscale)) { + do i = 0, len + Memr[scaled+i] = (Mem$t[data+i] - bzero) / bscale + } else + call amovk$t (PIXEL(0), Mem$t[scaled], len) + $endfor + } + + case GAMMA: + data = O_VALP(args[1]) + gamma = 1.0 / O_VALR(args[2]) + if (nargs == 3) + scale = max (1.0, O_VALR(args[3])) + else + scale = 255.0 + len = O_LEN(args[1]) - 1 + O_LEN(o) = len + 1 + O_TYPE(o) = TY_REAL + call malloc (O_VALP(o), len+1, TY_REAL) + scaled = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + do i = 0, len { + pix = max (zero, Mems[data+i]) + Memr[scaled+i] = scale * ((pix/scale) ** gamma) + } + $for (ilrd) + case TY_PIXEL: + do i = 0, len { + pix = max (PIXEL(0), Mem$t[data+i]) + Memr[scaled+i] = scale * ((pix/scale) ** gamma) + } + $endfor + } + + case BLOCK: + len = O_VALI(args[2]) + O_LEN(o) = len + O_TYPE(o) = O_TYPE(args[1]) + call malloc (O_VALP(o), len, O_TYPE(args[1])) + scaled = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + call amovks (O_VALS(args[1]), Mems[scaled], len) + case TY_INT: + call amovki (O_VALI(args[1]), Memi[scaled], len) + case TY_LONG: + call amovkl (O_VALL(args[1]), Meml[scaled], len) + case TY_REAL: + call amovkr (O_VALR(args[1]), Memr[scaled], len) + case TY_DOUBLE: + call amovkd (O_VALD(args[1]), Memd[scaled], len) + } + + + } + + if (DEBUG) { call zze_pevop (o) } + + call sfree (sp) +end diff --git a/pkg/dataio/export/export.h b/pkg/dataio/export/export.h new file mode 100644 index 00000000..279e4378 --- /dev/null +++ b/pkg/dataio/export/export.h @@ -0,0 +1,155 @@ +# EXPORT.H -- Main include file for the task structure. + +# Main task structure. +define SZ_EXPSTRUCT 40 +define SZ_EXPSTR (20*SZ_LINE) +define EX_UNDEFINED -999 +define MAX_OBEXPR 250 +define MAX_OPERANDS 50 + + +define EX_FD Memi[$1] # output binary file descriptor +define EX_HEADER Memi[$1+1] # write an output header? +define EX_OUTTYPE Memi[$1+2] # outtype parameter value +define EX_INTERLEAVE Memi[$1+3] # interleave parameter value +define EX_BSWAP Memi[$1+4] # bswap parameter value +define EX_VERBOSE Memi[$1+5] # verbose parameter value + +define EX_FORMAT Memi[$1+6] # format parameter code +define EX_BLTIN Memi[$1+7] # buitlin format code +define EX_COLOR Memi[$1+8] # does format support color? +define EX_OROWS Memi[$1+9] # no. rows in output image +define EX_OCOLS Memi[$1+10] # no. cols in output image + +define EX_IMDIM Memi[$1+11] # input image list dimensionality +define EX_IMTYPE Memi[$1+12] # input image list type +define EX_NIMAGES Memi[$1+13] # number of images to convert +define EX_NCOLS Memi[$1+14] # number of columns in image +define EX_NLINES Memi[$1+15] # number of lines in image +define EX_NEXPR Memi[$1+16] # number of outbands expressions +define EX_NIMOPS Memi[$1+17] # image operand array (ptr) +define EX_IMOPS Memi[$1+18] # image operand array (ptr) + +define EX_OUTFLAGS Memi[$1+20] # output format flags +define EX_BFNPTR Memi[$1+21] # binary file name (ptr) +define EX_HDRPTR Memi[$1+22] # user-defined head file (ptr) +define EX_OTPTR Memi[$1+23] # output type string (ptr) +define EX_OBPTR Memi[$1+24] # outbands expression string (ptr) +define EX_CMPTR Memi[$1+25] # colormap filename (ptr) +define EX_LUTPTR Memi[$1+26] # LUT filename (ptr) +define EX_TIMPTR Memi[$1+27] # temp image name (ptr) +define EX_PSDPI Memr[P2R($1+28)] # EPS dpi resolution +define EX_PSSCALE Memr[P2R($1+29)] # EPS scale +define EX_BRIGHTNESS Memr[P2R($1+30)] # display brightness value +define EX_CONTRAST Memr[P2R($1+31)] # display contrast value + +define EX_CMAP Memi[$1+32] # colormap struct (ptr) +define EX_NCOLORS Memi[$1+33] # no. of colors in colormap +define EX_LUT Memi[$1+34] # LUT struct (ptr) +define EX_NLUTEL Memi[$1+35] # no. of indices in lut +define EX_OBANDS Memi[$1+36] # outbands array (ptr) + + +# Handy macros. +define HDRFILE Memc[EX_HDRPTR($1)] +define LUTFILE Memc[EX_LUTPTR($1)] +define CMAPFILE Memc[EX_CMPTR($1)] +define BFNAME Memc[EX_BFNPTR($1)] +define TIMNAME Memc[EX_TIMPTR($1)] +define OBANDS Memi[EX_OBANDS($1)+$2-1] +define IMOP Memi[EX_IMOPS($1)+$2-1] + + +# Define the outbands struct. +define LEN_OUTBANDS 5 +define OB_EXPSTR Memi[$1] # expression string (ptr) +define OB_WIDTH Memi[$1+1] # expression width +define OB_HEIGHT Memi[$1+2] # expression height + +define O_EXPR Memc[OB_EXPSTR(OBANDS($1,$2))] +define O_WIDTH OB_WIDTH(OBANDS($1,$2)) +define O_HEIGHT OB_HEIGHT(OBANDS($1,$2)) + + +# Operand structure. +define LEN_OPERAND 10 +define IO_IMPTR Memi[$1] # image descriptor +define IO_BAND Memi[$1+1] # image band +define IO_LINE Memi[$1+2] # image line + +define IO_TAG Memi[$1+3] # operand tag name +define IO_TYPE Memi[$1+4] # operand type +define IO_NBYTES Memi[$1+5] # number of bytes +define IO_NPIX Memi[$1+6] # number of pixels +define IO_DATA Memi[$1+7] # pixel ptr +define IO_ISIM Memi[$1+8] # is data an image ptr? + +define OP_TAG Memc[IO_TAG($1)] + +#----------------------------------------------------------------------------- +# Useful Macro Definitions. + +define bitset (and($1,$2)==($2)) + +# Format flags. +define FMT_RAW 1 # write a generic binary raster +define FMT_LIST 2 # list pixels values to the screen +define FMT_BUILTIN 3 # write a builtin format + +# OUTPUT FLAGS: +# Byte swapping flags. +define S_NONE 0000B # swap nothing +define S_ALL 0001B # swap everything +define S_I2 0002B # swap short ints +define S_I4 0004B # swap long ints +define SWAP_STR "|no|none|yes|i2|i4|" + +# Pixel storage flags. +define PIXEL_STORAGE 0001B # { {RGB} {RGB} ... {RGB} ... } +define LINE_STORAGE 0002B # { {RRRR} {GGG} {BBB} .... {RRR} ... } +define BAND_STORAGE 0004B # { {RR..RRR} {GG...GGG} {BB..BBB} } + +# Output flags. +define OF_CMAP 00010B # a colormap was defined +define OF_MKCMAP 00020B # compute a colormap +define OF_BAND 00040B # force band storage +define OF_LINE 00100B # force line storage +define OF_FLIPX 00200B # flip image in X +define OF_FLIPY 00400B # flip image in Y +define OF_IEEE 01000B # write IEEE floating point + +# Header flags. +define HDR_NONE 1 # no output header +define HDR_SHORT 2 # write a short header +define HDR_LONG 3 # write a verbose header +define HDR_USER 4 # user defined a file + +# Pixtype pixel types. +define PT_BYTE 1 # byte data (no conversion) +define PT_UINT 2 # unsigned integer +define PT_INT 3 # signed integer +define PT_IEEE 4 # ieee floating point +define PT_NATIVE 5 # native floating point +define PT_SKIP 6 # skip + +# EPS output params. +define EPS_DPI 72 # dpi resolution +define EPS_SCALE 1.0 # output scale + +# Define colormap/grayscale macros and parameters. +define CMAP_SIZE 256 # Output colormap length +define CMAP_MAX 255 # Maximum map value +define CMAP Memc[$1+($2*CMAP_SIZE)+$3-1] + +define R_COEFF 0.299 # NTSC grayscale coefficients +define G_COEFF 0.587 +define B_COEFF 0.114 + +define EX_RED 0 # color flags +define EX_GREEN 1 +define EX_BLUE 2 + +define SAMPLE_SIZE 10000 # default zscale() sample size +define CONTRAST 0.25 # default zscale() contrast +define SAMP_LEN 40 # default zscale() sample length + diff --git a/pkg/dataio/export/expreproc.x b/pkg/dataio/export/expreproc.x new file mode 100644 index 00000000..579f1fde --- /dev/null +++ b/pkg/dataio/export/expreproc.x @@ -0,0 +1,352 @@ +include +include +include "export.h" +include "exfcn.h" + +define DEBUG false + + +# EX_PREPROCESS - Some of the output functions aren't really applied to +# each line in the image (which is how the expressions are evaluated) but +# just define some feature of the whole output image. We'll strip out +# those functions here and set a flag so that the expression evaluation +# code doesn't have to see them. + +procedure ex_preprocess (ex, expr) + +pointer ex #i task struct pointer +char expr[ARB] #i input expression strings + +char expstr[SZ_EXPSTR] +int ip, pp, last_ip, explen +char func[SZ_FNAME] +bool saw_output_func + +int strlen(), strdic(), nowhite() + +errchk ex_pp_setcmap, ex_pp_psdpi +errchk ex_cnt_parens, ex_pp_psscale + +begin + # Strip out any whitespace chars. + call aclrc (expstr, SZ_EXPSTR) + ip = nowhite (expr, expstr, SZ_EXPSTR) + + # Do a quick syntax check. + iferr (call ex_cnt_parens (expstr)) + call erract (EA_FATAL) + + # Only some functions may be nested, loop until we're forced to break. + # The functions have a precedence such that "special functions" + # may have as arguments "output functions". Below that are "scaling + # functions" and "builtin functions" that are evaluated for each image + # line. Functions w/in the same class may/may not call each other + # where it makes sense, we check for that here. + # + # The precedence order is: + # + # CMAP, SETCMAP, PSDPI, PSSCALE + # BAND, LINE, FLIPX, FLIPY + # ZSCALE, GRAY, BSCALE, GAMMA + # builtin functions + + if (DEBUG) { call eprintf("preproc: str=`%s'\n");call pargstr(expstr) } + + saw_output_func = false + for (ip = 1 ; expstr[ip] == '(' ; ip = ip + 1) + ; + + last_ip = 1 + explen = strlen (expstr) + repeat { + # Get the function name. + pp = 1 + call aclrc (func, SZ_FNAME) + while (expstr[ip] != '(' && expstr[ip] != EOS) { + func[pp] = expstr[ip] + ip = ip + 1 + pp = pp + 1 + } + func[pp+1] = EOS + if (expstr[ip] == EOS) { + call strcpy (expstr[last_ip], expr, SZ_EXPSTR) + return + } + if (DEBUG) { call eprintf("\tfunc=`%s'\n");call pargstr(func) } + + # Update pointer into string past '('. + ip = ip + 1 + + switch (strdic (func, func, SZ_FNAME, OB_FUNCTIONS)) { + + case CMAP: + if (EX_NEXPR(ex) > 1) + call error (4, + "cmap() func allowed only in single expression") + if (saw_output_func) + call error (5, + "Function cmap() may not be nested in output func.") + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_MKCMAP) + + case SETCMAP: + if (EX_NEXPR(ex) > 1) + call error (4, + "setcmap() func allowed only in single expression") + if (saw_output_func) + call error (5, + "Function setcmap(0 may not be nested in output func.") + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_CMAP) + iferr (call ex_pp_setcmap (ex, expstr[ip])) + call erract (EA_FATAL) + last_ip = ip + explen = strlen (expstr) + next + + case PSDPI: + if (EX_NEXPR(ex) > 1) + call error (4, + "psdpi() func allowed only in single expression") + if (saw_output_func) + call error (5, + "Function psdpi() may not be nested in output func.") + iferr (call ex_pp_psdpi (ex, expstr[ip])) + call erract (EA_FATAL) + last_ip = ip + explen = strlen (expstr) + next + + case PSSCALE: + if (EX_NEXPR(ex) > 1) + call error (4, + "psscale() func allowed only in single expression") + if (saw_output_func) + call error (5, + "Function psscale() may not be nested in output func.") + iferr (call ex_pp_psscale (ex, expstr[ip])) + call erract (EA_FATAL) + last_ip = ip + explen = strlen (expstr) + next + + + case BAND: + saw_output_func = true + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_BAND) + case LINE: + saw_output_func = true + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_LINE) + case FLIPX: + saw_output_func = true + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPX) + case FLIPY: + saw_output_func = true + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), OF_FLIPY) + + default: + # No special function seen so just punt. + break + } + + last_ip = ip # update string ptr + if (expstr[explen] != ')') + call error (5, + "Malformed expression, expecting ')' as last char") + expstr[explen] = EOS # remove trailing right paren + } + + # Copy expression from current ip to begining of buffer. + call strcpy (expstr[last_ip], expr, SZ_EXPSTR) + + if (DEBUG) { call eprintf("\tfixed exp =`%s'\n");call pargstr(expr) } +end + + +# EX_PP_SETCMAP - Process the SETCMAP special function. + +procedure ex_pp_setcmap (ex, expstr) + +pointer ex #i task struct pointer +char expstr[ARB] #i expression string + +pointer sp, cm, cmap +int ip, lp # string pointers +int tp, i # where to trim the string + +int ctor() +bool streq() +include "cmaps.inc" + +begin + call smark (sp) + call salloc (cm, SZ_FNAME, TY_CHAR) + call aclrc (Memc[cm], SZ_FNAME) + + if (DEBUG) { call eprintf("\t\texp=`%s'\n");call pargstr(expstr)} + + # Skip ahead to a quote char single or double) indicating colormap + # name, we also stop at another non-blank char incase they didn't + # use quotes. If we find a comma, back up one so it's handled below. + ip = 1 + while (expstr[ip] != EOS && + expstr[ip] != '"' && + expstr[ip] != '\'') { + if (expstr[ip] == '@') + for (ip=ip+2; expstr[ip] != '"'; ip=ip+1) + ; + ip = ip + 1 + } + tp = ip - 1 + + if (expstr[ip+1] == '"' || (expstr[ip+1]==' ' && expstr[ip+2]=='"') || + expstr[ip+1] == '\'' || (expstr[ip+1]==' ' && expstr[ip+2]=='\'')) { + # No colormap file specified, assume it's a greyscale. + call strcpy ("greyscale", CMAPFILE(ex), SZ_FNAME) + ip = ip + 1 + + } else { + # Get colormap name and put it in the task struct. + ip = ip + 1 + lp = 0 + repeat { + Memc[cm+lp] = expstr[ip] + lp = lp + 1 + ip = ip + 1 + } until (expstr[ip] == EOS || expstr[ip] == '"' || + expstr[ip] == '\'') + call strcpy (Memc[cm], CMAPFILE(ex), SZ_FNAME) + } + + # Allocate the colormap pointer and read the colormap. + iferr (call calloc (EX_CMAP(ex), 3*CMAP_SIZE, TY_CHAR)) + call error (0, "Error allocating colormap pointer.") + call ex_read_cmap (ex, CMAPFILE(ex)) + + # Get optional brightness and contrast values. + ip = ip + 1 + if (expstr[ip] == ',') { + ip = ip + 1 + if (ctor (expstr, ip, EX_BRIGHTNESS(ex)) == 0) + call error (5, "cannot interpret brightness value") + ip = ip + 1 + if (ctor (expstr, ip, EX_CONTRAST(ex)) == 0) + call error (5, "cannot interpret contrast value") + + # Don't scale the overlay colors in colormap. + if (streq(CMAPFILE(ex), "overlay")) { + cmap = EX_CMAP(ex) + call ex_scale_cmap (cmap, 200, + EX_BRIGHTNESS(ex), EX_CONTRAST(ex)) + + # Patch up the static overlay colors. + do i = 201, 255 { + Memc[cmap+(EX_RED*CMAP_SIZE)+i] = overlay[i*3+1] + Memc[cmap+(EX_GREEN*CMAP_SIZE)+i] = overlay[i*3+2] + Memc[cmap+(EX_BLUE*CMAP_SIZE)+i] = overlay[i*3+3] + } + } else { + call ex_scale_cmap (EX_CMAP(ex), EX_NCOLORS(ex), + EX_BRIGHTNESS(ex), EX_CONTRAST(ex)) + } + } + + # We should be at the end of the string now. + if (expstr[ip] != ')') + call error (5, "Malformed expression, expecting ')' as last char") + + if (DEBUG) { + call eprintf("\t\tcmfile=`%s' brightness=%g contrast=%g\n") + call pargstr(CMAPFILE(ex));call pargr(EX_BRIGHTNESS(ex)) + call pargr(EX_CONTRAST(ex)) + } + + # Now trim the expression string. + expstr[tp] = EOS + call sfree (sp) +end + + +# EX_PP_PSDPI - Process the PSDPI special function. + +procedure ex_pp_psdpi (ex, expstr) + +pointer ex #i task struct pointer +char expstr[ARB] #i expression string + +int ip, tp +int ctor(), strlen() + +begin + if (DEBUG) { call eprintf("\t\texp=`%s'\n");call pargstr(expstr)} + + # The last argument is required to be the dpi resolution so pull + # it out. + ip = strlen (expstr) + while (expstr[ip] != ',') { + ip = ip - 1 + if (expstr[ip] == ')' || IS_ALPHA(expstr[ip])) + call error (6, "syntax error") + } + + tp = ip + ip = ip + 1 + if (ctor(expstr,ip,EX_PSDPI(ex)) == 0) + call error (5, "cannot interpret EPS dpi value") + + # Now trim the expression string. + expstr[tp] = EOS +end + + +# EX_PP_PSSCALE - Process the PSSCALE special function. + +procedure ex_pp_psscale (ex, expstr) + +pointer ex #i task struct pointer +char expstr[ARB] #i expression string + +int ip, tp +int ctor(), strlen() + +begin + if (DEBUG) { call eprintf("\t\texp=`%s'\n");call pargstr(expstr)} + + # The last argument is required to be the dpi resolution so pull + # it out. + ip = strlen (expstr) + while (expstr[ip] != ',') { + ip = ip - 1 + if (expstr[ip] == ')' || IS_ALPHA(expstr[ip])) + call error (6, "syntax error") + } + + tp = ip + ip = ip + 1 + if (ctor(expstr,ip,EX_PSSCALE(ex)) == 0) + call error (5, "cannot interpret EPS scale value") + + # Now trim the expression string. + expstr[tp] = EOS +end + + +# EX_CNT_PARENS - Count the number of parentheses in the expression string. + +procedure ex_cnt_parens (expr) + +char expr[ARB] #i outbands expression strinf + +int ip, plev + +begin + ip = 1 + plev = 0 + while (expr[ip] != EOS) { + if (expr[ip] == '(') plev = plev + 1 + if (expr[ip] == ')') plev = plev - 1 + ip = ip + 1 + } + if (plev > 0) + call error (5, "Missing right paren in `outbands' expression.") + if (plev < 0) + call error (5, "Missing left paren in `outbands' expression.") +end diff --git a/pkg/dataio/export/exraster.gx b/pkg/dataio/export/exraster.gx new file mode 100644 index 00000000..a4c08710 --- /dev/null +++ b/pkg/dataio/export/exraster.gx @@ -0,0 +1,621 @@ +include +include +include +include "../export.h" + +define DEBUG false + + +# EX_NO_INTERLEAVE - Write out the image with no interleaving. + +procedure ex_no_interleave (ex) + +pointer ex #i task struct pointer + +pointer op, out +int i, j, k, line, percent, orow +int fd, outtype + +pointer ex_evaluate(), ex_chtype() + +begin + if (DEBUG) { call eprintf ("ex_no_interleave:\n") + call eprintf ("NEXPR = %d OCOLS = %d OROWS = %d\n") + call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex)) + call pargi(EX_OROWS(ex)) + } + + # Loop over the number of image expressions. + fd = EX_FD(ex) + outtype = EX_OUTTYPE(ex) + percent = 0 + orow = 0 + 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 + line = O_HEIGHT(ex,i) - 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, outtype) + + # Write evaluated pixels. + if (EX_FORMAT(ex) != FMT_LIST) + call ex_wpixels (fd, outtype, out, O_LEN(op)) + else { + call ex_listpix (fd, outtype, out, O_LEN(op), j, i, + EX_NEXPR(ex), NO) + } + + # Clean up the pointers. + if (outtype == TY_UBYTE || outtype == TY_CHAR) + call mfree (out, TY_CHAR) + else + call mfree (out, outtype) + call evvfree (op) + do k = 1, EX_NIMOPS(ex) { + op = IMOP(ex,k) +# if (IO_ISIM(op) == NO) + call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op))) + } + + # Print percent done if being verbose + orow = orow + 1 + #if (EX_VERBOSE(ex) == YES) + call ex_pstat (ex, orow, percent) + } + } + + if (DEBUG) { call zze_prstruct ("Finished processing", ex) } +end + + +# EX_LN_INTERLEAVE - Write out the image with line interleaving. + +procedure ex_ln_interleave (ex) + +pointer ex #i task struct pointer + +pointer op, out +int i, j, line, percent, orow +int fd, outtype + +pointer ex_evaluate(), ex_chtype() + +begin + if (DEBUG) { call eprintf ("ex_ln_interleave:\n") + call eprintf ("NEXPR = %d OCOLS = %d OROWS = %d\n") + call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex)) + call pargi(EX_OROWS(ex)) + } + + # Process each line in the image. + fd = EX_FD(ex) + outtype = EX_OUTTYPE(ex) + percent = 0 + orow = 0 + do i = 1, EX_NLINES(ex) { + + # See if we're flipping the image. + if (bitset (EX_OUTFLAGS(ex), OF_FLIPY)) + line = EX_NLINES(ex) - i + 1 + else + line = i + + # Get pixels from image(s). + call ex_getpix (ex, line) + + # Loop over the number of image expressions. + do j = 1, EX_NEXPR(ex) { + + # Evaluate expression. + op = ex_evaluate (ex, O_EXPR(ex,j)) + + # Convert to the output pixel type. + out = ex_chtype (ex, op, outtype) + + # Write evaluated pixels. + if (EX_FORMAT(ex) != FMT_LIST) + call ex_wpixels (fd, outtype, out, O_LEN(op)) + else { + call ex_listpix (fd, outtype, out, O_LEN(op), i, j, + EX_NEXPR(ex), NO) + } + + # Clean up the pointers. + if (outtype == TY_UBYTE || outtype == TY_CHAR) + call mfree (out, TY_CHAR) + else + call mfree (out, outtype) + call evvfree (op) + + # Print percent done if being verbose + orow = orow + 1 + #if (EX_VERBOSE(ex) == YES) + call ex_pstat (ex, orow, percent) + } + + do j = 1, EX_NIMOPS(ex) { + op = IMOP(ex,j) +# if (IO_ISIM(op) == NO) + call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op))) + } + } + + if (DEBUG) { call zze_prstruct ("Finished processing", ex) } +end + + +# EX_PX_INTERLEAVE - Write out the image with pixel interleaving. + +procedure ex_px_interleave (ex) + +pointer ex #i task struct pointer + +pointer sp, pp, op +pointer o, outptr +int i, j, line, npix, outtype +long totpix +int fd, percent, orow + +pointer ex_evaluate(), ex_chtype() + +begin + if (DEBUG) { call eprintf ("ex_px_interleave:\n") + call eprintf ("NEXPR = %d OCOLS = %d OROWS = %d\n") + call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex)) + call pargi(EX_OROWS(ex)) + } + + call smark (sp) + call salloc (pp, EX_NEXPR(ex), TY_POINTER) + + # Process each line in the image. + fd = EX_FD(ex) + outptr = NULL + outtype = EX_OUTTYPE(ex) + percent = 0 + orow = 0 + do i = 1, EX_NLINES(ex) { + + # See if we're flipping the image. + if (bitset (EX_OUTFLAGS(ex), OF_FLIPY)) + line = EX_NLINES(ex) - i + 1 + else + line = i + + # Get pixels from image(s). + call ex_getpix (ex, line) + + # Loop over the number of image expressions. + totpix = 0 + do j = 1, EX_NEXPR(ex) { + + # Evaluate expression. + op = ex_evaluate (ex, O_EXPR(ex,j)) + + # Convert to the output pixel type. + o = ex_chtype (ex, op, outtype) + Memi[pp+j-1] = o + + npix = O_LEN(op) + #npix = EX_OCOLS(op) + call evvfree (op) + } + + # Merge pixels into a single vector. + call ex_merge_pixels (Memi[pp], EX_NEXPR(ex), npix, outtype, + outptr, totpix) + + # Write vector of merged pixels. + if (outtype == TY_UBYTE) + call achtsb (Memc[outptr], Memc[outptr], totpix) + if (EX_FORMAT(ex) != FMT_LIST) + call ex_wpixels (fd, outtype, outptr, totpix) + else { + call ex_listpix (fd, outtype, outptr, totpix, + i, EX_NEXPR(ex), EX_NEXPR(ex), YES) + } + + if (outtype != TY_CHAR && outtype != TY_UBYTE) + call mfree (outptr, outtype) + else + call mfree (outptr, TY_CHAR) + do j = 1, EX_NIMOPS(ex) { + op = IMOP(ex,j) +# if (IO_ISIM(op) == NO) + call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op))) + } + do j = 1, EX_NEXPR(ex) { + if (outtype != TY_CHAR && outtype != TY_UBYTE) + call mfree (Memi[pp+j-1], outtype) + else + call mfree (Memi[pp+j-1], TY_CHAR) + } + + # Print percent done if being verbose + orow = orow + 1 + #if (EX_VERBOSE(ex) == YES) + call ex_pstat (ex, orow, percent) + } + + call sfree (sp) + + if (DEBUG) { call zze_prstruct ("Finished processing", ex) } +end + + +# EX_GETPIX - Get the pixels from the image and load each operand. + +procedure ex_getpix (ex, line) + +pointer ex #i task struct pointer +int line #i current line number + +pointer im, op, data +int nptrs, i, band + +pointer imgl3s(), imgl3i(), imgl3l() +pointer imgl3r(), imgl3d() + +begin + # Loop over each of the image operands. + nptrs = EX_NIMOPS(ex) + do i = 1, nptrs { + op = IMOP(ex,i) + im = IO_IMPTR(op) + band = max (1, IO_BAND(op)) + + if (line > IM_LEN(im,2)) { + call calloc (IO_DATA(op), IM_LEN(im,1), IM_PIXTYPE(im)) + IO_ISIM(op) = NO + IO_NPIX(op) = IM_LEN(im,1) + next + } else if (IO_DATA(op) == NULL) + call malloc (IO_DATA(op), IM_LEN(im,1), IM_PIXTYPE(im)) + + switch (IM_PIXTYPE(im)) { + case TY_USHORT: + data = imgl3s (im, line, band) + call amovs (Mems[data], Mems[IO_DATA(op)], IM_LEN(im,1)) + IO_TYPE(op) = TY_SHORT + IO_NBYTES(op) = SZ_SHORT * SZB_CHAR + IO_ISIM(op) = YES + $for (silrd) + case TY_PIXEL: + data = imgl3$t (im, line, band) + call amov$t (Mem$t[data], Mem$t[IO_DATA(op)], IM_LEN(im,1)) + IO_TYPE(op) = TY_PIXEL + $if (datatype == i) + IO_NBYTES(op) = SZ_INT32 * SZB_CHAR + $else + IO_NBYTES(op) = SZ_PIXEL * SZB_CHAR + $endif + IO_ISIM(op) = YES + $endfor + } + IO_NPIX(op) = IM_LEN(im,1) + } +end + + +# EX_WPIXELS - Write the pixels to the current file. + +procedure ex_wpixels (fd, otype, pix, npix) + +int fd #i output file descriptor +int otype #i output data type +pointer pix #i pointer to pixel data +int npix #i number of pixels to write + +begin + # Write binary output. + switch (otype) { + case TY_UBYTE: + call write (fd, Mems[pix], npix / SZB_CHAR) + case TY_USHORT: + call write (fd, Mems[pix], npix * SZ_SHORT/SZ_CHAR) + $for (silrd) + case TY_PIXEL: + $if (datatype == i) + if (SZ_INT != SZ_INT32) + call ipak32 (Memi[pix], Memi[pix], npix) + call write (fd, Memi[pix], npix * SZ_INT32/SZ_CHAR) + $else + call write (fd, Mem$t[pix], npix * SZ_PIXEL/SZ_CHAR) + $endif + $endfor + } +end + + +# EX_LISTPIX - Write the pixels to the current file as ASCII text. + +procedure ex_listpix (fd, type, data, npix, line, band, nbands, merged) + +int fd #i output file descriptor +int type #i output data type +pointer data #i pointer to pixel data +int npix #i number of pixels to write +int line #i current output line number +int band #i current output band number +int nbands #i no. of output bands +int merged #i are pixels interleaved? + +int i, j, k +int val, pix, shifti(), andi() + +begin + if (merged == YES && nbands > 1) { + do i = 1, npix { + k = 0 + do j = 1, nbands { + call fprintf (fd, "%4d %4d %4d ") + call pargi (i) + call pargi (line) + call pargi (j) + + switch (type) { + case TY_UBYTE: + val = Memc[data+k] + if (mod(i,2) == 1) { + pix = shifti (val, -8) + } else { + pix = andi (val, 000FFX) + k = k + 1 + } + if (pix < 0) pix = pix + 256 + call fprintf (fd, "%d\n") + call pargi (pix) + case TY_CHAR, TY_SHORT, TY_USHORT: + call fprintf (fd, "%d\n") + call pargs (Mems[data+((j-1)*npix+i)-1]) + case TY_INT: + call fprintf (fd, "%d\n") + call pargi (Memi[data+((j-1)*npix+i)-1]) + case TY_LONG: + call fprintf (fd, "%d\n") + call pargl (Meml[data+((j-1)*npix+i)-1]) + case TY_REAL: + call fprintf (fd, "%g\n") + call pargr (Memr[data+((j-1)*npix+i)-1]) + case TY_DOUBLE: + call fprintf (fd, "%g\n") + call pargd (Memd[data+((j-1)*npix+i)-1]) + } + } + } + } else { + j = 0 + do i = 1, npix { + if (nbands > 1) { + call fprintf (fd, "%4d %4d %4d ") + call pargi (i) + call pargi (line) + call pargi (band) + } else { + call fprintf (fd, "%4d %4d ") + call pargi (i) + call pargi (line) + } + + switch (type) { + case TY_UBYTE: + val = Memc[data+j] + if (mod(i,2) == 1) { + pix = shifti (val, -8) + } else { + pix = andi (val, 000FFX) + j = j + 1 + } + if (pix < 0) pix = pix + 256 + call fprintf (fd, "%d\n") + call pargi (pix) + case TY_CHAR, TY_SHORT, TY_USHORT: + call fprintf (fd, "%d\n") + call pargs (Mems[data+i-1]) + case TY_INT: + call fprintf (fd, "%d\n") + call pargi (Memi[data+i-1]) + case TY_LONG: + call fprintf (fd, "%d\n") + call pargl (Meml[data+i-1]) + case TY_REAL: + call fprintf (fd, "%g\n") + call pargr (Memr[data+i-1]) + case TY_DOUBLE: + call fprintf (fd, "%g\n") + call pargd (Memd[data+i-1]) + } + } + } +end + + +# EX_MERGE_PIXELS - Merge a group of pixels arrays into one array by combining +# the elements. Returns an allocated pointer which must be later freed and +# the total number of pixels. + +procedure ex_merge_pixels (ptrs, nptrs, npix, dtype, pix, totpix) + +pointer ptrs[ARB] #i array of pixel ptrs +int nptrs #i number of ptrs +int npix #i no. of pixels in each array +int dtype #i type of pointer to alloc +pointer pix #o output pixel array ptr +int totpix #o total no. of output pixels + +int i, j, ip + +begin + # Calculate the number of output pixels and allocate the pointer. + totpix = nptrs * npix + if (dtype != TY_CHAR && dtype != TY_UBYTE) + call realloc (pix, totpix, dtype) + else { + call realloc (pix, totpix, TY_CHAR) + do i = 1, nptrs + call achtbs (Mems[ptrs[i]], Mems[ptrs[i]], npix) + } + + # Fill the output array + ip = 0 + for (i = 1; i<=npix; i=i+1) { + do j = 1, nptrs { + switch (dtype) { + case TY_UBYTE: + Mems[pix+ip] = Mems[ptrs[j]+i-1] + case TY_USHORT: + Mems[pix+ip] = Mems[ptrs[j]+i-1] + $for (silrd) + case TY_PIXEL: + Mem$t[pix+ip] = Mem$t[ptrs[j]+i-1] + $endfor + } + + ip = ip + 1 + } + } +end + + +# EX_CHTYPE - Change the expression operand vector to the output datatype. +# We allocate and return a pointer to the correct type to the converted +# pixels, this pointer must be freed later on. Any IEEE or byte-swapping +# requests are also handled here. + +pointer procedure ex_chtype (ex, op, type) + +pointer ex #i task struct pointer +pointer op #i evvexpr operand pointer +int type #i new type of pointer + +pointer out, coerce() +int swap, flags + +begin + # Allocate the pointer and coerce it so the routine works. + if (type == TY_UBYTE || type == TY_CHAR) + call calloc (out, O_LEN(op), TY_CHAR) + else { + call calloc (out, O_LEN(op), type) + out = coerce (out, type, TY_CHAR) + } + + # If this is a color index image subtract one from the pixel value + # to get the index. + if (bitset (flags, OF_CMAP)) + call ex_pix_to_index (O_VALP(op), O_TYPE(op), O_LEN(op)) + + # Change the pixel type. + flags = EX_OUTFLAGS(ex) + swap = EX_BSWAP(ex) + switch (O_TYPE(op)) { + case TY_CHAR: + call achtc (Memc[O_VALP(op)], Memc[out], O_LEN(op), type) + + case TY_SHORT: + call achts (Mems[O_VALP(op)], Memc[out], O_LEN(op), type) + + # Do any requested byte swapping. + if (bitset (swap, S_I2) || bitset (swap, S_ALL)) + call bswap4 (Mems[out], 1, Mems[out], 1, O_LEN(op)) + + case TY_INT: + call achti (Memi[O_VALP(op)], Memc[out], O_LEN(op), type) + + # Do any requested byte swapping. + if (bitset (swap, S_I4) || bitset (swap, S_ALL)) + call bswap4 (Memi[out], 1, Memi[out], 1, O_LEN(op)) + + case TY_LONG: + call achtl (Meml[O_VALP(op)], Memc[out], O_LEN(op), type) + + # Do any requested byte swapping. + if (bitset (swap, S_I4) || bitset (swap, S_ALL)) + call bswap4 (Meml[out], 1, Meml[out], 1, O_LEN(op)) + + case TY_REAL: + call achtr (Memr[O_VALP(op)], Memc[out], O_LEN(op), type) + + # See if we need to convert to IEEE + if (bitset (flags, OF_IEEE) && IEEE_USED == NO) + call ieevpakr (Memr[out], Memr[out], O_LEN(op)) + + case TY_DOUBLE: + call achtd (Memd[O_VALP(op)], Memc[out], O_LEN(op), type) + + # See if we need to convert to IEEE + if (bitset (flags, OF_IEEE) && IEEE_USED == NO) + call ieevpakd (Memd[P2D(out)], Memd[P2D(out)], O_LEN(op)) + + default: + call error (0, "Invalid output type requested.") + } + + if (type != TY_UBYTE && type != TY_CHAR) + out = coerce (out, TY_CHAR, type) + return (out) +end + + +# EX_PIX_TO_INDEX - Convert pixel values to color index values. We assume +# the colormap has at most 256 entries. + +procedure ex_pix_to_index (ptr, type, len) + +pointer ptr #i data ptr +int type #i data type of array +int len #i length of array + +$for (silrd) +PIXEL $tindx, $tmin, $tmax +$endfor + +begin + $for (silrd) + $tindx = PIXEL (1) + $tmin = PIXEL (0) + $tmax = PIXEL (255) + $endfor + + switch (type) { + $for (silrd) + case TY_PIXEL: + call asubk$t (Mem$t[ptr], $tindx, Mem$t[ptr], len) + call amaxk$t (Mem$t[ptr], $tmin, Mem$t[ptr], len) + call amink$t (Mem$t[ptr], $tmax, Mem$t[ptr], len) + $endfor + } +end + + +# EX_PSTAT - Print information about the progress we're making. + +procedure ex_pstat (ex, row, percent) + +pointer ex #i task struct pointer +int row #u current row +int percent #u percent completed + +begin + # Print percent done if being verbose + if (row * 100 / EX_OROWS(ex) >= percent + 10) { + percent = percent + 10 + call eprintf (" Status: %2d%% complete\r") + call pargi (percent) + call flush (STDERR) + } +end diff --git a/pkg/dataio/export/exrgb8.x b/pkg/dataio/export/exrgb8.x new file mode 100644 index 00000000..9eac4705 --- /dev/null +++ b/pkg/dataio/export/exrgb8.x @@ -0,0 +1,994 @@ +include +include "export.h" + + +# Size definitions +define A_BITS 8 # Number of bits of color +define B_BITS 5 # Number of bits/pixel to use +define C_BITS 3 # Number of cells/color to use +define A_LEN 256 # 2 ** A_BITS +define B_LEN 32 # 2 ** B_BITS +define C_LEN 8 # 2 ** C_BITS +define AB_SHIFT 8 # 2 ** (A_BITS - B_BITS) +define BC_SHIFT 4 # 2 ** (B_BITS - C_BITS) +define AC_SHIFT 32 # 2 ** (A_BITS - C_BITS) + +# Color metric definitions +define R2FACT 20 # .300 * .300 * 256 = 23 +define G2FACT 39 # .586 * .586 * 256 = 88 +define B2FACT 8 # .114 * .114 * 256 = 3 + +define RED 1 +define GREEN 2 +define BLUE 3 + +# Colorbox structure +define CBOX_LEN 9 +define CBOX_NEXT Memi[$1] # pointer to next colorbox structure +define CBOX_PREV Memi[$1+1] # pointer to previous colorbox structure +define CBOX_RMIN Memi[$1+2] +define CBOX_RMAX Memi[$1+3] +define CBOX_GMIN Memi[$1+4] +define CBOX_GMAX Memi[$1+5] +define CBOX_BMIN Memi[$1+6] +define CBOX_BMAX Memi[$1+7] +define CBOX_TOTAL Memi[$1+8] + +# Color cell structure +define CCELL_LEN (A_LEN*2+1) +define CCELL_NUM_ENTS Memi[$1] +define CCELL_ENTRIES Memi[$1+2*($2)+$3+1] + +# Output number of colors +define NCOLORS 256 + + +# EX_MKCMAP -- Generate an 8-bit colormap from three input image expressions +# using Heckbert's Median Cut algorithm. The implementation of this algorithm +# was modeled, with permission, on that in the program XV written by John +# Bradley. + +procedure ex_mkcmap (ex) + +pointer ex #i task struct pointer + +pointer oim # Output image +real z1[3], dz[3] # Display ranges + +int i, ncolors +pointer sp, cmap, box_list, histogram, ColorCells +pointer freeboxes, usedboxes, ptr, im + +pointer immap(), cm_largest_box() +errchk open, immap + +begin + # Since we're creating a colormap we force the output pixel size + # to be 8-bits. + call ex_do_outtype (ex, "b1") + + # Create a temporary image of the processed expressions. We'll + # evaluate the expressions only once an save the results, later + # we'll path up the operand and expressions structs to it copies + # this out to the requested format. + + if (EX_TIMPTR(ex) == NULL) + call calloc (EX_TIMPTR(ex), SZ_FNAME, TY_CHAR) + else + call aclrc (TIMNAME(ex), SZ_FNAME) + call mktemp ("tmp$ex", TIMNAME(ex), SZ_FNAME) + oim = immap (TIMNAME(ex), NEW_IMAGE, 0) + IM_PIXTYPE(oim) = TY_SHORT + IM_LEN(oim,1) = EX_OCOLS(ex) + IM_LEN(oim,2) = EX_OROWS(ex) + IM_NDIM(oim) = 2 + + # Set input image intensity scaling. + z1[1] = 0.0 + dz[1] = 1.0 + z1[2] = 0.0 + dz[2] = 1.0 + z1[3] = 0.0 + dz[3] = 1.0 + + # Allocate color map. + ncolors = NCOLORS + call smark (sp) + call salloc (cmap, 3 * ncolors, TY_SHORT) + + # Allocate and initialize color boxes. + call salloc (box_list, ncolors * CBOX_LEN, TY_STRUCT) + + freeboxes = box_list + usedboxes = NULL + ptr = freeboxes + CBOX_PREV(ptr) = NULL + CBOX_NEXT(ptr) = ptr + CBOX_LEN + for (i=2; i CBOX_RMIN(tmp) || + CBOX_GMAX(tmp) > CBOX_GMIN(tmp) || + CBOX_BMAX(tmp) > CBOX_BMIN(tmp)) && + CBOX_TOTAL(tmp) > size) { + ptr = tmp + size = CBOX_TOTAL(tmp) + } + } + return(ptr) +end + + +# CM_SPLITBOX -- Split a box along largest dimension + +procedure cm_splitbox (box, usedboxes, freeboxes, histogram) + +pointer box #U Box to split +pointer usedboxes #U Used boxes +pointer freeboxes #U Free boxes +int histogram[B_LEN, B_LEN, B_LEN] #I Histogram + +int first, last, i, j, rdel, gdel, bdel, sum1, sum2 +pointer sp, hist, new +int ir, ig, ib +int rmin, rmax, gmin, gmax, bmin, bmax +int which + +begin + call smark (sp) + call salloc (hist, B_LEN, TY_INT) + + # see which axis is the largest, do a histogram along that + # axis. Split at median point. Contract both new boxes to + # fit points and return + + first = 1; last = 1 + rmin = CBOX_RMIN(box); rmax = CBOX_RMAX(box) + gmin = CBOX_GMIN(box); gmax = CBOX_GMAX(box) + bmin = CBOX_BMIN(box); bmax = CBOX_BMAX(box) + + rdel = rmax - rmin + gdel = gmax - gmin + bdel = bmax - bmin + + if (rdel>=gdel && rdel>=bdel) + which = RED + else if (gdel>=bdel) + which = GREEN + else + which = BLUE + + # get histogram along longest axis + switch (which) { + case RED: + for (ir=rmin; ir<=rmax; ir=ir+1) { + sum1 = 0 + for (ig=gmin; ig<=gmax; ig=ig+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + sum1 = sum1 + histogram[ir,ig,ib] + } + } + Memi[hist+ir-1] = sum1 + } + first = rmin; last = rmax + + case GREEN: + for (ig=gmin; ig<=gmax; ig=ig+1) { + sum1 = 0 + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + sum1 = sum1 + histogram[ir,ig,ib] + } + } + Memi[hist+ig-1] = sum1 + } + first = gmin; last = gmax + + case BLUE: + for (ib=bmin; ib<=bmax; ib=ib+1) { + sum1 = 0 + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + sum1 = sum1 + histogram[ir,ig,ib] + } + } + Memi[hist+ib-1] = sum1 + } + first = bmin; last = bmax + } + + + # find median point + sum1 = 0 + sum2 = CBOX_TOTAL(box) / 2 + for (i=first; i<=last; i=i+1) { + sum1 = sum1 + Memi[hist+i-1] + if (sum1 >= sum2) + break + } + if (i == first) + i = i + 1 + + + # Create new box, re-allocate points + + new = freeboxes + freeboxes = CBOX_NEXT(new) + if (freeboxes != NULL) + CBOX_PREV(freeboxes) = NULL + if (usedboxes != NULL) + CBOX_PREV(usedboxes) = new + CBOX_NEXT(new) = usedboxes + usedboxes = new + + sum1 = 0 + sum2 = 0 + for (j = first; j < i; j=j+1) + sum1 = sum1 + Memi[hist+j-1] + for (; j <= last; j=j+1) + sum2 = sum2 + Memi[hist+j-1] + CBOX_TOTAL(new) = sum1 + CBOX_TOTAL(box) = sum2 + + CBOX_RMIN(new) = rmin; CBOX_RMAX(new) = rmax + CBOX_GMIN(new) = gmin; CBOX_GMAX(new) = gmax + CBOX_BMIN(new) = bmin; CBOX_BMAX(new) = bmax + + switch (which) { + case RED: + CBOX_RMAX(new) = i-1; CBOX_RMIN(box) = i + case GREEN: + CBOX_GMAX(new) = i-1; CBOX_GMIN(box) = i + case BLUE: + CBOX_BMAX(new) = i-1; CBOX_BMIN(box) = i + } + + call cm_shrinkbox (new, histogram) + call cm_shrinkbox (box, histogram) + call sfree (sp) +end + + +# CM_SHRINKBOX -- Shrink box + +procedure cm_shrinkbox (box, histogram) + +pointer box #U Box +int histogram[B_LEN,B_LEN,B_LEN] #I Histogram + +int ir, ig, ib +int rmin, rmax, gmin, gmax, bmin, bmax + +define have_rmin 11 +define have_rmax 12 +define have_gmin 13 +define have_gmax 14 +define have_bmin 15 +define have_bmax 16 + +begin + + rmin = CBOX_RMIN(box); rmax = CBOX_RMAX(box) + gmin = CBOX_GMIN(box); gmax = CBOX_GMAX(box) + bmin = CBOX_BMIN(box); bmax = CBOX_BMAX(box) + + if (rmax > rmin) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + if (histogram[ir,ig,ib] != 0) { + rmin = ir + CBOX_RMIN(box) = rmin + goto have_rmin + } + } + } + } + +have_rmin + if (rmax > rmin) { + for (ir=rmax; ir>=rmin; ir=ir-1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + if (histogram[ir,ig,ib] != 0) { + rmax = ir + CBOX_RMAX(box) = rmax + goto have_rmax + } + } + } + } + } + } + + +have_rmax + if (gmax > gmin) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + if (histogram[ir,ig,ib] != 0) { + gmin = ig + CBOX_GMIN(box) = gmin + goto have_gmin + } + } + } + } + +have_gmin + if (gmax > gmin) { + for (ig=gmax; ig>=gmin; ig=ig-1) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + if (histogram[ir,ig,ib] != 0) { + gmax = ig + CBOX_GMAX(box) = gmax + goto have_gmax + } + } + } + } + } + } + +have_gmax + if (bmax > bmin) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + if (histogram[ir,ig,ib] != 0) { + bmin = ib + CBOX_BMIN(box) = bmin + goto have_bmin + } + } + } + } + +have_bmin + if (bmax > bmin) { + for (ib=bmax; ib>=bmin; ib=ib-1) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + if (histogram[ir,ig,ib] != 0) { + bmax = ib + CBOX_BMAX(box) = bmax + goto have_bmax + } + } + } + } + } + } + +have_bmax + return +end + + + +# CM_ASSIGN_COLOR -- Assign colors + +procedure cm_assign_color (box, cmap) + +pointer box #I Box +short cmap[3] #O Color map entry + +begin + # +1 ensures that color represents the middle of the box + + cmap[1] = ((CBOX_RMIN(box) + CBOX_RMAX(box) - 2) * AB_SHIFT) / 2 + cmap[2] = ((CBOX_GMIN(box) + CBOX_GMAX(box) - 2) * AB_SHIFT) / 2 + cmap[3] = ((CBOX_BMIN(box) + CBOX_BMAX(box) - 2) * AB_SHIFT) / 2 +end + + + +# CM_MAP_COLORTABLE -- Map the color table + +procedure cm_map_colortable (histogram, cmap, ncolor, ColorCells) + +int histogram[B_LEN,B_LEN,B_LEN] #U Histogram +short cmap[3,ncolor] #I Color map +int ncolor #I Number of colors +pointer ColorCells[C_LEN,C_LEN,C_LEN] #O Color cells + +int i, j, ir, ig, ib, rcell, bcell, gcell +long dist, d2, tmp +pointer cell, cm_create_colorcell() + +begin + for (ir=0; irCCELL_ENTRIES(cell,i,1); i=i+1) { + j = CCELL_ENTRIES(cell,i,0) + d2 = cmap[1,1+j] - (ir * BC_SHIFT) + d2 = (d2 * d2 * R2FACT) + tmp = cmap[2,1+j] - (ig * BC_SHIFT) + d2 = d2 + (tmp*tmp * G2FACT) + tmp = cmap[3,1+j] - (ib * BC_SHIFT) + d2 = d2 + (tmp*tmp * B2FACT) + if (d2 < dist) { + dist = d2 + histogram[1+ir,1+ig,1+ib] = j + } + } + } + } + } + } +end + + + +# CM_CREATE_COLORCELL -- Create a color cell structure + +pointer procedure cm_create_colorcell (ColorCells, ra, ga, ba, cmap, ncolor) + +pointer ColorCells[C_LEN,C_LEN,C_LEN] #U Color cells +int ra, ga, ba #I Color to create cell for +short cmap[3,ncolor] #I Color map +int ncolor #I Number of colors + +int i, n, next_n, ir,ig,ib, r1,g1,b1 +long dist, mindist, tmp +pointer ptr + +begin + ir = ra / AC_SHIFT + ig = ga / AC_SHIFT + ib = ba / AC_SHIFT + + r1 = ir * AC_SHIFT + g1 = ig * AC_SHIFT + b1 = ib * AC_SHIFT + + call malloc (ptr, CCELL_LEN, TY_STRUCT) + ColorCells[1+ir,1+ig,1+ib] = ptr + CCELL_NUM_ENTS(ptr) = 0 + + # step 1: find all colors inside this cell, while we're at + # it, find distance of centermost point to furthest corner + + mindist = 2000000000 + + for (i=1; i<=ncolor; i=i+1) { + if (cmap[1,i]/AC_SHIFT == ir && + cmap[2,i]/AC_SHIFT == ig && + cmap[3,i]/AC_SHIFT == ib) { + CCELL_ENTRIES(ptr,CCELL_NUM_ENTS(ptr),0) = i - 1 + CCELL_ENTRIES(ptr,CCELL_NUM_ENTS(ptr),1) = 0 + CCELL_NUM_ENTS(ptr) = CCELL_NUM_ENTS(ptr) + 1 + + tmp = cmap[1,i] - r1 + if (tmp < (A_LEN/C_LEN/2)) + tmp = A_LEN/C_LEN-1 - tmp + dist = (tmp*tmp * R2FACT) + + tmp = cmap[2,i] - g1 + if (tmp < (A_LEN/C_LEN/2)) + tmp = A_LEN/C_LEN-1 - tmp + dist = dist + (tmp*tmp * G2FACT) + + tmp = cmap[3,i] - b1 + if (tmp < (A_LEN/C_LEN/2)) + tmp = A_LEN/C_LEN-1 - tmp + dist = dist + (tmp*tmp * B2FACT) + + mindist = min (mindist, dist) + } + } + + + # step 3: find all points within that distance to box + + for (i=1; i<=ncolor; i=i+1) { + if (cmap[1,i]/AC_SHIFT != ir || + cmap[2,i]/AC_SHIFT != ig || + cmap[3,i]/AC_SHIFT != ib) { + dist = 0 + tmp = r1 - cmap[1,i] + if (tmp>0) { + dist = dist + (tmp*tmp * R2FACT) + } else { + tmp = cmap[1,i] - (r1 + A_LEN/C_LEN-1) + if (tmp > 0) + dist = dist + (tmp*tmp * R2FACT) + } + + tmp = g1 - cmap[2,i] + if (tmp>0) { + dist = dist + (tmp*tmp * G2FACT) + } else { + tmp = cmap[2,i] - (g1 + A_LEN/C_LEN-1) + if (tmp > 0) + dist = dist + (tmp*tmp * G2FACT) + } + + tmp = b1 - cmap[3,i] + if (tmp>0) { + dist = dist + (tmp*tmp * B2FACT) + } else { + tmp = cmap[3,i] - (b1 + A_LEN/C_LEN-1) + if (tmp > 0) + dist = dist + (tmp*tmp * B2FACT) + } + + if (dist < mindist) { + CCELL_ENTRIES(ptr,CCELL_NUM_ENTS(ptr),0) = i - 1 + CCELL_ENTRIES(ptr,CCELL_NUM_ENTS(ptr),1) = dist + CCELL_NUM_ENTS(ptr) = CCELL_NUM_ENTS(ptr) + 1 + } + } + } + + + # sort color cells by distance, use cheap exchange sort + n = CCELL_NUM_ENTS(ptr) - 1 + while (n > 0) { + next_n = 0 + for (i=0; i CCELL_ENTRIES(ptr,i+1,1)) { + tmp = CCELL_ENTRIES(ptr,i,0) + CCELL_ENTRIES(ptr,i,0) = CCELL_ENTRIES(ptr,i+1,0) + CCELL_ENTRIES(ptr,i+1,0) = tmp + tmp = CCELL_ENTRIES(ptr,i,1) + CCELL_ENTRIES(ptr,i,1) = CCELL_ENTRIES(ptr,i+1,1) + CCELL_ENTRIES(ptr,i+1,1) = tmp + next_n = i + } + } + n = next_n + } + + return (ptr) +end + + + +# CM_QUANT_FSDITHER -- Quantized Floyd-Steinberg Dither + +procedure cm_quant_fsdither (ex, z1, dz, histogram, + ColorCells, cmap, ncolor, oim) + +pointer ex #I task struct pointer +real z1[3] #I Intensity mapping origins +real dz[3] #I Intensity mapping ranges +int histogram[B_LEN,B_LEN,B_LEN] #U Histogram +pointer ColorCells[C_LEN,C_LEN,C_LEN] #U Color cell data +short cmap[3,ncolor] #I Color map +int ncolor #I Number of colors +pointer oim #O Output IMIO pointer + +pointer thisptr, nextptr, optr, impl2s() +pointer sp, thisline, nextline, tmpptr +int ir, ig, ib, r1, g1, b1, rcell, bcell, gcell +int i, j, nc, nl, oval + +int ci, cj +long dist, d2, tmp +pointer cell + +pointer cm_create_colorcell() + +begin + nc = EX_OCOLS(ex) + nl = EX_OROWS(ex) + + call smark (sp) + call salloc (thisline, nc * 3, TY_INT) + call salloc (nextline, nc * 3, TY_INT) + + # get first line of picture + call cm_getline (ex, z1, dz, 1, nextline) + + for (i=1; i<=nl; i=i+1) { + # swap thisline and nextline + tmpptr = thisline + thisline = nextline + nextline = tmpptr + + # read in next line + if (i < nl) + #call cm_getline (ex, z1, dz, i, nextline, nc) + call cm_getline (ex, z1, dz, i, nextline) + + # dither this line and put it into the output picture + thisptr = thisline + nextptr = nextline + optr = impl2s (oim, i) + + for (j=1; j<=nc; j=j+1) { + r1 = Memi[thisptr] + g1 = Memi[thisptr+1] + b1 = Memi[thisptr+2] + thisptr = thisptr + 3 + + r1 = max (0, min (A_LEN-1, r1)) + g1 = max (0, min (A_LEN-1, g1)) + b1 = max (0, min (A_LEN-1, b1)) + + ir = r1 / AB_SHIFT + ig = g1 / AB_SHIFT + ib = b1 / AB_SHIFT + + oval = histogram[1+ir,1+ig,1+ib] + if (oval == -1) { + rcell = 1 + ir / BC_SHIFT + gcell = 1 + ig / BC_SHIFT + bcell = 1 + ib / BC_SHIFT + cell = ColorCells[rcell, gcell, bcell] + if (cell == NULL) + cell = cm_create_colorcell (ColorCells, r1, g1, b1, + cmap, ncolor) + + dist = 2000000000 + for (ci=0; ciCCELL_ENTRIES(cell,ci,1); ci=ci+1) { + cj = CCELL_ENTRIES(cell,ci,0) + d2 = (cmap[1,1+cj]/AB_SHIFT) - ir + d2 = (d2*d2 * R2FACT) + tmp = (cmap[2,1+cj]/AB_SHIFT) - ig + d2 = d2 + (tmp*tmp * G2FACT) + tmp = (cmap[3,1+cj]/AB_SHIFT) - ib + d2 = d2 + (tmp*tmp * B2FACT) + if (d2 1) { + tmpptr = nextptr - 3 + if (r1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (r1*3-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (r1*3+8)/16 + tmpptr = tmpptr + 1 + if (g1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (g1*3-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (g1*3+8)/16 + tmpptr = tmpptr + 1 + if (b1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (b1*3-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (b1*3+8)/16 + } + + tmpptr = nextptr + if (r1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (r1*5-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (r1*5+8)/16 + tmpptr = tmpptr + 1 + if (g1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (g1*5-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (g1*5+8)/16 + tmpptr = tmpptr + 1 + if (b1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (b1*5-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (b1*5+8)/16 + + if (j < nc) { + tmpptr = nextptr + 3 + if (r1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (r1-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (r1+8)/16 + tmpptr = tmpptr + 1 + if (g1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (g1-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (g1+8)/16 + tmpptr = tmpptr + 1 + if (b1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (b1-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (b1+8)/16 + } + nextptr = nextptr + 3 + } + } + } + + # Flush the pixels to the output image, otherwise we end up with an + # odd line which may or may not be actual pixels. + call imflush (oim) + + call sfree (sp) +end diff --git a/pkg/dataio/export/exzscale.x b/pkg/dataio/export/exzscale.x new file mode 100644 index 00000000..f0a4b506 --- /dev/null +++ b/pkg/dataio/export/exzscale.x @@ -0,0 +1,755 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "export.h" + +define DEBUG false + + +.help ex_zscale +.nf ___________________________________________________________________________ +EX_ZSCALE -- Compute the optimal Z1, Z2 (range of greyscale values to be +displayed) of an expression. For efficiency a statistical subsample of the +expression is used. The pixel sample evenly subsamples the expression in x +and y. The entire expression is used if the number of pixels in the expression +is smaller than the desired sample. + +The sample is accumulated in a buffer and sorted by greyscale value. +The median value is the central value of the sorted array. The slope of a +straight line fitted to the sorted sample is a measure of the standard +deviation of the sample about the median value. Our algorithm is to sort +the sample and perform an iterative fit of a straight line to the sample, +using pixel rejection to omit gross deviants near the endpoints. The fitted +straight line is the transfer function used to map image Z into display Z. +If more than half the pixels are rejected the full range is used. The slope +of the fitted line is divided by the user-supplied contrast factor and the +final Z1 and Z2 are computed, taking the origin of the fitted line at the +median value. +.endhelp ______________________________________________________________________ + +define MIN_NPIXELS 5 # smallest permissible sample +define MAX_REJECT 0.5 # max frac. of pixels to be rejected +define GOOD_PIXEL 0 # use pixel in fit +define BAD_PIXEL 1 # ignore pixel in all computations +define REJECT_PIXEL 2 # reject pixel after a bit +define KREJ 2.5 # k-sigma pixel rejection factor +define MAX_ITERATIONS 5 # maximum number of fitline iterations + + +# EX_PATCH_ZSCALE - Rather than compute the optimal zscale values for each +# line in the expression we'll go through the expression string and compute +# the values here. The expression string is modified with the values so that +# when evaluated they are seen as arguments to the function. + +procedure ex_patch_zscale (ex, expnum) + +pointer ex #i task struct pointer +int expnum #i expression number to fix + +pointer sp, exp, func +int ip, pp + +bool streq() + +begin + call smark (sp) + call salloc (exp, SZ_EXPSTR, TY_CHAR) + call salloc (func, SZ_FNAME, TY_CHAR) + call aclrc(Memc[exp], SZ_EXPSTR) + call aclrc(Memc[func], SZ_FNAME) + + # Copy the final expression string to the output buffer. + call strcpy (O_EXPR(ex,expnum), Memc[exp], SZ_EXPSTR) + + # Now fix up any zscale functions calls embedded in the expression. + ip = 0 + repeat { + # Skip ahead to a possible zscale()/mzscale() call. + while (Memc[exp+ip] != 'z' && Memc[exp+ip] != EOS) + ip = ip + 1 + if (Memc[exp+ip] == EOS) + break + + # Get the function name. + pp = 0 + call aclrc (Memc[func], SZ_FNAME) + while (Memc[exp+ip] != '(' && Memc[exp+ip] != EOS) { + Memc[func+pp] = Memc[exp+ip] + ip = ip + 1 + pp = pp + 1 + } + Memc[func+pp+1] = EOS + if (Memc[exp+ip] == EOS) + break + + if (DEBUG) { call eprintf("\tfunc=`%s'\n");call pargstr(Memc[func])} + + # Update pointer into string past '('. + ip = ip + 1 + + if (streq(Memc[func],"zscale") || streq(Memc[func],"zscalem")) { + iferr (call ex_edit_zscale (ex, Memc[exp], ip+1)) + call erract (EA_FATAL) + ip = ip + 1 + } + } + + # Copy the final expression string to the output buffer. + call strcpy (Memc[exp], O_EXPR(ex,expnum), SZ_EXPSTR) + + call sfree (sp) +end + + +# EX_EDIT_ZSCALE - Process the ZSCALE special function. This function requires +# preprocessing in the event the user didn't supply a z1/z2 value. What +# we'll do here is pre-compute those values and patch up the expression +# string. Otherwise we'll make sure the rest of the arguments are legal. + +procedure ex_edit_zscale (ex, expstr, pp) + +pointer ex #i task struct pointer +char expstr[ARB] #i expression string +int pp #i position pointer + +pointer sp, arg, arg2, exp, buf +pointer exptr, exptr2, ep +char ch +int ip, op, tp, tp2, plev +real z1, z2 + +pointer ex_evaluate() + +begin + call smark (sp) + call salloc (arg, SZ_EXPSTR, TY_CHAR); call aclrc (Memc[arg], SZ_EXPSTR) + call salloc (arg2, SZ_EXPSTR,TY_CHAR); call aclrc (Memc[arg2],SZ_EXPSTR) + call salloc (exp, SZ_EXPSTR, TY_CHAR); call aclrc (Memc[exp], SZ_EXPSTR) + call salloc (buf, SZ_EXPSTR, TY_CHAR); call aclrc (Memc[buf], SZ_EXPSTR) + + if (DEBUG) { call eprintf("\t\texp=`%s'\n");call pargstr(expstr)} + + # Gather the expression argument. + ip = pp + op = 0 + plev = 0 + repeat { + ch = expstr[ip] + if (ch == '(') plev = plev + 1 + if (ch == ')') plev = plev - 1 + Memc[arg+op] = ch + if ((ch == ',' && plev == 0) || (ch == ')' && plev < 0)) + break + ip = ip + 1 + op = op + 1 + } + Memc[arg+op] = EOS + tp = ip - 1 + tp2 = tp + if (DEBUG) {call eprintf("\t\targ = `%s'\n");call pargstr(Memc[arg])} + + # Gather the mask argument. + if (expstr[pp-2] == 'm' && ch == ',') { + ip = ip + 1 + op = 0 + plev = 0 + repeat { + ch = expstr[ip] + if (ch == '(') plev = plev + 1 + if (ch == ')') plev = plev - 1 + Memc[arg2+op] = ch + if ((ch == ',' && plev == 0) || (ch == ')' && plev < 0)) + break + ip = ip + 1 + op = op + 1 + } + Memc[arg2+op] = EOS + tp2 = ip - 1 + if (DEBUG) { + call eprintf("\t\targ2 = `%s'\n") + call pargstr(Memc[arg2]) + } + } + + if (ch == ',') { + # We have more arguments, assume they're okay and return. + call sfree (sp) + return + + } else if (ch == ')') { + # This is the end of the zscale function, so compute the optimal + # z1/z2 values for the given expression. First, dummy up an out- + # bands pointer. + + call ex_alloc_outbands (exptr) + call strcpy (Memc[arg], Memc[OB_EXPSTR(exptr)], SZ_EXPSTR) + + # Get the size of the expression. + call ex_getpix (ex, 1) + ep = ex_evaluate (ex, Memc[OB_EXPSTR(exptr)]) + OB_WIDTH(exptr) = O_LEN(ep) + call evvfree (ep) + if (OB_WIDTH(exptr) == 0) + OB_HEIGHT(exptr) = 1 + else + OB_HEIGHT(exptr) = EX_NLINES(ex) + + # Setup the mask expression if needed. + if (Memc[arg2] != EOS) { + call ex_alloc_outbands (exptr2) + call strcpy (Memc[arg2], Memc[OB_EXPSTR(exptr2)], SZ_EXPSTR) + + # Get the size of the expression. + ep = ex_evaluate (ex, Memc[OB_EXPSTR(exptr2)]) + OB_WIDTH(exptr2) = O_LEN(ep) + call evvfree (ep) + if (OB_WIDTH(exptr2) == 0) + OB_HEIGHT(exptr2) = 1 + else + OB_HEIGHT(exptr2) = EX_NLINES(ex) + if (OB_WIDTH(exptr2) != OB_WIDTH(exptr) || + OB_WIDTH(exptr2) != OB_WIDTH(exptr)) + call error (1, "Sizes of zscalem arguments not the same.") + } else + exptr2 = NULL + + if (EX_VERBOSE(ex) == YES) { + call printf ("Computing zscale values...") + call flush (STDOUT) + } + + call ex_zscale (ex, exptr, exptr2, z1, z2, + CONTRAST, SAMPLE_SIZE, SAMP_LEN) + call ex_free_outbands (exptr) + if (exptr2 != NULL) + call ex_free_outbands (exptr2) + + if (DEBUG) {call eprintf("\t\t\tz1=%g z2=%g\n") + call pargr(z1) ; call pargr (z2) } + + # Now patch up the expression string to insert the computed values. + if (expstr[pp-2] == 'm') { + call strcpy (expstr, Memc[exp], pp-3) + call strcat (expstr[pp-1], Memc[exp], tp-1) + } else + call strcpy (expstr, Memc[exp], tp) + call sprintf (Memc[buf], SZ_EXPSTR, ",%g,%g,256") + call pargr (z1) + call pargr (z2) + call strcat (Memc[buf], Memc[exp], SZ_EXPSTR) + call strcat (expstr[tp2+1], Memc[exp], SZ_EXPSTR) + + # Print the computed values to the screen. + if (EX_VERBOSE(ex) == YES) { + call printf ("z1=%g z2=%g\n") + call pargr (z1) + call pargr (z2) + } + } + + # Copy fixed-up expression to input buffer. + call aclrc (expstr, SZ_EXPSTR) + call strcpy (Memc[exp], expstr, SZ_EXPSTR) + + if (DEBUG){call eprintf("\t\tnew expr=`%s'\n");call pargstr(expstr)} + + call sfree (sp) +end + + +# EX_ZSCALE -- Sample the expression and compute Z1 and Z2. + +procedure ex_zscale (ex, exptr, exptr2, z1, z2, contrast, optimal_sample_size, + len_stdline) + +pointer ex # task struct pointer +pointer exptr # expression struct pointer +pointer exptr2 # expression struct pointer (mask) +real z1, z2 # output min and max greyscale values +real contrast # adj. to slope of transfer function +int optimal_sample_size # desired number of pixels in sample +int len_stdline # optimal number of pixels per line + +int npix, minpix, ngoodpix, center_pixel, ngrow +real zmin, zmax, median +real zstart, zslope +pointer sample, left +int ex_sample_expr(), ex_fit_line() + +begin + # Subsample the expression. + npix = ex_sample_expr (ex, exptr, exptr2, sample, optimal_sample_size, + len_stdline) + center_pixel = max (1, (npix + 1) / 2) + + # Sort the sample, compute the minimum, maximum, and median pixel + # values. + + call asrtr (Memr[sample], Memr[sample], npix) + zmin = Memr[sample] + zmax = Memr[sample+npix-1] + + # The median value is the average of the two central values if there + # are an even number of pixels in the sample. + + left = sample + center_pixel - 1 + if (mod (npix, 2) == 1 || center_pixel >= npix) + median = Memr[left] + else + median = (Memr[left] + Memr[left+1]) / 2 + + # Fit a line to the sorted sample vector. If more than half of the + # pixels in the sample are rejected give up and return the full range. + # If the user-supplied contrast factor is not 1.0 adjust the scale + # accordingly and compute Z1 and Z2, the y intercepts at indices 1 and + # npix. + + minpix = max (MIN_NPIXELS, int (npix * MAX_REJECT)) + ngrow = max (1, nint (npix * .01)) + ngoodpix = ex_fit_line (Memr[sample], npix, zstart, zslope, + KREJ, ngrow, MAX_ITERATIONS) + + if (ngoodpix < minpix) { + z1 = zmin + z2 = zmax + } else { + if (contrast > 0) + zslope = zslope / contrast + z1 = max (zmin, median - (center_pixel - 1) * zslope) + z2 = min (zmax, median + (npix - center_pixel) * zslope) + } + + call mfree (sample, TY_REAL) +end + + +# EX_SAMPLE_EXPR -- Extract an evenly gridded subsample of the pixels from +# a possibly two-dimensional expression into a one-dimensional vector. + +int procedure ex_sample_expr (ex, exptr, exptr2, sample, optimal_sample_size, + len_stdline) + +pointer ex # task struct pointer +pointer exptr # expression struct pointer +pointer exptr2 # expression struct pointer (mask) +pointer sample # output vector containing the sample +int optimal_sample_size # desired number of pixels in sample +int len_stdline # optimal number of pixels per line + +pointer op, ep, out, bpm +int ncols, nlines, col_step, line_step, maxpix, line +int opt_npix_per_line, npix_per_line, nsubsample +int opt_nlines_in_sample, min_nlines_in_sample, max_nlines_in_sample + +pointer ex_evaluate() + +begin + ncols = OB_WIDTH(exptr) + nlines = OB_HEIGHT(exptr) + + # Compute the number of pixels each line will contribute to the sample, + # and the subsampling step size for a line. The sampling grid must + # span the whole line on a uniform grid. + + opt_npix_per_line = max (1, min (ncols, len_stdline)) + col_step = max (1, (ncols + opt_npix_per_line-1) / opt_npix_per_line) + npix_per_line = max (1, (ncols + col_step-1) / col_step) + + # Compute the number of lines to sample and the spacing between lines. + # We must ensure that the image is adequately sampled despite its + # size, hence there is a lower limit on the number of lines in the + # sample. We also want to minimize the number of lines accessed when + # accessing a large image, because each disk seek and read is expensive. + # The number of lines extracted will be roughly the sample size divided + # by len_stdline, possibly more if the lines are very short. + + min_nlines_in_sample = max (1, optimal_sample_size / len_stdline) + opt_nlines_in_sample = max(min_nlines_in_sample, min(nlines, + (optimal_sample_size + npix_per_line-1) / npix_per_line)) + line_step = max (1, nlines / (opt_nlines_in_sample)) + max_nlines_in_sample = (nlines + line_step-1) / line_step + + # Allocate space for the output vector. Buffer must be freed by our + # caller. + + maxpix = npix_per_line * max_nlines_in_sample + call malloc (sample, maxpix, TY_REAL) + + # Extract the vector. + op = sample + call malloc (out, ncols, TY_REAL) + if (exptr2 != NULL) + call malloc (bpm, ncols, TY_INT) + do line = (line_step + 1) / 2, nlines, line_step { + + # Evaluate the expression at the current line. + call ex_getpix (ex, line) + ep = ex_evaluate (ex, Memc[OB_EXPSTR(exptr)]) + switch (O_TYPE(ep)) { + case TY_CHAR: + call achtcr (Memc[O_VALP(ep)], Memr[out], O_LEN(ep)) + case TY_SHORT: + call achtsr (Mems[O_VALP(ep)], Memr[out], O_LEN(ep)) + case TY_INT: + call achtir (Memi[O_VALP(ep)], Memr[out], O_LEN(ep)) + case TY_LONG: + call achtlr (Meml[O_VALP(ep)], Memr[out], O_LEN(ep)) + case TY_REAL: + call amovr (Memr[O_VALP(ep)], Memr[out], O_LEN(ep)) + case TY_DOUBLE: + call achtdr (Memd[O_VALP(ep)], Memr[out], O_LEN(ep)) + default: + call error (0, "Unknown expression type in zscale/zscalem().") + } + call evvfree (ep) + if (exptr2 != NULL) { + ep = ex_evaluate (ex, Memc[OB_EXPSTR(exptr2)]) + switch (O_TYPE(ep)) { + case TY_BOOL: + call amovi (Memi[O_VALP(ep)], Memi[bpm], O_LEN(ep)) + default: + call error (0, + "Selection expression must be boolean in zscalem().") + } + call ex_subsample1 (Memr[out], Memi[bpm], Memr[op], O_LEN(ep), + npix_per_line, col_step, nsubsample) + call evvfree (ep) + } else + call ex_subsample (Memr[out], Memr[op], O_LEN(ep), + npix_per_line, col_step, nsubsample) + + op = op + nsubsample + if (op - sample + npix_per_line > maxpix) + break + } + call mfree (out, TY_REAL) + + return (op - sample) +end + + +# EX_SUBSAMPLE -- Subsample an image line. Extract the first pixel and +# every "step"th pixel thereafter for a total of npix pixels. + +procedure ex_subsample (a, b, n, npix, step, nsubsample) + +real a[n] +real b[npix] +int n +int npix, step, nsubsample +int ip, i + +begin + nsubsample = npix + if (step <= 1) + call amovr (a, b, npix) + else { + ip = 1 + do i = 1, npix { + b[i] = a[ip] + ip = ip + step + } + } +end + + +# EX_SUBSAMPLE1 -- Subsample an image line. Extract the first pixel and +# every "step"th pixel thereafter for a total of npix pixels. +# +# Check for mask values and exclude them from the sample. In case a +# subsampled line has fewer than 75% good pixels then increment the starting +# pixel and step through again. Return the number of good pixels. + +procedure ex_subsample1 (a, c, b, n, npix, step, nsubsample) + +real a[ARB] +int c[ARB] +real b[npix] +int n +int npix, step, nsubsample +int i, j + +begin + nsubsample = 0 + if (step <= 1) { + do i = 1, n { + if (c[i] == 0) + next + nsubsample = nsubsample + 1 + b[nsubsample] = a[i] + if (nsubsample == npix) + break + } + } else { + do j = 1, step-1 { + do i = j, n, step { + if (c[i] == 0) + next + nsubsample = nsubsample + 1 + b[nsubsample] = a[i] + if (nsubsample == npix) + break + } + if (nsubsample >= 0.75 * npix) + break + } + } +end + + +# EX_FIT_LINE -- Fit a straight line to a data array of type real. This is +# an iterative fitting algorithm, wherein points further than ksigma from the +# current fit are excluded from the next fit. Convergence occurs when the +# next iteration does not decrease the number of pixels in the fit, or when +# there are no pixels left. The number of pixels left after pixel rejection +# is returned as the function value. + +int procedure ex_fit_line (data, npix, zstart, zslope, krej, ngrow, maxiter) + +real data[npix] #i data to be fitted +int npix #i number of pixels before rejection +real zstart #o Z-value of pixel data[1] +real zslope #o dz/pixel +real krej #i k-sigma pixel rejection factor +int ngrow #i number of pixels of growing +int maxiter #i max iterations + +int i, ngoodpix, last_ngoodpix, minpix, niter +real xscale, z0, dz, x, z, mean, sigma, threshold +double sumxsqr, sumxz, sumz, sumx, rowrat +pointer sp, flat, badpix, normx +int ex_reject_pixels(), ex_compute_sigma() + +begin + if (npix <= 0) + return (0) + else if (npix == 1) { + zstart = data[1] + zslope = 0.0 + return (1) + } else + xscale = 2.0 / (npix - 1) + + # Allocate a buffer for data minus fitted curve, another for the + # normalized X values, and another to flag rejected pixels. + + call smark (sp) + call salloc (flat, npix, TY_REAL) + call salloc (normx, npix, TY_REAL) + call salloc (badpix, npix, TY_SHORT) + call aclrs (Mems[badpix], npix) + + # Compute normalized X vector. The data X values [1:npix] are + # normalized to the range [-1:1]. This diagonalizes the lsq matrix + # and reduces its condition number. + + do i = 0, npix - 1 + Memr[normx+i] = i * xscale - 1.0 + + # Fit a line with no pixel rejection. Accumulate the elements of the + # matrix and data vector. The matrix M is diagonal with + # M[1,1] = sum x**2 and M[2,2] = ngoodpix. The data vector is + # DV[1] = sum (data[i] * x[i]) and DV[2] = sum (data[i]). + + sumxsqr = 0 + sumxz = 0 + sumx = 0 + sumz = 0 + + do i = 1, npix { + x = Memr[normx+i-1] + z = data[i] + sumxsqr = sumxsqr + (x ** 2) + sumxz = sumxz + z * x + sumz = sumz + z + } + + # Solve for the coefficients of the fitted line. + z0 = sumz / npix + dz = sumxz / sumxsqr + + # Iterate, fitting a new line in each iteration. Compute the flattened + # data vector and the sigma of the flat vector. Compute the lower and + # upper k-sigma pixel rejection thresholds. Run down the flat array + # and detect pixels to be rejected from the fit. Reject pixels from + # the fit by subtracting their contributions from the matrix sums and + # marking the pixel as rejected. + + ngoodpix = npix + minpix = max (MIN_NPIXELS, int (npix * MAX_REJECT)) + + for (niter=1; niter <= maxiter; niter=niter+1) { + last_ngoodpix = ngoodpix + + # Subtract the fitted line from the data array. + call ex_flatten_data (data, Memr[flat], Memr[normx], npix, z0, dz) + + # Compute the k-sigma rejection threshold. In principle this + # could be more efficiently computed using the matrix sums + # accumulated when the line was fitted, but there are problems with + # numerical stability with that approach. + + ngoodpix = ex_compute_sigma (Memr[flat], Mems[badpix], npix, + mean, sigma) + threshold = sigma * krej + + # Detect and reject pixels further than ksigma from the fitted + # line. + ngoodpix = ex_reject_pixels (data, Memr[flat], Memr[normx], + Mems[badpix], npix, sumxsqr, sumxz, sumx, sumz, threshold, + ngrow) + + # Solve for the coefficients of the fitted line. Note that after + # pixel rejection the sum of the X values need no longer be zero. + + if (ngoodpix > 0) { + rowrat = sumx / sumxsqr + z0 = (sumz - rowrat * sumxz) / (ngoodpix - rowrat * sumx) + dz = (sumxz - z0 * sumx) / sumxsqr + } + + if (ngoodpix >= last_ngoodpix || ngoodpix < minpix) + break + } + + # Transform the line coefficients back to the X range [1:npix]. + zstart = z0 - dz + zslope = dz * xscale + + call sfree (sp) + return (ngoodpix) +end + + +# EX_FLATTEN_DATA -- Compute and subtract the fitted line from the data array, +# returned the flattened data in FLAT. + +procedure ex_flatten_data (data, flat, x, npix, z0, dz) + +real data[npix] # raw data array +real flat[npix] # flattened data (output) +real x[npix] # x value of each pixel +int npix # number of pixels +real z0, dz # z-intercept, dz/dx of fitted line +int i + +begin + do i = 1, npix + flat[i] = data[i] - (x[i] * dz + z0) +end + + +# EX_COMPUTE_SIGMA -- Compute the root mean square deviation from the +# mean of a flattened array. Ignore rejected pixels. + +int procedure ex_compute_sigma (a, badpix, npix, mean, sigma) + +real a[npix] # flattened data array +short badpix[npix] # bad pixel flags (!= 0 if bad pixel) +int npix +real mean, sigma # (output) + +real pixval +int i, ngoodpix +double sum, sumsq, temp + +begin + sum = 0 + sumsq = 0 + ngoodpix = 0 + + # Accumulate sum and sum of squares. + do i = 1, npix + if (badpix[i] == GOOD_PIXEL) { + pixval = a[i] + ngoodpix = ngoodpix + 1 + sum = sum + pixval + sumsq = sumsq + pixval ** 2 + } + + # Compute mean and sigma. + switch (ngoodpix) { + case 0: + mean = INDEF + sigma = INDEF + case 1: + mean = sum + sigma = INDEF + default: + mean = sum / ngoodpix + temp = sumsq / (ngoodpix - 1) - sum**2 / (ngoodpix * (ngoodpix - 1)) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngoodpix) +end + + +# EX_REJECT_PIXELS -- Detect and reject pixels more than "threshold" greyscale +# units from the fitted line. The residuals about the fitted line are given +# by the "flat" array, while the raw data is in "data". Each time a pixel +# is rejected subtract its contributions from the matrix sums and flag the +# pixel as rejected. When a pixel is rejected reject its neighbors out to +# a specified radius as well. This speeds up convergence considerably and +# produces a more stringent rejection criteria which takes advantage of the +# fact that bad pixels tend to be clumped. The number of pixels left in the +# fit is returned as the function value. + +int procedure ex_reject_pixels (data, flat, normx, badpix, npix, + sumxsqr, sumxz, sumx, sumz, threshold, ngrow) + +real data[npix] # raw data array +real flat[npix] # flattened data array +real normx[npix] # normalized x values of pixels +short badpix[npix] # bad pixel flags (!= 0 if bad pixel) +int npix +double sumxsqr,sumxz,sumx,sumz # matrix sums +real threshold # threshold for pixel rejection +int ngrow # number of pixels of growing + +int ngoodpix, i, j +real residual, lcut, hcut +double x, z + +begin + ngoodpix = npix + lcut = -threshold + hcut = threshold + + do i = 1, npix + if (badpix[i] == BAD_PIXEL) + ngoodpix = ngoodpix - 1 + else { + residual = flat[i] + if (residual < lcut || residual > hcut) { + # Reject the pixel and its neighbors out to the growing + # radius. We must be careful how we do this to avoid + # directional effects. Do not turn off thresholding on + # pixels in the forward direction; mark them for rejection + # but do not reject until they have been thresholded. + # If this is not done growing will not be symmetric. + + do j = max(1,i-ngrow), min(npix,i+ngrow) { + if (badpix[j] != BAD_PIXEL) { + if (j <= i) { + x = normx[j] + z = data[j] + sumxsqr = sumxsqr - (x ** 2) + sumxz = sumxz - z * x + sumx = sumx - x + sumz = sumz - z + badpix[j] = BAD_PIXEL + ngoodpix = ngoodpix - 1 + } else + badpix[j] = REJECT_PIXEL + } + } + } + } + + return (ngoodpix) +end diff --git a/pkg/dataio/export/generic/exobands.x b/pkg/dataio/export/generic/exobands.x new file mode 100644 index 00000000..d8a7d636 --- /dev/null +++ b/pkg/dataio/export/generic/exobands.x @@ -0,0 +1,489 @@ +include +include +include +include +include +include "../export.h" +include "../exfcn.h" + +define DEBUG false +define VDEBUG false + + +# EX_EVALUATE -- Evaluate the outbands expression. + +pointer procedure ex_evaluate (ex, expr) + +pointer ex #i task struct pointer +char expr[ARB] #i expression to be evaluated + +pointer o # operand pointer to result + +int locpr() +pointer evvexpr() +extern ex_getop(), ex_obfcn() +errchk evvexpr + +begin + if (DEBUG) { call eprintf("ex_eval: expr='%s'\n") ; call pargstr(expr) } + + # Evaluate the expression. + iferr { + o = evvexpr (expr, locpr(ex_getop), ex, locpr(ex_obfcn), ex, + EV_RNGCHK) + } then + call erract (EA_FATAL) + + return (o) +end + + +# EX_GETOP -- Called by evvexpr to get an operand. + +procedure ex_getop (ex, opname, o) + +pointer ex #i task struct pointer +char opname[ARB] #i operand name to retrieve +pointer o #o output operand pointer + +int i, nops, found, optype, imnum +pointer sp, buf +pointer op, param, emsg +pointer im + +#int ex_ptype() +int imgeti(), imgftype(), btoi(), ctoi() +bool streq(), imgetb() +double imgetd() + +define getpar_ 99 + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call salloc (param, SZ_FNAME, TY_CHAR) + call salloc (emsg, SZ_LINE, TY_CHAR) + call aclrc (Memc[buf], SZ_LINE) + call aclrc (Memc[param], SZ_FNAME) + call aclrc (Memc[emsg], SZ_LINE) + + if (VDEBUG) { call eprintf ("getop: opname=%s ");call pargstr(opname)} + + # First see if it's one of the special image operands that was + # referenced in an "@param" call. + + if (((opname[1] != 'i' && opname[1] != 'b') && !IS_DIGIT(opname[2])) || + (opname[1] == 'i' && opname[2] == '_')) { + call strcpy (opname, Memc[param], SZ_FNAME) + im = IO_IMPTR(IMOP(ex,1)) +getpar_ O_LEN(o) = 0 + switch (imgftype (im, Memc[param])) { + case TY_BOOL: + O_TYPE(o) = TY_BOOL + O_VALI(o) = btoi (imgetb (im, Memc[param])) + case TY_CHAR: + O_TYPE(o) = TY_CHAR + O_LEN(o) = SZ_LINE + call malloc (O_VALP(o), SZ_LINE, TY_CHAR) + call imgstr (im, Memc[param], O_VALC(o), SZ_LINE) + case TY_INT: + O_TYPE(o) = TY_INT + O_VALI(o) = imgeti (im, Memc[param]) + case TY_REAL: + O_TYPE(o) = TY_DOUBLE + O_VALD(o) = imgetd (im, Memc[param]) + default: + call sprintf (Memc[emsg], SZ_LINE, "param %s not found\n") + call pargstr (Memc[param]) + call error (6, Memc[emsg]) + } + + call sfree (sp) + return + + } else if (IS_LOWER(opname[1]) && opname[3] == '.') { + # This is a tag.param operand. Break out the image tag name and + # get the image pointer for it, then get the parameter + if (opname[1] == 'b') { # band of 3-D image, only 1 ptr + imnum = 1 + } else if (opname[1] == 'i') { # image descriptor + i = 2 + if (ctoi (opname, i, imnum) == 0) + call error (6, "can't parse operand") + } else { + call sprintf (Memc[buf], SZ_LINE, + "Unknown outbands operand `%s'\n") + call pargstr(opname) + call error (1, Memc[buf]) + } + + # Get the parameter value. + im = IO_IMPTR(IMOP(ex,imnum)) + call strcpy (opname[4], Memc[param], SZ_FNAME) + goto getpar_ + } + + nops = EX_NIMOPS(ex) + found = NO + do i = 1, nops { + # Search for operand name which matches requested value. + op = IMOP(ex,i) + if (streq (Memc[IO_TAG(op)],opname)) { + found = YES + break + } + } + + if (VDEBUG && found == YES) { + call eprintf (" tag=%s found=%d ") + call pargstr(Memc[IO_TAG(op)]) ; call pargi(found) + call zze_prop (op) + } + + if (found == YES) { + # Copy operand descriptor to 'o' + #optype = ex_ptype (IO_TYPE(op), IO_NBYTES(op)) + optype = IO_TYPE(op) + switch (optype) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + O_LEN(o) = IO_NPIX(op) + O_TYPE(o) = TY_SHORT + call malloc (O_VALP(o), IO_NPIX(op), TY_SHORT) + call amovs (Mems[IO_DATA(op)], Mems[O_VALP(o)], IO_NPIX(op)) + + case TY_INT: + O_LEN(o) = IO_NPIX(op) + O_TYPE(o) = TY_INT + call malloc (O_VALP(o), IO_NPIX(op), TY_INT) + call amovi (Memi[IO_DATA(op)], Memi[O_VALP(o)], IO_NPIX(op)) + + case TY_LONG: + O_LEN(o) = IO_NPIX(op) + O_TYPE(o) = TY_LONG + call malloc (O_VALP(o), IO_NPIX(op), TY_LONG) + call amovl (Meml[IO_DATA(op)], Meml[O_VALP(o)], IO_NPIX(op)) + + case TY_REAL: + O_LEN(o) = IO_NPIX(op) + O_TYPE(o) = TY_REAL + call malloc (O_VALP(o), IO_NPIX(op), TY_REAL) + call amovr (Memr[IO_DATA(op)], Memr[O_VALP(o)], IO_NPIX(op)) + + case TY_DOUBLE: + O_LEN(o) = IO_NPIX(op) + O_TYPE(o) = TY_DOUBLE + call malloc (O_VALP(o), IO_NPIX(op), TY_DOUBLE) + call amovd (Memd[IO_DATA(op)], Memd[O_VALP(o)], IO_NPIX(op)) + + } + + } else { + call sprintf (Memc[buf], SZ_LINE, "Unknown outbands operand `%s'\n") + call pargstr(opname) + call error (1, Memc[buf]) + } + + call sfree (sp) +end + + +# EX_OBFCN -- Called by evvexpr to execute import outbands special functions. + +procedure ex_obfcn (ex, fcn, args, nargs, o) + +pointer ex #i package pointer +char fcn[ARB] #i function to be executed +pointer args[ARB] #i argument list +int nargs #i number of arguments +pointer o #o operand pointer + +pointer sp, buf +pointer r, g, b, gray +pointer scaled, data +int i, len, v_nargs, func, nbins +short sz1, sz2, sb1, sb2, zero +real gamma, bscale, bzero, scale, pix +real z1, z2 + +int strdic() +bool fp_equalr(), strne() + +define setop_ 99 + +begin + call smark (sp) + call salloc (buf, SZ_FNAME, TY_CHAR) + + # Lookup function in dictionary. + func = strdic (fcn, Memc[buf], SZ_LINE, OB_FUNCTIONS) + if (func > 0 && strne(fcn,Memc[buf])) + func = 0 + + # Abort if the function is not known. + if (func <= 0) + call xev_error1 ("unknown function `%s' called", fcn) + + # Verify the correct number of arguments, negative value means a + # variable number of args, handle it in the evaluation. + switch (func) { + case GRAY, GREY: + v_nargs = 3 + case ZSCALE: + v_nargs = -1 + case BSCALE: + v_nargs = 3 + case GAMMA: + v_nargs = -1 + case BLOCK: + v_nargs = 3 + } + if (v_nargs > 0 && nargs != v_nargs) + call xev_error2 ("function `%s' requires %d arguments", + fcn, v_nargs) + else if (v_nargs < 0 && nargs < abs(v_nargs)) + call xev_error2 ("function `%s' requires at least %d arguments", + fcn, abs(v_nargs)) + + if (DEBUG) { + call eprintf ("obfcn: nargs=%d func=%d\n") + call pargi (nargs) ; call pargi (func) + do i = 1, nargs { call eprintf ("\t") ; call zze_pevop (args[i]) } + call flush (STDERR) + } + + # Evaluate the function. + zero = 0 + switch (func) { + case GRAY, GREY: + # evaluate expression for NTSC grayscale. + r = O_VALP(args[1]) + g = O_VALP(args[2]) + b = O_VALP(args[3]) + len = O_LEN(args[1]) - 1 + O_LEN(o) = len + 1 + O_TYPE(o) = TY_REAL + call malloc (O_VALP(o), len+1, TY_REAL) + gray = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + do i = 0, len { + Memr[gray+i] = R_COEFF * Mems[r+i] + + G_COEFF * Mems[g+i] + + B_COEFF * Mems[b+i] + } + + case TY_INT: + do i = 0, len { + Memr[gray+i] = R_COEFF * Memi[r+i] + + G_COEFF * Memi[g+i] + + B_COEFF * Memi[b+i] + } + + case TY_LONG: + do i = 0, len { + Memr[gray+i] = R_COEFF * Meml[r+i] + + G_COEFF * Meml[g+i] + + B_COEFF * Meml[b+i] + } + + case TY_REAL: + do i = 0, len { + Memr[gray+i] = R_COEFF * Memr[r+i] + + G_COEFF * Memr[g+i] + + B_COEFF * Memr[b+i] + } + + case TY_DOUBLE: + do i = 0, len { + Memr[gray+i] = R_COEFF * Memd[r+i] + + G_COEFF * Memd[g+i] + + B_COEFF * Memd[b+i] + } + + } + + case ZSCALE: + data = O_VALP(args[1]) + switch (O_TYPE(args[2])) { + case TY_SHORT: z1 = O_VALS(args[2]) + case TY_INT: z1 = O_VALI(args[2]) + case TY_LONG: z1 = O_VALL(args[2]) + case TY_REAL: z1 = O_VALR(args[2]) + case TY_DOUBLE: z1 = O_VALD(args[2]) + } + switch (O_TYPE(args[3])) { + case TY_SHORT: z2 = O_VALS(args[3]) + case TY_INT: z2 = O_VALI(args[3]) + case TY_LONG: z2 = O_VALL(args[3]) + case TY_REAL: z2 = O_VALR(args[3]) + case TY_DOUBLE: z2 = O_VALD(args[3]) + } + if (nargs < 4) + nbins = 256 + else + nbins = O_VALI(args[4]) + len = O_LEN(args[1]) + O_LEN(o) = len + O_TYPE(o) = O_TYPE(args[1]) + call malloc (O_VALP(o), len, O_TYPE(args[1])) + scaled = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + sz1 = z1 + sz2 = z2 + sb1 = 0 + sb2 = nbins - 1 + if (abs(sz2-sz1) > 1.0e-5) + call amaps (Mems[data], Mems[scaled], len, sz1, sz2, + sb1, sb2) + else + call amovks (0, Mems[scaled], len) + + case TY_INT: + if (abs(z2-z1) > 1.0e-5) + call amapi (Memi[data], Memi[scaled], len, int (z1), + int(z2), int (0), int (nbins-1)) + else + call amovki (int (0), Memi[scaled], len) + + case TY_LONG: + if (abs(z2-z1) > 1.0e-5) + call amapl (Meml[data], Meml[scaled], len, long (z1), + long(z2), long (0), long (nbins-1)) + else + call amovkl (long (0), Meml[scaled], len) + + case TY_REAL: + if (abs(z2-z1) > 1.0e-5) + call amapr (Memr[data], Memr[scaled], len, real (z1), + real(z2), real (0), real (nbins-1)) + else + call amovkr (real (0), Memr[scaled], len) + + case TY_DOUBLE: + if (abs(z2-z1) > 1.0e-5) + call amapd (Memd[data], Memd[scaled], len, double (z1), + double(z2), double (0), double (nbins-1)) + else + call amovkd (double (0), Memd[scaled], len) + + } + + case BSCALE: + data = O_VALP(args[1]) + bzero = O_VALR(args[2]) + bscale = O_VALR(args[3]) + len = O_LEN(args[1]) - 1 + O_LEN(o) = len + 1 + O_TYPE(o) = TY_REAL + call malloc (O_VALP(o), len+1, TY_REAL) + scaled = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + if (!fp_equalr (0.0, bscale)) { + do i = 0, len + Memr[scaled+i] = (Mems[data+i] - bzero) / bscale + } else + call amovks (zero, Mems[scaled], len) + + case TY_INT: + if (!fp_equalr (0.0, bscale)) { + do i = 0, len + Memr[scaled+i] = (Memi[data+i] - bzero) / bscale + } else + call amovki (int(0), Memi[scaled], len) + + case TY_LONG: + if (!fp_equalr (0.0, bscale)) { + do i = 0, len + Memr[scaled+i] = (Meml[data+i] - bzero) / bscale + } else + call amovkl (long(0), Meml[scaled], len) + + case TY_REAL: + if (!fp_equalr (0.0, bscale)) { + do i = 0, len + Memr[scaled+i] = (Memr[data+i] - bzero) / bscale + } else + call amovkr (real(0), Memr[scaled], len) + + case TY_DOUBLE: + if (!fp_equalr (0.0, bscale)) { + do i = 0, len + Memr[scaled+i] = (Memd[data+i] - bzero) / bscale + } else + call amovkd (double(0), Memd[scaled], len) + + } + + case GAMMA: + data = O_VALP(args[1]) + gamma = 1.0 / O_VALR(args[2]) + if (nargs == 3) + scale = max (1.0, O_VALR(args[3])) + else + scale = 255.0 + len = O_LEN(args[1]) - 1 + O_LEN(o) = len + 1 + O_TYPE(o) = TY_REAL + call malloc (O_VALP(o), len+1, TY_REAL) + scaled = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + do i = 0, len { + pix = max (zero, Mems[data+i]) + Memr[scaled+i] = scale * ((pix/scale) ** gamma) + } + + case TY_INT: + do i = 0, len { + pix = max (int(0), Memi[data+i]) + Memr[scaled+i] = scale * ((pix/scale) ** gamma) + } + + case TY_LONG: + do i = 0, len { + pix = max (long(0), Meml[data+i]) + Memr[scaled+i] = scale * ((pix/scale) ** gamma) + } + + case TY_REAL: + do i = 0, len { + pix = max (real(0), Memr[data+i]) + Memr[scaled+i] = scale * ((pix/scale) ** gamma) + } + + case TY_DOUBLE: + do i = 0, len { + pix = max (double(0), Memd[data+i]) + Memr[scaled+i] = scale * ((pix/scale) ** gamma) + } + + } + + case BLOCK: + len = O_VALI(args[2]) + O_LEN(o) = len + O_TYPE(o) = O_TYPE(args[1]) + call malloc (O_VALP(o), len, O_TYPE(args[1])) + scaled = O_VALP(o) + switch (O_TYPE(args[1])) { + case TY_UBYTE, TY_USHORT, TY_SHORT: + call amovks (O_VALS(args[1]), Mems[scaled], len) + case TY_INT: + call amovki (O_VALI(args[1]), Memi[scaled], len) + case TY_LONG: + call amovkl (O_VALL(args[1]), Meml[scaled], len) + case TY_REAL: + call amovkr (O_VALR(args[1]), Memr[scaled], len) + case TY_DOUBLE: + call amovkd (O_VALD(args[1]), Memd[scaled], len) + } + + + } + + if (DEBUG) { call zze_pevop (o) } + + call sfree (sp) +end diff --git a/pkg/dataio/export/generic/exraster.x b/pkg/dataio/export/generic/exraster.x new file mode 100644 index 00000000..9838894f --- /dev/null +++ b/pkg/dataio/export/generic/exraster.x @@ -0,0 +1,709 @@ +include +include +include +include "../export.h" + +define DEBUG false + + +# EX_NO_INTERLEAVE - Write out the image with no interleaving. + +procedure ex_no_interleave (ex) + +pointer ex #i task struct pointer + +pointer op, out +int i, j, k, line, percent, orow +int fd, outtype + +pointer ex_evaluate(), ex_chtype() + +begin + if (DEBUG) { call eprintf ("ex_no_interleave:\n") + call eprintf ("NEXPR = %d OCOLS = %d OROWS = %d\n") + call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex)) + call pargi(EX_OROWS(ex)) + } + + # Loop over the number of image expressions. + fd = EX_FD(ex) + outtype = EX_OUTTYPE(ex) + percent = 0 + orow = 0 + 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 + line = O_HEIGHT(ex,i) - 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, outtype) + + # Write evaluated pixels. + if (EX_FORMAT(ex) != FMT_LIST) + call ex_wpixels (fd, outtype, out, O_LEN(op)) + else { + call ex_listpix (fd, outtype, out, O_LEN(op), j, i, + EX_NEXPR(ex), NO) + } + + # Clean up the pointers. + if (outtype == TY_UBYTE || outtype == TY_CHAR) + call mfree (out, TY_CHAR) + else + call mfree (out, outtype) + call evvfree (op) + do k = 1, EX_NIMOPS(ex) { + op = IMOP(ex,k) +# if (IO_ISIM(op) == NO) + call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op))) + } + + # Print percent done if being verbose + orow = orow + 1 + #if (EX_VERBOSE(ex) == YES) + call ex_pstat (ex, orow, percent) + } + } + + if (DEBUG) { call zze_prstruct ("Finished processing", ex) } +end + + +# EX_LN_INTERLEAVE - Write out the image with line interleaving. + +procedure ex_ln_interleave (ex) + +pointer ex #i task struct pointer + +pointer op, out +int i, j, line, percent, orow +int fd, outtype + +pointer ex_evaluate(), ex_chtype() + +begin + if (DEBUG) { call eprintf ("ex_ln_interleave:\n") + call eprintf ("NEXPR = %d OCOLS = %d OROWS = %d\n") + call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex)) + call pargi(EX_OROWS(ex)) + } + + # Process each line in the image. + fd = EX_FD(ex) + outtype = EX_OUTTYPE(ex) + percent = 0 + orow = 0 + do i = 1, EX_NLINES(ex) { + + # See if we're flipping the image. + if (bitset (EX_OUTFLAGS(ex), OF_FLIPY)) + line = EX_NLINES(ex) - i + 1 + else + line = i + + # Get pixels from image(s). + call ex_getpix (ex, line) + + # Loop over the number of image expressions. + do j = 1, EX_NEXPR(ex) { + + # Evaluate expression. + op = ex_evaluate (ex, O_EXPR(ex,j)) + + # Convert to the output pixel type. + out = ex_chtype (ex, op, outtype) + + # Write evaluated pixels. + if (EX_FORMAT(ex) != FMT_LIST) + call ex_wpixels (fd, outtype, out, O_LEN(op)) + else { + call ex_listpix (fd, outtype, out, O_LEN(op), i, j, + EX_NEXPR(ex), NO) + } + + # Clean up the pointers. + if (outtype == TY_UBYTE || outtype == TY_CHAR) + call mfree (out, TY_CHAR) + else + call mfree (out, outtype) + call evvfree (op) + + # Print percent done if being verbose + orow = orow + 1 + #if (EX_VERBOSE(ex) == YES) + call ex_pstat (ex, orow, percent) + } + + do j = 1, EX_NIMOPS(ex) { + op = IMOP(ex,j) +# if (IO_ISIM(op) == NO) + call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op))) + } + } + + if (DEBUG) { call zze_prstruct ("Finished processing", ex) } +end + + +# EX_PX_INTERLEAVE - Write out the image with pixel interleaving. + +procedure ex_px_interleave (ex) + +pointer ex #i task struct pointer + +pointer sp, pp, op +pointer o, outptr +int i, j, line, npix, outtype +long totpix +int fd, percent, orow + +pointer ex_evaluate(), ex_chtype() + +begin + if (DEBUG) { call eprintf ("ex_px_interleave:\n") + call eprintf ("NEXPR = %d OCOLS = %d OROWS = %d\n") + call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex)) + call pargi(EX_OROWS(ex)) + } + + call smark (sp) + call salloc (pp, EX_NEXPR(ex), TY_POINTER) + + # Process each line in the image. + fd = EX_FD(ex) + outptr = NULL + outtype = EX_OUTTYPE(ex) + percent = 0 + orow = 0 + do i = 1, EX_NLINES(ex) { + + # See if we're flipping the image. + if (bitset (EX_OUTFLAGS(ex), OF_FLIPY)) + line = EX_NLINES(ex) - i + 1 + else + line = i + + # Get pixels from image(s). + call ex_getpix (ex, line) + + # Loop over the number of image expressions. + totpix = 0 + do j = 1, EX_NEXPR(ex) { + + # Evaluate expression. + op = ex_evaluate (ex, O_EXPR(ex,j)) + + # Convert to the output pixel type. + o = ex_chtype (ex, op, outtype) + Memi[pp+j-1] = o + + npix = O_LEN(op) + #npix = EX_OCOLS(op) + call evvfree (op) + } + + # Merge pixels into a single vector. + call ex_merge_pixels (Memi[pp], EX_NEXPR(ex), npix, outtype, + outptr, totpix) + + # Write vector of merged pixels. + if (outtype == TY_UBYTE) + call achtsb (Memc[outptr], Memc[outptr], totpix) + if (EX_FORMAT(ex) != FMT_LIST) + call ex_wpixels (fd, outtype, outptr, totpix) + else { + call ex_listpix (fd, outtype, outptr, totpix, + i, EX_NEXPR(ex), EX_NEXPR(ex), YES) + } + + if (outtype != TY_CHAR && outtype != TY_UBYTE) + call mfree (outptr, outtype) + else + call mfree (outptr, TY_CHAR) + do j = 1, EX_NIMOPS(ex) { + op = IMOP(ex,j) +# if (IO_ISIM(op) == NO) + call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op))) + } + do j = 1, EX_NEXPR(ex) { + if (outtype != TY_CHAR && outtype != TY_UBYTE) + call mfree (Memi[pp+j-1], outtype) + else + call mfree (Memi[pp+j-1], TY_CHAR) + } + + # Print percent done if being verbose + orow = orow + 1 + #if (EX_VERBOSE(ex) == YES) + call ex_pstat (ex, orow, percent) + } + + call sfree (sp) + + if (DEBUG) { call zze_prstruct ("Finished processing", ex) } +end + + +# EX_GETPIX - Get the pixels from the image and load each operand. + +procedure ex_getpix (ex, line) + +pointer ex #i task struct pointer +int line #i current line number + +pointer im, op, data +int nptrs, i, band + +pointer imgl3s(), imgl3i(), imgl3l() +pointer imgl3r(), imgl3d() + +begin + # Loop over each of the image operands. + nptrs = EX_NIMOPS(ex) + do i = 1, nptrs { + op = IMOP(ex,i) + im = IO_IMPTR(op) + band = max (1, IO_BAND(op)) + + if (line > IM_LEN(im,2)) { + call calloc (IO_DATA(op), IM_LEN(im,1), IM_PIXTYPE(im)) + IO_ISIM(op) = NO + IO_NPIX(op) = IM_LEN(im,1) + next + } else if (IO_DATA(op) == NULL) + call malloc (IO_DATA(op), IM_LEN(im,1), IM_PIXTYPE(im)) + + switch (IM_PIXTYPE(im)) { + case TY_USHORT: + data = imgl3s (im, line, band) + call amovs (Mems[data], Mems[IO_DATA(op)], IM_LEN(im,1)) + IO_TYPE(op) = TY_SHORT + IO_NBYTES(op) = SZ_SHORT * SZB_CHAR + IO_ISIM(op) = YES + + case TY_SHORT: + data = imgl3s (im, line, band) + call amovs (Mems[data], Mems[IO_DATA(op)], IM_LEN(im,1)) + IO_TYPE(op) = TY_SHORT + IO_NBYTES(op) = SZ_SHORT * SZB_CHAR + IO_ISIM(op) = YES + + case TY_INT: + data = imgl3i (im, line, band) + call amovi (Memi[data], Memi[IO_DATA(op)], IM_LEN(im,1)) + IO_TYPE(op) = TY_INT + IO_NBYTES(op) = SZ_INT32 * SZB_CHAR + IO_ISIM(op) = YES + + case TY_LONG: + data = imgl3l (im, line, band) + call amovl (Meml[data], Meml[IO_DATA(op)], IM_LEN(im,1)) + IO_TYPE(op) = TY_LONG + IO_NBYTES(op) = SZ_LONG * SZB_CHAR + IO_ISIM(op) = YES + + case TY_REAL: + data = imgl3r (im, line, band) + call amovr (Memr[data], Memr[IO_DATA(op)], IM_LEN(im,1)) + IO_TYPE(op) = TY_REAL + IO_NBYTES(op) = SZ_REAL * SZB_CHAR + IO_ISIM(op) = YES + + case TY_DOUBLE: + data = imgl3d (im, line, band) + call amovd (Memd[data], Memd[IO_DATA(op)], IM_LEN(im,1)) + IO_TYPE(op) = TY_DOUBLE + IO_NBYTES(op) = SZ_DOUBLE * SZB_CHAR + IO_ISIM(op) = YES + + } + IO_NPIX(op) = IM_LEN(im,1) + } +end + + +# EX_WPIXELS - Write the pixels to the current file. + +procedure ex_wpixels (fd, otype, pix, npix) + +int fd #i output file descriptor +int otype #i output data type +pointer pix #i pointer to pixel data +int npix #i number of pixels to write + +begin + # Write binary output. + switch (otype) { + case TY_UBYTE: + call write (fd, Mems[pix], npix / SZB_CHAR) + case TY_USHORT: + call write (fd, Mems[pix], npix * SZ_SHORT/SZ_CHAR) + + case TY_SHORT: + call write (fd, Mems[pix], npix * SZ_SHORT/SZ_CHAR) + + case TY_INT: + if (SZ_INT != SZ_INT32) + call ipak32 (Memi[pix], Memi[pix], npix) + call write (fd, Memi[pix], npix * SZ_INT32/SZ_CHAR) + + case TY_LONG: + call write (fd, Meml[pix], npix * SZ_LONG/SZ_CHAR) + + case TY_REAL: + call write (fd, Memr[pix], npix * SZ_REAL/SZ_CHAR) + + case TY_DOUBLE: + call write (fd, Memd[pix], npix * SZ_DOUBLE/SZ_CHAR) + + } +end + + +# EX_LISTPIX - Write the pixels to the current file as ASCII text. + +procedure ex_listpix (fd, type, data, npix, line, band, nbands, merged) + +int fd #i output file descriptor +int type #i output data type +pointer data #i pointer to pixel data +int npix #i number of pixels to write +int line #i current output line number +int band #i current output band number +int nbands #i no. of output bands +int merged #i are pixels interleaved? + +int i, j, k +int val, pix, shifti(), andi() + +begin + if (merged == YES && nbands > 1) { + do i = 1, npix { + k = 0 + do j = 1, nbands { + call fprintf (fd, "%4d %4d %4d ") + call pargi (i) + call pargi (line) + call pargi (j) + + switch (type) { + case TY_UBYTE: + val = Memc[data+k] + if (mod(i,2) == 1) { + pix = shifti (val, -8) + } else { + pix = andi (val, 000FFX) + k = k + 1 + } + if (pix < 0) pix = pix + 256 + call fprintf (fd, "%d\n") + call pargi (pix) + case TY_CHAR, TY_SHORT, TY_USHORT: + call fprintf (fd, "%d\n") + call pargs (Mems[data+((j-1)*npix+i)-1]) + case TY_INT: + call fprintf (fd, "%d\n") + call pargi (Memi[data+((j-1)*npix+i)-1]) + case TY_LONG: + call fprintf (fd, "%d\n") + call pargl (Meml[data+((j-1)*npix+i)-1]) + case TY_REAL: + call fprintf (fd, "%g\n") + call pargr (Memr[data+((j-1)*npix+i)-1]) + case TY_DOUBLE: + call fprintf (fd, "%g\n") + call pargd (Memd[data+((j-1)*npix+i)-1]) + } + } + } + } else { + j = 0 + do i = 1, npix { + if (nbands > 1) { + call fprintf (fd, "%4d %4d %4d ") + call pargi (i) + call pargi (line) + call pargi (band) + } else { + call fprintf (fd, "%4d %4d ") + call pargi (i) + call pargi (line) + } + + switch (type) { + case TY_UBYTE: + val = Memc[data+j] + if (mod(i,2) == 1) { + pix = shifti (val, -8) + } else { + pix = andi (val, 000FFX) + j = j + 1 + } + if (pix < 0) pix = pix + 256 + call fprintf (fd, "%d\n") + call pargi (pix) + case TY_CHAR, TY_SHORT, TY_USHORT: + call fprintf (fd, "%d\n") + call pargs (Mems[data+i-1]) + case TY_INT: + call fprintf (fd, "%d\n") + call pargi (Memi[data+i-1]) + case TY_LONG: + call fprintf (fd, "%d\n") + call pargl (Meml[data+i-1]) + case TY_REAL: + call fprintf (fd, "%g\n") + call pargr (Memr[data+i-1]) + case TY_DOUBLE: + call fprintf (fd, "%g\n") + call pargd (Memd[data+i-1]) + } + } + } +end + + +# EX_MERGE_PIXELS - Merge a group of pixels arrays into one array by combining +# the elements. Returns an allocated pointer which must be later freed and +# the total number of pixels. + +procedure ex_merge_pixels (ptrs, nptrs, npix, dtype, pix, totpix) + +pointer ptrs[ARB] #i array of pixel ptrs +int nptrs #i number of ptrs +int npix #i no. of pixels in each array +int dtype #i type of pointer to alloc +pointer pix #o output pixel array ptr +int totpix #o total no. of output pixels + +int i, j, ip + +begin + # Calculate the number of output pixels and allocate the pointer. + totpix = nptrs * npix + if (dtype != TY_CHAR && dtype != TY_UBYTE) + call realloc (pix, totpix, dtype) + else { + call realloc (pix, totpix, TY_CHAR) + do i = 1, nptrs + call achtbs (Mems[ptrs[i]], Mems[ptrs[i]], npix) + } + + # Fill the output array + ip = 0 + for (i = 1; i<=npix; i=i+1) { + do j = 1, nptrs { + switch (dtype) { + case TY_UBYTE: + Mems[pix+ip] = Mems[ptrs[j]+i-1] + case TY_USHORT: + Mems[pix+ip] = Mems[ptrs[j]+i-1] + + case TY_SHORT: + Mems[pix+ip] = Mems[ptrs[j]+i-1] + + case TY_INT: + Memi[pix+ip] = Memi[ptrs[j]+i-1] + + case TY_LONG: + Meml[pix+ip] = Meml[ptrs[j]+i-1] + + case TY_REAL: + Memr[pix+ip] = Memr[ptrs[j]+i-1] + + case TY_DOUBLE: + Memd[pix+ip] = Memd[ptrs[j]+i-1] + + } + + ip = ip + 1 + } + } +end + + +# EX_CHTYPE - Change the expression operand vector to the output datatype. +# We allocate and return a pointer to the correct type to the converted +# pixels, this pointer must be freed later on. Any IEEE or byte-swapping +# requests are also handled here. + +pointer procedure ex_chtype (ex, op, type) + +pointer ex #i task struct pointer +pointer op #i evvexpr operand pointer +int type #i new type of pointer + +pointer out, coerce() +int swap, flags + +begin + # Allocate the pointer and coerce it so the routine works. + if (type == TY_UBYTE || type == TY_CHAR) + call calloc (out, O_LEN(op), TY_CHAR) + else { + call calloc (out, O_LEN(op), type) + out = coerce (out, type, TY_CHAR) + } + + # If this is a color index image subtract one from the pixel value + # to get the index. + if (bitset (flags, OF_CMAP)) + call ex_pix_to_index (O_VALP(op), O_TYPE(op), O_LEN(op)) + + # Change the pixel type. + flags = EX_OUTFLAGS(ex) + swap = EX_BSWAP(ex) + switch (O_TYPE(op)) { + case TY_CHAR: + call achtc (Memc[O_VALP(op)], Memc[out], O_LEN(op), type) + + case TY_SHORT: + call achts (Mems[O_VALP(op)], Memc[out], O_LEN(op), type) + + # Do any requested byte swapping. + if (bitset (swap, S_I2) || bitset (swap, S_ALL)) + call bswap4 (Mems[out], 1, Mems[out], 1, O_LEN(op)) + + case TY_INT: + call achti (Memi[O_VALP(op)], Memc[out], O_LEN(op), type) + + # Do any requested byte swapping. + if (bitset (swap, S_I4) || bitset (swap, S_ALL)) + call bswap4 (Memi[out], 1, Memi[out], 1, O_LEN(op)) + + case TY_LONG: + call achtl (Meml[O_VALP(op)], Memc[out], O_LEN(op), type) + + # Do any requested byte swapping. + if (bitset (swap, S_I4) || bitset (swap, S_ALL)) + call bswap4 (Meml[out], 1, Meml[out], 1, O_LEN(op)) + + case TY_REAL: + call achtr (Memr[O_VALP(op)], Memc[out], O_LEN(op), type) + + # See if we need to convert to IEEE + if (bitset (flags, OF_IEEE) && IEEE_USED == NO) + call ieevpakr (Memr[out], Memr[out], O_LEN(op)) + + case TY_DOUBLE: + call achtd (Memd[O_VALP(op)], Memc[out], O_LEN(op), type) + + # See if we need to convert to IEEE + if (bitset (flags, OF_IEEE) && IEEE_USED == NO) + call ieevpakd (Memd[P2D(out)], Memd[P2D(out)], O_LEN(op)) + + default: + call error (0, "Invalid output type requested.") + } + + if (type != TY_UBYTE && type != TY_CHAR) + out = coerce (out, TY_CHAR, type) + return (out) +end + + +# EX_PIX_TO_INDEX - Convert pixel values to color index values. We assume +# the colormap has at most 256 entries. + +procedure ex_pix_to_index (ptr, type, len) + +pointer ptr #i data ptr +int type #i data type of array +int len #i length of array + + +short sindx, smin, smax + +int iindx, imin, imax + +long lindx, lmin, lmax + +real rindx, rmin, rmax + +double dindx, dmin, dmax + + +begin + + sindx = short (1) + smin = short (0) + smax = short (255) + + iindx = int (1) + imin = int (0) + imax = int (255) + + lindx = long (1) + lmin = long (0) + lmax = long (255) + + rindx = real (1) + rmin = real (0) + rmax = real (255) + + dindx = double (1) + dmin = double (0) + dmax = double (255) + + + switch (type) { + + case TY_SHORT: + call asubks (Mems[ptr], sindx, Mems[ptr], len) + call amaxks (Mems[ptr], smin, Mems[ptr], len) + call aminks (Mems[ptr], smax, Mems[ptr], len) + + case TY_INT: + call asubki (Memi[ptr], iindx, Memi[ptr], len) + call amaxki (Memi[ptr], imin, Memi[ptr], len) + call aminki (Memi[ptr], imax, Memi[ptr], len) + + case TY_LONG: + call asubkl (Meml[ptr], lindx, Meml[ptr], len) + call amaxkl (Meml[ptr], lmin, Meml[ptr], len) + call aminkl (Meml[ptr], lmax, Meml[ptr], len) + + case TY_REAL: + call asubkr (Memr[ptr], rindx, Memr[ptr], len) + call amaxkr (Memr[ptr], rmin, Memr[ptr], len) + call aminkr (Memr[ptr], rmax, Memr[ptr], len) + + case TY_DOUBLE: + call asubkd (Memd[ptr], dindx, Memd[ptr], len) + call amaxkd (Memd[ptr], dmin, Memd[ptr], len) + call aminkd (Memd[ptr], dmax, Memd[ptr], len) + + } +end + + +# EX_PSTAT - Print information about the progress we're making. + +procedure ex_pstat (ex, row, percent) + +pointer ex #i task struct pointer +int row #u current row +int percent #u percent completed + +begin + # Print percent done if being verbose + if (row * 100 / EX_OROWS(ex) >= percent + 10) { + percent = percent + 10 + call eprintf (" Status: %2d%% complete\r") + call pargi (percent) + call flush (STDERR) + } +end diff --git a/pkg/dataio/export/generic/mkpkg b/pkg/dataio/export/generic/mkpkg new file mode 100644 index 00000000..4902710d --- /dev/null +++ b/pkg/dataio/export/generic/mkpkg @@ -0,0 +1,12 @@ +# Compile the generic sources. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + exobands.x ../exfcn.h ../export.h \ + + exraster.x ../export.h + ; diff --git a/pkg/dataio/export/mkpkg b/pkg/dataio/export/mkpkg new file mode 100644 index 00000000..986450a7 --- /dev/null +++ b/pkg/dataio/export/mkpkg @@ -0,0 +1,36 @@ +# MKPKG file for the EXPORT task + +$call update +$exit + +update: + $checkout libpkg.a ../ + $update libpkg.a + $checkin libpkg.a ../ + ; + +generic: + $set GEN = "$$generic -k" + $ifolder (generic/exobands.x, exobands.gx) + $(GEN) exobands.gx -o generic/exobands.x $endif + $ifolder (generic/exraster.x, exraster.gx) + $(GEN) exraster.gx -o generic/exraster.x $endif + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call generic $endif + + @generic # compile the generic format code + @bltins # compile the builtin format code + + exbltins.x exbltins.h export.h + excmap.x cmaps.inc export.h + exhdr.x export.h \ + + expreproc.x exfcn.h cmaps.inc export.h + exrgb8.x export.h + exzscale.x export.h + t_export.x export.h \ + + zzedbg.x exbltins.h export.h + ; diff --git a/pkg/dataio/export/t_export.x b/pkg/dataio/export/t_export.x new file mode 100644 index 00000000..6516ed11 --- /dev/null +++ b/pkg/dataio/export/t_export.x @@ -0,0 +1,1160 @@ +include +include +include +include +include +include +include "export.h" + +define DEBUG false + + +# T_EXPORT -- Task entry. Convert one or more IRAF image to an output binary +# file. Output may be a raw binary raster, with or without header information, +# a pixel listing, or a specified (supported) format. Arbitrary expressions +# may be applied to the input images before conversion. + +procedure t_export () + +pointer ex # task struct pointer +pointer sp, blist, bfname # stack pointers +pointer imname[MAX_OPERANDS] +pointer imlist # image list pointer +pointer im # image descriptor +int binlist # binary file list pointer +int imdim # dimensionality of images +int imtype # datatype of images +int i + +pointer ex_init(), immap() +int ex_getpars() +int clgfil(), access(), fntopnb() +int imtlen(), imtopenp(), open(), imtgetim() +bool streq() + +errchk open, immap, ex_chkimlist + +define quit_ 99 + +begin + # Allocate local stack storage. + call smark (sp) + call salloc (bfname, SZ_FNAME, TY_CHAR) + call salloc (blist, SZ_FNAME, TY_CHAR) + call aclrc (Memc[blist], SZ_FNAME) + call aclrc (Memc[bfname], SZ_FNAME) + do i = 1, MAX_OPERANDS { + call salloc (imname[i], SZ_FNAME, TY_CHAR) + call aclrc (Memc[imname[i]], SZ_FNAME) + } + + # Get the image and file lists. + imlist = imtopenp ("images") + call clgstr ("binfiles", Memc[blist], SZ_FNAME) + if (!streq("", Memc[blist]) && !streq(" ", Memc[blist])) { + binlist = fntopnb (Memc[blist], YES) + iferr (call ex_chkimlist (imlist, binlist, imdim, imtype)) { + call imtclose (imlist) + call clpcls (binlist) + call sfree (sp) + call erract (EA_FATAL) + } + call clprew (binlist) + } else { + binlist = -1 + iferr (call ex_chkimlist (imlist, binlist, imdim, imtype)) { + call imtclose (imlist) + call sfree (sp) + call erract (EA_FATAL) + } + } + call imtrew (imlist) # rewind the list ptrs + + # Allocate structure and get the task parameters. + ex = ex_init () + EX_IMDIM(ex) = imdim + EX_IMTYPE(ex) = imtype + if (ex_getpars (ex) != OK) + goto quit_ + + # Do some last minute error checking. + if (imtlen(imlist) < EX_NIMAGES(ex)) + call error (0, "Too many image operands in expression list") + + # Start processing the files. + repeat { + + # Open the output binary file. + if (binlist > 0) { + if (clgfil(binlist, Memc[bfname], SZ_FNAME) == EOF) + break + + # If this is a builtin format append the format suffix if it's + # not already there and then open the file. + call ex_mkfname (ex, Memc[bfname]) + if (access (BFNAME(ex), 0, 0) == YES) { + call eprintf ("Output file `%s' already exists.\n") + call pargstr (BFNAME(ex)) + goto quit_ + } + if (EX_FORMAT(ex) != FMT_LIST) + EX_FD(ex) = open (BFNAME(ex), NEW_FILE, BINARY_FILE) + else + EX_FD(ex) = open (BFNAME(ex), NEW_FILE, TEXT_FILE) + } else { + call strcpy ("STDOUT", Memc[bfname], SZ_FNAME) + call strcpy ("STDOUT", BFNAME(ex), SZ_FNAME) + EX_FD(ex) = STDOUT + } + + # Open the image pointers. If no outbands expressions were given + # we're converting only one image, but we need to fake up the + # image operands. + if (EX_NIMAGES(ex) == EX_UNDEFINED) { + i = imtgetim(imlist, Memc[imname[1]], SZ_FNAME) + im = immap (Memc[imname[1]], READ_ONLY, 0) + EX_NIMAGES(ex) = 1 + EX_NEXPR(ex) = max (1, IM_LEN(im,3)) + EX_NCOLS(ex) = IM_LEN(im,1) + EX_NLINES(ex) = IM_LEN(im,2) + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), BAND_STORAGE) + if (EX_IMDIM(ex) == 0) + EX_IMDIM(ex) = IM_NDIM(im) + if (EX_IMTYPE(ex) == 0) { + EX_IMTYPE(ex) = IM_PIXTYPE(im) + EX_OUTTYPE(ex) = IM_PIXTYPE(im) + } + + # Fake the expressions and break out the operands. + do i = 1, EX_NEXPR(ex) { + call ex_alloc_outbands (OBANDS(ex,i)) + call sprintf (O_EXPR(ex,i), SZ_LINE, "b%d") + call pargi (i) + } + call ex_parse_operands (ex) + if (EX_NEXPR(ex) > 1) { + EX_OUTFLAGS(ex) = and (EX_OUTFLAGS(ex), not(BAND_STORAGE)) + EX_OUTFLAGS(ex) = and (EX_OUTFLAGS(ex), not(LINE_STORAGE)) + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), PIXEL_STORAGE) + } + IO_IMPTR(IMOP(ex,1)) = im + + # Print some status stuff so we know what's being converted. + call eprintf ("%s -> %s\n") + call pargstr (Memc[imname[1]]) + call pargstr (BFNAME(ex)) + } else { + EX_NLINES(ex) = 0 + do i = 1, EX_NIMAGES(ex) { + if (imtgetim(imlist, Memc[imname[i]], SZ_FNAME) == EOF) + call error (1, "Short image list") + im = immap (Memc[imname[i]], READ_ONLY, 0) + EX_NCOLS(ex) = IM_LEN(im,1) + EX_NLINES(ex) = max (EX_NLINES(ex), IM_LEN(im,2)) + IO_IMPTR(IMOP(ex,i)) = im + if (EX_IMDIM(ex) == 0) + EX_IMDIM(ex) = IM_NDIM(im) + if (EX_IMTYPE(ex) == 0) { + EX_IMTYPE(ex) = IM_PIXTYPE(im) + EX_OUTTYPE(ex) = IM_PIXTYPE(im) + } + + # Print some status stuff so we know what's being converted. + call eprintf ("%s") + call pargstr (Memc[imname[i]]) + if (i < EX_NIMAGES(ex)) + call eprintf (",") + else { + call eprintf (" -> %s\n") + call pargstr (BFNAME(ex)) + } + call flush (STDERR) + } + } + + # For 3-D data we only have one image, but we may have multiple + # image operands (bands) within the image. If this is the case + # then copy the image pointer to the remaining operand structs. + if (EX_NIMAGES(ex) == 1 && EX_NIMOPS(ex) > 1) { + do i = 2, EX_NIMOPS(ex) + IO_IMPTR(IMOP(ex,i)) = IO_IMPTR(IMOP(ex,1)) + } + + # Now patch up any zscale calls in the expression string. + do i = 1, EX_NEXPR(ex) + call ex_patch_zscale (ex, i) + + # Now that we have all the image information and things are going + # well, compute the size of the output image. + call ex_outsize (ex) + + # If we're being verbose the print some more information on the + # input images and output file. + if (EX_VERBOSE(ex) == YES) + call ex_prinfo (ex, imname) + + # Write the header now if this is a generic raster. + if (EX_HEADER(ex) != HDR_NONE && EX_FORMAT(ex) != FMT_BUILTIN) + call ex_wheader (ex, Memc[bfname]) + + # Process the image. + call ex_process_image (ex) + + # Unmap the image pointer(s). + do i = 1, EX_NIMAGES(ex) { + im = IO_IMPTR(IMOP(ex,i)) + if (im != NULL) + call imunmap (im) + } + + # Close the output file descriptor. + if (EX_FD(ex) != NULL) + call close (EX_FD(ex)) + + # If we created a temp image then delete that now. + if (EX_TIMPTR(ex) != NULL) + call imdelete (TIMNAME(ex)) + + if (binlist < 0) + break + } + + # Clean up. +quit_ call imtclose (imlist) + if (binlist > 0) + call clpcls (binlist) + call sfree (sp) +end + + +# EX_INIT - Initialize the export task structure. + +pointer procedure ex_init () + +pointer ex + +begin + # Allocate the task structure pointer. + iferr (call calloc (ex, SZ_EXPSTRUCT, TY_STRUCT)) + call error (0, "Error allocating EXPORT task structure.") + + # Allocate internal pointers. + call calloc (EX_HDRPTR(ex), SZ_FNAME, TY_CHAR) + call calloc (EX_CMPTR(ex), SZ_FNAME, TY_CHAR) + call calloc (EX_LUTPTR(ex), SZ_FNAME, TY_CHAR) + call calloc (EX_BFNPTR(ex), SZ_FNAME, TY_CHAR) + call calloc (EX_OBANDS(ex), MAX_OBEXPR, TY_STRUCT) + call calloc (EX_IMOPS(ex), MAX_OPERANDS, TY_STRUCT) + call calloc (EX_OTPTR(ex), SZ_LINE, TY_CHAR) + call calloc (EX_OBPTR(ex), SZ_EXPSTR, TY_CHAR) + + # Initialize some parameters. + EX_OUTFLAGS(ex) = NULL + EX_NLUTEL(ex) = INDEFI + EX_NCOLORS(ex) = CMAP_SIZE + EX_PSDPI(ex) = EPS_DPI + EX_PSSCALE(ex) = EPS_SCALE + EX_BRIGHTNESS(ex) = 0.5 + EX_CONTRAST(ex) = 1.0 + + return (ex) +end + + +# EX_FREE - Free the export task structure. + +procedure ex_free (ex) + +pointer ex #i task struct pointer + +int i + +begin + # Free internal pointers. + call mfree (EX_HDRPTR(ex), TY_CHAR) + call mfree (EX_CMPTR(ex), TY_CHAR) + call mfree (EX_LUTPTR(ex), TY_CHAR) + call mfree (EX_BFNPTR(ex), TY_CHAR) + call mfree (EX_TIMPTR(ex), TY_CHAR) + call mfree (EX_OTPTR(ex), TY_CHAR) + call mfree (EX_OBPTR(ex), TY_CHAR) + + # Free outbands pointers. + for (i=1; i < MAX_OBEXPR; i=i+1) + call ex_free_outbands (OBANDS(ex,i)) + call mfree (EX_OBANDS(ex), TY_POINTER) + + # Free operand pointers. + for (i=1; i < MAX_OPERANDS; i=i+1) + call ex_free_operand (IMOP(ex,i)) + call mfree (EX_IMOPS(ex), TY_POINTER) + + # Free the colormap. + if (EX_CMAP(ex) != NULL) + call mfree (EX_CMAP(ex), TY_CHAR) + + call mfree (ex, TY_STRUCT) +end + + +# EX_GETPARS - Get the task parameters. + +int procedure ex_getpars (ex) + +pointer ex #i task struct pointer + +pointer sp, format, header, bswap +pointer outtype, outbands + +int ex_chkpars(), clgeti(), btoi() +bool clgetb() + +errchk ex_do_format, ex_do_header, ex_do_bswap +errchk ex_do_outtype, ex_do_outbands + +begin + call smark (sp) + call salloc (format, SZ_FNAME, TY_CHAR) + call salloc (header, SZ_FNAME, TY_CHAR) + call salloc (bswap, SZ_FNAME, TY_CHAR) + call salloc (outtype, SZ_LINE, TY_CHAR) + call salloc (outbands, SZ_EXPSTR, TY_CHAR) + + call aclrc (Memc[format], SZ_FNAME) + call aclrc (Memc[header], SZ_FNAME) + call aclrc (Memc[bswap], SZ_FNAME) + call aclrc (Memc[outtype], SZ_FNAME) + call aclrc (Memc[outbands], SZ_EXPSTR) + + # Get the string valued parameters. + call clgstr ("format", Memc[format], SZ_FNAME) + call clgstr ("header", Memc[header], SZ_FNAME) + call clgstr ("bswap", Memc[bswap], SZ_FNAME) + call clgstr ("outtype", Memc[outtype], SZ_LINE) + call strcpy (Memc[outtype], Memc[EX_OTPTR(ex)], SZ_LINE) + call clgstr ("outbands", Memc[outbands], SZ_EXPSTR) + call strcpy (Memc[outbands], Memc[EX_OBPTR(ex)], SZ_EXPSTR) + + # Get the simple params. + EX_INTERLEAVE(ex) = clgeti ("interleave") + EX_VERBOSE(ex) = btoi (clgetb ("verbose")) + + # Process the parameter values, due error checking + iferr { + call ex_do_format (ex, Memc[format]) + call ex_do_header (ex, Memc[header]) + call ex_do_bswap (ex, Memc[bswap]) + call ex_do_outtype (ex, Memc[outtype]) + call ex_do_outbands(ex, Memc[outbands]) + } then { + call sfree (sp) + call erract (EA_FATAL) + } + + call sfree (sp) + + if (DEBUG) { + call eprintf("ex_format=%d\n"); call pargi (EX_FORMAT(ex)) + call eprintf("ex_bswap=%d\n"); call pargi (EX_BSWAP(ex)) + call eprintf("ex_outtype=%d\n"); call pargi (EX_OUTTYPE(ex)) + call eprintf("ex_header=%d\n"); call pargi (EX_HEADER(ex)) + } + + # Do a sanity check on the params so we can exit now if needed. + return (ex_chkpars (ex)) +end + + +# EX_CHKPARS - Check task parameters to be sure we have a valid conversion. + +int procedure ex_chkpars (ex) + +pointer ex #i task struct pointer + +int flags, exb_chkpars() + +begin + flags = EX_OUTFLAGS(ex) + if (EX_FORMAT(ex) == FMT_BUILTIN && !bitset(EX_OUTFLAGS(ex),OF_MKCMAP)){ + return (exb_chkpars(ex)) + } else { + if (bitset (flags, OF_CMAP)) { + call error (1, "Colormap creation not supported for raw output") + return (ERR) + } + } + + return (OK) +end + + +# EX_CHKIMLIST - Check the image list to be sure it's valid. + +procedure ex_chkimlist (images, files, ndim, type) + +int images #i image list pointer +int files #i binary files list pointer +int ndim #o dimensionality of images +int type #o datatype of images + +pointer im, sp, imname +int dim + +pointer immap() +int imtlen(), imtgetim(), clplen() + +errchk immap + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + call aclrc (Memc[imname], SZ_FNAME) + + # Get dimension of first image. + if (imtgetim (images, Memc[imname], SZ_FNAME) != EOF) { + im = immap (Memc[imname], READ_ONLY, 0) + ndim = IM_NDIM(im) + type = IM_PIXTYPE(im) + call imunmap (im) + } else + call error (0, "Unexpected EOF in image list.\n") + + # Loop over remaining images in the list. + while (imtgetim (images, Memc[imname], SZ_FNAME) != EOF) { + im = immap (Memc[imname], READ_ONLY, 0) + dim = IM_NDIM(im) + call imunmap (im) + if (dim != ndim) + call error (0, "Images must all be the same dimension.\n") + } + + if (files > 0) { + if (ndim == 3 && (imtlen (images) != clplen (files))) + call error (0, "No. of images must equal no. of output files\n") + } + + call sfree (sp) +end + + +# EX_OUTSIZE - Compute the output file dimensions. We don't require that +# the expressions all evaluate to same length so we'll patch up the expr +# string to pad with zeroes to the maximum width. + +procedure ex_outsize (ex) + +pointer ex #i task struct pointer + +pointer sp, expr +int i, ip, imnum, plev +int height, maxlen, maxhgt +char ch + +pointer op, ex_evaluate() +int ctoi(), strncmp() + +begin + call smark (sp) + call salloc (expr, SZ_EXPSTR, TY_CHAR) + call aclrc (Memc[expr], SZ_EXPSTR) + + call ex_getpix (ex, 1) + maxlen = 0 + do i = 1, EX_NEXPR(ex) { # get length of each expr + op = ex_evaluate (ex, O_EXPR(ex,i)) + O_WIDTH(ex,i) = O_LEN(op) + maxlen = max (maxlen, O_WIDTH(ex,i)) + call evvfree (op) + } + + do i = 1, EX_NEXPR(ex) { # patch expressions + + if (O_WIDTH(ex,i) <= 1) { + # If the width is 1 we have a constant, meaning we only want + # one line on output and need to pad the constant. + O_HEIGHT(ex,i) = 1 + O_WIDTH(ex,i) = maxlen + call aclrc (Memc[expr], SZ_EXPSTR) + call sprintf (Memc[expr], SZ_EXPSTR, "repl(%s,%d)") + call pargstr (O_EXPR(ex,i)) + call pargi (maxlen) + call strcpy (Memc[expr], O_EXPR(ex,i), SZ_EXPSTR) + + } else if (O_WIDTH(ex,i) <= maxlen) { + # If this is a vector expression then look for image operands. + # The 'height' of the expression will be the largest height + # of the found operands. + + ip = 1 + maxhgt = 1 + call strcpy (O_EXPR(ex,i), Memc[expr], SZ_EXPSTR) + repeat { + while (Memc[expr+ip-1] != 'i' && Memc[expr+ip-1] != 'b' && + Memc[expr+ip-1] != EOS) + ip = ip + 1 + if (Memc[expr+ip-1] == EOS) + break + if (IS_DIGIT(Memc[expr+ip])) { + ip = ip + 1 + if (ctoi (Memc[expr], ip, imnum) == 0) + call error (4, "ex_outsize: can't parse operand") + maxhgt = max (maxhgt,IM_LEN(IO_IMPTR(IMOP(ex,imnum)),2)) + + } else if (strncmp(Memc[expr+ip-1], "block", 5) == 0) { + ip = ip + 1 + + # This is a "block" function call to fill a vertical + # area. The syntax is "block(constant, width, height)" + # so get the height argument. + while (Memc[expr+ip] != '(') + ip = ip + 1 + plev = 0 + repeat { # skip over 1st arg + ip = ip + 1 + ch = Memc[expr+ip] + if (ch == '(') plev = plev + 1 + if (ch == ')') plev = plev - 1 + if (ch == ',' && plev == 0) + break + } + # Should be the start of arg2. + ip = ip + 2 # should be the width + if (ctoi (Memc[expr], ip, height) == 0) + call error (4, "ex_outsize: block() syntax error") + ip = ip + 1 # should be the height + if (ctoi (Memc[expr], ip, height) == 0) + call error (4, "ex_outsize: block() syntax error") + + maxhgt = max (maxhgt, height) + } else + ip = ip + 1 + } + O_HEIGHT(ex,i) = maxhgt + + if (O_WIDTH(ex,i) < maxlen) { + call aclrc (Memc[expr], SZ_EXPSTR) + call sprintf (Memc[expr], SZ_EXPSTR, "%s//repl(0,%d)") + call pargstr (O_EXPR(ex,i)) + call pargi (maxlen - O_WIDTH(ex,i)) + call strcpy (Memc[expr], O_EXPR(ex,i), SZ_EXPSTR) + O_WIDTH(ex,i) = maxlen + } + } + + if (DEBUG) { call eprintf ("%d: len=%d maxlen=%d height=%d\n") + call pargi(i) ; call pargi(O_WIDTH(ex,i)) + call pargi(maxlen) ; call pargi (O_HEIGHT(ex,i)) } + + } + EX_OCOLS(ex) = maxlen + + # Now compute the total number of rows. + if (EX_IMDIM(ex) == 3) { + if (!bitset (EX_OUTFLAGS(ex), PIXEL_STORAGE)) { + if (EX_NEXPR(ex) > 1 && bitset (EX_OUTFLAGS(ex), OF_BAND)) + EX_OROWS(ex) = IM_LEN(IO_IMPTR(IMOP(ex,1)),3)*EX_NLINES(ex) + else + EX_OROWS(ex) = EX_NLINES(ex) + } else + EX_OROWS(ex) = EX_NLINES(ex) + } else if (bitset (EX_OUTFLAGS(ex), OF_BAND)) { + EX_OROWS(ex) = 0 + do i = 1, EX_NEXPR(ex) + EX_OROWS(ex) = EX_OROWS(ex) + O_HEIGHT(ex,i) + } else + EX_OROWS(ex) = EX_NLINES(ex) + + call sfree (sp) +end + + +# EX_DO_FORMAT - Get the task format parameter and set appropriate flags. + +procedure ex_do_format (ex, format) + +pointer ex #i task struct pointer +char format[ARB] #i format parameter value + +bool streq() + +begin + if (DEBUG) { call eprintf("format='%s'\n");call pargstr (format) } + + EX_COLOR(ex) = NO + if (streq(format,"raw")) + EX_FORMAT(ex) = FMT_RAW + else if (streq(format,"list")) + EX_FORMAT(ex) = FMT_LIST + else { + EX_FORMAT(ex) = FMT_BUILTIN + call exb_do_format (ex, format) + } +end + + +# EX_DO_HEADER - Process the header parameter. + +procedure ex_do_header (ex, header) + +pointer ex #i task struct pointer +char header[ARB] #i header parameter string + +bool streq() +int access() + +begin + if (DEBUG) { call eprintf("header='%s'\n") ; call pargstr (header) } + + if (streq(header,"no")) + EX_HEADER(ex) = HDR_NONE + else if (streq(header,"yes")) + EX_HEADER(ex) = HDR_SHORT + else if (streq(header,"long")) + EX_HEADER(ex) = HDR_LONG + else { + EX_HEADER(ex) = HDR_USER + if (access (header, 0, 0) == NO) + call error (2, "User-defined header file does not exist.") + else + call strcpy (header, HDRFILE(ex), SZ_FNAME) + } +end + + +# EX_DO_OUTTYPE - Process the output pixel type parameter. + +procedure ex_do_outtype (ex, outtype) + +pointer ex #i task struct pointer +char outtype[ARB] #i outtype parameter string + +int pixtype, nbytes + +int ex_ptype(), stridx() + +begin + if (DEBUG) { call eprintf("outtype='%s'\n");call pargstr (outtype) } + + if (outtype[1] == EOS) { + EX_OUTTYPE(ex) = EX_IMTYPE(ex) # use type of input image + return + } + + pixtype = stridx(outtype[1],"buirn") + if (pixtype == 0) + call error (2, "Invalid 'outtype' value specified\n") + + if (outtype[2] == EOS) { + if (outtype[1] == 'b') # set minimal sizes + nbytes = 1 + else if (outtype[1] == 'u') + nbytes = 2 + else + nbytes = 4 + } else + nbytes = outtype[2] - '1' + 1 + + # Set struct param. + EX_OUTTYPE(ex) = ex_ptype (pixtype, nbytes) + call sprintf (Memc[EX_OTPTR(ex)], SZ_FNAME, "%c%d") + call pargc (Memc[EX_OTPTR(ex)]) + call pargi (nbytes) +end + + +# EX_DO_BSWAP -- Read the byte-swap string an load the ip structure. + +procedure ex_do_bswap (ex, bswap) + +pointer ex #i task struct pointer +char bswap[ARB] #i byte swap string + +char ch, flag[SZ_FNAME] +int sp, i + +int strdic() + +begin + if (DEBUG) { call eprintf("swap='%s'\n");call pargstr (bswap) } + + sp = 1 + EX_BSWAP(ex) = NULL + while (bswap[sp] != EOS) { + i = 1 + for (ch=bswap[sp]; ch != EOS && ch != ','; ch=bswap[sp]) { + flag[i] = ch + i = i + 1 + sp = sp + 1 + } + flag[i] = EOS + + switch (strdic (flag, flag, SZ_FNAME, SWAP_STR)) { + case 1, 2: + EX_BSWAP(ex) = or (EX_BSWAP(ex), S_NONE) + case 3: + EX_BSWAP(ex) = or (EX_BSWAP(ex), S_ALL) + case 4: + EX_BSWAP(ex) = or (EX_BSWAP(ex), S_I2) + case 5: + EX_BSWAP(ex) = or (EX_BSWAP(ex), S_I4) + default: + break + } + } +end + + +# EX_DO_OUTBANDS - Parse the 'outbands' expressions. The operand tags are +# caught and space allocated. + +procedure ex_do_outbands (ex, outbands) + +pointer ex #i task struct pointer +char outbands[ARB] #i outbands expression string + +pointer sp, exp, expr +int fd, nchars, nexpr +int j, ip, plevel + +int open(), fstatl(), strlen() +char getc() + +errchk open + +begin + if (DEBUG) { call eprintf("outbands='%s'\n");call pargstr (outbands) } + + if (outbands[1] == EOS) { + EX_NIMAGES(ex) = EX_UNDEFINED # convert the whole image + EX_NEXPR(ex) = EX_UNDEFINED + return + } + + call smark (sp) + call salloc (exp, SZ_EXPSTR, TY_CHAR) + call aclrc (Memc[exp], SZ_EXPSTR) + + # If the outbands parameter is an @-file read in the expression from + # the file, otherwise just copy the param to the working buffer. + if (outbands[1] == '@') { + fd = open (outbands[2], READ_ONLY, TEXT_FILE) + nchars = fstatl (fd, F_FILESIZE) + 1 + call calloc (expr, max(SZ_EXPSTR,nchars), TY_CHAR) + ip = 0 + for (j=0; j 1) + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), PIXEL_STORAGE) + else if (EX_INTERLEAVE(ex) > 0 && EX_NEXPR(ex) > 1) + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), LINE_STORAGE) + else + EX_OUTFLAGS(ex) = or (EX_OUTFLAGS(ex), BAND_STORAGE) + } + + call mfree (expr, TY_CHAR) + call sfree (sp) +end + + +# EX_PARSE_OPERANDS - Parse each expression string to break out the image +# operands. If the input image list is 2-D data we'll be generous and +# allow either 'b1' or 'i1', otherwise require the bands number. + +define SZ_TAG 7 + +procedure ex_parse_operands (ex) + +pointer ex #i task struct pointer + +pointer sp, expr +int i, ip, opnum +char ch, tag[SZ_TAG] + +int ctoi() + +begin + call smark (sp) + call salloc (expr, SZ_EXPSTR, TY_CHAR) + + EX_NIMOPS(ex) = 0 + EX_NIMAGES(ex) = 0 + do i = 1, EX_NEXPR(ex) { + call aclrc (Memc[expr], SZ_EXPSTR) + call strcpy (O_EXPR(ex,i), Memc[expr], SZ_EXPSTR) + + ip = 1 + while (Memc[expr+ip] != EOS) { + ch = Memc[expr+ip-1] + + # See if we have an operand descriptor. + if ((ch == 'b' || ch == 'i') && IS_DIGIT(Memc[expr+ip])) { + ip = ip + 1 + if (ctoi (Memc[expr], ip, opnum) == 0) + call error (4, "can't parse operand") + call sprintf (tag, SZ_TAG, "%c%d") + call pargc (ch) + call pargi (opnum) + + # Allocate the operand structure + if (IMOP(ex,opnum) == NULL) { + call ex_alloc_operand (IMOP(ex,opnum)) + call strcpy (tag, OP_TAG(IMOP(ex,opnum)), SZ_TAG) + EX_NIMOPS(ex) = EX_NIMOPS(ex) + 1 + } + + # For 2-D images allow either name interchangeably. Here + # we set the struct image band, we'll load the image de- + # scriptor later. + if (EX_IMDIM(ex) == 2) { + IO_BAND(IMOP(ex,opnum)) = 1 + EX_NIMAGES(ex) = EX_NIMOPS(ex) + } else if (EX_IMDIM(ex) == 3) { + if (ch == 'i') + call error (4, "Image operand illegal w/ 3-D lists") + IO_BAND(IMOP(ex,opnum)) = opnum + EX_NIMAGES(ex) = 1 + } + if (DEBUG) call zze_prop (IMOP(ex,opnum)) + } + ip = ip + 1 + } + } + + call sfree (sp) +end + + +# EX_PROCESS_IMAGE - Process the image pixels. + +procedure ex_process_image (ex) + +pointer ex #i task struct pointer + +int flags + +begin + flags = EX_OUTFLAGS(ex) + + # Create the (if any) requested colormap first. + if (bitset (flags, OF_MKCMAP)) + call ex_mkcmap (ex) + + # Process the images. + if (EX_FORMAT(ex) == FMT_BUILTIN) { + # Write the builtin format. + call exb_process_image (ex) + + } else { + if (bitset (flags, OF_BAND) || bitset (flags, BAND_STORAGE)) + call ex_no_interleave (ex) + else if (bitset (flags, OF_LINE) || bitset (flags, LINE_STORAGE)) + call ex_ln_interleave (ex) + else if (bitset (flags, PIXEL_STORAGE)) + call ex_px_interleave (ex) + else + call error (0, "Unknown processing param.") + } + + #if (EX_VERBOSE(ex) == YES) { + call eprintf (" Status: Done. \n") + call flush (STDERR) + #} +end + + +# EX_PRINFO - Print verbose information about the conversion. + +procedure ex_prinfo (ex, np) + +pointer ex #i task struct pointer +pointer np[ARB] #i ptr to image names + +pointer im +int i, j, flags + +begin + # Print information about the input images. + call eprintf (" Input images:\n") + do i = 1, EX_NIMAGES(ex) { + im = IO_IMPTR(IMOP(ex,i)) + call eprintf ("\t%s: %s %40t") + call pargstr (OP_TAG(IMOP(ex,i))) + call pargstr (Memc[np[i]]) + do j = 1, IM_NDIM(im) { + call eprintf ("%d ") + call pargi (IM_LEN(im,j)) + if (j < IM_NDIM(im)) + call eprintf ("x ") + } + call eprintf (" `%s'\n") + call pargstr (IM_TITLE(im)) + } + + # Print information about the output file. + flags = EX_OUTFLAGS(ex) + call eprintf (" Output file:\n") + call eprintf ("\tName: %30t%s\n") + call pargstr (BFNAME(ex)) + call eprintf ("\tFormat: %30t%s\n") + switch (EX_FORMAT(ex)) { + case FMT_RAW: call pargstr ("Raw") + case FMT_LIST: call pargstr ("List") + case FMT_BUILTIN: + call exb_pname (ex) + } + + if (EX_FORMAT(ex) == FMT_RAW) { + call eprintf ("\tHeader: %30t%s%s\n") + switch(EX_HEADER(ex)) { + case HDR_NONE: call pargstr ("None") ; call pargstr ("") + case HDR_SHORT: call pargstr ("Short") ; call pargstr ("") + case HDR_LONG: call pargstr ("Long") ; call pargstr ("") + case HDR_USER: call pargstr ("User: ") + call pargstr (HDRFILE(ex)) + } + } + + call eprintf ("\tByte Order: %30t%s\n") + if (EX_FORMAT(ex) == FMT_BUILTIN) + call exb_pendian (ex) + else if (EX_BSWAP(ex) == 0 && (BYTE_SWAP2==NO || BYTE_SWAP4==NO)) + call pargstr ("Most Significant Byte First") + else + call pargstr ("Least Significant Byte First") + + call eprintf ("\tResolution: %30t%d x %d\n") + call pargi (EX_OCOLS(ex)) + call pargi (EX_OROWS(ex)) + + call eprintf ("\tPixel Storage: %30t%s\n") + if (EX_FORMAT(ex) == FMT_BUILTIN) + call exb_pstorage (ex) + else if (bitset(flags, OF_BAND) || bitset(flags,BAND_STORAGE)) + call pargstr ("Band Interleaved") + else if (bitset(flags, OF_LINE) || bitset(flags,LINE_STORAGE)) + call pargstr ("Line Interleaved") + else if (bitset(flags,PIXEL_STORAGE)) + call pargstr ("Pixel Interleaved") + else + call pargstr ("Unknown") + + if (bitset(flags, OF_CMAP) || bitset(flags, OF_MKCMAP)) + call eprintf ("\tType: %30t8-bit Color Indexed\n") + else { + if (bitset(flags, OF_BAND) && EX_NEXPR(ex) > 1) + call eprintf ("\tType: %30tGrayscale\n") + else + call eprintf ("\tType: %30tRGB\n") + } + + if (bitset(flags, OF_CMAP) || bitset(flags, OF_MKCMAP)) { + call eprintf ("\tColor Table: %30t%d entries\n") + call pargi (EX_NCOLORS(ex)) + } else + call eprintf ("\tColor Table: %30tnone\n") + + if (DEBUG && EX_NEXPR(ex) != 0) { + call eprintf ("\tEvaluated Expressions:\n") + do i = 1, EX_NEXPR(ex) { + call eprintf ("\t %d) %s\n") + call pargi (i) + call pargstr (O_EXPR(ex,i)) + } + } +end + + +# EX_PTYPE -- For a given outtype parameter return the corresponding IRAF +# data type. + +define NTYPES 6 +define NBITPIX 4 + +int procedure ex_ptype (type, nbytes) + +int type #i pixel type +int nbytes #i number of bytes + +int i, pt, pb, ptype +int tindex[NTYPES], bindex[NBITPIX], ttbl[NTYPES*NBITPIX] + +data tindex /PT_BYTE, PT_UINT, PT_INT, PT_IEEE, PT_NATIVE, PT_SKIP/ +data bindex /1, 2, 4, 8/ + +data (ttbl(i), i= 1, 4) /TY_UBYTE, TY_USHORT, TY_INT, 0/ # B +data (ttbl(i), i= 5, 8) /TY_UBYTE, TY_USHORT, 0, 0/ # U +data (ttbl(i), i= 9,12) /TY_UBYTE, TY_SHORT, TY_INT, 0/ # I +data (ttbl(i), i=13,16) / 0, 0, TY_REAL, TY_DOUBLE/ # R +data (ttbl(i), i=17,20) / 0, 0, TY_REAL, TY_DOUBLE/ # N +data (ttbl(i), i=21,24) /TY_UBYTE, TY_USHORT, TY_REAL, TY_DOUBLE/ # X + +begin + if (type == 0 || nbytes == 0) # uninitialized values + return (0) + + pt = NTYPES + do i = 1, NTYPES { + if (tindex[i] == type) + pt = i + } + pb = NBITPIX + do i = 1, NBITPIX { + if (bindex[i] == nbytes) + pb = i + } + + ptype = ttbl[(pt-1)*NBITPIX+pb] + + if (DEBUG) { call eprintf("pt=%d pb=%d -> ptype=%d\n") + call pargi (pt) ; call pargi (pb) ; call pargi (ptype) } + + if (ptype == 0) + call error (0, "Invalid outtype specified.") + else + return (ptype) +end + + +# EX_MKFNAME - Create an output filename based on the requested format. + +procedure ex_mkfname (ex, fname) + +pointer ex #i task struct pointer +char fname[ARB] # generate the output filename + +pointer sp, suffix, test +int fnextn() +bool streq() +pointer exb_fmt_ext() + +begin + call smark (sp) + call salloc (test, SZ_FNAME, TY_CHAR) + + if (EX_FORMAT(ex) == FMT_BUILTIN) + suffix = exb_fmt_ext (ex) + else if (EX_FORMAT(ex) == FMT_RAW || EX_FORMAT(ex) == FMT_LIST) { + call strcpy (fname, BFNAME(ex), SZ_FNAME) + call sfree (sp) + return + } + + # If the current extension is not the same as the format extn add it. + if (fnextn (fname, Memc[test], SZ_FNAME) > 0) { + if (streq(Memc[test], Memc[suffix+1])) { + call strcpy (fname, BFNAME(ex), SZ_FNAME) + call sfree (sp) + return + } + } + + call sprintf (BFNAME(ex), SZ_FNAME, "%s%s") + call pargstr (fname) + call pargstr (Memc[suffix]) + + call mfree (suffix, TY_CHAR) + call sfree (sp) +end + + +# EX_ALLOC_OUTBANDS -- Allocate an outbands structure. + +procedure ex_alloc_outbands (op) + +pointer op #i outbands struct pointer + +begin + call calloc (op, LEN_OUTBANDS, TY_STRUCT) + call calloc (OB_EXPSTR(op), SZ_EXPSTR, TY_CHAR) +end + + +# EX_FREE_OUTBANDS -- Free an outbands structure. + +procedure ex_free_outbands (op) + +pointer op #i outbands struct pointer + +begin + call mfree (OB_EXPSTR(op), TY_CHAR) + call mfree (op, TY_STRUCT) +end + + +# EX_ALLOC_OPERAND -- Allocate an operand structure. + +procedure ex_alloc_operand (op) + +pointer op #i operand struct pointer + +begin + call calloc (op, LEN_OPERAND, TY_STRUCT) + call calloc (IO_TAG(op), SZ_FNAME, TY_CHAR) +end + + +# EX_FREE_OPERAND -- Free an operand structure. + +procedure ex_free_operand (op) + +pointer op #i operand struct pointer + +begin + call mfree (IO_TAG(op), TY_CHAR) + call mfree (op, TY_STRUCT) +end diff --git a/pkg/dataio/export/zzedbg.x b/pkg/dataio/export/zzedbg.x new file mode 100644 index 00000000..d1eba755 --- /dev/null +++ b/pkg/dataio/export/zzedbg.x @@ -0,0 +1,157 @@ +include +include "exbltins.h" +include "export.h" + +procedure zze_prstruct (whence, ex) + +char whence[SZ_FNAME] +pointer ex +int i + +begin + call eprintf ("%s:\n") ; call pargstr (whence) + call eprintf ("\tformat=%s %s outflags=%d interleave=%d bswap=%s\n") + switch (EX_FORMAT(ex)) { + case FMT_RAW: call pargstr ("FMT_RAW") + case FMT_LIST: call pargstr ("FMT_LIST") + case FMT_BUILTIN: call pargstr ("FMT_BUILTIN") + default: call pargstr ("ERR") + } + switch (EX_BLTIN(ex)) { + case EPS: call pargstr ("(eps)") + case GIF: call pargstr ("(gif)") + case PGM: call pargstr ("(pgm)") + case PPM: call pargstr ("(ppm)") + case RAS: call pargstr ("(ras)") + case RGB: call pargstr ("(rgb)") + case XWD: call pargstr ("(xwd)") + default: call pargstr ("") + } + call pargi (EX_OUTFLAGS(ex)) + call pargi (EX_INTERLEAVE(ex)) + switch(EX_BSWAP(ex)) { + case S_NONE: call pargstr ("S_NONE") + case S_ALL: call pargstr ("S_ALL") + case S_I2: call pargstr ("S_I2") + case S_I4: call pargstr ("S_I4") + default: call pargstr ("ERR") + } + call eprintf ("\touttype=%s header='%s' verbose=%d\n") + switch(EX_OUTTYPE(ex)) { + case TY_SHORT: call pargstr ("TY_SHORT") + case TY_INT: call pargstr ("TY_INT") + case TY_LONG: call pargstr ("TY_LONG") + case TY_REAL: call pargstr ("TY_REAL") + case TY_DOUBLE: call pargstr ("TY_DOUBLE") + default: call pargstr ("ERR") + } + switch(EX_HEADER(ex)) { + case HDR_NONE: call pargstr ("HDR_NONE") + case HDR_SHORT: call pargstr ("HDR_SHORT") + case HDR_LONG: call pargstr ("HDR_LONG") + case HDR_USER: call pargstr ("HDR_USER") + default: call pargstr ("ERR") + } + call pargi (EX_VERBOSE(ex)) + call eprintf ("\toutbands (%d):\n") ; call pargi (EX_NEXPR(ex)) + do i = 1, EX_NEXPR(ex) + call zze_proband (ex, i) + call eprintf ("\tocols=%d orows=%d:\n") + call pargi (EX_OCOLS(ex)) ; call pargi (EX_OROWS(ex)) + call eprintf ("\tnimages=%d nimops=%d ncols=%d nlines=%d:\n") + call pargi (EX_NIMAGES(ex)) + call pargi (EX_NIMOPS(ex)) + call pargi (EX_NCOLS(ex)) + call pargi (EX_NLINES(ex)) + do i = 1, MAX_OPERANDS { + if (IMOP(ex,i) != NULL) { + call eprintf ("\t ") ; call zze_prop (IMOP(ex,i)) + } + } + + call eprintf ("\tuser header = '%s' LUT file = '%s'\n") + call pargstr (HDRFILE(ex)) + call pargstr (LUTFILE(ex)) + call eprintf ("\tEPS dpi = %g scale = %g ncolors = %d\n") + call pargr (EX_PSDPI(ex)) + call pargr (EX_PSSCALE(ex)) + call pargi (EX_NCOLORS(ex)) + call eprintf ("\tbrightness = %g contrast = %g\n") + call pargr (EX_BRIGHTNESS(ex)) + call pargr (EX_CONTRAST(ex)) + call flush (STDERR) +end + + +procedure zze_proband (ex, band) + +pointer ex +int band + +begin + call eprintf ("\t ob=%d w=%d h=%d expr='%s'\n") + call pargi (OBANDS(ex,band)) + call pargi (OB_WIDTH(OBANDS(ex,band))) + call pargi (OB_HEIGHT(OBANDS(ex,band))) + call pargstr (O_EXPR(ex,band)) +end + + +procedure zze_prop (o) + +pointer o +char buf[8] +int type, ex_ptype() + +begin + if (o == NULL) + return + + call sprintf (buf, 8, " buirnx") + type = ex_ptype(IO_TYPE(o), IO_NBYTES(o)) + call eprintf("(o=%d im=%d band=%d tag=%s (t='%c' N=%d=>%s) Np=%d %d)\n") + call pargi (o) + call pargi (IO_IMPTR(o)) + call pargi (IO_BAND(o)) + if (IO_TAG(o) == NULL) call pargstr ("") + else call pargstr (OP_TAG(o)) + #call pargc (buf[IO_TYPE(o)+1]) + call pargc (IO_TYPE(o)) + call pargi (IO_NBYTES(o)) + switch (type) { + case TY_UBYTE: call pargstr ("TY_UBYTE") + case TY_USHORT: call pargstr ("TY_USHORT") + case TY_SHORT: call pargstr ("TY_SHORT") + case TY_INT: call pargstr ("TY_INT") + case TY_LONG: call pargstr ("TY_LONG") + case TY_REAL: call pargstr ("TY_REAL") + case TY_DOUBLE: call pargstr ("TY_DOUBLE") + default: call pargstr ("ERR") + } + call pargi (IO_NPIX(o)) + call pargi (IO_DATA(o)) + call flush (STDERR) +end + + +procedure zze_pevop (o) + +pointer o + +begin + call eprintf ("o=%d type=%d len=%d flags=%d ") + call pargi (o) + call pargi (O_TYPE(o)) + call pargi (O_LEN(o)) + call pargi (O_FLAGS(o)) + switch (O_TYPE(o)) { + case TY_CHAR: call eprintf ("val='%s'\n") ; call pargstr (O_VALC(o)) + case TY_SHORT: call eprintf ("val=%d\n") ; call pargs (O_VALS(o)) + case TY_INT: call eprintf ("val=%d\n") ; call pargi (O_VALI(o)) + case TY_LONG: call eprintf ("val=%d\n") ; call pargl (O_VALL(o)) + case TY_REAL: call eprintf ("val=%g\n") ; call pargr (O_VALR(o)) + case TY_DOUBLE: call eprintf ("val=%g\n") ; call pargd (O_VALD(o)) + default: call eprintf ("ptr=%d\n") ; call pargi (O_VALP(o)) + } + call flush (STDERR) +end -- cgit