Repatch (from linux) of OSX IRAF

1 files changed, 394 insertions, 0 deletions

diff --git a/pkg/images/tv/tvmark/mkcolon.x b/pkg/images/tv/tvmark/mkcolon.x
new file mode 100644
index 00000000..e4dfe01a
--- /dev/null
+++ b/pkg/images/tv/tvmark/mkcolon.x
@@ -0,0 +1,394 @@
+include <imhdr.h>
+include <error.h>
+include <fset.h>
+include "tvmark.h"
+
+# MK_COLON -- Procedure to process immark colon commands.
+
+procedure mk_colon (mk, cmdstr, im, iw, sim, log, cl, ltid, dl)
+
+pointer	mk		# pointer to the immark structure
+char	cmdstr[ARB]	# command string
+pointer	im		# pointer to the frame buffer
+pointer	iw		# pointer to the wcs information
+pointer	sim		# pointer to a scratch image
+int	log		# log file descriptor
+int	cl		# coords file descriptor
+int	ltid		# coords file sequence number
+int	dl		# deletions file descriptor
+
+bool	bval
+real	rval
+pointer	sp, cmd, str, outim, deletions, ext
+int	ncmd, mark, font, ival, ip, nchars, wcs_status
+
+real	mk_statr()
+bool	itob(), streq()
+pointer	immap(), imd_mapframe(), iw_open()
+int	open(), strdic(), nscan(), mk_stati(), btoi(), ctowrd()
+errchk	imd_mapframe(), iw_open(), immap(), imunmap(), open()
+
+begin
+	# Allocate some working memory.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (deletions, SZ_FNAME, TY_CHAR)
+	call salloc (ext, SZ_FNAME, TY_CHAR)
+
+	# Get the command.
+	ip = 1
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	if (Memc[cmd] == EOS) {
+	    call sfree (sp)
+	    return
+	}
+
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, MKCMDS)
+	switch (ncmd) {
+	case MKCMD_IMAGE:
+
+	case MKCMD_OUTIMAGE:
+	    call gargstr (Memc[cmd], SZ_LINE)
+	    call mk_stats (mk, OUTIMAGE, Memc[str], SZ_FNAME)
+	    if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) {
+		call printf ("%s:  %s\n")
+		    call pargstr (KY_OUTIMAGE)
+		    call pargstr (Memc[str])
+	    } else {
+		nchars = ctowrd (Memc[cmd], ip, Memc[str], SZ_LINE)
+		call mk_sets (mk, OUTIMAGE, Memc[str])
+	    }
+
+	case MKCMD_DELETIONS:
+	    call gargstr (Memc[cmd], SZ_LINE)
+	    call mk_stats (mk, DELETIONS, Memc[str], SZ_FNAME)
+	    if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) {
+		call printf ("%s:  %s\n")
+		    call pargstr (KY_DELETIONS)
+		    call pargstr (Memc[str])
+	    } else {
+		nchars = ctowrd (Memc[cmd], ip, Memc[str], SZ_LINE)
+		call mk_sets (mk, DELETIONS, Memc[str])
+	    }
+
+	case MKCMD_SNAP:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS) {
+		call mk_stats (mk, OUTIMAGE, Memc[str], SZ_FNAME)
+		if (Memc[str] == EOS)
+		    call mk_stats (mk, IMAGE, Memc[str], SZ_FNAME)
+		call mk_imname (Memc[str], "", "snap", Memc[cmd], SZ_FNAME)
+	    }
+
+	    iferr {
+		outim = immap (Memc[cmd], NEW_COPY, im)
+		call printf ("Creating image: %s - ")
+		    call pargstr (Memc[cmd])
+		call flush (STDOUT)
+		call mk_imcopy (im, outim)
+		call imunmap (outim)
+	    } then {
+		call printf ("\n")
+		call erract (EA_WARN)
+	    } else {
+		call printf ("done\n")
+	    }
+
+	case MKCMD_COORDS:
+	    call gargstr (Memc[cmd], SZ_LINE)
+	    call mk_stats (mk, COORDS, Memc[str], SZ_FNAME)
+	    if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) {
+		call printf ("%s:  %s\n")
+		    call pargstr (KY_COORDS)
+		    call pargstr (Memc[str])
+	    } else {
+		nchars = ctowrd (Memc[cmd], ip, Memc[str], SZ_LINE)
+		if (cl != NULL) {
+		    call close( cl)
+		    call close (dl)
+		    cl = NULL
+		    dl = NULL
+		}
+		iferr {
+		    if (Memc[str] != EOS) {
+		        iferr (cl = open (Memc[str], READ_WRITE, TEXT_FILE)) {
+			    cl = open (Memc[str], NEW_FILE, TEXT_FILE)
+			    call close (cl)
+			    cl = open (Memc[str], READ_WRITE, TEXT_FILE)
+			    call mk_stats (mk, DELETIONS, Memc[ext], SZ_FNAME)
+			    call sprintf (Memc[deletions], SZ_FNAME, "%s.%s")
+				call pargstr (Memc[str])
+			    if (Memc[ext] == EOS)
+				call pargstr ("del")
+			    else
+				call pargstr (Memc[ext])
+			}
+		    }
+		} then {
+		    cl = NULL
+		    dl = NULL
+		    call erract (EA_WARN)
+		    call mk_sets (mk, COORDS, "")
+		} else {
+		    call mk_sets (mk, COORDS, Memc[str])
+		}
+		ltid = 0
+	    }
+
+	case MKCMD_LOGFILE:
+	    call gargstr (Memc[cmd], SZ_LINE)
+	    call mk_stats (mk, LOGFILE, Memc[str], SZ_FNAME)
+	    if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) {
+		call printf ("%s:  %s\n")
+		    call pargstr (KY_LOGFILE)
+		    call pargstr (Memc[str])
+	    } else {
+		nchars = ctowrd (Memc[cmd], ip, Memc[str], SZ_LINE)
+		if (log != NULL) {
+		    call close (log)
+		    log = NULL
+		}
+		iferr {
+		    if (Memc[str] != EOS)
+		        log = open (Memc[str], NEW_FILE, TEXT_FILE)
+		} then {
+		    log = NULL
+		    call erract (EA_WARN)
+		    call mk_sets (mk, LOGFILE, "")
+		    call printf ("Log file is undefined.\n")
+		} else
+		    call mk_sets (mk, LOGFILE, Memc[str])
+	    }
+
+	case MKCMD_AUTOLOG:
+	    call gargb (bval)
+	    if (nscan () == 1) {
+		call printf ("%s = %b\n")
+		    call pargstr (KY_AUTOLOG)
+		    call pargb (itob (mk_stati (mk, AUTOLOG)))
+	    } else
+		call mk_seti (mk, AUTOLOG, btoi (bval))
+
+	case MKCMD_FRAME:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("%s = %g\n")
+		    call pargstr (KY_FRAME)
+		    call pargi (mk_stati (mk, FRAME))
+	    } else if (ival != mk_stati (mk, FRAME)) {
+		call iw_close (iw)
+		call imunmap (im)
+		iferr {
+		    im = imd_mapframe (ival, READ_WRITE, YES)
+		    iw = iw_open (im, ival, Memc[str], SZ_FNAME, wcs_status)
+		    call mk_sets (mk, IMAGE, Memc[str])
+		} then {
+		    call erract (EA_WARN)
+		    im = imd_mapframe (mk_stati(mk,FRAME), READ_WRITE, YES)
+		    iw = iw_open (im, mk_stati(mk,FRAME),
+			Memc[str], SZ_FNAME, wcs_status)
+		    call mk_sets (mk, IMAGE, Memc[str])
+		} else 
+		    call mk_seti (mk, FRAME, ival)
+	    }
+
+	case MKCMD_FONT:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS) {
+	        call mk_stats (mk, FONT, Memc[cmd], SZ_LINE)
+	        call printf ("%s = %s\n")
+		    call pargstr (KY_FONT)
+		    call pargstr (Memc[cmd])
+	    } else {
+		font = strdic (Memc[cmd], Memc[cmd], SZ_LINE, MKFONTLIST)
+		if (font > 0)
+		    call mk_sets (mk, FONT, Memc[cmd])
+	    }
+
+	case MKCMD_LABEL:
+	    call gargb (bval)
+	    if (nscan () == 1) {
+		call printf ("%s = %b\n")
+		    call pargstr (KY_LABEL)
+		    call pargb (itob (mk_stati (mk, LABEL)))
+	    } else
+		call mk_seti (mk, LABEL, btoi (bval))
+
+	case MKCMD_NUMBER:
+	    call gargb (bval)
+	    if (nscan () == 1) {
+		call printf ("%s = %b\n")
+		    call pargstr (KY_NUMBER)
+		    call pargb (itob (mk_stati (mk, NUMBER)))
+	    } else
+		call mk_seti (mk, NUMBER, btoi (bval))
+
+	case MKCMD_NXOFFSET:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("%s = %g\n")
+		    call pargstr (KY_NXOFFSET)
+		    call pargi (mk_stati (mk, NXOFFSET))
+	    } else
+		call mk_seti (mk, NXOFFSET, ival)
+
+	case MKCMD_NYOFFSET:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("%s = %g\n")
+		    call pargstr (KY_NYOFFSET)
+		    call pargi (mk_stati (mk, NYOFFSET))
+	    } else
+		call mk_seti (mk, NYOFFSET, ival)
+
+	case MKCMD_GRAYLEVEL:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("%s = %d\n")
+		    call pargstr (KY_GRAYLEVEL)
+		    call pargi (mk_stati (mk, GRAYLEVEL))
+	    } else
+		call mk_seti (mk, GRAYLEVEL, ival)
+
+	case MKCMD_SZPOINT:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("%s = %d\n")
+		    call pargstr (KY_SZPOINT)
+		    call pargi (2 * mk_stati (mk, SZPOINT) + 1)
+	    } else {
+		if (mod (ival, 2) == 0)
+		    ival = ival + 1
+		ival = ival / 2
+		call mk_seti (mk, SZPOINT, ival)
+	    }
+
+	case MKCMD_SIZE:
+	    call gargi (ival)
+	    if (nscan () == 1) {
+		call printf ("%s = %d\n")
+		    call pargstr (KY_SIZE)
+		    call pargi (mk_stati (mk, SIZE))
+	    } else
+		call mk_seti (mk, SIZE, ival)
+
+	case MKCMD_TOLERANCE:
+	    call gargr (rval)
+	    if (nscan () == 1) {
+		call printf ("%s = %g\n")
+		    call pargstr (KY_TOLERANCE)
+		    call pargr (mk_statr (mk, TOLERANCE))
+	    } else
+		call mk_setr (mk, TOLERANCE, rval)
+
+	case MKCMD_MARK:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS) {
+	        call mk_stats (mk, MARK, Memc[cmd], SZ_LINE)
+	        call printf ("%s = %s\n")
+		    call pargstr (KY_MARK)
+		    call pargstr (Memc[cmd])
+	    } else {
+		mark = strdic (Memc[cmd], Memc[cmd], SZ_LINE, MKTYPELIST)
+		if (mark > 0) {
+		    call mk_seti (mk, MKTYPE, mark)
+		    call mk_sets (mk, MARK, Memc[cmd])
+		}
+	    }
+
+	case MKCMD_CIRCLES:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS) {
+	        call mk_stats (mk, CSTRING, Memc[cmd], SZ_LINE)
+	        call printf ("%s = %s %s\n")
+		    call pargstr (KY_CIRCLES)
+		    if (Memc[cmd] == EOS)
+			call pargstr ("0")
+		    else
+		        call pargstr (Memc[cmd])
+		    call pargstr ("pixels")
+	    } else
+		call mk_sets (mk, CSTRING, Memc[cmd])
+
+	case MKCMD_RECTANGLES:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    call gargr (rval)
+	    if (Memc[cmd] == EOS) {
+	        call mk_stats (mk, RSTRING, Memc[cmd], SZ_LINE)
+	        call printf ("%s = %s %g\n")
+		    call pargstr (KY_RECTANGLE)
+		    if (Memc[cmd] == EOS)
+			call pargstr ("0")
+		    else
+		        call pargstr (Memc[cmd])
+		    call pargr (mk_statr (mk, RATIO))
+	    } else {
+		call mk_sets (mk, RSTRING, Memc[cmd])
+		if (nscan () < 3)
+		    call mk_setr (mk, RATIO, 1.0)
+		else
+		    call mk_setr (mk, RATIO, rval)
+	    }
+
+	case MKCMD_SHOW:
+	    call mk_show (mk)
+
+	case MKCMD_SAVE:
+	    iferr {
+
+		# Check that the sizes agree.
+		if (sim == NULL) {
+		    call mktemp ("scratch", Memc[cmd], SZ_FNAME)
+		    sim = immap (Memc[cmd], NEW_COPY, im)
+		} else if (IM_LEN(im,1) != IM_LEN(sim,1) || IM_LEN(im,2) !=
+		    IM_LEN(sim,2)) {
+		    call strcpy (IM_HDRFILE(sim), Memc[cmd], SZ_FNAME)
+		    call imunmap (sim)
+		    call imdelete (Memc[cmd])
+		    call mktemp ("scratch", Memc[cmd], SZ_FNAME)
+		    sim = immap (Memc[cmd], NEW_COPY, im)
+		}
+
+		# Copy the image.
+		call printf ("Saving frame: %d - ")
+		    call pargi (mk_stati (mk, FRAME))
+		call flush (STDOUT)
+		call mk_imcopy (im, sim)
+
+	    } then {
+		call erract (EA_WARN)
+		call printf ("\n")
+	    } else {
+		call printf ("done\n")
+	    }
+
+	case MKCMD_RESTORE:
+	    if (sim == NULL) {
+		call printf ("Use :save to define a scratch image.\n")
+	    } else if (IM_LEN(sim,1) != IM_LEN(im,1) || IM_LEN(sim,2) !=
+	        IM_LEN(im,2)) {
+		call printf (
+		    "Scatch image and the frame buffer have different sizes.\n")
+	    } else {
+	        iferr {
+		    call printf ("Restoring frame: %d - ")
+		        call pargi (mk_stati (mk, FRAME))
+		    call flush (STDOUT)
+		    call mk_imcopy (sim, im)
+	        } then {
+		    call erract (EA_WARN)
+		    call printf ("\n")
+	        } else {
+		    call printf ("done\n")
+	        }
+	    }
+	    
+
+	default:
+	    call printf ("Unrecognized or ambiguous colon command.\7\n")
+	}
+
+	call sfree (sp)
+end