path: root/noao/digiphot/ptools/pexamine/ptplot.x

include <error.h>
include <mach.h>
include	<ctype.h>
include	<gset.h>
include	<fset.h>
include <tbset.h>
include "../../lib/ptkeysdef.h"
include "pexamine.h"

define	GHELPFILE	"ptools$pexamine/pexamine.key"
define	FRACTION	0.05

int procedure pt_plot (gd, px, apd, apkey, im, deleted, npix, max_npix,
	first_star, match_radius, use_display)

pointer	gd			# pointer to the graphics stream
pointer	px			# pointer to the pexamine structure
pointer	apd			# the input catalog descriptor
pointer	apkey			# pointer to the text file structure
pointer	im			# pointer to the input image
int	deleted[ARB]		# array of deleted values
int	npix			# number of points
int	max_npix		# maximum number of points
int	first_star		# first object read in
real	match_radius		# tolerance in pixels for cursor positioning
int	use_display		# use the image display

int	newdata, newxy, xyinvalid, newhist, hinvalid, plottype, newplot
int	firstplot, newcoo, cooinvalid, undelete, status, key, starno, curtype
pointer	sp, title, xlabel, ylabel, cmd, x, y, h, xpos, ypos
real	wx, wy, twx, twy

bool	fp_equalr()
int	pt_rxydata(), pt_rhdata(), pt_rcoodata(), pt_getphot(), pt_fstarg()
int	pt_gcur(), pt_gldata()

define	replot_		91

begin
	# Allocate working stack space.
	call smark (sp)
	call salloc (title, SZ_LINE, TY_CHAR)
	call salloc (xlabel, SZ_LINE, TY_CHAR)
	call salloc (ylabel, SZ_LINE, TY_CHAR)
	call salloc (cmd, SZ_LINE, TY_CHAR)

	# Initialize some parameters.
	twx = INDEFR
	twy = INDEFR
	newdata = NO
	newxy = YES
	newhist = YES
	newcoo = YES
	newplot = YES
	firstplot = YES
	curtype = 'g'
	plottype = PX_XYPLOT
	call amovki (PX_GOOD, deleted, npix)

	undelete = NO

