# 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