Initial commit

10 files changed, 4191 insertions, 0 deletions

diff --git a/vendor/x11iraf/ximtool/clients/wcspix/README b/vendor/x11iraf/ximtool/clients/wcspix/README
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/README
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/class.com b/vendor/x11iraf/ximtool/clients/wcspix/class.com
new file mode 100644
index 00000000..c6116c11
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/class.com
@@ -0,0 +1,6 @@
+# Class common.  
+int     cl_nclass                          	# number of defined functions
+int     cl_table[LEN_CLASS,MAX_CLASSES]        	# class table
+char    cl_names[SZ_CLNAME,MAX_CLASSES]      	# class names
+common  /class_com/ cl_nclass, cl_table, cl_names
+
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/mkpkg b/vendor/x11iraf/ximtool/clients/wcspix/mkpkg
new file mode 100644
index 00000000..80b80f48
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/mkpkg
@@ -0,0 +1,16 @@
+# Make the WCSPIX ISM Client task.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+        t_wcspix.x      wcspix.h class.com <ctype.h> <time.h>
+        wcimage.x       wcspix.h <ctype.h> <imhdr.h> <imio.h> <math.h> \
+				<time.h> <mwset.h> <pkg/skywcs.h> wcspix.h
+        wcmef.x 	wcspix.h
+        wcmspec.x       wcspix.h
+        wcunknown.x     wcspix.h <ctype.h>
+	;
+
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/t_wcspix.x b/vendor/x11iraf/ximtool/clients/wcspix/t_wcspix.x
new file mode 100644
index 00000000..b0170f5b
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/t_wcspix.x
@@ -0,0 +1,792 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <time.h>
+include "wcspix.h"
+
+
+# T_WCSPIX --  Entry point for the WCSPIX Image Support Module for XImtool.
+# The WCSPIX task is responsible for converting image coordinates and getting
+# pixel values from images of various types.  Results are returned to the
+# GUI directly using ISM messaging.
+
+procedure t_wcspix ()
+
+pointer	wp
+real	x, y
+int	len, disconnect, ncmd, objid, regid
+char	socket[SZ_FNAME], cmd[SZ_FNAME], message[SZ_LINE], buf[SZ_DATE]
+char	ref[SZ_FNAME], template[SZ_LINE], param[SZ_FNAME]
+bool	debug
+
+long	clktime()
+pointer	wp_init()
+int	envgets(), envgeti(), strdic()
+
+# Standard declarations for the Ximtool WCSPIX client interface.
+int	ism_connect(), wp_read(), ism_intrhandler()
+errchk	wp_read, envgets, envgeti
+
+begin
+	# Initialize local storage.
+	call aclrc (buf, SZ_DATE)
+	call aclrc (cmd, SZ_FNAME)
+	call aclrc (ref, SZ_FNAME)
+	call aclrc (param, SZ_FNAME)
+	call aclrc (socket, SZ_FNAME)
+	call aclrc (message, SZ_LINE)
+	call aclrc (template, SZ_LINE)
+
+	# Get the connection socket name from the environment if defined
+	# or else use the default socket.
+        if (envgets ("ISMDEV", socket, SZ_FNAME) <= 0)
+	    call strcpy (WCSPIX_CONNECT, socket, SZ_FNAME)
+
+	# Open the socket connection on a negotiated socket.
+	if (ism_connect (socket, WCSPIX_NAME, WCSPIX_MODE) == ERR)
+	    return
+
+        # Install an interrupt exception handler so we can exit cleanly.
+	if (ism_intrhandler() == ERR)
+	    return
+
+
+	# Initialize the task data structures.
+	wp = wp_init ()
+
+	# Check for a runtime debug level.
+	iferr (WP_DBGLEVEL(wp) = envgeti ("WCSPIX_DEBUG"))
+	    WP_DBGLEVEL(wp) = 0
+
+	# Log the connection.
+	call wp_cnvdate (clktime(0), buf, SZ_DATE)
+	call sprintf (message, SZ_LINE, "info { %s: WCSPIX Connect}\n") 
+	    call pargstr (buf)
+        call ism_message ("ism_msg", message)
+
+	# Loop over the commands read on the connection and process.
+	disconnect = 1
+	debug = (WCSPIX_DBG || WP_DBGLEVEL(wp) > 0)
+	while (wp_read (wp, message, len) != EOF) {
+
+	    if (debug) {
+		message[len] = '\0'
+		call eprintf("message: '%s' len=%d\n")
+		    call pargstr (message);  call pargi (len)
+	    }
+            if (len <= 0) {
+		# Server has disconnected.
+		disconnect = 0
+		break
+	    }
+
+            # Scan the command string and get the first word.
+            call sscan (message)
+            call gargwrd (cmd, SZ_LINE)
+            ncmd = strdic (cmd, cmd, SZ_LINE, WCSPIX_CMDS)
+
+            switch (ncmd) {
+	    case QUIT:
+		# Server wants us to shut down.
+		disconnect = 0
+		break
+
+	    case INITIALIZE:
+		call wp_cnvdate (clktime(0), buf, SZ_DATE)
+		call sprintf (message, SZ_LINE,
+		    "info { %s: WCSPIX Initialize}\n") 
+		        call pargstr (buf)
+		call wp_initialize (wp)
+
+	    case CACHE:
+		# <ref> <objid> <regid>
+		call gargwrd (ref, SZ_FNAME)
+		call gargi (objid)
+		call gargi (regid)
+		if (debug) {
+		    call printf ("cache: objid=%d regid=%d ref='%s'\n")
+			call pargi(objid); call pargi(regid); call pargstr(ref)
+		}
+
+		# Log the event.
+		call wp_cnvdate (clktime(0), buf, SZ_DATE)
+		call sprintf (message, SZ_LINE,
+		    "info { %s: WCSPIX Cache    objid=%3d %s}\n") 
+		        call pargstr (buf)
+		        call pargi (objid)
+		        call pargstr (ref)
+        	call ism_message ("ism_msg", message)
+
+		call wp_cache (wp, objid, regid, ref)
+
+	    case UNCACHE:
+		# <id>
+		call gargi (objid)
+		if (debug) { call printf("uncache: id=%d\n");call pargi(objid) }
+
+		# Log the event.
+		call wp_cnvdate (clktime(0), buf, SZ_DATE)
+		call sprintf (message, SZ_LINE,
+		    "info { %s: WCSPIX Uncache objid=%3d}\n") 
+		        call pargstr (buf)
+		        call pargi (objid)
+        	call ism_message ("ism_msg", message)
+
+		call wp_uncache (wp, objid)
+
+	    case WCSTRAN:
+		# <id> <x> <y> [[<region> <x> <y>] ["NDC" <x> <y> ]]
+		call gargi (objid)
+		call gargr (x)  ; call gargr (y)
+		if (debug) {
+		    call printf ("wcstran: id=%d  (%g,%g)\n")
+		        call pargi(objid); call pargr (x); call pargr (y) 
+		}
+		call wp_wcstran (wp, objid, x, y)
+
+	    case WCSLIST:
+		# <id>
+		call gargi (objid)
+		if (debug) { call printf ("wcslist: id=%d\n");call pargi(objid)}
+		call wp_wcslist (wp, objid)
+
+	    case OBJINFO:
+		# <id> <template_list>
+		call gargi (objid)
+		call gargwrd (template, SZ_FNAME)
+		if (debug) {
+		    call printf ("objinfo: id=%d  temp='%s'\n")
+		        call pargi(objid); call pargstr (template); 
+		}
+		call wp_objinfo (wp, objid, template)
+
+	    case SET:
+		# <param> <value>
+		call gargwrd (param, SZ_FNAME)
+		call wp_setpar (wp, param)
+
+	    case GET:
+		# <param>
+
+	    case DEBUG:
+		debug = !(debug)
+
+	    default:
+		if (debug) { 
+	            call eprintf ("ISM default: len=%d msg='%s'\n")
+	                call pargi(len); call pargstr(message)
+		}
+	    }
+
+	    # Clear the buffer for the next read.
+	    call aclrc (message, SZ_LINE)
+	}
+
+	# Disconnect from the server and clean up.
+	call ism_disconnect (disconnect)
+	call wp_shutdown (wp)
+end
+
+
+# WP_INITIALIZE -- Initialize the WCSPIX, uncache any previously cached images.
+
+procedure wp_initialize (wp)
+
+pointer	wp					#i WCSPIX structure
+
+pointer	cp, wp_id2obj()
+int	i
+
+begin
+	for (i=0; i < SZ_CACHE; i=i+1) {
+	    cp = wp_id2obj (wp, i)
+	    if (cp != NULL && C_OBJID(cp) != NULL)
+		call wp_uncache (wp, C_OBJID(cp))
+	}
+end
+
+
+# WP_CACHE -- Associate and object reference with a unique object id.
+
+procedure wp_cache (wp, objid, regid, ref)
+
+pointer	wp					#i WCSPIX structure
+int	objid					#i object id
+int	regid					#i region id
+char	ref[ARB]				#i object ref
+
+pointer cp
+int	i, class
+char	alert[SZ_FNAME]
+
+int	wp_class()
+
+include	"class.com"
+
+begin
+	# Find an unused slot in the object cache.
+	for (i=0; i < SZ_CACHE; i=i+1) {
+	    cp = OBJCACHE(wp,i)
+	    if (C_NREF(cp) == 0)
+		break
+	}
+
+	# Get the object class.
+	class = wp_class (ref)
+	if (class == ERR) {
+	    # Send alert to the GUI.
+	    call sprintf (alert, SZ_FNAME, "wp_cache: Unable to cache\n%s")
+		call pargstr (ref)
+	    call ism_alert (alert, "", "")
+
+	    # Setup for linear system.
+	    return
+	}
+	C_CLASS(cp) = class
+
+	# Initialize the object.
+	if (class != NULL && CL_INIT(class) != NULL)
+	    call zcall2 (CL_INIT(class), cp, wp)
+
+	# Call the cache function.
+	if (class != NULL && CL_CACHE(class) != NULL)
+	    call zcall4 (CL_CACHE(class), cp, objid, regid, ref)
+end
+
+
+# WP_UNCACHE -- Remove an object from the WCSPIX cache.
+
+procedure wp_uncache (wp, id)
+
+pointer	wp					#i WCSPIX structure
+int	id					#i object id
+
+pointer cp, wp_id2obj()
+int	class
+
+include	"class.com"
+
+begin
+	cp = wp_id2obj (wp, id)
+	if (cp == NULL)
+	    return
+
+	# Call the uncache function.
+	class = C_CLASS(cp)
+	if (class != NULL && CL_UNCACHE(class) != NULL)
+	    call zcall2 (CL_UNCACHE(class), cp, id)
+
+	C_NREF(cp) = 0
+end
+
+
+# WP_WCSTRAN -- Translate image coords to WCS values.
+
+procedure wp_wcstran (wp, id, x, y)
+
+pointer	wp					#i WCSPIX structure
+int	id					#i object id
+real	x, y					#i image coords
+
+pointer	cp, wp_id2obj()
+int	class
+
+include	"class.com"
+
+begin
+	cp = wp_id2obj (wp, id)
+	if (cp == NULL)
+	    return
+
+	# Call the uncache function.
+	class = C_CLASS(cp)
+	if (class != NULL && CL_WCSTRAN(class) != NULL)
+	    call zcall4 (CL_WCSTRAN(class), cp, id, x, y)
+end
+
+
+# WP_WCSLIST -- List the available world coordinate systems for the given
+# object.
+
+procedure wp_wcslist (wp, id)
+
+pointer	wp					#i WCSPIX structure
+int	id					#i object id
+
+pointer	cp, wp_id2obj()
+int	class
+
+include	"class.com"
+
+begin
+	cp = wp_id2obj (wp, id)
+	if (cp == NULL)
+	    return
+
+	# Call the uncache function.
+	class = C_CLASS(cp)
+	if (class != NULL && CL_WCSLIST(class) != NULL)
+	    call zcall2 (CL_WCSLIST(class), cp, id)
+end
+
+
+# WP_OBJINFO -- Get and image header or keyword templates for the given
+# object.
+
+procedure wp_objinfo (wp, id, template)
+
+pointer	wp					#i WCSPIX structure
+int	id					#i object id
+char	template[ARB]				#i keyword template
+
+pointer cp, wp_id2obj()
+int	class
+
+include	"class.com"
+
+begin
+	cp = wp_id2obj (wp, id)
+	if (cp == NULL)
+	    return
+
+	# Call the uncache function.
+	class = C_CLASS(cp)
+	if (class != NULL && CL_OBJINFO(class) != NULL)
+	    call zcall3 (CL_OBJINFO(class), cp, id, template)
+end
+
+
+# WP_SETPAR -- Set the value of a WCSPIX ISM parameter.
+
+procedure wp_setpar (wp, param)
+
+pointer	wp					#i WCSPIX structure pointer
+char	param[SZ_FNAME]				#i WCSPIX param name
+
+char	arg[SZ_PARAM], buf[SZ_PARAM], msg[SZ_PARAM]
+int	line
+
+int	strdic()
+
+include	"class.com"
+
+begin
+	if (WCSPIX_DBG) { call printf ("set: %s = ");call pargstr(param) }
+
+	switch (strdic (param, param, SZ_PARAM, WCSPIX_PARAMS)) {
+	case PAR_PSIZE:
+	    call gargi (WP_PTABSZ(wp))
+	    if (WCSPIX_DBG) { call printf ("%d\n");call pargi(WP_PTABSZ(wp)) }
+
+	case PAR_BPM:
+	    call gargi (WP_BPM(wp))
+	    if (WCSPIX_DBG) { call printf ("%d\n");call pargi(WP_BPM(wp)) }
+
+	case PAR_WCS:
+	    call gargwrd (buf, SZ_FNAME)
+	    call gargi (line)
+
+	    call strcpy (buf, arg, SZ_PARAM)
+	    call strlwr (buf)
+	    switch (strdic (buf, buf, SZ_FNAME, WCSPIX_SYSTEMS)) {
+	    case SYS_DISPLAY:	SYSTEMS(wp,line) = SYS_DISPLAY
+	    case SYS_LOGICAL:	SYSTEMS(wp,line) = SYS_LOGICAL
+	    case SYS_PHYSICAL:	SYSTEMS(wp,line) = SYS_PHYSICAL
+	    case SYS_WORLD:	SYSTEMS(wp,line) = SYS_WORLD
+	    case SYS_NONE:	SYSTEMS(wp,line) = SYS_NONE
+	    case SYS_AMP:	SYSTEMS(wp,line) = SYS_AMP
+	    case SYS_CCD:	SYSTEMS(wp,line) = SYS_PHYSICAL
+	    case SYS_DETECTOR:	SYSTEMS(wp,line) = SYS_DETECTOR
+	    default: 		SYSTEMS(wp,line) = SYS_SKY
+	    }
+	    call strcpy (buf, WCSNAME(wp,line), LEN_WCSNAME)
+
+	    if (WCSPIX_DBG) { 
+		call printf("%s line=%d\n");call pargstr(buf);call pargi(line) }
+
+	    call sprintf (msg, SZ_FNAME, "wcstype %s %d")
+		call pargstr (arg)
+		call pargi (line)
+	    call wcspix_message (msg)
+
+	case PAR_FMT:
+	    call gargwrd (buf, SZ_FNAME)
+	    call gargi (line)
+
+	    call strcpy (buf, arg, SZ_PARAM)
+	    call strlwr (buf)
+	    switch (strdic (buf, buf, SZ_FNAME, WCSPIX_FMT)) {
+	    case FMT_DEFAULT:  	FORMATS(wp,line) = FMT_DEFAULT
+	    case FMT_HMS:  	FORMATS(wp,line) = FMT_HMS
+	    case FMT_DEG:  	FORMATS(wp,line) = FMT_DEG
+	    case FMT_RAD:  	FORMATS(wp,line) = FMT_RAD
+	    default:       	FORMATS(wp,line) = FMT_DEFAULT
+	    }
+
+	    if (WCSPIX_DBG) { 
+		call printf("%s line=%d\n");call pargstr(buf);call pargi(line) }
+
+	    call sprintf (msg, SZ_FNAME, "wcsfmt %s %d")
+		call pargstr (arg)
+		call pargi (line)
+	    call wcspix_message (msg)
+	}
+end
+
+
+# WP_GETPAR -- Get the value of a WCSPIX ISM parameter.
+
+procedure wp_getpar (wp, param)
+
+pointer	wp					#i WCSPIX structure pointer
+char	param[SZ_FNAME]				#i WCSPIX param name
+
+int	strdic()
+
+begin
+	if (WCSPIX_DBG) { call printf ("set: %s = ");call pargstr(param) }
+
+	switch (strdic (param, param, SZ_PARAM, WCSPIX_PARAMS)) {
+	case PAR_PSIZE:
+	case PAR_BPM:
+	case PAR_WCS:
+	case PAR_FMT:
+	}
+end
+
+
+################################################################################
+#
+# Private procedures.
+#
+################################################################################
+
+
+# WP_INIT -- Initialize the WCSPIX task and data structures.
+
+pointer procedure wp_init ()
+
+pointer	wp					#r WCSPIX structure pointer
+int	i
+
+begin
+	# Allocate the task structure.
+        iferr (call calloc (wp, SZ_WCSPIX, TY_STRUCT))
+            call error (0, "Error opening WCSPIX task structure.")
+
+	call calloc (WP_SYSTEMS(wp), MAX_WCSLINES, TY_INT)
+	call calloc (WP_FORMATS(wp), MAX_WCSLINES, TY_INT)
+	call calloc (WP_WCS(wp), (LEN_WCSNAME*MAX_WCSLINES), TY_CHAR)
+	for (i=1; i <= MAX_WCSLINES; i=i+1) {
+	    FORMATS(wp,i) = DEF_FMT
+	    SYSTEMS(wp,i) = DEF_SYSTEM
+	    call strcpy ("none", WCSNAME(wp,i), LEN_WCSNAME)
+	}
+
+	# Allocate the object cache.
+	call calloc (WP_CPTR(wp), SZ_CACHE, TY_STRUCT)
+	for (i=0; i < SZ_CACHE; i=i+1)
+	    call calloc (OBJCACHE(wp,i), SZ_CNODE, TY_STRUCT)
+
+	WP_PTABSZ(wp) = 0
+	WP_BPM(wp)    = DEF_BPM_FLAG
+
+	# Initialize the class modules.
+	call wp_class_init()
+
+	return (wp)
+end
+
+
+# WP_READ -- Read messages from the connection and process them optimally for
+# this ISM.  This means we segment the messages and handle only the last
+# few WCS requests so we can keep up with the server requests.  Presumably
+# there are more cursor events coming which are no longer valid so some are
+# thrown out.
+
+int procedure wp_read (wp, message, len)
+
+pointer	wp					#i WCSPIX structure pointer
+char	message[ARB]				#o message buffer
+int	len					#o length of message
+
+int	nleft
+
+int	ism_read(), strncmp()
+errchk	ism_read
+
+begin
+	while (true) {
+	    nleft = ism_read (message, len)
+
+	    # Return EOF if the server hung up on us.
+	    if (nleft == EOF)
+		return (EOF)
+	
+	    # In debug mode process all messages.
+	    if (WP_DBGLEVEL(wp) > 0)
+		break
+
+	    # Pass back all non-wcstran messages.
+	    if (strncmp ("wcstran", message, 7) != 0)
+		break
+
+	    # Only pass back the last wcstran messages received (eat the rest).
+	    if (strncmp ("wcstran", message, 7) == 0 && nleft <= 1)
+		break
+	}
+
+	return (len)
+end
+
+
+# WP_SHUTDOWN -- Shut down the WCSPIX, freeing all storage
+
+procedure wp_shutdown (wp)
+
+pointer	wp					#i WCSPIX structure
+int	i
+
+begin
+	# Free the structures.
+	call mfree (WP_WCS(wp), TY_CHAR)
+	call mfree (WP_FORMATS(wp), TY_INT)
+	call mfree (WP_SYSTEMS(wp), TY_INT)
+	for (i=0; i < SZ_CACHE; i=i+1)
+	    call mfree (OBJCACHE(wp,i), TY_STRUCT)
+
+	call mfree (WP_CPTR(wp), TY_STRUCT)
+	call mfree (wp, TY_STRUCT)
+end
+
+
+# WP_CLASS -- Determine the object class for the named image/file.
+
+int procedure wp_class (object)
+
+char	object[ARB]				#i object reference
+
+int	n, class
+pointer	im
+char	ch, buf[SZ_FNAME]
+
+int	strlen(), stridx()
+bool	streq()
+pointer	immap()
+
+errchk	immap
+
+begin
+        # The following kludge is necessary to protect against the case
+        # where dev$pix is used as a test image.  The 'object' pathname in
+        # this case is "node!/path/dev/pix" which lacks the extension
+        # and causes the task to fail to open because of a conflict with
+        # the pix.hhh in the same directory.  Most IRAF tasks work since
+        # the imio$iki code treats the string "dev$pix" as a special case.
+
+	call imgimage (object, buf, SZ_FNAME)
+        n = strlen (buf) - 7
+        if (streq (buf[n], "/dev/pix")) {
+            call strcpy ("dev$pix", buf, SZ_FNAME)
+	    ch = '['
+	    n = stridx (ch, object)
+	    if (n > 0)
+                call strcat (object[n], buf, SZ_FNAME)
+            call strcpy (buf, object, SZ_FNAME)
+	}
+
+
+	# See if we can map the image to get at least an image class.  If
+	# so then check for special subclasses like Mosaic files, spectra, etc.
+
+	class =  UNKNOWN_CLASS
+	ifnoerr (im = immap (object, READ_ONLY, 0)) {
+	    class = IMAGE_CLASS
+
+	    # Now check for subclasses.  (TBD)
+
+	    call imunmap (im)
+	}
+
+	return (class)
+end
+
+
+# WP_ID2OBJ -- Utility routine to convert and object id to the cache pointer.
+
+pointer procedure wp_id2obj (wp, id)
+
+pointer	wp					#i WCSPIX structure
+int	id					#i object id
+
+int	i
+pointer	cp
+
+begin
+	for (i=0; i < SZ_CACHE; i=i+1) {
+	    cp = OBJCACHE(wp,i)
+	    if (C_OBJID(cp) == id)
+		return (cp)
+	}
+	return (NULL)
+end
+
+
+# WP_CLASS_INIT -- Initialize the WCSPIX ISM class modules.
+
+procedure wp_class_init()
+
+extern  img_init(), img_cache(), img_uncache()
+extern  img_wcstran(), img_wcslist(), img_objinfo()
+
+extern  mef_init(), mef_cache(), mef_uncache()
+extern  mef_wcstran(), mef_wcslist(), mef_objinfo()
+
+extern  msp_init(), msp_cache(), msp_uncache()
+extern  msp_wcstran(), msp_wcslist(), msp_objinfo()
+
+extern  unk_init(), unk_cache(), unk_uncache()
+extern  unk_wcstran(), unk_wcslist(), unk_objinfo()
+
+include	"class.com"
+int     locpr()
+
+begin
+	cl_nclass = 0
+
+	# Load the class modules.
+	call wp_load_class ("unknown",
+	    locpr(unk_init), locpr(unk_cache), locpr(unk_uncache),
+	    locpr(unk_wcstran), locpr(unk_wcslist), locpr(unk_objinfo))
+	call wp_load_class ("image",
+	    locpr(img_init), locpr(img_cache), locpr(img_uncache),
+	    locpr(img_wcstran), locpr(img_wcslist), locpr(img_objinfo))
+	call wp_load_class ("mef",
+	    locpr(mef_init), locpr(mef_cache), locpr(mef_uncache),
+	    locpr(mef_wcstran), locpr(mef_wcslist), locpr(mef_objinfo))
+	call wp_load_class ("multispec",
+	    locpr(msp_init), locpr(msp_cache), locpr(msp_uncache),
+	    locpr(msp_wcstran), locpr(msp_wcslist), locpr(msp_objinfo))
+end
+
+
+# WP_LOAD_CLASS -- Load an object class module for the ISM task.
+
+procedure wp_load_class (name, init, cache, uncache, tran, list, info)
+
+char	name[ARB]			#I module name
+int	init				#I initialize procedure
+int	cache				#I cache the object procedure
+int	uncache				#I uncache the object procedure
+int	tran				#I translate WCS procedure
+int	list				#I list WCS proedure
+int	info				#I get header procedure
+
+errchk	syserrs
+include	"class.com"
+
+begin
+	# Get a new driver slot.
+	if (cl_nclass + 1 > MAX_CLASSES)
+	    return
+	cl_nclass = cl_nclass + 1
+
+	# Load the driver.
+	CL_INIT(cl_nclass) = init
+	CL_CACHE(cl_nclass) = cache
+	CL_UNCACHE(cl_nclass) = uncache
+	CL_WCSTRAN(cl_nclass) = tran
+	CL_WCSLIST(cl_nclass) = list
+	CL_OBJINFO(cl_nclass) = info
+	call strcpy (name, CL_NAME(cl_nclass), SZ_FNAME)
+end
+
+
+# WCSPIX_MESSAGE -- Deliver a message to the ISM callback, tagged with
+# our name so it can be passed off to the correct code.
+
+procedure wcspix_message (message)
+
+char    message[ARB]                            #I message to send
+
+pointer sp, msgbuf
+int     msglen, mlen, ip 
+
+int	strlen()
+
+begin
+        # Get the message length plus some extra for the braces and padding.
+        mlen = strlen (message)
+        msglen = mlen + 64
+
+        # Allocate and clear the message buffer.
+        call smark (sp)
+        call salloc (msgbuf, msglen, TY_CHAR)
+        call aclrc (Memc[msgbuf], msglen)
+
+	ip = 0
+	call amovc ("deliver wcspix { ", Memc[msgbuf], 17)  ; ip = ip + 17
+	call amovc (message, Memc[msgbuf+ip], mlen)	    ; ip = ip + mlen
+	call amovc (" }\0", Memc[msgbuf+ip], 2)		    ; ip = ip + 2
+
+	call ism_message ("ism_msg", Memc[msgbuf])
+
+	call sfree (sp)
+end
+
+
+define	SZ_WEEKDAY		3
+define	SZ_MONTH		3
+
+# WP_CNVDATE -- Convert a time in integer seconds since midnight on Jan 1, 1980
+# into a short string such as "5/15 18:24". 
+
+procedure wp_cnvdate (ltime, outstr, maxch)
+
+long	ltime			# seconds since 00:00:00 10-Jan-1980
+char	outstr[ARB]
+int	maxch
+
+int	tm[LEN_TMSTRUCT]
+
+begin
+	call brktime (ltime, tm)
+
+# 	call sprintf (outstr, maxch, "%2d/%2d %2d:%02d")
+# 	    call pargi (TM_MONTH(tm))
+# 	    call pargi (TM_MDAY(tm))
+# 	    call pargi (TM_HOUR(tm))
+# 	    call pargi (TM_MIN(tm))
+
+#	call sprintf (outstr, maxch, "%2d:%02d")
+#	    call pargi (TM_HOUR(tm))
+#	    call pargi (TM_MIN(tm))
+
+	call sprintf (outstr, maxch, "%2d:%02d:%02d")
+	    call pargi (TM_HOUR(tm))
+	    call pargi (TM_MIN(tm))
+	    call pargi (TM_SEC(tm))
+end
+
+
+
+#----------------
+# DEBUG ROUTINES.
+#----------------
+procedure dbg_printcache (wp, buf)
+pointer	wp
+char	buf[ARB]
+pointer	cp, wp_id2obj()
+int	i
+begin
+	call printf ("%s\n") ; call pargstr (buf)
+	for (i=0; i < SZ_CACHE; i=i+1) {
+	    cp = wp_id2obj (wp, i)
+	    if (C_DATA(cp) != NULL) {
+		call printf ("%3d:  id=%d  ref='%s'\n")
+		    call pargi(i)
+		    call pargi(C_OBJID(cp))
+		    call pargstr(C_REF(cp))
+	    }
+	}
+end
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x b/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x
new file mode 100644
index 00000000..4a27af46
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x
@@ -0,0 +1,1465 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math.h>
+include <imio.h>
+include <imhdr.h>
+include <time.h>
+include <ctype.h>
+include <mwset.h>
+include <pkg/skywcs.h>
+include "wcspix.h"
+
+
+# Image class data.
+define  LEN_IMGDATA	15
+define  IMG_WP          Memi[$1  ]              # wcspix back-pointer
+define  IMG_IM          Memi[$1+1]              # image pointer
+define  IMG_BPM         Memi[$1+2]              # bad pixel mask pointer
+define  IMG_MW          Memi[$1+3]              # image wcs pointer
+define  IMG_CO          Memi[$1+4]              # skywcs transform pointer
+define  IMG_CTW         Memi[$1+5]              # mwcs log->world transform ptr
+define  IMG_CTP         Memi[$1+6]              # mwcs log->phys transform ptr
+define  IMG_CTA         Memi[$1+7]              # mwcs log->amplifier transform
+define  IMG_CTD         Memi[$1+8]              # mwcs log->detector transform
+define  IMG_ROT         Memr[$1+9]              # rotation angle
+define  IMG_SCALE       Memr[$1+10]             # plate scale
+define  IMG_LINEAR      Memi[$1+11]             # linear coords
+
+
+define	IMG_DEBUG	FALSE
+
+
+# IMG_INIT --  Initialize the object structure.
+
+procedure img_init (cp, wp)
+
+pointer	cp					#i cache pointer
+pointer	wp					#i WCSPIX structure
+
+pointer	img					# data pointer
+
+begin
+	if (IMG_DEBUG) call printf ("img_init: \n")
+
+	# Allocate the image data structure if not previously allocated.
+	if (C_DATA(cp) == NULL) {
+	    iferr (call calloc (C_DATA(cp), LEN_IMGDATA, TY_STRUCT))
+	        return
+	}
+
+	img = C_DATA(cp)
+	IMG_WP(img)     = wp
+	IMG_IM(img)     = NULL
+	IMG_BPM(img)    = NULL
+	IMG_MW(img)     = NULL
+	IMG_CO(img)     = NULL
+	IMG_CTW(img)    = NULL
+	IMG_CTP(img)    = NULL
+	IMG_CTA(img)    = NULL
+	IMG_CTD(img)    = NULL
+	IMG_ROT(img)    = 0.0
+	IMG_SCALE(img)  = 0.0
+	IMG_LINEAR(img) = YES
+end
+
+
+# IMG_CACHE --  Cache an image in the object cache.
+
+procedure img_cache (cp, objid, regid, ref)
+
+pointer	cp					#i cache pointer
+int	objid					#i object id
+int	regid					#i region id
+char	ref[ARB]				#i object reference
+
+pointer	img, im, wp, co
+int     stat, i1, i2
+char	alert[SZ_LINE]
+
+pointer immap(), ds_pmmap(), mw_sctran()
+pointer	img_amp_wcs(), img_det_wcs()
+int     imaccf(), sk_decim()
+
+errchk  immap, ds_pmmap, mw_sctran, sk_decim, sk_setd
+
+begin
+	if (IMG_DEBUG) call printf ("img_cache: \n")
+
+        # Now map the image and WCS.
+	img = C_DATA(cp)
+	wp  = IMG_WP(img)
+
+        iferr (IMG_IM(img) = immap (ref, READ_ONLY, 0)) {
+	    # Send alert to the GUI.
+            call sprintf (alert, SZ_FNAME, "Unable to cache\n%s")
+                call pargstr (ref)
+            call ism_alert (alert, "", "")
+            return
+        }
+	im = IMG_IM(img)
+
+        IMG_CO(img)  = NULL
+        IMG_CTW(img) = NULL
+        IMG_CTP(img) = NULL
+        IMG_CTA(img) = NULL
+        IMG_CTD(img) = NULL
+	iferr {
+            stat = sk_decim (IMG_IM(img), "world", IMG_MW(img), IMG_CO(img))
+	    if (IMG_DEBUG) {
+		call eprintf ("img_cache - decim: stat=%d  mw=%d  co=%d \n")
+		    call pargi(stat);call pargi(IMG_MW(img))
+		    call pargi(IMG_CO(img));
+	    }
+            if (stat == ERR || IMG_MW(img) == NULL) {
+                IMG_LINEAR(img) = YES
+
+		co = IMG_CO(img)
+        	i1 = IM_VMAP(im,1)
+        	i2 = IM_VMAP(im,2)
+		call sk_setd (co, S_VXOFF,  double(IM_VOFF(im,i1)))
+		call sk_setd (co, S_VYOFF,  double(IM_VOFF(im,i2)))
+		call sk_setd (co, S_VXSTEP, double(IM_VSTEP(im,i1)))
+		call sk_setd (co, S_VYSTEP, double(IM_VSTEP(im,i2)))
+
+            	IMG_MW(img) = NULL
+            	IMG_LINEAR(img) = YES
+	    }
+
+	    if (IMG_MW(img) != NULL) {
+                IMG_CTW(img) = mw_sctran (IMG_MW(img), "logical", "world", 03B)
+                IMG_CTP(img) = mw_sctran (IMG_MW(img), "logical", "physical",
+		    03B)
+
+	        # Get the amplifier transformation values if present.
+	        if (imaccf(im,"ATM1_1") == YES &&
+	            imaccf(im,"ATM2_2") == YES &&
+	            imaccf(im,"ATV1") == YES &&
+	            imaccf(im,"ATV2") == YES)
+		        IMG_CTA(img) = img_amp_wcs (im, IMG_MW(img))
+
+	        if (imaccf(im,"DTM1_1") == YES &&
+	            imaccf(im,"DTM2_2") == YES &&
+	            imaccf(im,"DTV1") == YES &&
+	            imaccf(im,"DTV2") == YES)
+		        IMG_CTD(img) = img_det_wcs (im, IMG_MW(img))
+	    }
+
+	} then {
+	    # Send alert to the GUI.
+            call sprintf (alert, SZ_FNAME, "Unable to decode image WCS\n%s")
+                call pargstr (ref)
+            call ism_alert (alert, "", "")
+            IMG_LINEAR(img) = YES
+	}
+
+
+	# See if we can find a bad pixel mask.
+        IMG_BPM(img) = NULL
+ 	if (WP_BPM(wp) == YES) {
+             iferr (IMG_BPM(img) = ds_pmmap ("BPM", IMG_IM(img)))
+ 	        IMG_BPM(img) = NULL
+ 	}
+
+        C_OBJID(cp) = objid
+        C_REGID(cp) = regid
+        C_NREF(cp)  = C_NREF(cp) + 1
+        call strcpy (ref, C_REF(cp), 128)
+end
+
+
+# IMG_UNCACHE --  Uncache an image in the object cache.
+
+procedure img_uncache (cp, id)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+
+pointer	img
+
+begin
+	if (IMG_DEBUG) call printf ("img_uncache: \n")
+
+        C_OBJID(cp) = NULL
+        C_NREF(cp) = 0
+        call strcpy ("", C_REF(cp), SZ_FNAME)
+
+	img = C_DATA(cp)
+	if (IMG_MW(img) != NULL)
+            call mw_close (IMG_MW(img))
+        if (IMG_BPM(img) != NULL)
+            call imunmap (IMG_BPM(img))
+        if (IMG_IM(img) != NULL)
+            call imunmap (IMG_IM(img))
+
+        IMG_IM(img)     = NULL
+        IMG_BPM(img)    = NULL
+        IMG_MW(img)     = NULL
+        IMG_CTW(img)    = NULL
+        IMG_CTP(img)    = NULL
+        IMG_CTA(img)    = NULL
+        IMG_CTD(img)    = NULL
+        IMG_CO(img)     = NULL
+        IMG_ROT(img)    = 0.0
+        IMG_SCALE(img)  = 0.0
+        IMG_LINEAR(img) = NO
+
+	call mfree (C_DATA(cp), TY_STRUCT)
+        C_DATA(cp) = NULL
+end
+
+
+# IMG_WCSTRAN -- Translate object source (x,y) coordinates to the
+# desired output WCSs.  Message is returned as something like:
+#
+#        set value {
+#            { object <objid> }  { region <regionid> }
+#            { pixval <pixel_value> [<units>] }
+#            { bpm    <bpm_pixel_value> }
+#            { coord  <wcsname> <x> <y> [<xunits> <yunits>] }
+#            { coord  <wcsname> <x> <y> [<xunits> <yunits>] }
+#            		:
+#        }
+
+
+procedure img_wcstran (cp, id, x, y)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+real	x, y					#i source coords
+
+pointer img, im, wp, co
+double  dx, dy, wx, wy
+real	rx, ry, pixval
+int     i, bpm
+
+# Use static storage to avoid allocation overhead.
+char	buf[SZ_LINE]
+char	msg[SZ_LINE], wcs[LEN_WCSNAME], xc[LEN_WCSNAME], yc[LEN_WCSNAME]
+char	xunits[LEN_WCSNAME], yunits[LEN_WCSNAME]
+
+double	sk_statd()
+
+begin
+	if (IMG_DEBUG) call printf ("img_wcstran: \n")
+
+	img = C_DATA(cp)			# initialize
+	co  = IMG_CO(img)
+	wp  = IMG_WP(img)
+	im  = IMG_IM(img)
+
+	# Get the translation to the image section.
+	dx  = (double(x) - sk_statd(co,S_VXOFF)) / sk_statd(co,S_VXSTEP)
+	dy  = (double(y) - sk_statd(co,S_VYOFF)) / sk_statd(co,S_VYSTEP)
+	rx = dx
+	ry = dy
+
+	# Read the pixel data.
+	call img_get_data (cp, id, rx, ry, pixval, bpm)
+
+	# Begin formatting the message.
+	call aclrc (msg, SZ_LINE)
+	call sprintf (msg, SZ_LINE, "wcstran { object %d } { region %d } ")
+	    call pargi (C_OBJID(cp))
+	    call pargi (C_REGID(cp))
+
+	call sprintf (buf, SZ_LINE, "{ pixval %9.9g } { bpm %d }\n")
+	    call pargr (pixval)
+	    call pargi (bpm)
+	call strcat (buf, msg, SZ_LINE)
+
+	# Now loop over the requested systems and generate a coordinate
+	# for each.
+	for (i=1; i <= MAX_WCSLINES; i=i+1) {
+
+	    # Get the coordinate value.
+	    call img_get_coord (img, dx, dy, SYSTEMS(wp,i), WCSNAME(wp,i),
+		wx, wy)
+
+	    # Get the system name, labels, and formats strings for the WCS.
+	    call img_coord_labels (cp, i, wcs, xunits, yunits)
+
+	    # Format the values as requested.
+	    call img_coord_fmt (cp, i, wx, wy, xc, yc)
+
+	    # Format the coord buffer and append it to the message.
+	    call sprintf (buf, SZ_LINE,
+		"{coord {%9s} {%12s} {%12s} {%4s} {%4s}}\n")
+	            call pargstr (wcs)
+	            call pargstr (xc)
+	            call pargstr (yc)
+	            call pargstr (xunits)
+	            call pargstr (yunits)
+	    call strcat (buf, msg, SZ_LINE)
+	}
+
+	# Now send the completed message.
+	call wcspix_message (msg);
+end
+
+
+# IMG_WCSLIST -- List the WCSs available for the given image.
+
+procedure img_wcslist (cp, id)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+
+pointer img, im, mw
+char	msg[SZ_LINE]
+
+begin
+	if (IMG_DEBUG) call printf ("img_wcslist: \n")
+
+	img = C_DATA(cp)			# initialize
+	mw  = IMG_MW(img)
+	im  = IMG_IM(img)
+
+	call strcpy ("wcslist {None Display Logical World Physical line ",
+	    msg, SZ_LINE)
+
+	# See if we can do amplifier/detector coords by checking for ATM/ATV
+	# and DTM/DTV keywords.
+
+	if (IMG_CTA(img) != NULL)
+	    call strcat (" Amplifier ", msg, SZ_LINE)
+	if (IMG_CTD(img) != NULL)
+	    call strcat (" Detector ", msg, SZ_LINE)
+	if (IMG_CTA(img) != NULL || IMG_CTD(img) != NULL)
+	    call strcat (" CCD ", msg, SZ_LINE)
+
+	# If we have a MWCS pointer list the sky projections.
+	if (mw != NULL) {
+	    call strcat (" line ", msg, SZ_LINE)
+	    call strcat (SKYPROJ, msg, SZ_LINE)
+	}
+
+	# Close the message.
+	call strcat ("}", msg, SZ_LINE)
+	
+	call wcspix_message (msg)
+end
+
+
+# IMG_GET_DATA -- Get data from the image.
+
+procedure img_get_data (cp, id, x, y, pixval, bpm_pix)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+real	x, y					#i source coords
+real	pixval					#o central pixel value
+int	bpm_pix					#o bad pixel mask value
+
+pointer img, wp, im, bpm, pix, sp, msg, buf
+int     nl, nc, ix, iy, s2
+int     size, x1, x2, y1, y2
+
+long	clktime()
+pointer imgs2r(), imgs2i(), ds_pmmap()
+errchk	ds_pmmap
+
+begin
+
+	img  = C_DATA(cp)
+	wp   = IMG_WP(img)
+	im   = IMG_IM(img)
+	bpm  = IMG_BPM(img)
+	nc   = IM_LEN(im,1)
+	nl   = IM_LEN(im,2)
+#	size = WP_PTABSZ(wp)
+	size = min(min(nc,nl),WP_PTABSZ(wp))
+
+	if (IMG_DEBUG) {
+	    call printf ("img_get_data: \n")
+	    call eprintf ("\tx: %g  y: %g  nc: %d  nl: %d\n")
+	        call pargr(x); call pargr(y); call pargi(nc); call pargi(nl)
+	}
+
+	# Sanity check on the cursor image position.
+	if (x < 0.0 || y < 0.0 || x > (nc+0.5) || y > (nl+0.5))
+	    return
+
+	# Bounds checking.  Rather than deal with out of bounds pixels we'll
+	# adjust the center pixel so we get the same size raster up to each
+	# boundary.
+
+	ix = int (x + 0.5) 		;     iy = int (y + 0.5)
+	ix = min (ix, (nc-(size/2)-1))  ;     iy = min (iy, (nl-(size/2)-1))
+	ix = max (size/2+1, ix)		;     iy = max (size/2+1, iy)
+
+	# Compute the box offset given the center and size.
+	x1 = ix - size / 2 + 0.5
+	x2 = ix + size / 2 + 0.5
+	y1 = iy - size / 2 + 0.5
+	y2 = iy + size / 2 + 0.5
+
+	if (IMG_DEBUG) {
+	    call printf ("img_get_data: \n")
+	    call eprintf ("\tix: %d iy: %g  size: %d\n")
+	        call pargi(ix); call pargi(iy); call pargi(size)
+	    call eprintf ("\tx1: %d y1: %d  x2: %d  y2: %d\n")
+	        call pargi(x1); call pargi(y1);
+	        call pargi(x2); call pargi(y2);
+	}
+
+        x1 = max (1, x1)
+        x2 = min (nc, x2)
+        y1 = max (1, y1)
+        y2 = min (nl, y2)
+
+	if (IMG_DEBUG) {
+	    call eprintf ("\tx1: %d y1: %d  x2: %d  y2: %d\n")
+	        call pargi(x1); call pargi(y1);
+	        call pargi(x2); call pargi(y2);
+	}
+
+	# Get the image pixels
+	pix = imgs2r (im, int(x1), int(x2), int(y1), int(y2))
+
+	if (WP_BPM(wp) == YES) {
+	    if (bpm != NULL) {
+	        bpm_pix = Memi[imgs2i (bpm, ix, ix, iy, iy)]
+ 	    } else {
+	        # See if we can find a bad pixel mask.  The option is enabled
+		# but we haven't mappend the mask yet.
+
+                # Log the event.
+		call smark (sp)
+		call salloc (msg, SZ_LINE, TY_CHAR)
+		call salloc (buf, SZ_LINE, TY_CHAR)
+                call wp_cnvdate (clktime(0), Memc[buf], SZ_DATE)
+                call sprintf (Memc[msg], SZ_LINE,
+                    "info { %s: WCSPIX BPM map  objid=%3d %s}\n")
+                        call pargstr (Memc[buf])
+                        call pargi (C_OBJID(cp))
+                        call pargstr (C_REF(cp))
+                call ism_message ("ism_msg", Memc[msg])
+
+                iferr (IMG_BPM(img) = ds_pmmap ("BPM", im)) {
+ 	            IMG_BPM(img) = NULL
+		    bpm_pix = 0
+
+	    	    # Send alert to the GUI.
+            	    call sprintf (Memc[buf], SZ_FNAME,
+			"Unable to map BPM image for\n%s")
+                	    call pargstr (C_REF(cp))
+            	    call ism_alert (Memc[buf], "", "")
+		} else
+	            bpm_pix = Memi[imgs2i (IMG_BPM(img), ix, ix, iy, iy)]
+
+		call sfree (sp)
+ 	    }
+	} else
+	    bpm_pix = 0
+
+	# See if we're near an edge...
+	s2 = size / 2
+	if (int(x)<s2 || int(x)>(nl-s2-1) || int(y)<s2 || int(x)>(nc-s2-1)) { 
+	    # Compute the image pixel associated with the requested coords.
+	    ix = int (x + 0.5)
+	    iy = int (y + 0.5)
+	    pixval = Memr[imgs2r(im, ix, ix, iy, iy)]
+	} else {
+	    pixval = Memr[pix + ((size/2)*size) + (size/2)]
+	}
+
+	# Send the pixel table.
+	if (WP_PTABSZ(wp) > 1)
+	    call img_send_pixtab (Memr[pix], WP_PTABSZ(wp), x1, x2, y1, y2)
+
+	if (IMG_DEBUG) {
+	    call printf ("img_get_data: pixval=%g\n") ; call pargr (pixval)
+	}
+end
+
+
+# IMG_OBJINFO -- Get header information from the image.
+
+procedure img_objinfo (cp, id, template)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+char	template[ARB]				#i keyword template
+
+pointer	im, img
+
+define  WCS_TEMPLATE "WCSDIM,CTYPE*,CRPIX*,CRVAL*,CD*,CROTA2,LTV*,LTM*,WSV*,WAT*,RA*,DEC*,EQUINOX,EPOCH,MJD*,DATE-OBS"
+
+begin
+	if (IMG_DEBUG) call printf ("img_objinfo: \n")
+
+	# Send the full header (or keyword filtered header), only the WCS
+	# keywords, and a plain-text explanation of the WCS.
+
+	img = C_DATA(cp)
+	im  = IMG_IM(img)
+
+	call img_send_header  (im, "imghdr", template)
+	call img_send_header  (im, "wcshdr", WCS_TEMPLATE)
+	call img_send_wcsinfo (im, cp)
+	call img_send_compass (im, cp)
+end
+
+
+
+#==============================================================================
+
+# IMG_SEND_HEADER -- Send an image header to the named GUI object.  Keywords
+# are filtered according to a specified template
+
+procedure img_send_header (im, object, template)
+
+pointer	im					#i image descriptor
+char	object[ARB]				#i object for the message
+char	template[ARB]				#i keyword template
+
+pointer	sp, hdr, lbuf, line, field, keyw, dict
+pointer	ip, lp, list
+int	nlines, in, out, i, hdr_size
+bool	keyw_filter
+
+int     stropen(), getline(), stridx(), imgnfn(), strdic()
+pointer	imofnlu()
+bool	streq()
+errchk  stropen, getline, putci, putline, imgnfn, imofnlu, strdic
+
+define  USER_AREA       Memc[($1+IMU-1)*SZ_STRUCT + 1]
+define  SZ_KEYW		8
+
+begin
+        hdr_size = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1
+        hdr_size = hdr_size + SZ_LINE
+
+	call smark (sp)
+	call salloc (hdr, hdr_size, TY_CHAR)
+	call salloc (dict, hdr_size, TY_CHAR)
+	call salloc (field, SZ_LINE, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (line, SZ_LINE, TY_CHAR)
+	call salloc (keyw, SZ_KEYW, TY_CHAR)
+
+	in  = stropen (USER_AREA(im), hdr_size, READ_ONLY)
+	out = stropen (Memc[hdr], hdr_size, WRITE_ONLY)
+	call fprintf (out, "%s {")
+	    call pargstr (object)
+
+	# Build up a dictionary of header keywords based on the template.
+	keyw_filter = (!streq (template, "*"))
+	if (keyw_filter) {
+	    list = imofnlu (im, template)
+	    call strcpy ("|", Memc[dict], hdr_size)
+            while (imgnfn (list, Memc[field], SZ_FNAME) != EOF) {
+	        call strcat (Memc[field], Memc[dict], hdr_size)
+	        call strcat ("|", Memc[dict], hdr_size)
+	    }
+	    call imcfnl (list)
+	}
+
+
+        # Copy header records to the output, stripping any trailing
+        # whitespace and clipping at the right margin.  We also filter
+	# against the keyword dictionary found above.
+
+	nlines = 0
+        while (getline (in, Memc[lbuf]) != EOF) {
+
+	    call aclrc (Memc[line], SZ_LINE)
+
+	    # Escape any brackets passed to the Tcl.
+	    ip = lbuf
+	    lp = line	
+            while (Memc[ip] != EOS && Memc[ip] != '\n') {
+		if (stridx (Memc[ip], "[{") > 0) {
+		    Memc[lp] = '\\'
+		    lp = lp + 1
+		}
+		Memc[lp] = Memc[ip]
+	  	ip = ip + 1
+	  	lp = lp + 1
+	    }
+            Memc[lp] = '\n'
+            Memc[lp+1] = EOS
+            
+	    # See whether the line matches a keyword we want to output.
+	    if (keyw_filter) {
+		for (i=0; i < SZ_KEYW && !IS_WHITE(Memc[line+i]); i=i+1)
+		    Memc[keyw+i] = Memc[line+i]
+		Memc[keyw+i] = '\0'
+
+		# If not in the dictionary skip to the next line.
+	        if (strdic (Memc[keyw], Memc[keyw], SZ_KEYW, Memc[dict]) == 0)
+		    next
+	    }
+
+            call putci (out, ' ')
+            call putline (out, Memc[line])
+
+	    # Send the header in small chunks so we don't overflow the
+	    # message buffer.
+	    nlines = nlines + 1
+	    if (mod(nlines,10) == 0) {
+		call fprintf (out, "}")
+		call close (out)
+		call wcspix_message (Memc[hdr]);
+	        call aclrc (Memc[hdr], hdr_size)
+		out = stropen (Memc[hdr], hdr_size, WRITE_ONLY)
+		call fprintf (out, "%s {")
+	    	    call pargstr (object)
+	    }
+        }
+	call fprintf (out, "}")
+
+	call close (in)
+	call close (out)
+
+	# Send the final message.
+	call wcspix_message (Memc[hdr])
+
+	# Pad a few lines for the GUI
+	call sprintf (Memc[hdr], SZ_LINE, "%d { \n\n\n }")
+	    call pargstr (object)
+	call wcspix_message (Memc[hdr])
+
+	call sfree (sp)
+end
+
+
+# IMG_SEND_COMPASS -- Send information about the image WCS in a plain-english
+# string.
+
+procedure img_send_compass (im, cp)
+
+pointer	im					#i image descriptor
+pointer	cp					#i cache element pointer
+
+pointer	sp, buf, img, co, mw
+double	r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM]
+int	i, j
+long    axis[IM_MAXDIM], lv[IM_MAXDIM], pv1[IM_MAXDIM], pv2[IM_MAXDIM]
+
+real	north[2], east[2]
+
+int	mw_stati(), sk_stati()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call aclrc (Memc[buf], SZ_LINE)
+
+	# Get the data pointer.
+	img = C_DATA(cp)
+	co  = IMG_CO(img)
+
+	# Get world coords at the image corners.
+	if (IMG_CTW(img) != NULL) {
+
+	    # Get the CD matrix for the image.
+	    mw = IMG_MW(img)
+            call wcs_gfterm (mw, r, w, cd, mw_stati(mw, MW_NPHYSDIM))
+
+	    # Compute a Nort and East vector for the CD matrix.
+	    call img_cvectors (cd, 1.0, north, east)
+
+	} else {
+            # Determine the logical to physical mapping by evaluating two
+            # points and determining the axis reduction if any.  pv1 will be
+            # the offset and pv2-pv1 will be the scale.
+
+            lv[1] = 0; lv[2] = 0; call imaplv (im, lv, pv1, 2)
+            lv[1] = 1; lv[2] = 1; call imaplv (im, lv, pv2, 2)
+
+            i = 1
+            axis[1] = 1;  axis[2] = 2
+            do j = 1, IM_MAXDIM {
+                if (pv1[j] != pv2[j]) {
+                    axis[i] = j
+                    i = i + 1
+                }
+	    }
+	    north[1] = 0.0
+	    north[2] =  (pv2[axis[2]] - pv1[axis[2]])
+	    east[1]  = -(pv2[axis[1]] - pv1[axis[1]])
+	    east[2]  = 0.0
+	}
+	
+	call sprintf (Memc[buf], SZ_LINE, "compass %d %g %g %g %g %g %d %s\0")
+	    call pargi (C_OBJID(cp))
+	    call pargr (IMG_ROT(img))
+	    call pargr (north[1])
+	    call pargr (north[2])
+	    call pargr (east[1])
+	    call pargr (east[2])
+	    if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX))
+	        call pargi (1)			# transposed image
+	    else
+	        call pargi (0)
+	    if (IMG_MW(img) != NULL)
+		call pargstr ("E N")
+	    else
+		call pargstr ("X Y")
+
+	call wcspix_message (Memc[buf])
+
+	call sfree (sp)
+end
+
+
+# IMG_CVECTORS -- Get north and east vectors for the compass
+
+procedure img_cvectors (cd, length, north, east)
+
+double  cd[2,2]         		#i CD matrix
+real    length          		#i length of vectors
+real    north[2]        		#o vector pointing north
+real    east[2]         		#o vector pointing east
+
+double  d               		# determinant of CD matrix
+double  x, y            		# scratch for vector components
+double  l               		# length of a vector
+
+begin
+        d = cd[1,1] * cd[2,2] - cd[1,2] * cd[2,1]
+        if (d == 0.d0)
+            call error (1, "CD matrix is singular")
+
+        # North.
+        x = -cd[1,2] / d
+        y =  cd[1,1] / d
+
+        # Normalize by the length and copy to output.
+        l = sqrt (x**2 + y**2)
+        north[1] = x * length / l
+        north[2] = y * length / l
+
+        # East.
+        x =  cd[2,2] / d
+        y = -cd[2,1] / d
+        l = sqrt (x**2 + y**2)
+        east[1] = x * length / l
+        east[2] = y * length / l
+end
+
+
+# IMG_SEND_WCSINFO -- Send information about the image WCS in a plain-english
+# string.
+
+procedure img_send_wcsinfo (im, cp)
+
+pointer	im					#i image descriptor
+pointer	cp					#i cache element pointer
+
+pointer	sp, co, img, mw
+pointer	buf, proj, radecstr
+int	fd, radecsys, ctype, wtype, ndim
+double 	crpix1, crpix2, crval1, crval2, cval1, cval2
+double	xscale, yscale, xrot, yrot
+double	r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM], 
+
+int	idxstr(), sk_stati(), stropen(), mw_stati()
+double	sk_statd(), sl_epj(), sl_epb()
+bool	fp_equald()
+
+errchk	stropen
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (proj, SZ_FNAME, TY_CHAR)
+	call salloc (radecstr, SZ_FNAME, TY_CHAR)
+	
+	# Open a string on a file.
+	fd = stropen (Memc[buf], SZ_LINE, WRITE_ONLY)
+
+	# Get the data pointer.
+	img = C_DATA(cp)
+
+	# Get the coordinate transform descriptor.
+	co = IMG_CO(img)
+	radecsys = sk_stati (co, S_RADECSYS)
+	ctype = sk_stati (co, S_CTYPE)
+	wtype = sk_stati (co, S_WTYPE)
+
+	mw = IMG_MW(img)
+	if (mw != NULL) {
+	    # Now get the mwcs Rterm (CRPIXi), Wterm (CRVALi), and CD matrix.
+	    ndim = mw_stati (mw, MW_NPHYSDIM)
+	    call wcs_gfterm (mw, r, w, cd, ndim)
+	    crpix1 = r[1]
+	    crpix2 = r[2]
+	    crval1 = w[1]
+	    crval2 = w[2]
+
+	    xscale = sqrt (cd[1,1]**2 + cd[2,1]**2) * 3600.0d0
+	    yscale = sqrt (cd[1,2]**2 + cd[2,2]**2) * 3600.0d0
+	    xrot   = 0.0
+	    yrot   = 0.0
+	    if (!fp_equald (cd[1,1], 0.0d0))
+	        xrot   = DRADTODEG(atan ( cd[2,1] / cd[1,1]))
+	    if (!fp_equald (cd[2,2], 0.0d0))
+	        yrot   = DRADTODEG(atan (-cd[1,2] / cd[2,2]))
+	} else {
+	    ndim = 2
+	    xscale = 1.0
+	    yscale = 1.0
+	    xrot   = 0.0
+	    yrot   = 0.0
+	}
+
+	if (IMG_DEBUG) {
+	    call printf("WCS Info:\n=========\n")
+	    call printf("R term: %g %g\n"); call pargd(r[1]); call pargd(r[2])
+	    call printf("W term: %g %g\n"); call pargd(w[1]); call pargd(w[2])
+	    call printf("    cd: %g %g\n        %g %g\n")
+	        call pargd(cd[1,1]); call pargd(cd[1,2])
+	        call pargd(cd[2,1]); call pargd(cd[2,2])
+	    call printf(" scale: %g %g\n");call pargd(xscale);call pargd(yscale)
+	    call printf("   rot: %g %g\n");call pargd(xrot);call pargd(yrot)
+	}
+
+	IMG_SCALE(img) = (xscale + yscale) / 2.0d0
+	#IMG_ROT(img)  = (xrot + yrot) / 2.0d0
+	IMG_ROT(img)   = xrot
+	
+
+	# Now format a WCS text panel such as
+	#
+	#      Projection:  TAN                     System:  Equatorial FK5
+	#     Ra/Dec axes:  1/2                 Dimensions:  512 x 512
+	#
+	#      Center Pos:  RA:  13:29:52.856          Dec:  +47:11:40.39
+	#   Reference Pos:  RA:  13:29:52.856          Dec:  +47:11:40.39
+	# Ref pixel coord:   X:  250.256                 Y:  266.309
+	#     Plate Scale:  0.765194             Rot Angle:  1.02939
+	#         Equinox:  J2000.000                Epoch:  J1987.25775240
+	#             MJD:  46890.39406
+
+	# Get some preliminary values.
+        if (idxstr (radecsys, Memc[radecstr], SZ_FNAME, EQTYPE_LIST) <= 0)
+            call strcpy ("FK5", Memc[radecstr], SZ_FNAME)
+        call strupr (Memc[radecstr])
+
+        if (idxstr (wtype, Memc[proj], SZ_FNAME, WTYPE_LIST) <= 0)
+            call strcpy ("logical", Memc[proj], SZ_FNAME)
+        call strupr (Memc[proj])
+
+	call fprintf (fd, "wcsinfo {\n")
+
+	call fprintf (fd, 
+	    "      Projection:  %-6s\t            System:  %s %s\n")
+	    call pargstr (Memc[proj])
+	    switch (ctype) {
+	    case CTYPE_EQUATORIAL:
+		call pargstr ("Equatorial")
+	        call pargstr (Memc[radecstr])
+	    case CTYPE_ECLIPTIC:
+		call pargstr ("Ecliptic")
+	        call pargstr ("")
+	    case CTYPE_GALACTIC:
+		call pargstr ("Galactic")
+	        call pargstr ("")
+	    case CTYPE_SUPERGALACTIC:
+		call pargstr ("SuperGalactic")
+	        call pargstr ("")
+	    default:
+		call pargstr ("Linear")
+	        call pargstr ("")
+	    }
+
+	call fprintf (fd, "     Ra/Dec axes:  %d/%d")
+		call pargi (sk_stati (co, S_PLNGAX))
+		call pargi (sk_stati (co, S_PLATAX))
+	call fprintf (fd, "                  Dimensions:  %d x %d\n\n")
+		call pargi (IM_LEN(im,1))
+		call pargi (IM_LEN(im,2))
+
+	call fprintf (fd, 
+	    "      Center Pos: %3s:  %-12H           %3s:  %-12h\n")
+	    if (ctype == CTYPE_EQUATORIAL)
+		call pargstr (" RA")
+	    else
+		call pargstr ("Lon")
+	    call pargd (cval1)
+	    if (ctype == CTYPE_EQUATORIAL)
+		call pargstr ("Dec")
+	    else
+		call pargstr ("Lat")
+	    call pargd (cval2)
+
+	call fprintf (fd, 
+	    "   Reference Pos: %3s:  %-12H           %3s:  %-12h\n")
+	    if (ctype == CTYPE_EQUATORIAL)
+		call pargstr (" RA")
+	    else
+		call pargstr ("Lon")
+	    call pargd (crval1)
+	    if (ctype == CTYPE_EQUATORIAL)
+		call pargstr ("Dec")
+	    else
+		call pargstr ("Lat")
+	    call pargd (crval2)
+
+	call fprintf (fd, 
+	    " Reference Pixel:   X:  %-9.4f                Y:  %-9.4f\n")
+	        call pargd (crpix1)
+	        call pargd (crpix2)
+
+	call fprintf (fd, 
+	    "     Plate Scale:  %-8f              Rot Angle:  %-8f\n")
+	        call pargr (IMG_SCALE(img))
+	        call pargr (IMG_ROT(img))
+
+	call fprintf (fd, 
+	    "         Equinox:  %s%8f                 Epoch:  %s%.6f\n")
+	    switch (radecsys) {
+	    case EQTYPE_FK5, EQTYPE_ICRS:
+		call pargstr ("J") ; call pargd (sk_statd(co,S_EQUINOX))
+		call pargstr ("J") ; call pargd (sl_epj(sk_statd(co,S_EPOCH)))
+	    default:
+		if (IMG_LINEAR(img) == YES) {
+		    call pargstr (" ") ; call pargd (INDEFD)
+		    call pargstr (" ") ; call pargd (INDEFD)
+		} else {
+		    call pargstr ("B")
+		    call pargd (sk_statd(co,S_EQUINOX))
+		    call pargstr ("B")
+		    call pargd (sl_epb(sk_statd(co,S_EPOCH)))
+		}
+	    }
+
+	call fprintf (fd, "             MJD:  %.6f\n")
+	    call pargd (sk_statd(co,S_EPOCH))
+
+	call fprintf (fd, "}\n \n \n")
+
+	# Close the formatted string and send the message.
+	call close (fd)
+	call wcspix_message (Memc[buf])
+
+	call sfree (sp)
+end
+
+
+# IMG_SEND_PIXTAB -- Send a 'pixtab' message.  Format of the message is
+#
+#  	pixtab {
+#  	  { {pix} {pix} ...  }	    	# pixel table values
+#  	  { {x1}  {x2}  ...  }		# column label values
+#  	  { {y1}  {y2}  ...  }		# row label values
+#  	  { <mean>  <stdev>  }		# pixtab statistics
+#  	}
+#
+
+procedure img_send_pixtab (pixtab, size, x1, x2, y1, y2)
+
+real	pixtab[ARB]				#i pixtab array
+int	size					#i pixtab size
+int	x1, x2, y1, y2				#i raster boundaries
+
+pointer	sp, buf, el
+int	i, j, npix
+real	pix, sum, sum2, mean, var, stdev, x, y
+
+define  SZ_PIXTAB	(6*SZ_LINE)
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_PIXTAB, TY_CHAR)
+	call salloc (el, SZ_FNAME, TY_CHAR)
+
+	# Begin the pixtab message.  
+	call strcpy ("pixtab {\n{\ntable {\n", Memc[buf], SZ_PIXTAB)
+
+	# Format the pixels into a table for presentation.  Do the y-flip
+	# here so the pixels are in order for the List widget in the GUI.
+	# Accumulate the pixel statistics so we don't have to do it in the
+	# GUI where it's slower.
+
+	sum = 0.0
+	sum2 = 0.0
+	npix = size * size
+
+	for (i=size - 1; i >= 0; i=i-1) {
+	    for (j=1; j <= size; j=j+1) {
+	        pix =  pixtab[(i * size) + j]
+		sum = sum + pix
+		sum2 = sum2 + (pix * pix)
+
+	        call sprintf (Memc[el], SZ_FNAME, " {%10.1f}")
+	            call pargr (pix)
+
+		call strcat (Memc[el], Memc[buf], SZ_PIXTAB)
+	    }
+	    call strcat ("\n", Memc[buf], SZ_PIXTAB)
+	}
+	call strcat ("}\n}\n", Memc[buf], SZ_PIXTAB)
+
+
+	# Do the row and column label parts of the message.
+	call strcat ("{", Memc[buf], SZ_PIXTAB)
+	for (x = x1; x <= x2; x = x + 1.) {
+	    call sprintf (Memc[el], SZ_FNAME, " {%10.1f}")
+	        call pargr (x)
+	    call strcat (Memc[el], Memc[buf], SZ_PIXTAB)
+	}
+	call strcat ("}\n", Memc[buf], SZ_PIXTAB)
+
+	call strcat ("{", Memc[buf], SZ_PIXTAB)
+	for (y = y2; y >= y1; y = y - 1.) {
+	    call sprintf (Memc[el], SZ_FNAME, " {%10.1f}")
+	        call pargr (y)
+	    call strcat (Memc[el], Memc[buf], SZ_PIXTAB)
+	}
+	call strcat ("}\n", Memc[buf], SZ_PIXTAB)
+
+
+	# Compute the statistics for the raster.
+	mean = sum / real(npix)
+	var = (sum2 - sum * mean) / real(npix - 1)
+	if (var <= 0)
+	    stdev = 0.0
+	else
+	    stdev = sqrt (var)
+
+	call sprintf (Memc[el], SZ_FNAME, " { %10.2f %10.4f }\n")
+	    call pargr (mean)
+	    call pargr (stdev)
+	call strcat (Memc[el], Memc[buf], SZ_PIXTAB)
+
+
+	# Close the message.
+	call strcat ("}", Memc[buf], SZ_PIXTAB) 	
+
+	if (IMG_DEBUG) {
+	    call eprintf ("pixtab: %s\n");call pargstr(Memc[buf])
+	}
+
+	# Send the formatted message.
+	call wcspix_message (Memc[buf])
+
+	call sfree (sp)
+end
+
+
+# IMG_AMP_WCS -- Create a WCS transformation for the amplifier coordinates.
+
+pointer procedure img_amp_wcs (im, mw)
+
+pointer	im					#i image pointer
+pointer	mw					#i MWCS descriptor
+
+pointer	ct
+double	r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM]
+
+double	imgetd()
+pointer	mw_sctran()
+
+begin
+	r[1]    = 0.0d0
+	r[2]    = 0.0d0
+	w[1]    = imgetd (im, "ATV1")
+	w[2]    = imgetd (im, "ATV2")
+	cd[1,1] = imgetd (im, "ATM1_1")
+	cd[1,2] = 0.0d0
+	cd[2,1] = 0.0d0
+	cd[2,2] = imgetd (im, "ATM2_2")
+
+	# Create a new named system.
+	call mw_newsystem (mw, "amplifier", 2)
+
+	# Set the new Wterm for the system.
+	call mw_swtermd (mw, r, w, cd, 2)
+
+	# Set up the transform.
+	ct = mw_sctran (mw, "logical", "amplifier", 03B)
+
+	# Reset the default world system.
+	call mw_sdefwcs (mw)
+
+	return (ct)
+end
+
+
+# IMG_DET_WCS -- Create a WCS transformation for the detector coordinates.
+
+pointer procedure img_det_wcs (im, mw)
+
+pointer	im					#i image pointer
+pointer	mw					#i MWCS descriptor
+
+pointer	ct
+double	r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM]
+
+double	imgetd()
+pointer	mw_sctran()
+
+begin
+	r[1]    = 0.0d0
+	r[2]    = 0.0d0
+	w[1]    = imgetd (im, "DTV1")
+	w[2]    = imgetd (im, "DTV2")
+	cd[1,1] = imgetd (im, "DTM1_1")
+	cd[1,2] = 0.0d0
+	cd[2,1] = 0.0d0
+	cd[2,2] = imgetd (im, "DTM2_2")
+
+	# Create a new named system.
+	call mw_newsystem (mw, "detector", 2)
+
+	# Set the new Wterm for the system.
+	call mw_swtermd (mw, r, w, cd, 2)
+
+	# Set up the transform.
+	ct = mw_sctran (mw, "logical", "detector", 03B)
+
+	# Reset the default world system.
+	call mw_sdefwcs (mw)
+
+	return (ct)
+end
+
+
+# IMG_COORD_LABELS -- Get the WCS name, coord labels and format strings for
+# the specified object.
+
+procedure img_coord_labels (cp, line, wcsname, xunits, yunits)
+
+pointer	cp					#i cache pointer
+pointer	line					#i WCS output line
+char	wcsname[ARB]				#o WCS name string
+char	xunits[ARB], yunits[ARB]		#o WCS coord labels
+
+pointer	img, co, wp
+pointer	sp, proj, radecstr
+            
+int	strcmp(), sk_stati(), idxstr()
+
+begin
+	img = C_DATA(cp)			# initialize ptrs
+	co  = IMG_CO(img)
+	wp  = IMG_WP(img)
+
+	if (SYSTEMS(wp,line) == SYS_WORLD) {
+	    switch (sk_stati(co,S_CTYPE)) {
+	    case CTYPE_EQUATORIAL:
+	        call strcpy ("  RA", xunits, LEN_WCSNAME)
+	        call strcpy (" Dec", yunits, LEN_WCSNAME)
+	    case CTYPE_ECLIPTIC:
+	        call strcpy ("ELon", xunits, LEN_WCSNAME)
+	        call strcpy ("ELat", yunits, LEN_WCSNAME)
+	    case CTYPE_GALACTIC:
+	        call strcpy ("GLon", xunits, LEN_WCSNAME)
+	        call strcpy ("GLat", yunits, LEN_WCSNAME)
+	    case CTYPE_SUPERGALACTIC:
+	        call strcpy ("SLon", xunits, LEN_WCSNAME)
+	        call strcpy ("SLat", yunits, LEN_WCSNAME)
+	    }
+	} else if (SYSTEMS(wp,line) == SYS_SKY) {
+	    call strcpy (WCSNAME(wp,line), wcsname, LEN_WCSNAME)
+	    call strlwr (wcsname)
+	    if (strcmp (wcsname,"ecliptic") == 0) {
+	        call strcpy ("ELon", xunits, LEN_WCSNAME)
+	        call strcpy ("ELat", yunits, LEN_WCSNAME)
+	    } else if (strcmp (wcsname,"galactic") == 0) {
+	        call strcpy ("GLon", xunits, LEN_WCSNAME)
+	        call strcpy ("GLat", yunits, LEN_WCSNAME)
+	    } else if (strcmp (wcsname,"supergalactic") == 0) {
+	        call strcpy ("SLon", xunits, LEN_WCSNAME)
+	        call strcpy ("SLat", yunits, LEN_WCSNAME)
+	    } else {
+	        call strcpy ("  RA", xunits, LEN_WCSNAME)
+	        call strcpy (" Dec", yunits, LEN_WCSNAME)
+	    }
+	} else {
+	    call strcpy ("X", xunits, LEN_WCSNAME)
+	    call strcpy ("Y", yunits, LEN_WCSNAME)
+	}
+
+
+	# Now get the format strings.  For systems other than the image 
+	# default just use the WCS string as the name, otherwise format a
+	# string giving more information about the system.
+	if (SYSTEMS(wp,line) != SYS_WORLD)
+	    call strcpy (WCSNAME(wp,line), wcsname, LEN_WCSNAME)
+
+	else {
+	    call smark (sp)
+	    call salloc (radecstr, SZ_FNAME, TY_CHAR)
+	    call salloc (proj, SZ_FNAME, TY_CHAR)
+
+	    call sprintf (wcsname, LEN_WCSNAME, "%s-%s-%s")
+
+	    switch (sk_stati(co,S_CTYPE)) {
+	    case CTYPE_EQUATORIAL:      call pargstr ("EQ")
+	    case CTYPE_ECLIPTIC:        call pargstr ("ECL")
+	    case CTYPE_GALACTIC:        call pargstr ("GAL")
+	    case CTYPE_SUPERGALACTIC:   call pargstr ("SGAL")
+	    default:                    call pargstr ("UNKN")
+	    }
+
+            if (sk_stati(co,S_CTYPE) == CTYPE_EQUATORIAL) {
+                if (idxstr(sk_stati(co,S_RADECSYS), Memc[radecstr], 
+                    SZ_FNAME, EQTYPE_LIST) <= 0)
+                        call strcpy ("FK5", Memc[radecstr], SZ_FNAME)
+                call strupr (Memc[radecstr])
+                call pargstr (Memc[radecstr])
+            } else {
+                if (sk_stati(co,S_CTYPE) == CTYPE_SUPERGALACTIC)
+                    call pargstr ("-")
+                else
+                    call pargstr ("--")
+            }
+
+            if (idxstr(sk_stati(co,S_WTYPE), Memc[proj], SZ_FNAME,
+		WTYPE_LIST) <= 0)
+                    call strcpy ("linear", Memc[proj], SZ_FNAME)
+            call strupr (Memc[proj])
+            call pargstr (Memc[proj])
+
+	    call sfree (sp)
+	}
+
+	# Now fix up the WCS system name.
+	if (strcmp (wcsname, "fk4") == 0 ||
+	    strcmp (wcsname, "fk5") == 0 ||
+	    strcmp (wcsname, "icrs") == 0 ||
+	    strcmp (wcsname, "gappt") == 0 ||
+	    strcmp (wcsname, "fk4-no-e") == 0) {
+		call strupr (wcsname)
+
+	} else if (IS_LOWER(wcsname[1]))
+	    wcsname[1] = TO_UPPER(wcsname[1])
+end
+
+
+# IMG_COORD_FMT --  Format the coordinate strings.
+
+procedure img_coord_fmt (cp, line, xval, yval, xc, yc)
+
+pointer	cp					#i object cache pointer
+int	line					#i output line number
+double	xval, yval				#i input coords
+char	xc[ARB], yc[ARB]			#o formatted coord strings
+
+pointer	img, co, wp
+char	xfmt[LEN_WCSNAME], yfmt[LEN_WCSNAME]
+int	ctype
+
+int	sk_stati()
+bool	streq()
+
+begin
+	img = C_DATA(cp)			# initialize ptrs
+	co  = IMG_CO(img)
+	wp  = IMG_WP(img)
+
+
+        ctype = sk_stati (co, S_CTYPE)
+
+	# Convert coords to the requested format.
+	if (FORMATS(wp,line) == FMT_DEFAULT) {
+	    if (IMG_MW(img) == NULL) {
+	        call strcpy ("%10.2f", xfmt, LEN_WCSNAME)
+	        call strcpy ("%10.2f", yfmt, LEN_WCSNAME)
+	    } else {
+	        if (SYSTEMS(wp,line) == SYS_WORLD ||
+		    SYSTEMS(wp,line) == SYS_SKY) {
+
+	            if (streq(WCSNAME(wp,line),"ecliptic") ||
+	                streq(WCSNAME(wp,line),"galactic") ||
+	                streq(WCSNAME(wp,line),"supergalactic"))
+	                    call strcpy ("%h", xfmt, LEN_WCSNAME)
+	            else {
+	    		if (sk_stati(co, S_CTYPE) == CTYPE_EQUATORIAL)
+	                    call strcpy ("%.2H", xfmt, LEN_WCSNAME)
+	                else
+	                    call strcpy ("%.2h", xfmt, LEN_WCSNAME)
+	            }
+	            call strcpy ("%.1h", yfmt, LEN_WCSNAME)
+	        } else {
+	            call strcpy ("%10.2f", xfmt, LEN_WCSNAME)
+	            call strcpy ("%10.2f", yfmt, LEN_WCSNAME)
+	        }
+	    }
+
+	} else if (FORMATS(wp,line) == FMT_HMS) {
+	    if (sk_stati(co, S_CTYPE) == CTYPE_EQUATORIAL)
+	        call strcpy ("%.2H", xfmt, LEN_WCSNAME)
+	    else
+	        call strcpy ("%.1h", xfmt, LEN_WCSNAME)
+	    call strcpy ("%h", yfmt, LEN_WCSNAME)
+	} else {
+	    call strcpy ("%10.2f", xfmt, LEN_WCSNAME)
+	    call strcpy ("%10.2f", yfmt, LEN_WCSNAME)
+	}
+
+	# Convert the value to the requested format
+        call sprintf (xc, LEN_WCSNAME, xfmt)
+	    if (FORMATS(wp,line) != FMT_RAD)
+	        call pargd (xval)
+	    else
+	        call pargd (DEGTORAD(xval))
+
+        call sprintf (yc, LEN_WCSNAME, yfmt)
+	    if (FORMATS(wp,line) != FMT_RAD)
+	        call pargd (yval)
+	    else
+	        call pargd (DEGTORAD(yval))
+end
+
+
+# IMG_GET_COORD -- Given an x,y position in the image return the coordinate in
+# the given system.
+
+procedure img_get_coord (img, x, y, system, wcsname, wx, wy)
+
+pointer	img					#i IMG struct pointer
+double	x, y					#i input image position
+int	system					#i coordinate system requested
+char	wcsname[ARB]				#i desired WCS name
+double	wx, wy					#o output coordinates
+
+double 	ox, oy, tmp
+real 	epoch
+pointer	im, co, nco
+char	buf[SZ_LINE]
+int	stat
+
+real	imgetr()
+int	imaccf(), sk_stati(), sk_decwstr()
+bool	streq()
+
+errchk imgetr
+
+begin	
+	im  = IMG_IM(img)
+	co  = IMG_CO(img)
+
+	wx = x					# fallback values
+	wy = y
+
+	switch (system) {
+	case SYS_NONE:
+	    wx = x
+	    wy = y
+	case SYS_DISPLAY:
+	    call img_ltov (im, x, y, wx, wy)
+	    #wx = x
+	    #wy = y
+	case SYS_PHYSICAL:
+            if (IMG_CTP(img) != NULL)
+                call mw_c2trand (IMG_CTP(img), x, y, wx, wy)
+	case SYS_WORLD:
+            if (IMG_CTW(img) != NULL) {
+                call mw_c2trand (IMG_CTW(img), x, y, wx, wy)
+
+		# Check for transposed image.
+	        if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) {
+	            tmp = wx 			
+	            wx  = wy
+	            wy  = tmp
+	        }
+	    }
+	case SYS_AMP:
+            if (IMG_CTA(img) != NULL)
+                call mw_c2trand (IMG_CTA(img), x, y, wx, wy)
+	case SYS_CCD:
+            if (IMG_CTD(img) != NULL)
+                call mw_c2trand (IMG_CTD(img), x, y, wx, wy)
+	case SYS_DETECTOR:
+            if (IMG_CTD(img) != NULL)
+                call mw_c2trand (IMG_CTD(img), x, y, wx, wy)
+	case SYS_SKY:
+	    # Note Ecliptic/GAPPT coords need an epoch value.
+	    if (imaccf (im, "EPOCH") == YES) {
+	        epoch = imgetr (im, "EPOCH")
+	        if (epoch == 0.0 || IS_INDEFR(epoch))
+	            epoch = 1950.0
+	    } else
+	        epoch = 1950.0
+
+	    if (streq (wcsname, "ecliptic") || streq (wcsname, "gappt")) {
+		call sprintf (buf, SZ_LINE, "%s %.1f")
+		    if (streq (wcsname, "gappt"))
+		        call pargstr ("apparent")
+		    else
+		        call pargstr (wcsname)
+		    call pargr (epoch)
+	    } else {
+		call sprintf (buf, SZ_LINE, "%s")
+		    if (streq(wcsname,"gappt"))
+		        call pargstr ("apparent")
+		    else if (streq(wcsname,"fk4-no-e"))
+		        call pargstr ("noefk4")
+		    else
+		        call pargstr (wcsname)
+	    }
+
+	    stat = sk_decwstr (buf, nco, co)
+	    if (stat != ERR) {
+        	if (IMG_CTW(img) != NULL)
+        	    call mw_c2trand (IMG_CTW(img), x, y, ox, oy)
+	   	call sk_lltran (co, nco, DEGTORAD(ox), DEGTORAD(oy),
+		    INDEFD, INDEFD, 0.0d0, 0.0d0, wx, wy)
+		if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) {
+		    wx = RADTODEG(wy) 		# transposed image
+		    wy = RADTODEG(wx)
+		} else {
+		    wx = RADTODEG(wx)		# regular image
+		    wy = RADTODEG(wy)
+		}
+	    } else {
+	        wx = x
+	        wy = y
+	    }
+	case SYS_OTHER:
+	    ;					# TBD
+
+	default: 				# default coords
+	    wx = x
+	    wy = y
+	}
+end
+
+
+# IMG_LTOV -- Convert coordinate from the logical coordinate system to the
+# output coordinate system.
+
+procedure img_ltov (im, xin, yin, xout, yout)
+
+pointer	im			# the input image descriptor
+double	xin			# the input x coordinate
+double	yin			# the input y coordinate
+double	xout			# the output x coordinate 
+double	yout			# the output y coordinate
+
+int	index1, index2
+
+begin
+	index1 = IM_VMAP(im,1)
+	index2 = IM_VMAP(im,2)
+
+	xout = xin * IM_VSTEP(im,index1) + IM_VOFF(im,index1)
+	yout = yin * IM_VSTEP(im,index2) + IM_VOFF(im,index2)
+end
+
+
+# IMG_VTOL -- Convert coordinate from the tv coordinate system to the
+# logical coordinate system.
+
+procedure img_vtol (im, xin, yin, xout, yout)
+
+pointer	im			# the input image descriptor
+double	xin     		# the input x coordinate
+double	yin     		# the input y coordinate
+double	xout     		# the output x coordinate 
+double	yout     		# the output y coordinate
+
+int	index1, index2
+
+begin
+	index1 = IM_VMAP(im,1)
+	index2 = IM_VMAP(im,2)
+
+	xout = (xin - IM_VOFF(im,index1)) / IM_VSTEP(im,index1)
+	yout = (yin - IM_VOFF(im,index2)) / IM_VSTEP(im,index2)
+end
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x.bak b/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x.bak
new file mode 100644
index 00000000..87a12a39
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x.bak
@@ -0,0 +1,1515 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <math.h>
+include <imio.h>
+include <imhdr.h>
+include <time.h>
+include <ctype.h>
+include <mwset.h>
+include <pkg/skywcs.h>
+include "wcspix.h"
+
+
+# Image class data.
+define  LEN_IMGDATA	15
+define  IMG_WP          Memi[$1  ]              # wcspix back-pointer
+define  IMG_IM          Memi[$1+1]              # image pointer
+define  IMG_BPM         Memi[$1+2]              # bad pixel mask pointer
+define  IMG_MW          Memi[$1+3]              # image wcs pointer
+define  IMG_CO          Memi[$1+4]              # skywcs transform pointer
+define  IMG_CTW         Memi[$1+5]              # mwcs log->world transform ptr
+define  IMG_CTP         Memi[$1+6]              # mwcs log->phys transform ptr
+define  IMG_CTA         Memi[$1+7]              # mwcs log->amplifier transform
+define  IMG_CTD         Memi[$1+8]              # mwcs log->detector transform
+define  IMG_ROT         Memr[$1+9]              # rotation angle
+define  IMG_SCALE       Memr[$1+10]             # plate scale
+define  IMG_LINEAR      Memi[$1+11]             # linear coords
+
+
+define	IMG_DEBUG	FALSE
+
+
+# IMG_INIT --  Initialize the object structure.
+
+procedure img_init (cp, wp)
+
+pointer	cp					#i cache pointer
+pointer	wp					#i WCSPIX structure
+
+pointer	img					# data pointer
+
+begin
+	if (IMG_DEBUG) call printf ("img_init: \n")
+
+	# Allocate the image data structure if not previously allocated.
+	if (C_DATA(cp) == NULL) {
+	    iferr (call calloc (C_DATA(cp), LEN_IMGDATA, TY_STRUCT))
+	        return
+	}
+
+	img = C_DATA(cp)
+	IMG_WP(img)     = wp
+	IMG_IM(img)     = NULL
+	IMG_BPM(img)    = NULL
+	IMG_MW(img)     = NULL
+	IMG_CO(img)     = NULL
+	IMG_CTW(img)    = NULL
+	IMG_CTP(img)    = NULL
+	IMG_CTA(img)    = NULL
+	IMG_CTD(img)    = NULL
+	IMG_ROT(img)    = 0.0
+	IMG_SCALE(img)  = 0.0
+	IMG_LINEAR(img) = YES
+end
+
+
+# IMG_CACHE --  Cache an image in the object cache.
+
+procedure img_cache (cp, objid, regid, ref)
+
+pointer	cp					#i cache pointer
+int	objid					#i object id
+int	regid					#i region id
+char	ref[ARB]				#i object reference
+
+pointer	img, im, wp, co
+int     stat, i1, i2
+char	alert[SZ_LINE]
+
+pointer immap(), ds_pmmap(), mw_sctran()
+pointer	img_amp_wcs(), img_det_wcs()
+int     imaccf(), sk_decim()
+
+errchk  immap, ds_pmmap, mw_sctran, sk_decim, sk_setd
+
+begin
+	if (IMG_DEBUG) call printf ("img_cache: \n")
+
+        # Now map the image and WCS.
+	img = C_DATA(cp)
+	wp  = IMG_WP(img)
+
+        iferr (IMG_IM(img) = immap (ref, READ_ONLY, 0)) {
+	    # Send alert to the GUI.
+            call sprintf (alert, SZ_FNAME, "Unable to cache\n%s")
+                call pargstr (ref)
+            call ism_alert (alert, "", "")
+            return
+        }
+	im = IMG_IM(img)
+
+        IMG_CO(img)  = NULL
+        IMG_CTW(img) = NULL
+        IMG_CTP(img) = NULL
+        IMG_CTA(img) = NULL
+        IMG_CTD(img) = NULL
+	iferr {
+            stat = sk_decim (IMG_IM(img), "world", IMG_MW(img), IMG_CO(img))
+	    if (IMG_DEBUG) {
+		call eprintf ("img_cache - decim: stat=%d  mw=%d  co=%d \n")
+		    call pargi(stat);call pargi(IMG_MW(img))
+		    call pargi(IMG_CO(img));
+	    }
+            if (stat == ERR || IMG_MW(img) == NULL) {
+                IMG_LINEAR(img) = YES
+
+		co = IMG_CO(img)
+        	i1 = IM_VMAP(im,1)
+        	i2 = IM_VMAP(im,2)
+		call sk_setd (co, S_VXOFF,  double(IM_VOFF(im,i1)))
+		call sk_setd (co, S_VYOFF,  double(IM_VOFF(im,i2)))
+		call sk_setd (co, S_VXSTEP, double(IM_VSTEP(im,i1)))
+		call sk_setd (co, S_VYSTEP, double(IM_VSTEP(im,i2)))
+
+            	IMG_MW(img) = NULL
+            	IMG_LINEAR(img) = YES
+	    }
+
+	    if (IMG_MW(img) != NULL) {
+                IMG_CTW(img) = mw_sctran (IMG_MW(img), "logical", "world", 03B)
+                IMG_CTP(img) = mw_sctran (IMG_MW(img), "logical", "physical",
+		    03B)
+
+	        # Get the amplifier transformation values if present.
+	        if (imaccf(im,"ATM1_1") == YES &&
+	            imaccf(im,"ATM2_2") == YES &&
+	            imaccf(im,"ATV1") == YES &&
+	            imaccf(im,"ATV2") == YES)
+		        IMG_CTA(img) = img_amp_wcs (im, IMG_MW(img))
+
+	        if (imaccf(im,"DTM1_1") == YES &&
+	            imaccf(im,"DTM2_2") == YES &&
+	            imaccf(im,"DTV1") == YES &&
+	            imaccf(im,"DTV2") == YES)
+		        IMG_CTD(img) = img_det_wcs (im, IMG_MW(img))
+	    }
+
+	} then {
+	    # Send alert to the GUI.
+            call sprintf (alert, SZ_FNAME, "Unable to decode image WCS\n%s")
+                call pargstr (ref)
+            call ism_alert (alert, "", "")
+            IMG_LINEAR(img) = YES
+	}
+
+
+	# See if we can find a bad pixel mask.
+        IMG_BPM(img) = NULL
+ 	if (WP_BPM(wp) == YES) {
+             iferr (IMG_BPM(img) = ds_pmmap ("BPM", IMG_IM(img)))
+ 	        IMG_BPM(img) = NULL
+ 	}
+
+        C_OBJID(cp) = objid
+        C_REGID(cp) = regid
+        C_NREF(cp)  = C_NREF(cp) + 1
+        call strcpy (ref, C_REF(cp), 128)
+end
+
+
+# IMG_UNCACHE --  Uncache an image in the object cache.
+
+procedure img_uncache (cp, id)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+
+pointer	img
+
+begin
+	if (IMG_DEBUG) call printf ("img_uncache: \n")
+
+        C_OBJID(cp) = NULL
+        C_NREF(cp) = 0
+        call strcpy ("", C_REF(cp), SZ_FNAME)
+
+	img = C_DATA(cp)
+	if (IMG_MW(img) != NULL)
+            call mw_close (IMG_MW(img))
+        if (IMG_BPM(img) != NULL)
+            call imunmap (IMG_BPM(img))
+        if (IMG_IM(img) != NULL)
+            call imunmap (IMG_IM(img))
+
+        IMG_IM(img)     = NULL
+        IMG_BPM(img)    = NULL
+        IMG_MW(img)     = NULL
+        IMG_CTW(img)    = NULL
+        IMG_CTP(img)    = NULL
+        IMG_CTA(img)    = NULL
+        IMG_CTD(img)    = NULL
+        IMG_CO(img)     = NULL
+        IMG_ROT(img)    = 0.0
+        IMG_SCALE(img)  = 0.0
+        IMG_LINEAR(img) = NO
+
+	call mfree (C_DATA(cp), TY_STRUCT)
+        C_DATA(cp) = NULL
+end
+
+
+# IMG_WCSTRAN -- Translate object source (x,y) coordinates to the
+# desired output WCSs.  Message is returned as something like:
+#
+#        set value {
+#            { object <objid> }  { region <regionid> }
+#            { pixval <pixel_value> [<units>] }
+#            { bpm    <bpm_pixel_value> }
+#            { coord  <wcsname> <x> <y> [<xunits> <yunits>] }
+#            { coord  <wcsname> <x> <y> [<xunits> <yunits>] }
+#            		:
+#        }
+
+
+procedure img_wcstran (cp, id, x, y)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+real	x, y					#i source coords
+
+pointer img, im, wp, co
+double  dx, dy, wx, wy
+real	rx, ry, pixval
+int     i, bpm
+
+# Use static storage to avoid allocation overhead.
+char	buf[SZ_LINE]
+char	msg[SZ_LINE], wcs[LEN_WCSNAME], xc[LEN_WCSNAME], yc[LEN_WCSNAME]
+char	xunits[LEN_WCSNAME], yunits[LEN_WCSNAME]
+
+double	sk_statd()
+
+begin
+	if (IMG_DEBUG) call printf ("img_wcstran: \n")
+
+	img = C_DATA(cp)			# initialize
+	co  = IMG_CO(img)
+	wp  = IMG_WP(img)
+	im  = IMG_IM(img)
+
+	# Get the translation to the image section.
+	dx  = (double(x) - sk_statd(co,S_VXOFF)) / sk_statd(co,S_VXSTEP)
+	dy  = (double(y) - sk_statd(co,S_VYOFF)) / sk_statd(co,S_VYSTEP)
+	rx = dx
+	ry = dy
+
+	# Read the pixel data.
+	call img_get_data (cp, id, rx, ry, pixval, bpm)
+
+	# Begin formatting the message.
+	call aclrc (msg, SZ_LINE)
+	call sprintf (msg, SZ_LINE, "wcstran { object %d } { region %d } ")
+	    call pargi (C_OBJID(cp))
+	    call pargi (C_REGID(cp))
+
+	call sprintf (buf, SZ_LINE, "{ pixval %9.9g } { bpm %d }\n")
+	    call pargr (pixval)
+	    call pargi (bpm)
+	call strcat (buf, msg, SZ_LINE)
+
+	# Now loop over the requested systems and generate a coordinate
+	# for each.
+	for (i=1; i <= MAX_WCSLINES; i=i+1) {
+
+	    # Get the coordinate value.
+	    call img_get_coord (img, dx, dy, SYSTEMS(wp,i), WCSNAME(wp,i),
+		wx, wy)
+
+	    # Get the system name, labels, and formats strings for the WCS.
+	    call img_coord_labels (cp, i, wcs, xunits, yunits)
+
+	    # Format the values as requested.
+	    call img_coord_fmt (cp, i, wx, wy, xc, yc)
+
+	    # Format the coord buffer and append it to the message.
+	    call sprintf (buf, SZ_LINE,
+		"{coord {%9s} {%12s} {%12s} {%4s} {%4s}}\n")
+	            call pargstr (wcs)
+	            call pargstr (xc)
+	            call pargstr (yc)
+	            call pargstr (xunits)
+	            call pargstr (yunits)
+	    call strcat (buf, msg, SZ_LINE)
+	}
+
+	# Now send the completed message.
+	call wcspix_message (msg);
+end
+
+
+# IMG_WCSLIST -- List the WCSs available for the given image.
+
+procedure img_wcslist (cp, id)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+
+pointer img, im, mw
+char	msg[SZ_LINE]
+
+begin
+	if (IMG_DEBUG) call printf ("img_wcslist: \n")
+
+	img = C_DATA(cp)			# initialize
+	mw  = IMG_MW(img)
+	im  = IMG_IM(img)
+
+	call strcpy ("wcslist {None Display Logical World Physical line ",
+	    msg, SZ_LINE)
+
+	# See if we can do amplifier/detector coords by checking for ATM/ATV
+	# and DTM/DTV keywords.
+
+	if (IMG_CTA(img) != NULL)
+	    call strcat (" Amplifier ", msg, SZ_LINE)
+	if (IMG_CTD(img) != NULL)
+	    call strcat (" Detector ", msg, SZ_LINE)
+	if (IMG_CTA(img) != NULL || IMG_CTD(img) != NULL)
+	    call strcat (" CCD ", msg, SZ_LINE)
+
+	# If we have a MWCS pointer list the sky projections.
+	if (mw != NULL) {
+	    call strcat (" line ", msg, SZ_LINE)
+	    call strcat (SKYPROJ, msg, SZ_LINE)
+	}
+
+	# Close the message.
+	call strcat ("}", msg, SZ_LINE)
+	
+	call wcspix_message (msg)
+end
+
+
+# IMG_GET_DATA -- Get data from the image.
+
+procedure img_get_data (cp, id, x, y, pixval, bpm_pix)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+real	x, y					#i source coords
+real	pixval					#o central pixel value
+int	bpm_pix					#o bad pixel mask value
+
+pointer img, wp, im, bpm, pix, sp, msg, buf
+int     nl, nc, ix, iy, s2
+int     size, x1, x2, y1, y2
+
+long	clktime()
+pointer imgs2r(), imgs2i(), ds_pmmap()
+errchk	ds_pmmap
+
+begin
+
+	img  = C_DATA(cp)
+	wp   = IMG_WP(img)
+	im   = IMG_IM(img)
+	bpm  = IMG_BPM(img)
+	nc   = IM_LEN(im,1)
+	nl   = IM_LEN(im,2)
+#	size = WP_PTABSZ(wp)
+	size = min(min(nc,nl),WP_PTABSZ(wp))
+
+	if (IMG_DEBUG) {
+	    call printf ("img_get_data: \n")
+	    call eprintf ("\tx: %g  y: %g  nc: %d  nl: %d\n")
+	        call pargr(x); call pargr(y); call pargi(nc); call pargi(nl)
+	}
+
+	# Sanity check on the cursor image position.
+	if (x < 0.0 || y < 0.0 || x > (nc+0.5) || y > (nl+0.5))
+	    return
+
+	# Bounds checking.  Rather than deal with out of bounds pixels we'll
+	# adjust the center pixel so we get the same size raster up to each
+	# boundary.
+
+	ix = int (x + 0.5) 		;     iy = int (y + 0.5)
+	ix = min (ix, (nc-(size/2)-1))  ;     iy = min (iy, (nl-(size/2)-1))
+	ix = max (size/2+1, ix)		;     iy = max (size/2+1, iy)
+
+	# Compute the box offset given the center and size.
+	x1 = ix - size / 2 + 0.5
+	x2 = ix + size / 2 + 0.5
+	y1 = iy - size / 2 + 0.5
+	y2 = iy + size / 2 + 0.5
+
+	if (IMG_DEBUG) {
+	    call printf ("img_get_data: \n")
+	    call eprintf ("\tix: %d iy: %g  size: %d\n")
+	        call pargi(ix); call pargi(iy); call pargi(size)
+	    call eprintf ("\tx1: %d y1: %d  x2: %d  y2: %d\n")
+	        call pargi(x1); call pargi(y1);
+	        call pargi(x2); call pargi(y2);
+	}
+
+        x1 = max (1, x1)
+        x2 = min (nc, x2)
+        y1 = max (1, y1)
+        y2 = min (nl, y2)
+
+	if (IMG_DEBUG) {
+	    call eprintf ("\tx1: %d y1: %d  x2: %d  y2: %d\n")
+	        call pargi(x1); call pargi(y1);
+	        call pargi(x2); call pargi(y2);
+	}
+
+	# Get the image pixels
+	pix = imgs2r (im, int(x1), int(x2), int(y1), int(y2))
+
+	if (WP_BPM(wp) == YES) {
+	    if (bpm != NULL) {
+	        bpm_pix = Memi[imgs2i (bpm, ix, ix, iy, iy)]
+ 	    } else {
+	        # See if we can find a bad pixel mask.  The option is enabled
+		# but we haven't mappend the mask yet.
+
+                # Log the event.
+		call smark (sp)
+		call salloc (msg, SZ_LINE, TY_CHAR)
+		call salloc (buf, SZ_LINE, TY_CHAR)
+                call wp_cnvdate (clktime(0), Memc[buf], SZ_DATE)
+                call sprintf (Memc[msg], SZ_LINE,
+                    "info { %s: WCSPIX BPM map  objid=%3d %s}\n")
+                        call pargstr (Memc[buf])
+                        call pargi (C_OBJID(cp))
+                        call pargstr (C_REF(cp))
+                call ism_message ("ism_msg", Memc[msg])
+
+                iferr (IMG_BPM(img) = ds_pmmap ("BPM", im)) {
+ 	            IMG_BPM(img) = NULL
+		    bpm_pix = 0
+
+	    	    # Send alert to the GUI.
+            	    call sprintf (Memc[buf], SZ_FNAME,
+			"Unable to map BPM image for\n%s")
+                	    call pargstr (C_REF(cp))
+            	    call ism_alert (Memc[buf], "", "")
+		} else
+	            bpm_pix = Memi[imgs2i (IMG_BPM(img), ix, ix, iy, iy)]
+
+		call sfree (sp)
+ 	    }
+	} else
+	    bpm_pix = 0
+
+	# See if we're near an edge...
+	s2 = size / 2
+	if (int(x)<s2 || int(x)>(nl-s2-1) || int(y)<s2 || int(x)>(nc-s2-1)) { 
+	    # Compute the image pixel associated with the requested coords.
+	    ix = int (x + 0.5)
+	    iy = int (y + 0.5)
+	    pixval = Memr[imgs2r(im, ix, ix, iy, iy)]
+	} else {
+	    pixval = Memr[pix + ((size/2)*size) + (size/2)]
+	}
+
+	# Send the pixel table.
+	if (WP_PTABSZ(wp) > 1)
+	    call img_send_pixtab (Memr[pix], WP_PTABSZ(wp), x1, x2, y1, y2)
+
+	if (IMG_DEBUG) {
+	    call printf ("img_get_data: pixval=%g\n") ; call pargr (pixval)
+	}
+end
+
+
+# IMG_OBJINFO -- Get header information from the image.
+
+procedure img_objinfo (cp, id, template)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+char	template[ARB]				#i keyword template
+
+pointer	im, img
+
+define  WCS_TEMPLATE "WCSDIM,CTYPE*,CRPIX*,CRVAL*,CD*,CROTA2,LTV*,LTM*,WSV*,WAT*,RA*,DEC*,EQUINOX,EPOCH,MJD*,DATE-OBS"
+
+begin
+	if (IMG_DEBUG) call printf ("img_objinfo: \n")
+
+	# Send the full header (or keyword filtered header), only the WCS
+	# keywords, and a plain-text explanation of the WCS.
+
+	img = C_DATA(cp)
+	im  = IMG_IM(img)
+
+	call img_send_header  (im, "imghdr", template)
+	call img_send_header  (im, "wcshdr", WCS_TEMPLATE)
+	call img_send_wcsinfo (im, cp)
+	call img_send_compass (im, cp)
+end
+
+
+
+#==============================================================================
+
+# IMG_SEND_HEADER -- Send an image header to the named GUI object.  Keywords
+# are filtered according to a specified template
+
+procedure img_send_header (im, object, template)
+
+pointer	im					#i image descriptor
+char	object[ARB]				#i object for the message
+char	template[ARB]				#i keyword template
+
+pointer	sp, hdr, lbuf, line, field, keyw, dict
+pointer	ip, lp, list
+int	nlines, in, out, i, hdr_size
+bool	keyw_filter
+
+int     stropen(), getline(), stridx(), imgnfn(), strdic()
+pointer	imofnlu()
+bool	streq()
+errchk  stropen, getline, putci, putline, imgnfn, imofnlu, strdic
+
+define  USER_AREA       Memc[($1+IMU-1)*SZ_STRUCT + 1]
+define  SZ_KEYW		8
+
+begin
+        hdr_size = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1
+        hdr_size = hdr_size + SZ_LINE
+
+	call smark (sp)
+	call salloc (hdr, hdr_size, TY_CHAR)
+	call salloc (dict, hdr_size, TY_CHAR)
+	call salloc (field, SZ_LINE, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+	call salloc (line, SZ_LINE, TY_CHAR)
+	call salloc (keyw, SZ_KEYW, TY_CHAR)
+
+	in  = stropen (USER_AREA(im), hdr_size, READ_ONLY)
+	out = stropen (Memc[hdr], hdr_size, WRITE_ONLY)
+	call fprintf (out, "%s {")
+	    call pargstr (object)
+
+	# Build up a dictionary of header keywords based on the template.
+	keyw_filter = (!streq (template, "*"))
+	if (keyw_filter) {
+	    list = imofnlu (im, template)
+	    call strcpy ("|", Memc[dict], hdr_size)
+            while (imgnfn (list, Memc[field], SZ_FNAME) != EOF) {
+	        call strcat (Memc[field], Memc[dict], hdr_size)
+	        call strcat ("|", Memc[dict], hdr_size)
+	    }
+	    call imcfnl (list)
+	}
+
+
+        # Copy header records to the output, stripping any trailing
+        # whitespace and clipping at the right margin.  We also filter
+	# against the keyword dictionary found above.
+
+	nlines = 0
+        while (getline (in, Memc[lbuf]) != EOF) {
+
+	    call aclrc (Memc[line], SZ_LINE)
+
+	    # Escape any brackets passed to the Tcl.
+	    ip = lbuf
+	    lp = line	
+            while (Memc[ip] != EOS && Memc[ip] != '\n') {
+		if (stridx (Memc[ip], "[{") > 0) {
+		    Memc[lp] = '\\'
+		    lp = lp + 1
+		}
+		Memc[lp] = Memc[ip]
+	  	ip = ip + 1
+	  	lp = lp + 1
+	    }
+            Memc[lp] = '\n'
+            Memc[lp+1] = EOS
+            
+	    # See whether the line matches a keyword we want to output.
+	    if (keyw_filter) {
+		for (i=0; i < SZ_KEYW && !IS_WHITE(Memc[line+i]); i=i+1)
+		    Memc[keyw+i] = Memc[line+i]
+		Memc[keyw+i] = '\0'
+
+		# If not in the dictionary skip to the next line.
+	        if (strdic (Memc[keyw], Memc[keyw], SZ_KEYW, Memc[dict]) == 0)
+		    next
+	    }
+
+            call putci (out, ' ')
+            call putline (out, Memc[line])
+
+	    # Send the header in small chunks so we don't overflow the
+	    # message buffer.
+	    nlines = nlines + 1
+	    if (mod(nlines,10) == 0) {
+		call fprintf (out, "}")
+		call close (out)
+		call wcspix_message (Memc[hdr]);
+	        call aclrc (Memc[hdr], hdr_size)
+		out = stropen (Memc[hdr], hdr_size, WRITE_ONLY)
+		call fprintf (out, "%s {")
+	    	    call pargstr (object)
+	    }
+        }
+	call fprintf (out, "}")
+
+	call close (in)
+	call close (out)
+
+	# Send the final message.
+	call wcspix_message (Memc[hdr])
+
+	# Pad a few lines for the GUI
+	call sprintf (Memc[hdr], SZ_LINE, "%d { \n\n\n }")
+	    call pargstr (object)
+	call wcspix_message (Memc[hdr])
+
+	call sfree (sp)
+end
+
+
+# IMG_SEND_COMPASS -- Send information about the image WCS in a plain-english
+# string.
+
+procedure img_send_compass (im, cp)
+
+pointer	im					#i image descriptor
+pointer	cp					#i cache element pointer
+
+pointer	sp, buf, img, co, mw
+double	cx, cy, cx1, cy1, dx, dy, x1, y1
+double	cosa, sina, angle
+double	r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM]
+int	i, j, comp_x, comp_y
+long    axis[IM_MAXDIM], lv[IM_MAXDIM], pv1[IM_MAXDIM], pv2[IM_MAXDIM]
+bool	fp_equalr()
+
+real	length, north[2], east[2]
+
+int	mw_stati(), sk_stati()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call aclrc (Memc[buf], SZ_LINE)
+
+	# Get the data pointer.
+	img = C_DATA(cp)
+	co  = IMG_CO(img)
+
+	# Get world coords at the image corners.
+	if (IMG_CTW(img) != NULL) {
+
+	    if (fp_equalr(IMG_ROT(img),0.0))
+		angle = -IMG_ROT(img)
+	    else if (IMG_ROT(img) > 0.0)
+		angle = -IMG_ROT(img)
+	    else
+		angle = IMG_ROT(img) + 360.0
+            cosa = cos (DEGTORAD(angle))
+            sina = sin (DEGTORAD(angle))
+call eprintf ("compass: angle = %g  sina=%g   cosa=%g\n")
+call pargd(angle); call pargd(sina); call pargd(cosa)
+
+	    # Image center position
+	    cx = IM_LEN(im,1) / 2.0d0
+	    cy = IM_LEN(im,2) / 2.0d0
+            call mw_c2trand (IMG_CTW(img), cx, cy, cx1, cy1)
+
+	    # Extend a unit vector up from the center assuming it's North
+	    # and rotate it by the wcs angle.
+            dx  = cx + ( 10.0 * sina)
+            dy  = cy + ( 10.0 * cosa)
+            call mw_c2trand (IMG_CTW(img), dx, dy, x1, y1)
+
+	    # Check new point Y value relative to the center position.
+	    if (y1 >= cy1)
+	        comp_y = 1			# North is up
+	    else
+	        comp_y = -1			# North is down
+call eprintf ("compass: y1=%g  cy1=%g \n");call pargd(y1);call pargd(cy1)
+
+	    # Extend a unit vector left from the center assuming it's East
+	    # and rotate it by the wcs angle.
+            dx  = cx + (-10.0 * cosa)
+            dy  = cy + ( 10.0 * sina)
+            call mw_c2trand (IMG_CTW(img), dx, dy, x1, y1)
+
+	    # Check new point X value relative to the center position.
+	    if (x1 >= cx1)
+	        comp_x = 1			# East is left and we have a WCS
+	    else
+	        comp_x = -1			# East is right
+call eprintf ("compass: x1=%g  cx1=%g \n");call pargd(x1);call pargd(cx1)
+
+#------------------------------
+#  New compass algorithm
+#------------------------------
+
+	    # Get the CD matrix for the image.
+	    mw = IMG_MW(img)
+            call wcs_gfterm (mw, r, w, cd, mw_stati(mw, MW_NPHYSDIM))
+	    call img_cvectors (cd, 1.0, north, east)
+
+	    if (y1 >= 0.0)
+	        comp_y = 1			# North is up
+	    else
+	        comp_y = -1			# North is down
+
+	    if (x1 >= 0.0)
+	        comp_x = 1			# East is left
+	    else
+	        comp_x = -1			# East is right
+
+	} else {
+            # Determine the logical to physical mapping by evaluating two
+            # points and determining the axis reduction if any.  pv1 will be
+            # the offset and pv2-pv1 will be the scale.
+
+            lv[1] = 0; lv[2] = 0; call imaplv (im, lv, pv1, 2)
+            lv[1] = 1; lv[2] = 1; call imaplv (im, lv, pv2, 2)
+
+            i = 1
+            axis[1] = 1;  axis[2] = 2
+            do j = 1, IM_MAXDIM {
+                if (pv1[j] != pv2[j]) {
+                    axis[i] = j
+                    i = i + 1
+                }
+	    }
+            comp_x = - (pv2[axis[1]] - pv1[axis[1]])
+            comp_y =   (pv2[axis[2]] - pv1[axis[2]])
+	}
+	
+	call sprintf (Memc[buf], SZ_LINE, "compass %d %g %d %d %d %s\0")
+	    call pargi (C_OBJID(cp))
+	    call pargr (IMG_ROT(img))
+	    call pargi (comp_x)
+	    call pargi (comp_y)
+	    if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX))
+	        call pargi (1)			# transposed image
+	    else
+	        call pargi (0)
+	    if (IMG_MW(img) != NULL)
+		call pargstr ("E N")
+	    else
+		call pargstr ("X Y")
+call eprintf ("msg: '%s'\n");call pargstr(Memc[buf])
+
+	call wcspix_message (Memc[buf])
+	call sfree (sp)
+end
+
+
+# IMG_CVECTORS -- Get north and east vectors for the compass
+
+procedure img_cvectors (cd, length, north, east)
+
+double  cd[2,2]         		#i CD matrix
+real    length          		#i length of vectors
+real    north[2]        		#o vector pointing north
+real    east[2]         		#o vector pointing east
+
+double  d               		# determinant of CD matrix
+double  x, y            		# scratch for vector components
+double  l               		# length of a vector
+
+begin
+        d = cd[1,1] * cd[2,2] - cd[1,2] * cd[2,1]
+        if (d == 0.d0)
+            call error (1, "CD matrix is singular")
+
+        # North.
+        x = -cd[1,2] / d
+        y =  cd[1,1] / d
+
+        # Normalize by the length and copy to output.
+        l = sqrt (x**2 + y**2)
+        north[1] = x * length / l
+        north[2] = y * length / l
+
+        # East.
+        x =  cd[2,2] / d
+        y = -cd[2,1] / d
+        l = sqrt (x**2 + y**2)
+        east[1] = x * length / l
+        east[2] = y * length / l
+
+call eprintf ("new: north (%g,%g)  east (%g,%g)\n")
+call pargr(north[1]);call pargr(north[2])
+call pargr(east[1]) ;call pargr(east[2])
+end
+
+
+
+# IMG_SEND_WCSINFO -- Send information about the image WCS in a plain-english
+# string.
+
+procedure img_send_wcsinfo (im, cp)
+
+pointer	im					#i image descriptor
+pointer	cp					#i cache element pointer
+
+pointer	sp, co, img, mw
+pointer	buf, proj, radecstr
+int	fd, radecsys, ctype, wtype, ndim
+double 	crpix1, crpix2, crval1, crval2, cval1, cval2
+double	xscale, yscale, xrot, yrot
+double	r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM], 
+
+int	idxstr(), sk_stati(), stropen(), mw_stati()
+double	sk_statd(), sl_epj(), sl_epb()
+bool	fp_equald()
+
+errchk	stropen
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (proj, SZ_FNAME, TY_CHAR)
+	call salloc (radecstr, SZ_FNAME, TY_CHAR)
+	
+	# Open a string on a file.
+	fd = stropen (Memc[buf], SZ_LINE, WRITE_ONLY)
+
+	# Get the data pointer.
+	img = C_DATA(cp)
+
+	# Get the coordinate transform descriptor.
+	co = IMG_CO(img)
+	radecsys = sk_stati (co, S_RADECSYS)
+	ctype = sk_stati (co, S_CTYPE)
+	wtype = sk_stati (co, S_WTYPE)
+
+	mw = IMG_MW(img)
+	if (mw != NULL) {
+	    # Now get the mwcs Rterm (CRPIXi), Wterm (CRVALi), and CD matrix.
+	    ndim = mw_stati (mw, MW_NPHYSDIM)
+	    call wcs_gfterm (mw, r, w, cd, ndim)
+	    crpix1 = r[1]
+	    crpix2 = r[2]
+	    crval1 = w[1]
+	    crval2 = w[2]
+
+	    xscale = sqrt (cd[1,1]**2 + cd[2,1]**2) * 3600.0d0
+	    yscale = sqrt (cd[1,2]**2 + cd[2,2]**2) * 3600.0d0
+	    xrot   = 0.0
+	    yrot   = 0.0
+	    if (!fp_equald (cd[1,1], 0.0d0))
+	        xrot   = DRADTODEG(atan ( cd[2,1] / cd[1,1]))
+	    if (!fp_equald (cd[2,2], 0.0d0))
+	        yrot   = DRADTODEG(atan (-cd[1,2] / cd[2,2]))
+	} else {
+	    ndim = 2
+	    xscale = 1.0
+	    yscale = 1.0
+	    xrot   = 0.0
+	    yrot   = 0.0
+	}
+
+	if (IMG_DEBUG) {
+	    call printf("WCS Info:\n=========\n")
+	    call printf("R term: %g %g\n"); call pargd(r[1]); call pargd(r[2])
+	    call printf("W term: %g %g\n"); call pargd(w[1]); call pargd(w[2])
+	    call printf("    cd: %g %g\n        %g %g\n")
+	        call pargd(cd[1,1]); call pargd(cd[1,2])
+	        call pargd(cd[2,1]); call pargd(cd[2,2])
+	    call printf(" scale: %g %g\n");call pargd(xscale);call pargd(yscale)
+	    call printf("   rot: %g %g\n");call pargd(xrot);call pargd(yrot)
+	}
+
+	IMG_SCALE(img) = (xscale + yscale) / 2.0d0
+	#IMG_ROT(img)  = (xrot + yrot) / 2.0d0
+	IMG_ROT(img)   = xrot
+	
+
+	# Now format a WCS text panel such as
+	#
+	#      Projection:  TAN                     System:  Equatorial FK5
+	#     Ra/Dec axes:  1/2                 Dimensions:  512 x 512
+	#
+	#      Center Pos:  RA:  13:29:52.856          Dec:  +47:11:40.39
+	#   Reference Pos:  RA:  13:29:52.856          Dec:  +47:11:40.39
+	# Ref pixel coord:   X:  250.256                 Y:  266.309
+	#     Plate Scale:  0.765194             Rot Angle:  1.02939
+	#         Equinox:  J2000.000                Epoch:  J1987.25775240
+	#             MJD:  46890.39406
+
+	# Get some preliminary values.
+        if (idxstr (radecsys, Memc[radecstr], SZ_FNAME, EQTYPE_LIST) <= 0)
+            call strcpy ("FK5", Memc[radecstr], SZ_FNAME)
+        call strupr (Memc[radecstr])
+
+        if (idxstr (wtype, Memc[proj], SZ_FNAME, WTYPE_LIST) <= 0)
+            call strcpy ("logical", Memc[proj], SZ_FNAME)
+        call strupr (Memc[proj])
+
+	call fprintf (fd, "wcsinfo {\n")
+
+	call fprintf (fd, 
+	    "      Projection:  %-6s\t            System:  %s %s\n")
+	    call pargstr (Memc[proj])
+	    switch (ctype) {
+	    case CTYPE_EQUATORIAL:
+		call pargstr ("Equatorial")
+	        call pargstr (Memc[radecstr])
+	    case CTYPE_ECLIPTIC:
+		call pargstr ("Ecliptic")
+	        call pargstr ("")
+	    case CTYPE_GALACTIC:
+		call pargstr ("Galactic")
+	        call pargstr ("")
+	    case CTYPE_SUPERGALACTIC:
+		call pargstr ("SuperGalactic")
+	        call pargstr ("")
+	    default:
+		call pargstr ("Linear")
+	        call pargstr ("")
+	    }
+
+	call fprintf (fd, "     Ra/Dec axes:  %d/%d")
+		call pargi (sk_stati (co, S_PLNGAX))
+		call pargi (sk_stati (co, S_PLATAX))
+	call fprintf (fd, "                  Dimensions:  %d x %d\n\n")
+		call pargi (IM_LEN(im,1))
+		call pargi (IM_LEN(im,2))
+
+	call fprintf (fd, 
+	    "      Center Pos: %3s:  %-12H           %3s:  %-12h\n")
+	    if (ctype == CTYPE_EQUATORIAL)
+		call pargstr (" RA")
+	    else
+		call pargstr ("Lon")
+	    call pargd (cval1)
+	    if (ctype == CTYPE_EQUATORIAL)
+		call pargstr ("Dec")
+	    else
+		call pargstr ("Lat")
+	    call pargd (cval2)
+
+	call fprintf (fd, 
+	    "   Reference Pos: %3s:  %-12H           %3s:  %-12h\n")
+	    if (ctype == CTYPE_EQUATORIAL)
+		call pargstr (" RA")
+	    else
+		call pargstr ("Lon")
+	    call pargd (crval1)
+	    if (ctype == CTYPE_EQUATORIAL)
+		call pargstr ("Dec")
+	    else
+		call pargstr ("Lat")
+	    call pargd (crval2)
+
+	call fprintf (fd, 
+	    " Reference Pixel:   X:  %-9.4f                Y:  %-9.4f\n")
+	        call pargd (crpix1)
+	        call pargd (crpix2)
+
+	call fprintf (fd, 
+	    "     Plate Scale:  %-8f              Rot Angle:  %-8f\n")
+	        call pargr (IMG_SCALE(img))
+	        call pargr (IMG_ROT(img))
+
+	call fprintf (fd, 
+	    "         Equinox:  %s%8f                 Epoch:  %s%.6f\n")
+	    switch (radecsys) {
+	    case EQTYPE_FK5, EQTYPE_ICRS:
+		call pargstr ("J") ; call pargd (sk_statd(co,S_EQUINOX))
+		call pargstr ("J") ; call pargd (sl_epj(sk_statd(co,S_EPOCH)))
+	    default:
+		if (IMG_LINEAR(img) == YES) {
+		    call pargstr (" ") ; call pargd (INDEFD)
+		    call pargstr (" ") ; call pargd (INDEFD)
+		} else {
+		    call pargstr ("B")
+		    call pargd (sk_statd(co,S_EQUINOX))
+		    call pargstr ("B")
+		    call pargd (sl_epb(sk_statd(co,S_EPOCH)))
+		}
+	    }
+
+	call fprintf (fd, "             MJD:  %.6f\n")
+	    call pargd (sk_statd(co,S_EPOCH))
+
+	call fprintf (fd, "}\n \n \n")
+
+	# Close the formatted string and send the message.
+	call close (fd)
+	call wcspix_message (Memc[buf])
+
+	call sfree (sp)
+end
+
+
+# IMG_SEND_PIXTAB -- Send a 'pixtab' message.  Format of the message is
+#
+#  	pixtab {
+#  	  { {pix} {pix} ...  }	    	# pixel table values
+#  	  { {x1}  {x2}  ...  }		# column label values
+#  	  { {y1}  {y2}  ...  }		# row label values
+#  	  { <mean>  <stdev>  }		# pixtab statistics
+#  	}
+#
+
+procedure img_send_pixtab (pixtab, size, x1, x2, y1, y2)
+
+real	pixtab[ARB]				#i pixtab array
+int	size					#i pixtab size
+int	x1, x2, y1, y2				#i raster boundaries
+
+pointer	sp, buf, el
+int	i, j, npix
+real	pix, sum, sum2, mean, var, stdev, x, y
+
+define  SZ_PIXTAB	(6*SZ_LINE)
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_PIXTAB, TY_CHAR)
+	call salloc (el, SZ_FNAME, TY_CHAR)
+
+	# Begin the pixtab message.  
+	call strcpy ("pixtab {\n{\ntable {\n", Memc[buf], SZ_PIXTAB)
+
+	# Format the pixels into a table for presentation.  Do the y-flip
+	# here so the pixels are in order for the List widget in the GUI.
+	# Accumulate the pixel statistics so we don't have to do it in the
+	# GUI where it's slower.
+
+	sum = 0.0
+	sum2 = 0.0
+	npix = size * size
+
+	for (i=size - 1; i >= 0; i=i-1) {
+	    for (j=1; j <= size; j=j+1) {
+	        pix =  pixtab[(i * size) + j]
+		sum = sum + pix
+		sum2 = sum2 + (pix * pix)
+
+	        call sprintf (Memc[el], SZ_FNAME, " {%10.1f}")
+	            call pargr (pix)
+
+		call strcat (Memc[el], Memc[buf], SZ_PIXTAB)
+	    }
+	    call strcat ("\n", Memc[buf], SZ_PIXTAB)
+	}
+	call strcat ("}\n}\n", Memc[buf], SZ_PIXTAB)
+
+
+	# Do the row and column label parts of the message.
+	call strcat ("{", Memc[buf], SZ_PIXTAB)
+	for (x = x1; x <= x2; x = x + 1.) {
+	    call sprintf (Memc[el], SZ_FNAME, " {%10.1f}")
+	        call pargr (x)
+	    call strcat (Memc[el], Memc[buf], SZ_PIXTAB)
+	}
+	call strcat ("}\n", Memc[buf], SZ_PIXTAB)
+
+	call strcat ("{", Memc[buf], SZ_PIXTAB)
+	for (y = y2; y >= y1; y = y - 1.) {
+	    call sprintf (Memc[el], SZ_FNAME, " {%10.1f}")
+	        call pargr (y)
+	    call strcat (Memc[el], Memc[buf], SZ_PIXTAB)
+	}
+	call strcat ("}\n", Memc[buf], SZ_PIXTAB)
+
+
+	# Compute the statistics for the raster.
+	mean = sum / real(npix)
+	var = (sum2 - sum * mean) / real(npix - 1)
+	if (var <= 0)
+	    stdev = 0.0
+	else
+	    stdev = sqrt (var)
+
+	call sprintf (Memc[el], SZ_FNAME, " { %10.2f %10.4f }\n")
+	    call pargr (mean)
+	    call pargr (stdev)
+	call strcat (Memc[el], Memc[buf], SZ_PIXTAB)
+
+
+	# Close the message.
+	call strcat ("}", Memc[buf], SZ_PIXTAB) 	
+
+	if (IMG_DEBUG) {
+	    call eprintf ("pixtab: %s\n");call pargstr(Memc[buf])
+	}
+
+	# Send the formatted message.
+	call wcspix_message (Memc[buf])
+
+	call sfree (sp)
+end
+
+
+# IMG_AMP_WCS -- Create a WCS transformation for the amplifier coordinates.
+
+pointer procedure img_amp_wcs (im, mw)
+
+pointer	im					#i image pointer
+pointer	mw					#i MWCS descriptor
+
+pointer	ct
+double	r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM]
+
+double	imgetd()
+pointer	mw_sctran()
+
+begin
+	r[1]    = 0.0d0
+	r[2]    = 0.0d0
+	w[1]    = imgetd (im, "ATV1")
+	w[2]    = imgetd (im, "ATV2")
+	cd[1,1] = imgetd (im, "ATM1_1")
+	cd[1,2] = 0.0d0
+	cd[2,1] = 0.0d0
+	cd[2,2] = imgetd (im, "ATM2_2")
+
+	# Create a new named system.
+	call mw_newsystem (mw, "amplifier", 2)
+
+	# Set the new Wterm for the system.
+	call mw_swtermd (mw, r, w, cd, 2)
+
+	# Set up the transform.
+	ct = mw_sctran (mw, "logical", "amplifier", 03B)
+
+	# Reset the default world system.
+	call mw_sdefwcs (mw)
+
+	return (ct)
+end
+
+
+# IMG_DET_WCS -- Create a WCS transformation for the detector coordinates.
+
+pointer procedure img_det_wcs (im, mw)
+
+pointer	im					#i image pointer
+pointer	mw					#i MWCS descriptor
+
+pointer	ct
+double	r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM]
+
+double	imgetd()
+pointer	mw_sctran()
+
+begin
+	r[1]    = 0.0d0
+	r[2]    = 0.0d0
+	w[1]    = imgetd (im, "DTV1")
+	w[2]    = imgetd (im, "DTV2")
+	cd[1,1] = imgetd (im, "DTM1_1")
+	cd[1,2] = 0.0d0
+	cd[2,1] = 0.0d0
+	cd[2,2] = imgetd (im, "DTM2_2")
+
+	# Create a new named system.
+	call mw_newsystem (mw, "detector", 2)
+
+	# Set the new Wterm for the system.
+	call mw_swtermd (mw, r, w, cd, 2)
+
+	# Set up the transform.
+	ct = mw_sctran (mw, "logical", "detector", 03B)
+
+	# Reset the default world system.
+	call mw_sdefwcs (mw)
+
+	return (ct)
+end
+
+
+# IMG_COORD_LABELS -- Get the WCS name, coord labels and format strings for
+# the specified object.
+
+procedure img_coord_labels (cp, line, wcsname, xunits, yunits)
+
+pointer	cp					#i cache pointer
+pointer	line					#i WCS output line
+char	wcsname[ARB]				#o WCS name string
+char	xunits[ARB], yunits[ARB]		#o WCS coord labels
+
+pointer	img, co, wp
+pointer	sp, proj, radecstr
+            
+int	strcmp(), sk_stati(), idxstr()
+
+begin
+	img = C_DATA(cp)			# initialize ptrs
+	co  = IMG_CO(img)
+	wp  = IMG_WP(img)
+
+	if (SYSTEMS(wp,line) == SYS_WORLD) {
+	    switch (sk_stati(co,S_CTYPE)) {
+	    case CTYPE_EQUATORIAL:
+	        call strcpy ("  RA", xunits, LEN_WCSNAME)
+	        call strcpy (" Dec", yunits, LEN_WCSNAME)
+	    case CTYPE_ECLIPTIC:
+	        call strcpy ("ELon", xunits, LEN_WCSNAME)
+	        call strcpy ("ELat", yunits, LEN_WCSNAME)
+	    case CTYPE_GALACTIC:
+	        call strcpy ("GLon", xunits, LEN_WCSNAME)
+	        call strcpy ("GLat", yunits, LEN_WCSNAME)
+	    case CTYPE_SUPERGALACTIC:
+	        call strcpy ("SLon", xunits, LEN_WCSNAME)
+	        call strcpy ("SLat", yunits, LEN_WCSNAME)
+	    }
+	} else if (SYSTEMS(wp,line) == SYS_SKY) {
+	    call strcpy (WCSNAME(wp,line), wcsname, LEN_WCSNAME)
+	    call strlwr (wcsname)
+	    if (strcmp (wcsname,"ecliptic") == 0) {
+	        call strcpy ("ELon", xunits, LEN_WCSNAME)
+	        call strcpy ("ELat", yunits, LEN_WCSNAME)
+	    } else if (strcmp (wcsname,"galactic") == 0) {
+	        call strcpy ("GLon", xunits, LEN_WCSNAME)
+	        call strcpy ("GLat", yunits, LEN_WCSNAME)
+	    } else if (strcmp (wcsname,"supergalactic") == 0) {
+	        call strcpy ("SLon", xunits, LEN_WCSNAME)
+	        call strcpy ("SLat", yunits, LEN_WCSNAME)
+	    } else {
+	        call strcpy ("  RA", xunits, LEN_WCSNAME)
+	        call strcpy (" Dec", yunits, LEN_WCSNAME)
+	    }
+	} else {
+	    call strcpy ("X", xunits, LEN_WCSNAME)
+	    call strcpy ("Y", yunits, LEN_WCSNAME)
+	}
+
+
+	# Now get the format strings.  For systems other than the image 
+	# default just use the WCS string as the name, otherwise format a
+	# string giving more information about the system.
+	if (SYSTEMS(wp,line) != SYS_WORLD)
+	    call strcpy (WCSNAME(wp,line), wcsname, LEN_WCSNAME)
+
+	else {
+	    call smark (sp)
+	    call salloc (radecstr, SZ_FNAME, TY_CHAR)
+	    call salloc (proj, SZ_FNAME, TY_CHAR)
+
+	    call sprintf (wcsname, LEN_WCSNAME, "%s-%s-%s")
+
+	    switch (sk_stati(co,S_CTYPE)) {
+	    case CTYPE_EQUATORIAL:      call pargstr ("EQ")
+	    case CTYPE_ECLIPTIC:        call pargstr ("ECL")
+	    case CTYPE_GALACTIC:        call pargstr ("GAL")
+	    case CTYPE_SUPERGALACTIC:   call pargstr ("SGAL")
+	    default:                    call pargstr ("UNKN")
+	    }
+
+            if (sk_stati(co,S_CTYPE) == CTYPE_EQUATORIAL) {
+                if (idxstr(sk_stati(co,S_RADECSYS), Memc[radecstr], 
+                    SZ_FNAME, EQTYPE_LIST) <= 0)
+                        call strcpy ("FK5", Memc[radecstr], SZ_FNAME)
+                call strupr (Memc[radecstr])
+                call pargstr (Memc[radecstr])
+            } else {
+                if (sk_stati(co,S_CTYPE) == CTYPE_SUPERGALACTIC)
+                    call pargstr ("-")
+                else
+                    call pargstr ("--")
+            }
+
+            if (idxstr(sk_stati(co,S_WTYPE), Memc[proj], SZ_FNAME,
+		WTYPE_LIST) <= 0)
+                    call strcpy ("linear", Memc[proj], SZ_FNAME)
+            call strupr (Memc[proj])
+            call pargstr (Memc[proj])
+
+	    call sfree (sp)
+	}
+
+	# Now fix up the WCS system name.
+	if (strcmp (wcsname, "fk4") == 0 ||
+	    strcmp (wcsname, "fk5") == 0 ||
+	    strcmp (wcsname, "icrs") == 0 ||
+	    strcmp (wcsname, "gappt") == 0 ||
+	    strcmp (wcsname, "fk4-no-e") == 0) {
+		call strupr (wcsname)
+
+	} else if (IS_LOWER(wcsname[1]))
+	    wcsname[1] = TO_UPPER(wcsname[1])
+end
+
+
+# IMG_COORD_FMT --  Format the coordinate strings.
+
+procedure img_coord_fmt (cp, line, xval, yval, xc, yc)
+
+pointer	cp					#i object cache pointer
+int	line					#i output line number
+double	xval, yval				#i input coords
+char	xc[ARB], yc[ARB]			#o formatted coord strings
+
+pointer	img, co, wp
+char	xfmt[LEN_WCSNAME], yfmt[LEN_WCSNAME]
+
+int	sk_stati()
+bool	streq()
+
+begin
+	img = C_DATA(cp)			# initialize ptrs
+	co  = IMG_CO(img)
+	wp  = IMG_WP(img)
+
+	# Convert coords to the requested format.
+	if (FORMATS(wp,line) == FMT_DEFAULT) {
+	    if (IMG_MW(img) == NULL) {
+	        call strcpy ("%10.2f", xfmt, LEN_WCSNAME)
+	        call strcpy ("%10.2f", yfmt, LEN_WCSNAME)
+	    } else {
+	        if (SYSTEMS(wp,line) == SYS_WORLD ||
+		    SYSTEMS(wp,line) == SYS_SKY) {
+
+	            if (streq(WCSNAME(wp,line),"ecliptic") ||
+	                streq(WCSNAME(wp,line),"galactic") ||
+	                streq(WCSNAME(wp,line),"supergalactic"))
+	                    call strcpy ("%h", xfmt, LEN_WCSNAME)
+	            else
+	                call strcpy ("%.2H", xfmt, LEN_WCSNAME)
+	            call strcpy ("%.1h", yfmt, LEN_WCSNAME)
+	        } else {
+	            call strcpy ("%10.2f", xfmt, LEN_WCSNAME)
+	            call strcpy ("%10.2f", yfmt, LEN_WCSNAME)
+	        }
+	    }
+
+	} else if (FORMATS(wp,line) == FMT_HMS) {
+	    if (sk_stati(co, S_CTYPE) == CTYPE_EQUATORIAL)
+	        call strcpy ("%.2H", xfmt, LEN_WCSNAME)
+	    else
+	        call strcpy ("%.1h", xfmt, LEN_WCSNAME)
+	    call strcpy ("%h", yfmt, LEN_WCSNAME)
+	} else {
+	    call strcpy ("%10.2f", xfmt, LEN_WCSNAME)
+	    call strcpy ("%10.2f", yfmt, LEN_WCSNAME)
+	}
+
+	# Convert the value to the requested format
+        call sprintf (xc, LEN_WCSNAME, xfmt)
+	    if (FORMATS(wp,line) != FMT_RAD)
+	        call pargd (xval)
+	    else
+	        call pargd (DEGTORAD(xval))
+
+        call sprintf (yc, LEN_WCSNAME, yfmt)
+	    if (FORMATS(wp,line) != FMT_RAD)
+	        call pargd (yval)
+	    else
+	        call pargd (DEGTORAD(yval))
+end
+
+
+# IMG_GET_COORD -- Given an x,y position in the image return the coordinate in
+# the given system.
+
+procedure img_get_coord (img, x, y, system, wcsname, wx, wy)
+
+pointer	img					#i IMG struct pointer
+double	x, y					#i input image position
+int	system					#i coordinate system requested
+char	wcsname[ARB]				#i desired WCS name
+double	wx, wy					#o output coordinates
+
+double 	ox, oy, tmp
+real 	epoch
+pointer	im, co, nco
+char	buf[SZ_LINE]
+int	stat
+
+real	imgetr()
+int	imaccf(), sk_stati(), sk_decwstr()
+bool	streq()
+
+errchk imgetr
+
+begin	
+	im  = IMG_IM(img)
+	co  = IMG_CO(img)
+
+	wx = x					# fallback values
+	wy = y
+
+	switch (system) {
+	case SYS_NONE:
+	    wx = x
+	    wy = y
+	case SYS_DISPLAY:
+	    call img_ltov (im, x, y, wx, wy)
+	    #wx = x
+	    #wy = y
+	case SYS_PHYSICAL:
+            if (IMG_CTP(img) != NULL)
+                call mw_c2trand (IMG_CTP(img), x, y, wx, wy)
+	case SYS_WORLD:
+            if (IMG_CTW(img) != NULL) {
+                call mw_c2trand (IMG_CTW(img), x, y, wx, wy)
+
+		# Check for transposed image.
+	        if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) {
+	            tmp = wx 			
+	            wx  = wy
+	            wy  = tmp
+	        }
+	    }
+	case SYS_AMP:
+            if (IMG_CTA(img) != NULL)
+                call mw_c2trand (IMG_CTA(img), x, y, wx, wy)
+	case SYS_CCD:
+            if (IMG_CTD(img) != NULL)
+                call mw_c2trand (IMG_CTD(img), x, y, wx, wy)
+	case SYS_DETECTOR:
+            if (IMG_CTD(img) != NULL)
+                call mw_c2trand (IMG_CTD(img), x, y, wx, wy)
+	case SYS_SKY:
+	    # Note Ecliptic/GAPPT coords need an epoch value.
+	    if (imaccf (im, "EPOCH") == YES) {
+	        epoch = imgetr (im, "EPOCH")
+	        if (epoch == 0.0 || IS_INDEFR(epoch))
+	            epoch = 1950.0
+	    } else
+	        epoch = 1950.0
+
+	    if (streq (wcsname, "ecliptic") || streq (wcsname, "gappt")) {
+		call sprintf (buf, SZ_LINE, "%s %.1f")
+		    if (streq (wcsname, "gappt"))
+		        call pargstr ("apparent")
+		    else
+		        call pargstr (wcsname)
+		    call pargr (epoch)
+	    } else {
+		call sprintf (buf, SZ_LINE, "%s")
+		    if (streq(wcsname,"gappt"))
+		        call pargstr ("apparent")
+		    else if (streq(wcsname,"fk4-no-e"))
+		        call pargstr ("noefk4")
+		    else
+		        call pargstr (wcsname)
+	    }
+
+	    stat = sk_decwstr (buf, nco, co)
+	    if (stat != ERR) {
+        	if (IMG_CTW(img) != NULL)
+        	    call mw_c2trand (IMG_CTW(img), x, y, ox, oy)
+	   	call sk_lltran (co, nco, DEGTORAD(ox), DEGTORAD(oy),
+		    INDEFD, INDEFD, 0.0d0, 0.0d0, wx, wy)
+		if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) {
+		    wx = RADTODEG(wy) 		# transposed image
+		    wy = RADTODEG(wx)
+		} else {
+		    wx = RADTODEG(wx)		# regular image
+		    wy = RADTODEG(wy)
+		}
+	    } else {
+	        wx = x
+	        wy = y
+	    }
+	case SYS_OTHER:
+	    ;					# TBD
+
+	default: 				# default coords
+	    wx = x
+	    wy = y
+	}
+end
+
+
+# IMG_LTOV -- Convert coordinate from the logical coordinate system to the
+# output coordinate system.
+
+procedure img_ltov (im, xin, yin, xout, yout)
+
+pointer	im			# the input image descriptor
+double	xin			# the input x coordinate
+double	yin			# the input y coordinate
+double	xout			# the output x coordinate 
+double	yout			# the output y coordinate
+
+int	index1, index2
+
+begin
+	index1 = IM_VMAP(im,1)
+	index2 = IM_VMAP(im,2)
+
+	xout = xin * IM_VSTEP(im,index1) + IM_VOFF(im,index1)
+	yout = yin * IM_VSTEP(im,index2) + IM_VOFF(im,index2)
+end
+
+
+# IMG_VTOL -- Convert coordinate from the tv coordinate system to the
+# logical coordinate system.
+
+procedure img_vtol (im, xin, yin, xout, yout)
+
+pointer	im			# the input image descriptor
+double	xin     		# the input x coordinate
+double	yin     		# the input y coordinate
+double	xout     		# the output x coordinate 
+double	yout     		# the output y coordinate
+
+int	index1, index2
+
+begin
+	index1 = IM_VMAP(im,1)
+	index2 = IM_VMAP(im,2)
+
+	xout = (xin - IM_VOFF(im,index1)) / IM_VSTEP(im,index1)
+	yout = (yin - IM_VOFF(im,index2)) / IM_VSTEP(im,index2)
+end
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcmef.x b/vendor/x11iraf/ximtool/clients/wcspix/wcmef.x
new file mode 100644
index 00000000..050e5596
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/wcmef.x
@@ -0,0 +1,50 @@
+#  Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "wcspix.h"
+
+
+# MEF Image class data.
+
+
+# MEF_INIT --  Initialize the MEF Class module.
+
+procedure mef_init ()
+begin
+end
+
+
+# MEF_CACHE --  Cache an image in the object cache.
+
+procedure mef_cache ()
+begin
+end
+
+
+# MEF_UNCACHE --  Uncache an image in the object cache.
+
+procedure mef_uncache ()
+begin
+end
+
+
+# MEF_WCSTRAN -- Translate object source (x,y) coordinates to the
+# desired output WCSs.
+
+procedure mef_wcstran ()
+begin
+end
+
+
+# MEF_WCSLIST -- List the WCSs available for the given image.
+
+procedure mef_wcslist ()
+begin
+end
+
+
+# MEF_OBJINFO -- Get header information from the image.
+
+procedure mef_objinfo ()
+begin
+end
+
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcmspec.x b/vendor/x11iraf/ximtool/clients/wcspix/wcmspec.x
new file mode 100644
index 00000000..64198d69
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/wcmspec.x
@@ -0,0 +1,50 @@
+#  Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "wcspix.h"
+
+
+# Multispec image class data.
+
+
+# MSP_INIT --  Initialize the Image Class module.
+
+procedure msp_init ()
+begin
+end
+
+
+# MSP_CACHE --  Cache an image in the object cache.
+
+procedure msp_cache ()
+begin
+end
+
+
+# MSP_UNCACHE --  Uncache an image in the object cache.
+
+procedure msp_uncache ()
+begin
+end
+
+
+# MSP_WCSTRAN -- Translate object source (x,y) coordinates to the
+# desired output WCSs.
+
+procedure msp_wcstran ()
+begin
+end
+
+
+# MSP_WCSLIST -- List the WCSs available for the given image.
+
+procedure msp_wcslist ()
+begin
+end
+
+
+# MSP_OBJINFO -- Get header information from the image.
+
+procedure msp_objinfo ()
+begin
+end
+
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcspix.h b/vendor/x11iraf/ximtool/clients/wcspix/wcspix.h
new file mode 100644
index 00000000..0233ff21
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/wcspix.h
@@ -0,0 +1,112 @@
+# WCSPIX.H -- Include file for the WCS/Pixel value ISM task
+
+define	WCSPIX_NAME	"wcspix"
+define	WCSPIX_MODE	"text"
+define	WCSPIX_CONNECT	"unix:/tmp/.ISM%d"
+
+define	WCSPIX_DBG	FALSE
+
+# Main task data structures.
+define  MAX_WCSLINES	4			# max WCS output lines
+define	LEN_PIXTAB	81			# size of pixel table
+define	LEN_WCSNAME	32			# size of a WCS name
+
+define  SZ_WCSPIX       7
+define  WP_CPTR         Memi[$1  ]              # object cache pointer
+define  WP_PTABSZ       Memi[$1+1]              # pixel table size
+define  WP_BPM       	Memi[$1+2]              # get BPM data
+define  WP_SYSTEMS      Memi[$1+3]              # WCS readout systems
+define  WP_WCS      	Memi[$1+4]              # WCS system string
+define  WP_FORMATS      Memi[$1+5]              # WCS readout formats
+define  WP_DBGLEVEL     Memi[$1+6]              # debug level
+
+define  OBJCACHE   Memi[WP_CPTR($1)+$2]		# object cache
+define  SYSTEMS    Memi[WP_SYSTEMS($1)+$2-1]
+define  FORMATS    Memi[WP_FORMATS($1)+$2-1]
+define  WCSNAME    Memc[WP_WCS($1)+(LEN_WCSNAME*($2-1))]
+
+
+# Element of an object cache.
+define  SZ_CACHE        256                     # size of object cache
+define  SZ_CNODE        135                     # size of a cache node
+define  SZ_OBJREF       128                     # size of a object reference
+
+define  C_OBJID         Memi[$1]                # object id
+define  C_REGID         Memi[$1+1]              # region id
+define  C_CLASS         Memi[$1+2]              # object class
+define  C_DATA          Memi[$1+3]              # object data ptr
+define  C_NREF          Memi[$1+4]		# no. times object referenced
+define  C_REF           Memc[P2C($1+6)]         # object reference file
+
+
+# WCSPIX ISM task methods.
+define	WCSPIX_CMDS	"|set|get|quit|initialize|cache|uncache\
+			 |wcstran|wcslist|objinfo|debug"
+
+define	SET		 1
+define	GET		 2
+define	QUIT		 3
+define	INITIALIZE	 4
+define	CACHE		 5
+define	UNCACHE		 6
+define	WCSTRAN		 7
+define	WCSLIST		 8
+define	OBJINFO	 	 9
+define	DEBUG		10
+
+# Parameters definable from the GUI
+define	SZ_PARAM	32			# size of a parameter string
+
+define WCSPIX_SYSTEMS  "|none|display|logical|physical|world|sky\
+			|amplifier|ccd|detector|other|"
+define  SYS_NONE	1			# no coords requested
+define  SYS_DISPLAY	2			# image display coords
+define  SYS_LOGICAL	3			# logical coords
+define  SYS_PHYSICAL	4			# physical coords
+define  SYS_WORLD	5			# world coords
+define  SYS_SKY		6			# sky coords
+define  SYS_AMP		7			# amplifier coords
+define  SYS_CCD		8			# CCD coords
+define  SYS_DETECTOR	9			# detector coords
+define  SYS_OTHER	10			# ??? coords
+
+define  SKYPROJ "FK5 FK4 ICRS GAPPT FK4-NO-E Ecliptic Galactic Supergalactic"
+
+
+define  WCSPIX_PARAMS	"|psize|bpm|wcs|format|"
+define  PAR_PSIZE	1			# pixel table size
+define  PAR_BPM		2			# get BPM data
+define  PAR_WCS		3			# WCS system
+define  PAR_FMT		4			# WCS format
+
+define	WCSPIX_FMT	"|default|hms|degrees|radians|"
+define  FMT_DEFAULT	1			# no formatting
+define  FMT_HMS		2			# covert to sexigesimal
+define  FMT_DEG		3			# output degrees
+define  FMT_RAD		4			# output radians
+
+define  DEF_PTABSZ	0			# default pixtable size
+define  DEF_FMT		FMT_DEFAULT		# default output format
+define  DEF_SYSTEM	SYS_LOGICAL		# default coord system
+define  DEF_BPM_FLAG	NO			# default get-BPM-data flag
+
+
+# Object class definitions.
+define	UNKNOWN_CLASS	1			# unknown class
+define	IMAGE_CLASS	2			# generic image class
+define	MEF_CLASS	3			# Mosaic MEF image class
+define	MULTISPEC_CLASS	4			# multispec data class
+
+# Class methods.
+define	LEN_CLASS	6			# length of class table
+define	MAX_CLASSES	16			# max supported classes
+define	SZ_CLNAME	32			# size of a class name
+
+define	CL_INIT		cl_table[1,$1]		# class initializer
+define	CL_CACHE	cl_table[2,$1]		# cache the object
+define	CL_UNCACHE	cl_table[3,$1]		# uncache the object
+define	CL_WCSTRAN	cl_table[4,$1]		# WCS tranformations
+define	CL_WCSLIST	cl_table[5,$1]		# list available WCS
+define	CL_OBJINFO	cl_table[6,$1]		# get object header
+define	CL_NAME		cl_names[1,$1]		# class name
+
diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcunknown.x b/vendor/x11iraf/ximtool/clients/wcspix/wcunknown.x
new file mode 100644
index 00000000..86e5e6d8
--- /dev/null
+++ b/vendor/x11iraf/ximtool/clients/wcspix/wcunknown.x
@@ -0,0 +1,185 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include "wcspix.h"
+
+
+# Unknown class data.
+define  LEN_UNKDATA     1
+define  UNK_WP          Memi[$1  ]              # wcspix back-pointer
+
+
+# UNK_INIT --  Initialize the object structure.
+
+procedure unk_init (cp, wp)
+
+pointer	cp					#i cache pointer
+pointer	wp					#i WCSPIX structure
+
+begin
+	# Allocate the image data structure if not previously allocated.
+	if (C_DATA(cp) == NULL) {
+	    iferr (call calloc (C_DATA(cp), LEN_UNKDATA, TY_STRUCT))
+	        return
+	}
+
+	UNK_WP(C_DATA(cp)) = wp
+end
+
+
+# UNK_CACHE --  Cache an image in the object cache.  Since we don't know
+# what this is we simply setup so that a query to the object id will still
+# return a result of some kind rather than ignore it.  In most cases this
+# just means the input arguments are echoed back (e.g. coords), or default
+# values such as a rotation value can be retrieved.
+
+procedure unk_cache (cp, objid, regid, ref)
+
+pointer	cp					#i cache pointer
+int	objid					#i object id
+int	regid					#i region id
+char	ref[ARB]				#i object reference
+
+begin
+	C_OBJID(cp) = objid
+	C_REGID(cp) = regid
+	C_NREF(cp)  = C_NREF(cp) + 1
+	call strcpy (ref, C_REF(cp), 128)
+end
+
+
+# UNK_UNCACHE --  Uncache an unknown image in the object cache.
+
+procedure unk_uncache (cp, id)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+
+begin
+	C_OBJID(cp) = NULL
+	C_NREF(cp)  = 0
+	call strcpy ("", C_REF(cp), SZ_FNAME)
+
+	call mfree (C_DATA(cp), TY_STRUCT)
+	C_DATA(cp)  = NULL
+end
+
+
+# UNK_WCSTRAN -- Translate object source (x,y) coordinates to the
+# desired output WCSs.  Message is returned as something like:
+#
+#        set value {
+#            { object <objid> }  { region <regionid> }
+#            { pixval <pixelvalue> [<units>] }
+#            { coord <wcsname> <x> <y> [<xunits> <yunits>] }
+#            { coord <wcsname> <x> <y> [<xunits> <yunits>] }
+#        }
+
+
+procedure unk_wcstran (cp, id, x, y)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+real	x, y					#i source coords
+
+pointer wp
+int     i
+
+# Use static storage to avoid allocation overhead.
+char	buf[SZ_LINE], msg[SZ_LINE]
+
+begin
+	wp  = UNK_WP(C_DATA(cp))
+
+	# Begin formatting the message.
+	call aclrc (msg, SZ_LINE)
+	call sprintf (msg, SZ_LINE, "wcstran { object %d } { region %d } ")
+	    call pargi (C_OBJID(cp))
+	    call pargi (C_REGID(cp))
+	call strcat ("{ pixval 0.0 } { bpm 0 } \n", msg, SZ_LINE)
+
+
+	# Now loop over the requested systems and generate a coordinate
+	# for each.
+	for (i=1; i <= MAX_WCSLINES; i=i+1) {
+
+	    # Format the coord buffer and append it to the message.
+	    call sprintf (buf, SZ_LINE, "{coord {%9s} {%12g} {%12g} {X} {Y}}\n")
+	        call pargstr ("UNKN")
+	        call pargr (x)
+	        call pargr (y)
+	    call strcat (buf, msg, SZ_LINE)
+	}
+
+	# Now send the completed message.
+	call wcspix_message (msg)
+end
+
+
+# UNK_WCSLIST -- List the WCSs available for the given image.
+
+procedure unk_wcslist (cp, id)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+
+begin
+	#call wcspix_message ("wcslist {None Logical}")
+end
+
+
+# UNK_GETDATA -- Get data from the image.
+
+procedure unk_getdata (cp, id, x, y, pixval)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+real	x, y					#i source coords
+real	pixval					#o central pixel value
+
+pointer wp, pix
+int     size, x1, x2, y1, y2
+
+begin
+	wp = UNK_WP(C_DATA(cp))
+	size = WP_PTABSZ(wp)
+
+	# Compute the box offset given the center and size.
+	x1 = x - size / 2 + 0.5
+	x2 = x + size / 2 + 0.5
+	y1 = y - size / 2 + 0.5
+	y2 = y + size / 2 + 0.5
+
+	pixval = 0.0
+
+	# Send the pixel table.
+	if (size > 1) {
+	    call calloc (pix, size *  size, TY_REAL)
+	    call img_send_pixtab (Memr[pix], size, x1, x2, y1, y2)
+	    call mfree (pix, TY_REAL)
+	}
+end
+
+
+# UNK_OBJINFO -- Get header information from the image.
+
+procedure unk_objinfo (cp, id, template)
+
+pointer	cp					#i cache pointer
+int	id					#i image id
+char	template[ARB]				#i keyword template
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	# Send a default (X,Y) compass indicator.
+	call aclrc (Memc[buf], SZ_LINE)
+	call sprintf (Memc[buf], SZ_LINE, "compass %d 0.0 -1 1 0 X Y\0")
+	    call pargi (C_OBJID(cp))
+	call wcspix_message (Memc[buf])
+
+	call sfree (sp)
+end