Repatch (from linux) of OSX IRAF

1 files changed, 268 insertions, 0 deletions

diff --git a/pkg/proto/t_suntoiraf.x b/pkg/proto/t_suntoiraf.x
new file mode 100644
index 00000000..df0046df
--- /dev/null
+++ b/pkg/proto/t_suntoiraf.x
@@ -0,0 +1,268 @@
+# SUNTOIRAF -- Convert 8-bit Sun rasterfile to IRAF image.
+
+include <imhdr.h>
+include <error.h>
+include	<mach.h>
+
+# These comments and defines are from /usr/include/rasterfile.h.  We
+# should probably recode this using Sun interface routines, but not yet.
+
+# NOTES:
+# Each line of the image is rounded out to a multiple of 16 bits.
+# This corresponds to the rounding convention used by the memory pixrect
+# package (/usr/include/pixrect/memvar.h) of the SunWindows system.
+# The ras_encoding field (always set to 0 by Sun's supported software)
+# was renamed to ras_length in release 2.0.  As a result, rasterfiles
+# of type 0 generated by the old software claim to have 0 length; for
+# compatibility, code reading rasterfiles must be prepared to compute the
+# true length from the width, height, and depth fields.
+
+define	RAS_HEADER_LEN	8
+
+define	RAS_MAGIC_NUM	Memi[$1]	# rasterfile magic number
+define	RAS_WIDTH	Memi[$1+1]	# width (pixels) of image
+define	RAS_HEIGHT	Memi[$1+2]	# height (pixels) of image
+define	RAS_DEPTH	Memi[$1+3]	# depth (1, 8, or 24 bits) of pixel
+define	RAS_LENGTH	Memi[$1+4]	# length (bytes) of image
+define	RAS_TYPE	Memi[$1+5]	# type of file; see RT_* below
+define	RAS_MAPTYPE	Memi[$1+6]	# type of colormap; see RMT_* below
+define	RAS_MAPLENGTH	Memi[$1+7]	# length (bytes) of following map
+
+define	RAS_MAGIC	059A66A95X
+
+# 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	0xffff	# Reserved for testing
+
+# 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	# Sun registered, not supported, ras_maptype
+
+
+# NTSC weights for converting color pixels to grayscale
+define	RED_WT		.299
+define	GREEN_WT	.587
+define	BLUE_WT		.114
+
+define	BADVALUE	0	# row value for bad read
+
+
+procedure t_suntoiraf ()
+
+int	infile, fd, fdtmp, i, krow, nlut, nchars, junk, nread
+pointer	fname, image, buf, im, imtmp, pix, sp, sp1, hdr, lut
+bool	apply_lut, delete_file, verbose, listonly, yflip
+
+int	clpopni(), clgfil(), open(), strcmp(), fnroot(), fnextn(), read()
+pointer	immap(), impl2s()
+bool	clgetb()
+
+errchk	open, read, immap
+
+begin
+	call smark (sp)
+	call salloc (hdr, RAS_HEADER_LEN, TY_INT)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+	call salloc (image, SZ_LINE, TY_CHAR)
+
+	infile = clpopni ("names")	# Get the raster/image names.
+	apply_lut = clgetb ("apply_lut")# Apply the raster lut?
+	delete_file = clgetb ("delete")	# Delete rasterfile after making image?
+	verbose = clgetb ("verbose")	# Verbose output?
+	listonly = clgetb ("listonly")	# Only list the rasterfile headers?
+	yflip = clgetb ("yflip")	# Flip the image top to bottom?
+
+	fd = NULL
+	im = NULL
+
+	# Loop over all images
+	while (clgfil (infile, Memc[fname], SZ_FNAME) != EOF) {
+	    iferr {
+		fdtmp = open (Memc[fname], READ_ONLY, BINARY_FILE); fd = fdtmp
+		nread = read (fd, Memi[hdr], RAS_HEADER_LEN * SZ_INT)
+
+		if (RAS_MAGIC_NUM(hdr) != RAS_MAGIC)
+		    call error (0, "not a rasterfile")
+
+		# correct for an old peculiarity
+		if (RAS_TYPE(hdr) == RT_OLD && RAS_LENGTH(hdr) == 0)
+		    RAS_LENGTH(hdr) = RAS_WIDTH(hdr) * RAS_HEIGHT(hdr)
+
+		if (verbose || listonly) {
+		    call printf ("\n%s is %dx%d pixels by %d bits deep.\n")
+			call pargstr (Memc[fname])
+			call pargi (RAS_WIDTH(hdr))
+			call pargi (RAS_HEIGHT(hdr))
+			call pargi (RAS_DEPTH(hdr))
+
+		    call printf ("  LENGTH=%d, MAPLENGTH=%d, total=%d bytes.\n")
+			call pargi (RAS_LENGTH(hdr))
+			call pargi (RAS_MAPLENGTH(hdr))
+			call pargi (RAS_LENGTH(hdr) + RAS_MAPLENGTH(hdr) + 32)
+
+		    call printf ("  TYPE=%s, MAP_TYPE=%s.\n")
+
+			switch (RAS_TYPE(hdr)) {
+			case RT_OLD:
+			    call pargstr ("OLD")
+			case RT_STANDARD:
+			    call pargstr ("STANDARD")
+			case RT_BYTE_ENCODED:
+			    call pargstr ("BYTE_ENCODED")
+			case RT_FORMAT_RGB:
+			    call pargstr ("FORMAT_RGB")
+			case RT_FORMAT_TIFF:
+			    call pargstr ("FORMAT_TIFF")
+			case RT_FORMAT_IFF:
+			    call pargstr ("FORMAT_IFF")
+			default:
+			    call pargstr ("EXPERIMENTAL (or unknown)")
+			}
+
+			switch (RAS_MAPTYPE(hdr)) {
+			case RMT_NONE:
+			    call pargstr ("NONE")
+			case RMT_EQUAL_RGB:
+			    call pargstr ("EQUAL_RGB")
+			case RMT_RAW:
+			    call pargstr ("RAW")
+			default:
+			    call pargstr ("unknown")
+			}
+		}
+
+		if (! listonly) {
+		    if (RAS_DEPTH(hdr) != 8)
+			call error (0, "unsupported number of bits/pixel")
+
+		    if (RAS_TYPE(hdr) != RT_STANDARD && RAS_TYPE(hdr) != RT_OLD)
+			call error (0, "unsupported rasterfile type")
+
+		    if (RAS_MAPTYPE(hdr) != RMT_NONE &&
+			RAS_MAPTYPE(hdr) != RMT_EQUAL_RGB)
+			    call error (0, "unsupported rasterfile type")
+
+		    junk = fnextn (Memc[fname], Memc[buf], SZ_FNAME)
+
+		    # remove any `.ras', catch this in calling script
+		    if (strcmp (Memc[buf], "ras") != 0) {
+			call sprintf (Memc[image], SZ_LINE, "%s")
+			    call pargstr (Memc[fname])
+		    } else {
+			junk = fnroot (Memc[fname], Memc[buf], SZ_FNAME)
+			call sprintf (Memc[image], SZ_LINE, "%s")
+			    call pargstr (Memc[buf])
+		    }
+
+		    imtmp = immap (Memc[image], NEW_IMAGE, 0); im = imtmp
+
+		    IM_NDIM (im) = 2
+		    IM_LEN (im, 1) = RAS_WIDTH(hdr)
+		    IM_LEN (im, 2) = RAS_HEIGHT(hdr)
+		    IM_PIXTYPE (im) = TY_SHORT
+		}
+
+	    } then {
+		call erract (EA_WARN)
+		call eprintf ("Error while translating %s\n")
+		    call pargstr (Memc[fname])
+
+		if (im != NULL)
+		    call imunmap (im)
+		if (fd != NULL)
+		    call close (fd)
+		next
+	    }
+
+	    if (listonly) {
+		call close (fd)
+		next
+	    }
+
+	    if (verbose) {
+		call printf ("  %s --> %s   (%dx%d)\n")
+		    call pargstr (Memc[fname])
+		    call pargstr (Memc[image])
+		    call pargi (RAS_WIDTH(hdr))
+		    call pargi (RAS_HEIGHT(hdr))
+		call flush (STDOUT)
+	    }
+
+	    call smark (sp1)
+	    call salloc (pix, RAS_WIDTH(hdr), TY_SHORT)
+
+	    # Extract the Sun raster LUT
+	    if (RAS_MAPLENGTH(hdr) > 0) {
+		call salloc (lut, RAS_MAPLENGTH(hdr), TY_SHORT)
+
+		# assumes that MAPLENGTH is even (for SZB_CHAR=2)
+		nread = read (fd, Mems[lut], RAS_MAPLENGTH(hdr) / SZB_CHAR)
+		call achtbs (Mems[lut], Mems[lut], RAS_MAPLENGTH(hdr))
+
+		nlut = RAS_MAPLENGTH(hdr) / 3
+	    }
+
+	    # round up to account for 16 bit line blocking
+	    nchars = RAS_WIDTH(hdr) / SZB_CHAR + mod (RAS_WIDTH(hdr), SZB_CHAR)
+
+	    # Access pixels and write them out for each row
+	    do i = 1, RAS_HEIGHT(hdr) {
+	        ifnoerr (nread = read (fd, Mems[pix], nchars)) {
+		    call achtbs (Mems[pix], Mems[pix], RAS_WIDTH(hdr))
+		    if (apply_lut && RAS_MAPLENGTH(hdr) > 0)
+		        call si_lut (Mems[pix], RAS_WIDTH(hdr), Mems[lut], nlut)
+		} else {
+		    call amovks (BADVALUE, Mems[pix], RAS_WIDTH(hdr))
+		    call eprintf ("Problem reading row %d in %s.\n")
+			call pargi (i)
+			call pargstr (Memc[fname])
+		}
+
+		# rasterfile is upside down
+		if (yflip)
+		    krow = RAS_HEIGHT(hdr)-i+1
+		else
+		    krow = i
+
+		call amovs (Mems[pix], Mems[impl2s (im, krow)], RAS_WIDTH(hdr))
+	    }
+
+	    call imunmap (im)
+	    call close (fd)
+	    if (delete_file)
+		call delete (Memc[fname])
+	    call sfree (sp1)
+	}
+
+	call sfree (sp)
+end
+
+
+# SI_LUT -- apply the rasterfile lookup table to each row of the raster.
+
+procedure si_lut (data, ndata, lut, nlut)
+
+short	data[ARB]	#U data array
+int	ndata		#I size of the data array
+short	lut[nlut,3]	#I RGB lookup tables
+int	nlut		#I size of the lookup table
+
+int	idata, idx, i
+
+begin
+	do i = 1, ndata {
+	    idata = int (data[i]) + 1
+	    idx = min (max (idata, 1), nlut)
+
+	    data[i] = RED_WT * lut[idx,1] +
+		    GREEN_WT * lut[idx,2] +
+		     BLUE_WT * lut[idx,3]
+	}
+end