Initial commit

1 files changed, 621 insertions, 0 deletions

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 <imhdr.h>
+include <mach.h>
+include <evvexpr.h>
+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