replot_
	if (newdata == YES) {
	    if (apkey != NULL) {
		call pt_kyfree (apkey)
		call pt_kyinit (apkey)
	    }
	    npix = pt_getphot (px, apd, apkey, npix, first_star)
	}

	if (newxy == YES)
	    xyinvalid = pt_rxydata (px, x, y)
	if (newhist == YES)
	    hinvalid = pt_rhdata (px, h)
	if (newcoo == YES)
	    cooinvalid = pt_rcoodata (px, xpos, ypos)

	switch (plottype) {
	case PX_XYPLOT:
	    call pt_xyinfo (px, apd, apkey, Memc[title], SZ_LINE,
	        Memc[xlabel], Memc[ylabel], SZ_LINE)
	    if (xyinvalid == NO) {
		if (newplot == YES) {
	            call pt_xyplot (gd, Memr[x], Memr[y], deleted, npix,
		        Memc[title], Memc[xlabel], Memc[ylabel])
		}
	    } else {
	        call printf ("Cannot plot X: %s versus Y: %s\n")
		    call pargstr (Memc[xlabel])
		    call pargstr (Memc[ylabel])
	    }

	case PX_HISTPLOT:
	    call pt_hinfo (px, apd, apkey, Memc[title], SZ_LINE,
		Memc[xlabel], Memc[ylabel], SZ_LINE)
	    if (hinvalid == NO) {
		if (newplot == YES) {
	            call pt_hplot (gd, Memr[h], deleted, npix, Memc[title],
		        Memc[xlabel], Memc[ylabel])
		}
	    } else {
	        call printf ("Cannot plot histogram of %s\n")
		    call pargstr (Memc[xlabel])
	    }

	case PX_RADPLOT:
	    if (im != NULL) {
		if (newplot == YES)
		    call pt_rplot (gd, im, twx, twy)
	    } else
		call printf ("The input image is undefined\n")

	case PX_SURFPLOT:
	    if (im != NULL) {
		if (newplot == YES)
		    call pt_splot (gd, im, twx, twy)
	    } else
		call printf ("The input image is undefined\n")

	case PX_CNTRPLOT:
	    if (im != NULL) {
		if (newplot == YES)
		    call pt_cplot (gd, im, twx, twy)
	    } else
		call printf ("The input image is undefined\n")

	default:
	    call printf ("Invalid plot type\n")
	}

	if ((firstplot == YES || newdata == YES) && (xyinvalid == NO)) {
	    call printf ("nstars read: %d  first_star: %d  max_nstars: %d\n")
	        call pargi (npix)
	        call pargi (first_star)
	        call pargi (max_npix)
	}

	newdata = NO
	newxy = NO
	newcoo = NO
	newhist = NO
	newplot = NO
	firstplot = NO

	while (pt_gcur (curtype, wx, wy, key, Memc[cmd], SZ_LINE) != EOF) {

	    switch (key) {

	    # Quit and do not make changes.
	    case 'q':
		call printf ("Type 'q' to confirm quit without saving edits\n")
		if (pt_gcur (curtype, wx, wy, key, Memc[cmd], SZ_LINE) == EOF)
		    next
		if (key != 'q')
		    next
		status = PX_QUIT
		break

	    # Exit and do the changes.
	    case 'e':
		status = PX_EXIT
		break

	    # Print the help page.
	    case '?':
		call gpagefile (gd, GHELPFILE, "")

	    # Activate the graphics cursor.
	    case 'g':
		curtype = 'g'
		
	    # Activate the image cursor.
	    case 'i':
		if (use_display == YES)
		    curtype = 'i'
		else
		    call printf ("The image display is not available\n")

	    # Plot the current y column versus the current x column.
	    case 'x':
		if (plottype != PX_XYPLOT) {
		    newplot = YES
		    plottype = PX_XYPLOT
		}
		if (newplot == YES)
		    goto replot_

	    # Plot the current histogram.
	    case 'h':
		if (plottype != PX_HISTPLOT) {
		    newplot = YES
		    plottype = PX_HISTPLOT
		}
		if (newplot == YES)
		    goto replot_

	    # Print a matrix of points around the cursor.
	    case 'm':
		if (im == NULL) {
		    call printf ("The input image is undefined\n")
		    next
		} else if (cooinvalid == YES) {
		    call printf ("The x or y coordinate data is undefined\n")
		    next
		} else if (curtype == 'i') {
		    starno = pt_fstarg (gd, wx, wy, Memr[xpos], Memr[ypos],
		        npix, match_radius)
		} else if (xyinvalid == YES) {
		    call printf ("The x or y column data is undefined\n")
		    next
		} else if (plottype != PX_XYPLOT) {
		    call printf ("Points must be marked on an X-Y plot\n")
		    next
		} else {
		    starno = pt_fstarg (gd, wx, wy, Memr[x], Memr[y], npix,
		        INDEFR)
		}

		if (starno > 0)
		    call pt_print (gd, im, Memr[xpos+starno-1],
		        Memr[ypos+starno-1])

	    # Plot the the radial profile of the point nearest the graphics
	    # cursor.
	    case 'r', 's', 'c':

		if (im == NULL) {
		    call printf ("The input image is undefined\n")
		    next
		}
		if (cooinvalid == YES) {
		    call printf ("The x or y coordinate data is undefined\n")
		    next
		}

		if (curtype == 'i') {
		    starno = pt_fstarg (gd, wx, wy, Memr[xpos], Memr[ypos],
		        npix, match_radius)
		} else if (xyinvalid == YES) {
		    call printf ("The x or y column data is undefined\n")
		    next
		} else if (plottype != PX_XYPLOT) {
		    call printf ("Points must be marked on the X-Y plot\n")
		    next
		} else {
		    starno = pt_fstarg (gd, wx, wy, Memr[x], Memr[y], npix,
		        INDEFR)
		}

		if (starno > 0) {
		    switch (key) {
		    case 'r':
			if (plottype != PX_RADPLOT)
			    newplot = YES
		        plottype = PX_RADPLOT
		    case 'c':
			if (plottype != PX_CNTRPLOT)
			    newplot = YES
		        plottype = PX_CNTRPLOT
		    case 's':
			if (plottype != PX_SURFPLOT)
			    newplot = YES
		        plottype = PX_SURFPLOT
		    }
		    wx = Memr[xpos+starno-1]
		    wy = Memr[ypos+starno-1]
		    if (! fp_equalr (wx, twx) && ! fp_equalr (wy, twy)) {
		        newplot = YES
			twx = wx
			twy = wy
		    }
		} else
		    call printf ("Cannot find selected star in the catalog\n")

		if (newplot == YES)
		    goto replot_

	    # Replot the current plot.
	    case 'p':
		newplot = YES
		goto replot_

	    # Print out the names, types and units of all defined columns.
	    case 'l':
		call pt_colinfo (gd, apd, apkey)

	    # Print out the names, values and units of the stored columns
	    # for the object nearest the cursor.
	    case 'o':
		if (curtype == 'g') {
		    if (xyinvalid == YES)
			call printf ("The x or y column data is undefined\n")
		    else if (plottype != PX_XYPLOT)
			call printf ("Points must be marked on an x-y plot\n")
		    else  {
		        starno = pt_gldata (gd, px, apd, apkey, wx, wy,
			    Memr[x], Memr[y], npix, INDEFR)
			if (starno > 0)
			    call printf ("Star found\n")
			else
			    call printf ("Star not found\n")
		    }
		} else if (curtype == 'i') {
		    if (cooinvalid == NO) {
		        starno = pt_gldata (gd, px, apd, apkey, wx, wy,
			    Memr[xpos], Memr[ypos], npix, match_radius)
			if ((gd != NULL) && (starno > 0) && (xyinvalid == NO) &&
			    (plottype == PX_XYPLOT)) {
			    call gscur (gd, Memr[x+starno-1], Memr[y+starno-1])
			    call printf ("Star found\n")
			    curtype = 'g'
			} else
			    call printf ("Star not found\n")
		    } else
			call printf (
			    "The x or y coordinate data is undefined\n")
		}

	    # Undelete everything.
	    case 'z':
		call amovki (PX_GOOD, deleted, npix)
		newplot = YES
		goto replot_

	    # Delete points and replot.
	    case 'f':
		call pt_update (deleted, npix)
		newplot = YES
		goto replot_

	    # Mark a point for deletion.
	    case 'd':
		if (curtype == 'g') {
		    if ((xyinvalid == YES) || (plottype != PX_XYPLOT))
			call printf (
			    "Invalid plot type for deleting points\n")
		    else
		        call pt_delpt (gd, wx, wy, Memr[x], Memr[y], Memr[x],
			    Memr[y], deleted, npix, NO, INDEFR)
		} else if (curtype == 'i') {
		    if (cooinvalid == NO) {
		        if ((xyinvalid == NO) && (plottype == PX_XYPLOT))
		            call pt_delpt (gd, wx, wy, Memr[xpos], Memr[ypos],
			        Memr[x], Memr[y], deleted, npix, NO,
				match_radius)
			else
		            call pt_delpt (NULL, wx, wy, Memr[xpos], Memr[ypos],
			        Memr[x], Memr[y], deleted, npix, NO,
				match_radius)
		    } else
		        call printf (
			"The x or y coordinate data is undefined\n")
		}

	    # Undelete a point marked for deletion.
	    case 'u':
		if (curtype == 'g') {
		    if ((xyinvalid == YES) || (plottype != PX_XYPLOT))
			call printf (
			    "Invalid plot type for undeleting points\n")
		    else
		        call pt_delpt (gd, wx, wy, Memr[x], Memr[y], Memr[x],
			    Memr[y], deleted, npix, YES, INDEFR)
		} else if (curtype == 'i') {
		    if (cooinvalid == NO) {
		        if (xyinvalid == NO && plottype == PX_XYPLOT)
		            call pt_delpt (gd, wx, wy, Memr[xpos], Memr[ypos],
			         Memr[x], Memr[y], deleted, npix, YES,
				 match_radius)
			else
		            call pt_delpt (NULL, wx, wy, Memr[xpos], Memr[ypos],
			         Memr[x], Memr[y], deleted, npix, YES,
				 match_radius)
		    } else
		        call printf (
			    "The x and y coordinate data is undefined\n")
		}

	    # Toggle the delete/undelete function
	    case 't':
		if (undelete == NO) {
		    call printf ("Now undeleting points\n")
		    undelete = YES
		} else if (undelete == YES) {
		    call printf ("Now deleting points\n")
		    undelete = NO
		}

	    # Mark for deletion points with X < X (cursor).
	    case '(':
		if (curtype == 'g') {
		    if ((xyinvalid == NO) && (plottype == PX_XYPLOT)) {
		        call pt_dxltg (gd, wx, Memr[x], Memr[x], Memr[y],
			    deleted, npix, undelete)
		    } else if ((hinvalid == NO) && plottype == PX_HISTPLOT) {
		        call pt_dxltg (NULL, wx, Memr[h], Memr[h], Memr[h],
			    deleted, npix, undelete)
			newplot = YES
		    } else
			call printf (
			    "Invalid plot type for (un)deleting points\n")
		} else if (curtype == 'i') {
		    if (cooinvalid == YES) {
		        call printf (
			    "The x or y coordinate data is undefined\n")
		    } else if ((xyinvalid == NO) && (plottype == PX_XYPLOT)) {
		        call pt_dxltg (gd, wx, Memr[xpos], Memr[x], Memr[y],
			    deleted, npix, undelete)
		    } else {
		        call pt_dxltg (NULL, wx, Memr[xpos], Memr[x], Memr[y],
			    deleted, npix, undelete)
			if (plottype == PX_XYPLOT || plottype == PX_HISTPLOT)
			    newplot = YES
			else
			    call printf (
			    "Replot x-y or histogram to show (un)deletions\n")
		    }
		}
		if (newplot == YES)
		    goto replot_

	    # Mark for deletion points with X > X (cursor).
	    case ')':
		if (curtype == 'g') {
		    if ((xyinvalid == NO) && (plottype == PX_XYPLOT)) {
		        call pt_dxgtg (gd, wx, Memr[x],  Memr[x], Memr[y],
			    deleted, npix, undelete)
		    } else if ((hinvalid == NO) && (plottype == PX_HISTPLOT)) {
		        call pt_dxgtg (NULL, wx, Memr[h], Memr[h], Memr[h],
			    deleted, npix, undelete)
		        newplot = YES
		    } else
			call printf (
			    "Invalid plot type for (un)deleting points\n")
		} else if (curtype == 'i') {
		    if (cooinvalid == YES) {
		        call printf (
			"The x and y coordinate data is undefined\n")
		    } else if ((xyinvalid == NO) && (plottype == PX_XYPLOT)) {
		        call pt_dxgtg (gd, wx, Memr[xpos], Memr[x], Memr[y],
			    deleted, npix, undelete)
		    } else {
		        call pt_dxgtg (NULL, wx, Memr[xpos], Memr[x], Memr[y],
			    deleted, npix, undelete)
			if (plottype == PX_XYPLOT || plottype == PX_HISTPLOT)
			    newplot = YES
			else
			    call printf (
			"Replot x-y or histogram to show (un)deletions\n")
		    }
		}
		if (newplot == YES)
		    goto replot_

	    # Mark for deletion points with Y  > Y (cursor).
	    case '^':
		if (curtype == 'g') {
		    if ((xyinvalid == NO) && (plottype == PX_XYPLOT))
		        call pt_dygtg (gd, wy, Memr[y], Memr[x], Memr[y],
			    deleted, npix, undelete)
		    else
			call printf (
			    "Invalid plot type for (un)deleting points\n")
		} else if (curtype == 'i') {
		    if (cooinvalid == YES)
		        call printf (
			"The x and y coordinate data is undefined\n")
		    else if ((xyinvalid == NO) && (plottype == PX_XYPLOT))
		        call pt_dygtg (gd, wy, Memr[ypos], Memr[x], Memr[y],
			    deleted, npix, undelete)
		    else {
		        call pt_dygtg (NULL, wy, Memr[ypos], Memr[x], Memr[y],
			    deleted, npix, undelete)
			if (plottype == PX_XYPLOT || plottype == PX_HISTPLOT)
			    newplot = YES
			else
			    call printf (
			    "Replot x-y or histogram to show (un)deletions\n")
		    }
		}
		if (newplot == YES)
		    goto replot_

	    # Mark for deletion points with Y < Y (cursor).
	    case 'v':
		if (curtype == 'g') {
		    if ((xyinvalid == NO) && (plottype == PX_XYPLOT))
		        call pt_dyltg (gd, wy, Memr[y], Memr[x], Memr[y],
			    deleted, npix, undelete)
		    else
			call printf (
			    "Invalid plot type for (un)deleting points\n")
		} else if (curtype == 'i') {
		    if (cooinvalid == YES)
		        call printf (
			    "The x and y coordinate data is undefined\n")
		    else if ((xyinvalid == NO) && (plottype == PX_XYPLOT))
		        call pt_dyltg (gd, wy, Memr[ypos], Memr[x], Memr[y],
			    deleted, npix, undelete)
		    else {
		        call pt_dyltg (NULL, wy, Memr[ypos], Memr[x], Memr[y],
			    deleted, npix, undelete)
			if (plottype == PX_XYPLOT || plottype == PX_HISTPLOT)
			    newplot = YES
			else
			    call printf (
			"Replot x-y or histogram to show (un)deletions\n")
		    }
		}
		if (newplot == YES)
		    goto replot_

	    # Mark points for deletion inside a box.
	    case 'b':
	        if (curtype == 'g') {
		    if ((xyinvalid == NO) && (plottype == PX_XYPLOT)) {
		        twx = wx; twy = wy
		        call printf ("again:\n")
		        if (pt_gcur (curtype,  wx, wy, key, Memc[cmd],
			    SZ_LINE) == EOF)
		            next
		        call pt_dboxg (gd, Memr[x], Memr[y], Memr[x], Memr[y],
		            deleted, npix, twx, twy, wx, wy, undelete)
		    } else
		        call printf (
			    "Invalid plot type for (un)deleting points\n")
	        } else if (curtype == 'i') {
		    if (cooinvalid == YES)
		        call printf (
			    "The x or y coordinate data is undefined\n")
		    else {
		        twx = wx; twy = wy
		        call printf ("again:\n")
		        if (pt_gcur (curtype,  wx, wy, key, Memc[cmd],
			    SZ_LINE) == EOF)
		            next
			if ((xyinvalid == NO) && (plottype == PX_XYPLOT))
		            call pt_dboxg (gd, Memr[xpos], Memr[ypos], Memr[x],
			        Memr[y], deleted, npix, twx, twy, wx, wy,
				undelete)
			else {
		            call pt_dboxg (NULL, Memr[xpos], Memr[ypos],
			        Memr[x], Memr[y], deleted, npix, twx, twy,
				wx, wy, undelete)
			    if ((plottype == PX_XYPLOT) || 
			        (plottype == PX_HISTPLOT))
			        newplot = YES
			    else
			        call printf (
			    "Replot x-y or histogram to show (un)deletions\n")
			}
		    }
	        }

	    # Colon commands:
	    case ':':
		iferr (call pt_colon (px, gd, Memc[cmd], newdata, newxy,
		    newhist, newcoo, newplot, plottype, undelete))
		    call erract (EA_WARN)
		if (newplot == YES)
		    goto replot_

	    default:
		call printf ("Unknown or ambiguous keystroke command\007\n")
	    }
	}

	call sfree (sp)

	return (status)
