Repatch (from linux) of OSX IRAF

1 files changed, 501 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/gtedit/gtplot.x b/pkg/utilities/nttools/gtedit/gtplot.x
new file mode 100644
index 00000000..160ed978
--- /dev/null
+++ b/pkg/utilities/nttools/gtedit/gtplot.x
@@ -0,0 +1,501 @@
+include	<xwhen.h>
+include	<config.h>
+include	<mach.h>
+include	<error.h>
+include	<ctype.h>
+include	<fset.h>	# FIO
+include	<gset.h>	# GIO
+include <tbset.h>	# TBtables
+
+define	HELPFILE	"tables$pkg/ttools/gtedit/gtedit.key" # (BPS 05.31.94)
+define	GT_QUIT		0
+define	GT_EXIT		1
+
+procedure gteplot (device, input, tp, tpr, deleted, xcolumn, ycolumn, x, y,
+	  size, null, npix, table_name, status)
+
+char	device[SZ_FNAME]	# Graphics device
+char	input[SZ_FNAME]		# Input table name
+pointer	tp			# Table descriptor
+pointer	tpr			# Reject Table descriptor
+pointer	deleted			# Pointer for array of delete flags
+char	xcolumn[SZ_COLNAME]	# X column in table
+char	ycolumn[SZ_COLNAME]	# Y column in table
+pointer	x
+pointer	y
+pointer size			# Size of markers to plot
+pointer null			# 
+int	npix			# Number of points per curve
+char	table_name[SZ_FNAME]	# Table name
+int	status			# return status
+
+pointer	gd
+int	mode, npix_save
+char	col_save[SZ_COLNAME]
+char	xlabel[SZ_LINE], ylabel[SZ_LINE]
+char	plotitle[2*SZ_LINE]
+char	marker[SZ_FNAME]
+char	cmd[SZ_LINE]
+char	bad_column[SZ_COLNAME]
+bool	xautoscale, yautoscale, mark_del
+bool	drawbox, rdmarks
+bool 	silent, readonly, inplace, auto_replot
+int	xtran, ytran, ticklabels, marker_type, j, drawgrid
+int	wcs, key, ip
+int	undelete
+real	px, py
+real	wx1, wx2, wy1, wy2, szmarker, vx1, vx2, vy1, vy2
+real	wb, wt, wl, wr
+real	tol, xx, yy, sz
+real	x1, y1, x2, y2
+pointer	sp, system_id, errmsg
+
+string	bell 	"\007"
+define	replot_		91
+define	next_		92
+
+pointer	gopen()
+bool	clgetb()
+int	strncmp()
+int	clgeti(), gstati()
+int	clgcur()
+real	clgetr()
+pointer	tbtopn()
+errchk	clgetb, clgeti, clgstr, clgetr, glabax, gpmark
+errchk	gswind, gseti, gascale, grscale
+
+begin
+	call smark (sp)
+	call salloc (system_id, SZ_LINE, TY_CHAR)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+
+	mode = NEW_FILE
+	mark_del = false
+	undelete = NO
+
+	# Get the marker character to be drawn at
+	# each point.  The size of the character is given by szmarker. If
+	# zero and the input operadd is a list, marker sizes are taken
+	# individually from the third column of each list element.  If
+	# negative, all markers are of size |szmarker| in NDC.  If
+	# positive and the input operand is a list, the size of a marker
+	# is the third column of each list element times szmarker. 
+
+	szmarker  = 0.0
+	rdmarks   = false
+
+	# Draw markers only
+	call clgstr ("marker", marker, SZ_FNAME)
+	call init_mark2 (marker, marker_type)
+	if (marker_type != GM_POINT) {
+    	    szmarker = clgetr ("szmarker")
+	    rdmarks = (szmarker <= 0)
+	}
+
+	gd = gopen (device, mode, STDGRAPH)
+
+	call gsetr (gd, G_PLWIDTH, 2.0)
+
+	tol = 10.0 * EPSILONR
+	xautoscale = false
+	yautoscale = false
+
+	# Set window and viewport.  If user window has not been set, enable
+	# autoscaling.  If device viewport has not been set, let glabax
+	# handle the viewport internally.
+
+	call gclear (gd)
+	wx1 = clgetr ("wx1")
+	wx2 = clgetr ("wx2")
+	wy1 = clgetr ("wy1")
+	wy2 = clgetr ("wy2")
+
+	if (abs (wx2 - wx1) < tol) 
+	    xautoscale = true
+	if (abs (wy2 - wy1) < tol)
+	    yautoscale = true
+
+	vx1 = clgetr ("vx1")
+	vx2 = clgetr ("vx2")
+	vy1 = clgetr ("vy1")
+	vy2 = clgetr ("vy2")
+
+	if ((abs (vx2 - vx1) > tol) && (abs (vy2 - vy1) > tol))
+	    call gsview (gd, vx1, vx2, vy1, vy2)
+
+	if (!clgetb ("fill"))
+	    call gseti (gd, G_ASPECT, 1)
+
+	if (clgetb ("round"))
+	    call gseti (gd, G_ROUND, YES)
+
+replot_
+	# Draw box around plot?
+	drawbox = false
+	if (mode != APPEND)
+	    if (clgetb ("box"))
+		drawbox = true
+
+	if (drawbox) {
+	    # Get number of major and minor tick marks.
+	    call gseti (gd, G_XNMAJOR, clgeti ("majrx"))
+	    call gseti (gd, G_XNMINOR, clgeti ("minrx"))
+	    call gseti (gd, G_YNMAJOR, clgeti ("majry"))
+	    call gseti (gd, G_YNMINOR, clgeti ("minry"))
+
+	    # Fetch labels and plot title string. 
+
+	    call clgstr ("xlabel", xlabel, SZ_LINE)
+	    call clgstr ("ylabel", ylabel, SZ_LINE)
+
+	    call gt_hinfo (tp, xlabel, ylabel, xcolumn, ycolumn, SZ_LINE)
+
+	    # Label tick marks on axes?
+	    ticklabels = NO
+	    if (clgetb ("ticklabels"))
+		ticklabels = YES
+
+	    # Draw grid ?
+	    drawgrid = NO
+	    if (clgetb ("grid"))
+		drawgrid = YES
+
+	    call gseti (gd, G_DRAWGRID, drawgrid)
+	}
+
+	# Log scale?  Call gswind to set log scaling regardless of whether
+	# the user window is known; if the user window was not input,
+	# autoscaling will reset it later.
+
+	if (mode == APPEND) {
+	    xtran = gstati (gd, G_XTRAN)
+	    ytran = gstati (gd, G_YTRAN)
+	    call ggwind (gd, wx1, wx2, wy1, wy2)
+	} else {
+	    xtran = GW_LINEAR
+	    if (clgetb ("logx"))
+		xtran = GW_LOG
+	    ytran = GW_LINEAR
+	    if (clgetb ("logy"))
+		ytran = GW_LOG
+	    call gswind (gd, wx1, wx2, wy1, wy2)
+	    call gseti (gd, G_XTRAN, xtran)
+	    call gseti (gd, G_YTRAN, ytran)
+	}
+
+	# Autoscale if enabled.
+	if (xautoscale) {
+	    call gascale (gd, Memr[x], npix, 1)
+	} 
+	call ggwind (gd, wl, wr, wb, wt)
+
+	if (yautoscale) {
+	    # Overplot multiple curves on the same viewport
+            call gascale (gd, Memr[y], npix, 2)
+	}
+
+	if (drawbox) {
+	    # Draw box around plot
+	    call gseti (gd, G_LABELTICKS, ticklabels)
+	    # Overplot multiple curves on the same viewport
+	    call strcpy ("", plotitle, SZ_FNAME)
+	    call glabax (gd, plotitle, xlabel, ylabel)
+	}
+
+	# Markers at each point with no connection
+	if (rdmarks) {
+	    # Variable marker sizes
+ 	    if (szmarker < 0)
+	        # World coordinate marker sizes
+	        call amulkr (Memr[size], -szmarker, Memr[size],
+	            npix)
+		do j = 1, npix {	# For each point in the curve
+	    	    xx = Memr[x+j-1]
+		    yy = Memr[y+j-1]
+		    sz = Memr[size+j-1]
+		    call gmark (gd, xx, yy, marker_type, sz, sz)
+		}
+	} else {
+	   call gpmark (gd, Memr[x], Memr[y],npix, marker_type,
+	      szmarker, szmarker)
+	}
+
+	# We have plotted things so now is the time to let the user
+	# do his thing.
+
+	# Over plot crosses for those points which have been deleted
+	if (mark_del) {
+	    call gt_pdel (gd, Memr[x], Memr[y], Memr[deleted], npix)
+	    mark_del = false
+	}
+
+next_
+	while (clgcur ("commands", px, py, wcs, key, cmd, SZ_LINE) 
+		!= EOF) {
+
+	    switch (key) {
+
+	    # Quit and do not make changes
+	    case 'q':
+		status = GT_QUIT
+		break
+
+	    # Exit and do the changes
+	    case 'e':
+		status = GT_EXIT
+		break
+
+	    # Help page
+	    case '?':
+		if (gd == NULL)
+		    call pagefile (HELPFILE, "")
+		else 
+		    call gpagefile (gd, HELPFILE, "")
+
+	    # Simply replot (may have new columns)
+	    case 'p':
+		call gclear (gd)
+		mark_del = true
+		goto replot_
+
+	    # Mark the corners of a box and delete the points within
+	    case 'c':
+		x1 = px; y1 = py
+		call gmark (gd, x1, y1, GM_DIAMOND, 1., 1.)
+		call printf ("again:")
+		if (clgcur ("commands", px, py, wcs, key, cmd, SZ_LINE) == EOF)
+		    goto next_
+		
+		call gt_dbox (gd, npix, Memi[deleted], undelete, Memr[x], 
+			      Memr[y], x1, y1, px, py)
+
+	    # Mark the end points of a line segment and delete points on
+	    # one side of this segment (indicated by user) for points with
+	    # X values between x1 and x2
+	    case 's':
+		x1 = px; y1 = py
+		call gmark (gd, x1, y1, GM_DIAMOND, 1., 1.)
+		call printf ("again:")
+		if (clgcur ("commands", px, py, wcs, key, cmd, SZ_LINE) == EOF)
+		    goto next_
+		x2 = px
+		y2 = py
+		call gmark (gd, x1, y1, GM_DIAMOND, 1., 1.)
+		call gline (gd, x1, y1, x2, y2)
+		call printf ("Move cursor to one side of line and hit any key")
+		if (clgcur ("commands", px, py, wcs, key, cmd, SZ_LINE) == EOF)
+		    goto next_
+		
+		call gt_dseg (gd, npix, Memi[deleted], undelete, Memr[x], 
+			      Memr[y], x1, y1, x2, y2, px, py)
+
+	    # Update graph (delete points and replot)
+	    case 'f':
+		call gt_update (tp, tpr, Memr[x], Memr[y], Memi[deleted], npix)
+		call gclear (gd)
+		goto replot_
+
+	    # Print out the complete record for this point
+	    case 'a':
+		call gt_wrdata (gd, tp, px, py, Memr[x], Memr[y], npix)
+
+	    # Print out the column names
+	    case 'h':
+		call gt_wrhead (gd, tp)
+
+	    # Delete a point
+	    case 'd':
+		call gt_delpt (gd,px, py, Memr[x], Memr[y], npix, 
+			       Memi[deleted], undelete)
+
+	    # Undelete a point
+	    case 'u':
+		if (undelete == YES) {
+		    undelete = NO
+		    call printf ("Now deleting points\n")
+		} else {
+		    undelete = YES
+		    call printf ("Now undeleting points\n")
+		}
+
+	    # Revert to normal table editor
+	    case 'v':
+		silent = false
+		readonly = false
+		inplace = false
+
+		# First update the table
+		call gt_update (tp, tpr, Memr[x], Memr[y], Memi[deleted], npix)
+		call tbtclo (tp)
+		call gdeactivate (gd, 0)
+		call edit (table_name, " ", silent, readonly, inplace)
+
+		# Now read in the data (which may have been edited
+		npix_save = npix
+		tp = tbtopn (table_name, READ_WRITE, NULL)
+		call gt_rdxycol (tp, xcolumn, ycolumn, x, y, size, null, npix,
+		    bad_column)
+		if (npix < 0) {
+		    npix = npix_save
+		    call printf ("Cannot find column %s")
+			call pargstr (bad_column)
+		}
+		call greactivate (gd, AW_PAUSE)
+		call gclear (gd)
+		goto replot_
+
+	    # Undelete status
+	    case 'z':
+		if (undelete == NO) {
+		    call printf ("Currently deleting points\n")
+		} else {
+		    call printf ("Currently undeleting points\n")
+		}
+
+	    # Delete points > Y
+	    case 't':
+		call gt_dygt (gd, py, Memr[x], Memr[y], npix, 
+		Memi[deleted], undelete)
+
+	    # Delete points < Y
+	    case 'b':
+		call gt_dylt (gd, py, Memr[x], Memr[y], npix, 
+		Memi[deleted], undelete)
+
+	    # Delete points > X
+	    case 'r':
+		call gt_dxgt (gd, px, Memr[x], Memr[y], npix, 
+		Memi[deleted], undelete)
+
+	    # Delete points < X
+	    case 'l':
+		call gt_dxlt (gd, px, Memr[x], Memr[y], npix, 
+		Memi[deleted], undelete)
+
+	    # Colon commands:
+	    case ':':
+		# Command mode
+		for (ip=1; IS_WHITE (cmd[ip]); ip = ip + 1)
+		    ;
+
+	   	switch (cmd[ip]) {
+		case 'x':
+		    # Read in a new X column
+		    ip = ip + 1
+		    auto_replot = true
+		    if (strncmp (cmd[ip], "-", 1) == 0) {
+			ip = ip + 1
+			auto_replot = false
+		    }
+		    call amovc (xcolumn, col_save, SZ_COLNAME)
+		    call ctowrd (cmd, ip, xcolumn, SZ_FNAME)
+		    npix_save = npix
+		    call gt_rdxycol (tp, xcolumn, ycolumn, x, y, size, null,
+			npix, bad_column)
+		    if (npix < 0) {
+			npix = npix_save
+		        call gdeactivate (gd, 0)
+		        call printf ("Cannot find column %s")
+			    call pargstr (bad_column)
+		        call greactivate (gd, 0)
+		        call amovc (col_save, xcolumn, SZ_COLNAME)
+		    }
+		    if (auto_replot) {
+		        call gclear (gd)
+		        mark_del = true
+		        goto replot_
+		    }
+
+		case 'y':
+		    # Read in a new Y column
+		    ip = ip + 1
+		    auto_replot = true
+		    if (strncmp (cmd[ip], "-", 1) == 0) {
+			ip = ip + 1
+			auto_replot = false
+		    }
+		    call amovc (ycolumn, col_save, SZ_COLNAME)
+		    call ctowrd (cmd, ip, ycolumn, SZ_FNAME)
+		    npix_save = npix
+		    call gt_rdxycol (tp, xcolumn, ycolumn, x, y,
+			size, null, npix, bad_column)
+		    if (npix < 0) {
+			call gdeactivate (gd, 0)
+			npix = npix_save
+		        call printf ("Cannot find column %s")
+			    call pargstr (bad_column)
+		        call greactivate (gd, 0)
+		        call amovc (col_save, ycolumn, SZ_COLNAME)
+		    }
+		    if (auto_replot) {
+		        call gclear (gd)
+		        mark_del = true
+		        goto replot_
+		    }
+
+		default:
+		    call printf (bell)
+
+		}
+
+	    default:
+		call printf (bell)
+
+	    }
+	}
+	call sfree (sp)
+	call gclose (gd)
+end
+
+# TGR_ONINT2 -- Interrupt handler for the task graph.  Branches back to ZSVJMP
+# in the main routine to permit shutdown without an error message.
+
+procedure tgr_onint2 (vex, next_handler)
+
+int	vex			# Virtual exception
+int	next_handler		# not used
+
+int	tgrjmp[LEN_JUMPBUF]
+common	/tgrcom/ tgrjmp
+
+begin
+	call xer_reset()
+	call zdojmp (tgrjmp, vex)
+end
+
+
+# INIT_MARK2 -- Returns integers code for marker type string.
+
+procedure init_mark2 (marker, imark)
+
+char	marker[SZ_FNAME]	# Marker type as a string
+int	imark			# Integer code for marker - returned
+
+bool	streq()
+
+begin
+	if (streq (marker, "point"))
+	    imark = GM_POINT
+	else if (streq (marker,   "box"))
+	    imark = GM_BOX
+	else if (streq (marker,  "plus"))
+	    imark = GM_PLUS
+	else if (streq (marker, "cross"))
+	    imark = GM_CROSS
+	else if (streq (marker, "circle"))
+	    imark = GM_CIRCLE
+	else if (streq (marker, "hebar"))
+	    imark = GM_HEBAR
+	else if (streq (marker, "vebar"))
+	    imark = GM_VEBAR
+	else if (streq (marker, "hline"))
+	    imark = GM_HLINE
+	else if (streq (marker, "vline"))
+	    imark = GM_VLINE
+	else if (streq (marker, "diamond"))
+	    imark = GM_DIAMOND
+	else {
+	    call eprintf ("Unrecognized marker type, using 'box'\n")
+	    imark = GM_BOX
+	}
+end