Repatch (from linux) of OSX IRAF

1 files changed, 162 insertions, 0 deletions

diff --git a/pkg/plot/crtpict/t_crtpict.x b/pkg/plot/crtpict/t_crtpict.x
new file mode 100644
index 00000000..bd1887f9
--- /dev/null
+++ b/pkg/plot/crtpict/t_crtpict.x
@@ -0,0 +1,162 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include <error.h>
+include	<gset.h>
+include	<fset.h>
+include	<imhdr.h>
+include	"crtpict.h"
+
+# T_CRTPICT -- Code for the CRTPICT replacement.  Input to the procedure
+# is an IRAF image; output is a file of GKI metacode instructions, 
+# essentially x,y,z for each pixel on the dicomed.  The image intensities
+# are scaled to the dynamic range of the output device.  The image
+# is also scaled spatially, either expanded or reduced.  
+
+procedure t_crtpict ()
+
+bool	redir
+pointer	sp, cl, gp, im, command, image, word, title, output, ofile, dev
+int	cmd, stat, fd
+
+pointer	immap(), gopen()
+bool	clgetb(), streq()
+int	strncmp(), clgeti(), btoi(), fstati(), open(), getline()
+int	imtopenp(), list, imtgetim()
+real	clgetr()
+
+begin
+	call smark (sp)
+	call salloc (cl, LEN_CLPAR, TY_STRUCT)
+	call salloc (command, SZ_LINE, TY_CHAR)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (word, SZ_LINE, TY_CHAR)
+	call salloc (title, SZ_LINE, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (ofile, SZ_FNAME, TY_CHAR)
+	call salloc (dev, SZ_FNAME, TY_CHAR)
+
+	# If the input has been redirected, input is read from the named
+	# command file.  If not, each image name in the input template is
+	# plotted.
+	
+	call fseti (STDOUT, F_FLUSHNL, YES)
+	if (fstati (STDIN, F_REDIR) == YES) {
+	    call printf ("Input has been redirected\n")
+	    redir = true
+	    cmd = open ("STDIN", READ_ONLY, TEXT_FILE)
+	} else 
+	    list = imtopenp ("input")
+
+	# The user can "trap" the output metacode and intercept the
+	# spooling process if an output file is specified.
+	call clgstr ("output", Memc[output], SZ_FNAME)
+	if (!streq (Memc[output], "")) {
+	    call strcpy (Memc[output], Memc[ofile], SZ_FNAME)
+	    fd = open (Memc[ofile], NEW_FILE, BINARY_FILE)
+	} else
+	    fd = STDGRAPH
+
+	# Now get the parameters necessary to calculate z1, z2.
+	call clgstr ("ztrans", ZTRANS(cl), SZ_LINE)
+	if (strncmp (ZTRANS(cl), "auto", 1) == 0) {
+	    CONTRAST(cl) = clgetr ("contrast")
+	    NSAMPLE_LINES(cl) = clgeti ("nsample_lines")
+	} else if (strncmp (ZTRANS(cl), "min_max", 1) == 0) {
+	    Z1(cl) = clgetr ("z1")
+	    Z2(cl) = clgetr ("z2")
+	    if (abs (Z1(cl) - Z2(cl)) < EPSILON) {
+		CONTRAST(cl) = clgetr ("contrast")
+		if (abs (CONTRAST(cl)) - 1.0 > EPSILON)
+		    NSAMPLE_LINES(cl) = clgeti ("nsample_lines")
+	    }
+	} else if (strncmp (ZTRANS(cl), "user", 1) == 0)
+	    call clgstr ("lutfile", UFILE(cl), SZ_FNAME)
+
+	# Get parameters necessary to compute the spatial transformation.
+	FILL(cl) = btoi (clgetb ("auto_fill"))
+	if (FILL(cl) == NO) {
+	    XMAG(cl) = clgetr ("xmag")
+	    YMAG(cl) = clgetr ("ymag")
+	    if (XMAG(cl) < 0)
+		XMAG(cl) = 1 / abs (XMAG(cl))
+	    if (YMAG(cl) < 0)
+		YMAG(cl) = 1 / abs (YMAG(cl))
+	}
+
+	if (FILL(cl) == YES || XMAG(cl) - 1.0 > EPSILON || 
+	    YMAG(cl) - 1.0 > EPSILON) {
+	    # Find out how spatial scaling is to be done
+	    REPLICATE(cl) = btoi (clgetb ("replicate"))
+	    if (REPLICATE(cl) == NO) {
+	        # Get block averaging factors
+	        X_BA(cl) = clgetr ("x_blk_average")
+	        Y_BA(cl) = clgetr ("y_blk_average")
+	    }
+	} else
+	    REPLICATE(cl) = YES
+
+	# And for the plotting fractions:
+	PERIM(cl) = btoi (clgetb ("perimeter"))
+	GRAPHICS_FRACTION(cl) = clgetr ("graphics_fraction")
+	IMAGE_FRACTION(cl) = clgetr ("image_fraction")
+	GREYSCALE_FRACTION(cl) = clgetr ("greyscale_fraction")
+
+	# Get the output device name and determine the graphics pointer.
+	call clgstr ("device", Memc[dev], SZ_FNAME)
+	gp = gopen (Memc[dev], NEW_FILE, fd)
+
+	# Loop over commands until EOF
+	repeat {
+	    if (redir) {
+		if (getline (STDIN, Memc[command]) == EOF)
+		    break
+		call sscan (Memc[command])
+		    call gargwrd (Memc[word], SZ_LINE)
+		if (!streq (Memc[word], "plot")) {
+		    # Pixel window has been stored as WCS 2
+		    call gseti (gp, G_WCS, 2)
+		    call gscan (gp, Memc[command])
+		    next
+		} else 
+		    call gargwrd (Memc[image], SZ_FNAME)
+	    } else {
+		stat = imtgetim (list, Memc[image], SZ_FNAME)
+		if (stat == EOF)
+		    break
+	    }
+
+	    # Open the input image; if an error occurs, go to next image in list
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    iferr (call crt_plot_image (gp, im, Memc[image], cl))
+		call erract (EA_WARN)
+
+	    # Add title to metacode file
+	    call sprintf (Memc[title], SZ_LINE, "CRTPICT: %s")
+		call pargstr (IM_TITLE(im))
+	    call gmftitle (gp, Memc[title])
+	    call imunmap (im)
+
+	    # Clear frame for next picture (unless plotting to terminal)
+	    if (strncmp (Memc[dev], "stdgraph", 4) == 0)
+	        call gflush (gp)
+	    else
+	        call gclear (gp)
+	}
+
+	# Clean up and close files
+	call gclose (gp)
+	call close (fd)
+
+	if (redir)
+	    call close (cmd)
+	else
+	    call imtclose (list)
+
+	call sfree (sp)
+	call flush (STDOUT)
+end