end


# PT_PRINT -- Print a 10 by 10 box of pixel values around the star.
 
procedure pt_print (gd, im, x, y)
 
pointer	gd			# pointer to the graphics stream
pointer	im			# pointer to the input image
real	x, y			# center of box
 
int	i, j, x1, x2, y1, y2, nx
pointer	data
pointer	pt_gdata()
 
begin
	if (gd != NULL)
	    call gdeactivate (gd, 0)

	# Check that the image is defined.
	if (im == NULL) {
	    call printf ("The input image is undefined\n")
	    return
	}

	# Check that the center is defined.
	if (IS_INDEFR(x) || IS_INDEFR(y)) {
	    call printf ("The box center is undefined\n")
	    return
	}

	x1 = x - 5 + 0.5
	x2 = x + 5 + 0.5
	y1 = y - 5 + 0.5
	y2 = y + 5 + 0.5
	data = pt_gdata (im, x1, x2, y1, y2) 
	if (data == NULL) {
	    call printf ("The requested image section is off the image\n")
	    return
	}
	nx = x2 - x1 + 1

	call printf ("\n%4w") 
	do i = x1, x2 {
	    call printf (" %4d ")
		call pargi (i)
	}
	call printf ("\n")
 
	do j = y2, y1, -1 {
	    call printf ("%4d")
		call pargi (j)
	    do i = x1, x2 {
		call printf (" %5g")
		    call pargr (Memr[data+(j-y1)*nx+(i-x1)])
	    }
	    call printf ("\n")
	}
	call printf ("\n")

	if (gd != NULL)
	    call greactivate (gd, 0)
end


define	LEN_TYPESTR	9

# PT_COLINFO -- Print the name, type and units of all the columns in the
# input catalog.

procedure pt_colinfo (gd, apd, key)

pointer	gd		# pointer to the graphics stream
pointer	apd		# the file descriptor for the input catalog
int	key		# the key structure for text catalogs

int	len_colname, i, datatype, numelems
pointer	tty, sp, name, units, type, junk, colptr
int	tbpsta(), tbcigi(), pt_gnfn(), pt_kstati()
pointer	ttyodes(), tbcnum(), pt_ofnl()

begin
	if (gd != NULL)
	    call gdeactivate (gd, AW_CLEAR)
	else {
	    tty = ttyodes ("terminal")
	    call ttyclear (STDOUT, tty)
	}

	len_colname = max (SZ_COLNAME, KY_SZPAR)
	call printf ("\n%*.*s  %*.*s  %s\n\n")
	    call pargi (-len_colname)
	    call pargi (len_colname)
	    call pargstr ("COLUMN")
	    call pargi (-LEN_TYPESTR)
	    call pargi (LEN_TYPESTR)
	    call pargstr ("TYPE")
	    call pargstr ("UNITS")

	call smark (sp)
	call salloc (name, len_colname, TY_CHAR)
	call salloc (units, max (SZ_COLUNITS, KY_SZPAR), TY_CHAR)
	call salloc (type, LEN_TYPESTR, TY_CHAR)

	if (key == NULL) {

	    do i = 1, tbpsta (apd, TBL_NCOLS) {

		colptr = tbcnum (apd, i)
		call tbcigt (colptr, TBL_COL_NAME, Memc[name], SZ_COLNAME)
		call tbcigt (colptr, TBL_COL_UNITS, Memc[units], SZ_COLUNITS)
		datatype = tbcigi (colptr, TBL_COL_DATATYPE)
		switch (datatype) {
		case TY_BOOL:
		    call strcpy ("boolean", Memc[type], LEN_TYPESTR)
		case TY_SHORT, TY_INT, TY_LONG:
		    call strcpy ("integer", Memc[type], LEN_TYPESTR)
		case TY_REAL:
		    call strcpy ("real", Memc[type], LEN_TYPESTR)
		case TY_DOUBLE:
		    call strcpy ("double", Memc[type], LEN_TYPESTR)
		default:
		    if (datatype < 0)
		        call strcpy ("character", Memc[type], LEN_TYPESTR)
		    else
		        call strcpy ("undefined", Memc[type], LEN_TYPESTR)
		}

		call printf ("%*.*s  %*.*s  %s\n")
		    call pargi (-len_colname)
		    call pargi (len_colname)
		    call pargstr (Memc[name])
		    call pargi (-LEN_TYPESTR)
		    call pargi (LEN_TYPESTR)
		    call pargstr (Memc[type])
		    call pargstr (Memc[units])
	    }

	} else {

	    call salloc (junk, SZ_LINE, TY_CHAR)
	    colptr = pt_ofnl (key, "*")
	    while (pt_gnfn (colptr, Memc[name], Memc[junk], KY_SZPAR) != EOF) {
		#if (pt_kstati (key, Memc[name], KY_INDEX) <= KY_NOKEYS(key))
		if (pt_kstati (key, Memc[name], KY_INDEX) <= KY_NPKEYS(key))
		    next
		numelems = pt_kstati (key, Memc[name], KY_NUMELEMS)
		call pt_kstats (key, Memc[name], KY_UNITSTR, Memc[units],
		    KY_SZPAR)
		datatype = pt_kstati (key, Memc[name], KY_DATATYPE)
		switch (datatype) {
		case TY_BOOL:
		    call strcpy ("boolean", Memc[type], LEN_TYPESTR)
		case TY_CHAR:
		    call strcpy ("character", Memc[type], LEN_TYPESTR)
		case TY_INT:
		    call strcpy ("integer", Memc[type], LEN_TYPESTR)
		case TY_REAL:
		    call strcpy ("real", Memc[type], LEN_TYPESTR)
		default:
		    call strcpy ("undefined", Memc[type], LEN_TYPESTR)
		}

	        do i = 1, numelems {
		    if (numelems == 1)
			call strcpy (Memc[name], Memc[junk], KY_SZPAR)
		    else {
			call sprintf (Memc[junk], KY_SZPAR, "%s[%d]")
			    call pargstr (Memc[name])
			    call pargi (numelems)
		    }
	            call printf ("%*.*s  %*.*s  %s\n")
		        call pargi (-len_colname)
		        call pargi (len_colname)
		        call pargstr (Memc[junk])
		        call pargi (-LEN_TYPESTR)
		        call pargi (LEN_TYPESTR)
		        call pargstr (Memc[type])
		        call pargstr (Memc[units])
	        }

	    }
	    call pt_cfnl (colptr)

	}
	call printf ("\n")

	call sfree (sp)

	if (gd != NULL)
	    call greactivate (gd, AW_PAUSE)
	else
	    call ttycdes (tty)
end


# PT_GLDATA -- List the values of the loaded columns for this point.

int procedure pt_gldata (gd, px, apd, key, wx, wy, x, y, npix, matchrad)

pointer	gd		# pointer to the graphics stream
pointer	px		# pointer to the pexamine structure	
int	apd		# file descriptor for catalog
pointer	key		# pointer to the key structure for text files
real	wx		# the graphics cursor x coordinate
real	wy		# the graphics cursor y coordinate
real	x[ARB]		# the array of x plotted data
real	y[ARB]		# the array of y plotted data
int	npix		# the number of points
real	matchrad	# matching radius

int	row, ip, ncol
pointer	sp, name, units, colptr
int	pt_getnames(), pt_fstarg()

begin
	if (gd != NULL)
	    call gdeactivate (gd, 0)

	# Find the star.
	row = pt_fstarg (gd, wx, wy, x, y, npix, matchrad)

	# List the values of the loaded columns.
	if (row != 0) {

	    call smark (sp)
	    call salloc (name, PX_SZCOLNAME, TY_CHAR)
	    call salloc (units, max (KY_SZPAR, SZ_COLUNITS), TY_CHAR)

	    call printf ("\n%*.*s  %s  (%s)\n\n")
		call pargi (-PX_SZCOLNAME)
		call pargi (PX_SZCOLNAME)
		call pargstr ("COLUMN")
		call pargstr ("VALUE")
		call pargstr ("UNITS")

	    ip = 1
	    ncol = 0
	    while (pt_getnames (Memc[PX_COLNAMES(px)], ip, Memc[name], 
	        PX_SZCOLNAME) != EOF) {
		if (PX_COLPTRS(px) == NULL)
		    next
		if (key == NULL) {
		    call tbcfnd (apd, Memc[name], colptr, 1)
		    call tbcigt (colptr, TBL_COL_UNITS, Memc[units],
		        SZ_COLUNITS)
		} else
		    call pt_kstats (key, Memc[name], KY_UNITSTR, Memc[units],
		        KY_SZPAR)
		call printf ("%*.*s  %g  (%s)\n")
		    call pargi (-PX_SZCOLNAME)
		    call pargi (PX_SZCOLNAME)
		    call pargstr (Memc[name])
		    call pargr (Memr[Memi[PX_COLPTRS(px)+ncol]+row-1])
		    call pargstr (Memc[units])
		ncol = ncol + 1
	    }
	    call printf ("\n")

	    call sfree (sp)
	}

	if (gd != NULL)
	    call greactivate (gd, 0)

	return (row)
end


# PT_XYPLOT -- Plot the x and y points.

procedure pt_xyplot (gd, x, y, deleted, npix, title, xlabel, ylabel)

pointer	gd		# pointer to the graphics stream
real	x[ARB]		# array of x coordinates
real	y[ARB]		# array of y coordinates
int	deleted[ARB]	# deletions array
int	npix		# number of points
char	title[ARB]	# title of the plot
char	xlabel[ARB]	# x axis label
char	ylabel[ARB]	# y axis label

int	i, marker_type
pointer	sp, marker, longtitle
real	szmarker, x1, x2, y1, y2, dmin, dmax
bool	clgetb()
int	clgeti(), strlen()
real	clgetr()

begin
	# Check for undefined graphis stream.
	if (gd == NULL) {
	    call printf ("The graphics device is undefined\n")
	    return
	}

	# Allocate working space.
	call smark (sp)
	call salloc (marker, SZ_FNAME, TY_CHAR)
	call salloc (longtitle, 2 * SZ_LINE, TY_CHAR)

	# Clear the plotting strucuture.
	call gclear (gd)

	# Fetch the window and viewport parameters.
	x1 = clgetr ("xyplot.x1")
	x2 = clgetr ("xyplot.x2")
	y1 = clgetr ("xyplot.y1")
	y2 = clgetr ("xyplot.y2")
	if (IS_INDEFR(x1) || IS_INDEFR(x2)) {
	    call pt_alimr (x, npix, dmin, dmax)
	    if (IS_INDEFR(x1))
		x1 = dmin - FRACTION * (dmax - dmin)
	    if (IS_INDEFR(x2))
		x2 = dmax + FRACTION * (dmax - dmin)
	}
	if (IS_INDEFR(y1) || IS_INDEFR(y2)) {
	    call pt_alimr (y, npix, dmin, dmax)
	    if (IS_INDEFR(y1))
		y1 = dmin - FRACTION * (dmax - dmin)
	    if (IS_INDEFR(y2))
		y2 = dmax + FRACTION * (dmax - dmin)
	}

	# Set the scale of the axes.
	call gswind (gd, x1, x2, y1, y2)
	if (clgetb ("xyplot.logx"))
	    call gseti (gd, G_XTRAN, GW_LOG)
	else
	    call gseti (gd, G_XTRAN, GW_LINEAR)
	if (clgetb ("xyplot.logy"))
	    call gseti (gd, G_YTRAN, GW_LOG)
	else
	    call gseti (gd, G_YTRAN, GW_LINEAR)

	# Get the x and y axes parameters.
	if (! clgetb ("xyplot.fill"))
	    call gseti (gd, G_ASPECT, 1)
	if (clgetb ("xyplot.round"))
	    call gseti (gd, G_ROUND, YES)

	# Get the axis drawing parameters. 
	if (clgetb ("xyplot.box")) {

	    # Get number of major and minor tick marks.
	    call gseti (gd, G_XNMAJOR, clgeti ("xyplot.majrx"))
	    call gseti (gd, G_XNMINOR, clgeti ("xyplot.minrx"))
	    call gseti (gd, G_YNMAJOR, clgeti ("xyplot.majry"))
	    call gseti (gd, G_YNMINOR, clgeti ("xyplot.minry"))

	    # Label tick marks on axes.
	    if (clgetb ("xyplot.ticklabels"))
	        call gseti (gd, G_LABELTICKS, YES)
	    else
	        call gseti (gd, G_LABELTICKS, NO)

	    # Draw grid.
	    if (clgetb ("xyplot.grid"))
	        call gseti (gd, G_DRAWGRID, YES)
	    else
	        call gseti (gd, G_DRAWGRID, NO)

	    # Optionally draw a box around the plot.
	    if (clgetb ("xyplot.banner")) {
		call sysid (Memc[longtitle], 2 * SZ_LINE)
		call sprintf (Memc[longtitle+strlen(Memc[longtitle])],
		    2 * SZ_LINE, "\n%s") 
		    call pargstr (title)
	    } else
		call strcpy (title, Memc[longtitle], 2 * SZ_LINE)
	    call glabax (gd, Memc[longtitle], xlabel, ylabel)

	}

	# Get the marker type, the size of the marker and the linewidth.
	call clgstr ("xyplot.marker", Memc[marker], SZ_FNAME)
	call pt_marker (Memc[marker], SZ_FNAME, marker_type)
	if (marker_type != GM_POINT)
	    szmarker = clgetr ("xyplot.szmarker")
	else
	    szmarker  = 0.0
	call gsetr (gd, G_PLWIDTH, 2.0)

	# Draw the points in using the deletions array.
	do i = 1, npix {
	    if (deleted[i] == PX_DELETE)
		next
	    call gmark (gd, x[i], y[i], marker_type, szmarker, szmarker)
	}

	# Overplot crosses for those new points marked for deletion.
	call pt_mdelete (gd, x, y, deleted, npix)

	call gflush (gd)
	call sfree (sp)
end


# PT_HPLOT -- Compute and plot histogram.

procedure pt_hplot (gd, x, deleted, npix, title, xlabel, ylabel)

pointer	gd		# pointer to the graphics stream
real	x[ARB]		# array of points to be made into a histogram
int	deleted[ARB]	# deletions array
int	npix		# number of pixels
char	title[ARB]	# the title of the plot
char	xlabel[ARB]	# the x axis label
char	ylabel[ARB]	# the y axis label

int	i, j, nbins, nbins1
pointer	sp, hgm, xp, yp, longtitle
real	z1, z2, dz, x1, x2, y1, y2, dmin, dmax
bool	clgetb(), fp_equalr()
int	clgeti(), strlen()
real	clgetr()

begin
	# Check for undefined graphis stream.
	if (gd == NULL) {
	    call printf ("The graphics device is undefined\n")
	    return
	}

	# Get default histogram resolution and range.
	nbins = clgeti ("histplot.nbins")
	z1 = clgetr ("histplot.z1")
	z2 = clgetr ("histplot.z2")

	# Use data limits for INDEF limits.
	if (IS_INDEFR(z1) || IS_INDEFR(z2)) {
	    call pt_alimr (x, npix, dmin, dmax)
	    if (IS_INDEFR(z1))
		z1 = dmin
	    if (IS_INDEFR(z2))
		z2 = dmax
	}
	if (z1 > z2) {
	    dz = z1
	    z1 = z2
	    z2 = dz
	}

	# Test for constant valued image, which causes zero divide in ahgm.
	if (fp_equalr (z1, z2)) {
	    call printf ("Warning: Histogram has no data range.\n")
	    return
	}

	# The extra bin counts the pixels that equal z2 and shifts the
	# remaining bins to evenly cover the interval [z1,z2].
	# Note that real numbers could be handled better - perhaps
	# adjust z2 upward by ~ EPSILONR (in ahgm itself).

	nbins1 = nbins + 1

	# Initialize the histogram buffer and image line vector.
	call smark (sp)
	call salloc (hgm, nbins1, TY_INT)
	call aclri  (Memi[hgm], nbins1)

	# Accumulate the histogram. Add the ability to use the deletions
	# array in future.
	call pt_ahgmr (x, deleted, npix, Memi[hgm], nbins1, z1, z2)

	# "Correct" the topmost bin for pixels that equal z2.  Each
	# histogram bin really wants to be half open.

	if (clgetb ("histplot.top_closed"))
	    Memi[hgm+nbins-1] = Memi[hgm+nbins-1] + Memi[hgm+nbins1-1]

	# List or plot the histogram.  In list format, the bin value is the
	# z value of the left side (start) of the bin.

	dz = (z2 - z1) / real (nbins)

	# Plot the histogram in box mode.
	nbins1 = 2 * nbins + 2
	call salloc (xp, nbins1, TY_REAL)
	call salloc (yp, nbins1, TY_REAL)
	Memr[xp] = z1
	Memr[yp] = 0.0
	j = 1
	do i = 0, nbins - 1 {
	    Memr[xp+j] = Memr[xp+j-1]
	    Memr[yp+j] = Memi[hgm+i]
	    j = j + 1
	    Memr[xp+j] = Memr[xp+j-1] + dz
	    Memr[yp+j] = Memr[yp+j-1]
	    j = j + 1
	}
	Memr[xp+j] = Memr[xp+j-1]
	Memr[yp+j] = 0.0

	# Construct the title.
	call salloc (longtitle, 2 * SZ_LINE, TY_CHAR)
	if (clgetb ("histplot.banner")) {
	    call sysid (Memc[longtitle], 2 * SZ_LINE)
	    call sprintf (Memc[longtitle+strlen(Memc[longtitle])], 2 * SZ_LINE, 
	        "\nHistogram from z1=%g to z2=%g, nbins=%d\n%s")
	        call pargr (z1)
	        call pargr (z2)
	        call pargi (nbins)
	        call pargstr (title)
	} else {
	    call sprintf (Memc[longtitle], 2 * SZ_LINE, 
	        "Histogram from z1=%g to z2=%g, nbins=%d\n%s")
	        call pargr (z1)
	        call pargr (z2)
	        call pargi (nbins)
	        call pargstr (title)
	}

	# Clear the screen.
	call gclear (gd)

	# Compute the data window to be plotted.
	x1 = clgetr ("histplot.x1")
	x2 = clgetr ("histplot.x2")
	if (IS_INDEFR(x1) || IS_INDEFR(x2)) {
	    call alimr (Memr[xp], nbins1, dmin, dmax)
	    if (IS_INDEFR(x1))
		x1 = dmin
	    if (IS_INDEFR(x2))
		x2 = dmax
	}
	y1 = clgetr ("histplot.y1")
	y2 = clgetr ("histplot.y2")
	if (IS_INDEFR(y1) || IS_INDEFR(y2)) {
	    call alimr (Memr[yp], nbins1, dmin, dmax)
	    if (IS_INDEFR(y1))
		y1 = dmin
	    if (IS_INDEFR(y2))
		y2 = dmax
	}

	# Set the scale of the axes.
	call gswind (gd, x1, x2, y1, y2)
	call gseti (gd, G_XTRAN, GW_LINEAR)
	if (clgetb ("histplot.logy"))
	    call gseti (gd, G_YTRAN, GW_LOG)
	else
	    call gseti (gd, G_YTRAN, GW_LINEAR)

	if (! clgetb ("xyplot.fill"))
	    call gseti (gd, G_ASPECT, 1)
	if (clgetb ("xyplot.round"))
	    call gseti (gd, G_ROUND, YES)
	call gsetr (gd, G_PLWIDTH, 2.0)

	# Draw a box around the axes.
	if (clgetb ("histplot.box")) {

	    # Label tick marks on axes.
	    if (clgetb ("histplot.ticklabels"))
	        call gseti (gd, G_LABELTICKS, YES)
	    else
	        call gseti (gd, G_LABELTICKS, NO)

	    # Get number of major and minor tick marks.
	    call gseti (gd, G_XNMAJOR, clgeti ("histplot.majrx"))
	    call gseti (gd, G_XNMINOR, clgeti ("histplot.minrx"))
	    call gseti (gd, G_YNMAJOR, clgeti ("histplot.majry"))
	    call gseti (gd, G_YNMINOR, clgeti ("histplot.minry"))

	    # Draw the axes.
	    call glabax (gd, Memc[longtitle], xlabel, ylabel)

	}

	# Draw the historgram.
	call gseti (gd, G_PLTYPE, GL_SOLID)
	call gpline (gd, Memr[xp], Memr[yp], nbins1)
	call gflush (gd)

	call sfree (sp)
end


# PT_XYINFO -- Get the title and axes labels for the X-Y plot.

procedure pt_xyinfo (px, tp, key, title, max_sztitle, xlabel, ylabel,
	max_szlabel)

pointer	px			# pointer to the pexamine strcuture
pointer	tp			# input catalog file descriptor
pointer	key			# pointer to key structure for text files
char	title[ARB]		# title for the plot
int	max_sztitle		# maximum length of the title
char	xlabel[ARB]		# X axis label
char	ylabel[ARB]		# Y axis label
int	max_szlabel		# maximum size of the label

pointer	sp, label, units, cd

begin
	call smark (sp)
	call salloc (label, max_szlabel, TY_CHAR)
	call salloc (units, max_szlabel, TY_CHAR)

	# Get the title.

	# Get the x and y labels for the columns.
	if (key == NULL) {

	    call tbtnam (tp, title, max_sztitle)

	    call tbcfnd (tp, PX_XCOLNAME(px), cd, 1)
	    if (cd != NULL) {
		call strcpy (PX_XCOLNAME(px), Memc[label], max_szlabel)
		call tbcigt (cd, TBL_COL_UNITS, Memc[units], SZ_COLUNITS)
	    } else {
		call strcpy ("UNDEFINED", Memc[label], max_szlabel)
		Memc[units] = EOS
	    }
	    call sprintf (xlabel, max_szlabel, "%s in %s")
		call pargstr (Memc[label])
		call pargstr (Memc[units])

	    call tbcfnd (tp, PX_YCOLNAME(px), cd, 1)
	    if (cd != NULL) {
		call strcpy (PX_YCOLNAME(px), Memc[label], max_szlabel)
		call tbcigt (cd, TBL_COL_UNITS, Memc[units], SZ_COLUNITS)
	    } else {
		call strcpy ("UNDEFINED", Memc[label], max_szlabel)
		Memc[units] = EOS
	    }
	    call sprintf (ylabel, max_szlabel, "%s in %s")
		call pargstr (Memc[label])
		call pargstr (Memc[units])

	} else {

	    call fstats (tp, F_FILENAME, title, max_sztitle)

	    if (PX_XCOLNAME(px) == EOS) {
		call strcpy ("UNDEFINED", Memc[label], max_szlabel)
		Memc[units] = EOS
	    } else {
		call strcpy (PX_XCOLNAME(px), Memc[label], max_szlabel)
		call pt_kstats (key, PX_XCOLNAME(px), KY_UNITSTR, Memc[units],
		    max_szlabel)
	    }
	    call sprintf (xlabel, max_szlabel, "%s %s")
		call pargstr (Memc[label])
		call pargstr (Memc[units])

	    if (PX_YCOLNAME(px) == EOS) {
		call strcpy ("UNDEFINED", Memc[label], max_szlabel)
		Memc[units] = EOS
	    } else {
		call strcpy (PX_YCOLNAME(px), Memc[label], max_szlabel)
		call pt_kstats (key, PX_YCOLNAME(px), KY_UNITSTR, Memc[units],
		    max_szlabel)
	    }
	    call sprintf (ylabel, max_szlabel, "%s %s")
		call pargstr (Memc[label])
		call pargstr (Memc[units])

	}

	call sfree (sp)
end


# PT_HINFO -- Get the title and axes labels for the histogram plot.

procedure pt_hinfo (px, tp, key, title, max_sztitle, xlabel, ylabel,
	max_szlabel)

pointer	px			# pointer to the pexamine strcuture
pointer	tp			# input catalog file descriptor
pointer	key			# pointer to key structure for text files
char	title[ARB]		# title for the plot
int	max_sztitle		# maximum length of the title
char	xlabel[ARB]		# X axis label
char	ylabel[ARB]		# Y axis label
int	max_szlabel		# maximum size of the label

pointer	sp, label, units, cd

begin
	call smark (sp)
	call salloc (label, max_szlabel, TY_CHAR)
	call salloc (units, max_szlabel, TY_CHAR)

	# Get the title.

	# Get the x and y labels for the columns.
	if (key == NULL) {

	    call tbtnam (tp, title, max_sztitle)

	    call tbcfnd (tp, PX_HCOLNAME(px), cd, 1)
	    if (cd != NULL) {
		call strcpy (PX_HCOLNAME(px), Memc[label], max_szlabel)
		call tbcigt (cd, TBL_COL_UNITS, Memc[units], SZ_COLUNITS)
	    } else {
		call strcpy ("UNDEFINED", Memc[label], max_szlabel)
		Memc[units] = EOS
	    }
	    call sprintf (xlabel, max_szlabel, "%s in %s")
		call pargstr (Memc[label])
		call pargstr (Memc[units])

	    call sprintf (ylabel, max_szlabel, "N(%s)")
		call pargstr (Memc[label])

	} else {

	    call fstats (tp, F_FILENAME, title, max_sztitle)

	    if (PX_HCOLNAME(px) == EOS) {
		call strcpy ("UNDEFINED", Memc[label], max_szlabel)
		Memc[units] = EOS
	    } else {
		call strcpy (PX_HCOLNAME(px), Memc[label], max_szlabel)
		call pt_kstats (key, PX_HCOLNAME(px), KY_UNITSTR, Memc[units],
		    max_szlabel)
	    }
	    call sprintf (xlabel, max_szlabel, "%s %s")
		call pargstr (Memc[label])
		call pargstr (Memc[units])

	    call sprintf (ylabel, max_szlabel, "N(%s)")
		call pargstr (Memc[label])

	}

	call sfree (sp)
end

 
# PT_GCUR -- Get PEXAMINE cursor value.
# This is an interface between the standard cursor input and PEXAMINE.
# It reads the appropriate cursor, makes the appropriate default
# coordinate conversions when using graphics cursor input, and gets any
# further cursor reads needed.  Missing coordinates default to the last
# coordinates.
 
int procedure pt_gcur (curtype, x, y, key, strval, maxch)
 
int	curtype			# cursor type
real	x, y			# cursor position
int	key			# keystroke value of cursor event
char	strval[ARB]		# string value, if any
int	maxch			# max chars out
 
char	ch
int	nitems, wcs, ip
int	clgcur(), ctor(), cctoc()
errchk	clgcur
 
begin
	# Initialize.
	strval[1] = EOS

	# Get a cursor values from the desired cursor parameter.
	switch (curtype) {
	case 'i':
	    nitems = clgcur ("icommands", x, y, wcs, key, strval, maxch)
	case 'g':
	    nitems = clgcur ("gcommands", x, y, wcs, key, strval, maxch)
	}

	call flush (STDOUT)

	# Map numeric colon sequences (: x [y] key strval) to make them appear
	# as ordinary "x y key" type cursor reads.  This makes it possible for
	# the user to access any command using typed in rather than positional
	# cursor coordinates.  Special treatment is also given to the syntax
	# ":lN" and ":cN", provided for compatibility with IMPLOT for simple
	# line and column plots.

	if (key == ':') {
	    for (ip=1;  IS_WHITE(strval[ip]);  ip=ip+1)
		;
	    if (IS_DIGIT(strval[ip])) {
		if (ctor (strval, ip, x) <= 0)
		    ;
		if (ctor (strval, ip, y) <= 0)
		    y = x
		for (;  IS_WHITE(strval[ip]);  ip=ip+1)
		    ;
		if (cctoc (strval, ip, ch) > 0)
		    key = ch
		call strcpy (strval[ip], strval, maxch)

	    } 
	}
 
	return (nitems)
end


# PT_FSTARG -- Find the the point data point nearest the input position.

int procedure pt_fstarg (gd, wx, wy, x, y, npix, matchrad)

pointer	gd		# pointer to the graphics descriptor
real	wx		# X cursor position
real	wy		# Y cursor position
real	x[ARB]		# X array of plotted data
real	y[ARB]		# Y array of plotted data
int	npix		# number of pixels
real	matchrad	# the matching radius

int	i, row
real	r2min, r2, mr2, wx0, wy0, x0, y0

begin
	row = 0
	r2min = MAX_REAL
	if (IS_INDEFR(matchrad)) {
	    mr2 = MAX_REAL
	    if (gd != NULL)
		call gctran (gd, wx, wy, wx0, wy0, 1, 0)
	    else {
	        wx0 = wx
	        wy0 = wy
	    }
	} else {
	    mr2 = matchrad ** 2
	    wx0 = wx
	    wy0 = wy
	}

	# Search for the nearest point.
	do i = 1 , npix {
	    if (! IS_INDEFR(x[i]) && ! IS_INDEFR(y[i])) {
		if (IS_INDEFR(matchrad)) {
		    if (gd != NULL)
			call gctran (gd, x[i], y[i], x0, y0, 1, 0)
		    else {
		        x0 = x[i]
		        y0 = y[i]
		    }
		} else {
		    x0 = x[i]
		    y0 = y[i]
		}
	        r2 = (wx0 - x0) ** 2 + (wy0 - y0) ** 2
	    } else
		r2 = MAX_REAL
	    if (r2 >= r2min)
		next
	    r2min = r2
	    row = i
	}

	if ((row != 0) && (r2min <= mr2))
	    return (row)
	else
	    return (0)
end


# PT_MARKER -- Return an integer code for the marker type string.

procedure pt_marker (marker, maxch, imark)

char	marker[ARB]		# string defining the marker type
int	maxch			# maximum length of the marker name
int	imark			# the integer code for the marker

int	i
int	strdic()

begin
	i = strdic (marker, marker, maxch, PX_MARKERS)
	switch (i) {
	case 1:
	    imark = GM_POINT
	case 2:
	    imark = GM_BOX
	case 3:
	    imark = GM_PLUS
	case 4:
	    imark = GM_CROSS
	case 5:
	    imark = GM_CIRCLE
	case 6:
	    imark = GM_HLINE
	case 7:
	    imark = GM_VLINE
	case 8:
	    imark = GM_DIAMOND
	default:
	    imark = GM_BOX
	    call strcpy ("box", marker, maxch)
	}
end