Repatch (from linux) of OSX IRAF

4 files changed, 296 insertions, 0 deletions

diff --git a/noao/digiphot/ptools/ptutils/mkpkg b/noao/digiphot/ptools/ptutils/mkpkg
new file mode 100644
index 00000000..3c3dc1bb
--- /dev/null
+++ b/noao/digiphot/ptools/ptutils/mkpkg
@@ -0,0 +1,12 @@
+# miscellaneous useful tasks
+
+$checkout libpkg.a ".."
+$update libpkg.a
+$checkin libpkg.a ".."
+$exit
+
+libpkg.a:
+	t_istable.x	../../lib/ptkeysdef.h
+	t_tbkeycol.x	<tbset.h>
+	t_tbcrename.x	<tbset.h>
+	;
diff --git a/noao/digiphot/ptools/ptutils/t_istable.x b/noao/digiphot/ptools/ptutils/t_istable.x
new file mode 100644
index 00000000..b8cbf5db
--- /dev/null
+++ b/noao/digiphot/ptools/ptutils/t_istable.x
@@ -0,0 +1,71 @@
+include "../../lib/ptkeysdef.h"
+
+# T_ISTABLE -- Decide whether an input file is an ST Table, an APPHOT style
+# text file or neither.
+
+procedure t_istable ()
+
+pointer	infile			# name of the input file
+
+bool	table, text, other
+int	fd, type
+pointer	sp, line
+int	access(), tbtopn(), open(), getline(), strmatch()
+errchk	tbtopn(), open()
+
+begin
+	# Get some working space.
+	call smark (sp)
+	call salloc (infile, SZ_FNAME, TY_CHAR)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	# Fetch the name of the input file
+	call clgstr ("infile", Memc[infile], SZ_FNAME)
+	if (access (Memc[infile], READ_ONLY, TEXT_FILE) == YES)
+	    type = TEXT_FILE
+	else
+	    type = BINARY_FILE
+
+	if (type == BINARY_FILE) {
+	    iferr {
+	        fd = tbtopn (Memc[infile], READ_ONLY, 0)
+	    } then {
+		table = false
+		text = false
+		other = true
+	    } else {
+		table = true
+		text = false
+		other = false
+		call tbtclo (fd)
+	    }
+	} else {
+	    table = false
+	    iferr {
+	        fd = open (Memc[infile], READ_ONLY, TEXT_FILE) 
+	    } then {
+	        text = false
+	        other = true
+	    } else {
+	        Memc[line] = EOS
+	        if (getline (fd, Memc[line]) != EOF) {
+		    if (strmatch (Memc[line], KY_CHAR_IRAF) != 0) {
+		        text = true
+		        other = false
+		    } else {
+		        text = false
+		        other = true
+		    }
+		}
+		call close (fd)
+	    }
+	}
+
+	# Store the results in the istable parameter file.
+	call clputb ("table", table)
+	call clputb ("text", text)
+	call clputb ("other", other)
+
+	# Free memory.
+	call sfree (sp)
+end
diff --git a/noao/digiphot/ptools/ptutils/t_tbcrename.x b/noao/digiphot/ptools/ptutils/t_tbcrename.x
new file mode 100644
index 00000000..8f54e9d5
--- /dev/null
+++ b/noao/digiphot/ptools/ptutils/t_tbcrename.x
@@ -0,0 +1,73 @@
+include <tbset.h>
+
+# T_TBCRENAME -- Rename a list of columns in an ST table. 
+
+procedure t_tbcrename ()
+
+int	tlist			# the tables list descriptor
+int	columns			# the input columns list descriptor
+int	names			# the output column names list descriptor
+
+pointer	sp, table, incname, outcname, tp, colptr
+int	clpopnu(), clplen(), clgfil(), access(), tbpsta()
+pointer	tbtopn()
+
+begin
+	# Open the lists of tables and keywords.
+	tlist = clpopnu ("table")
+	if (clplen (tlist) <= 0)
+	    return
+	columns = clpopnu ("columns")
+	names = clpopnu ("names")
+	if (clplen (columns) != clplen (names))
+	    call error (0,
+	        "The number of new names does not equal the number of columns")
+
+	# Allocate working space.
+	call smark (sp)
+	call salloc (table, SZ_FNAME, TY_CHAR)
+	call salloc (incname, SZ_COLNAME, TY_CHAR)
+	call salloc (outcname, SZ_COLNAME, TY_CHAR)
+
+	# Loop over the list of ST tables.
+	while (clgfil (tlist, Memc[table], SZ_FNAME) != EOF) {
+
+	    # If the file is not an ST table go to the next file in the list.
+	    if (access (Memc[table], 0, TEXT_FILE) == YES)
+		next
+	    iferr (tp = tbtopn (Memc[table], READ_WRITE, 0))
+		next
+	    if (tbpsta (tp, TBL_WHTYPE) == TBL_TYPE_TEXT)
+		next
+
+	    # Loop over the input column list.
+	    while (clgfil (columns, Memc[incname], SZ_COLNAME) != EOF &&
+	        clgfil (names, Memc[outcname], SZ_COLNAME) != EOF) {
+
+		# If the output column already exists in the table skip
+		# to the next input column.
+		call tbcfnd (tp, Memc[outcname], colptr, 1)
+		if (colptr != NULL)
+		    next
+
+		# If the input column does not exist in the table skip to the
+		# next column.
+
+		call tbcfnd (tp, Memc[incname], colptr, 1)
+		if (colptr == NULL)
+		    next
+
+		# Rename the column.
+		call tbcnam (tp, colptr, Memc[outcname])
+	    }
+
+	    call tbtclo (tp)
+	    call clprew (columns)
+	    call clprew (names)
+	}
+
+	call clpcls (columns)
+	call clpcls (names)
+	call clpcls (tlist)
+	call sfree (sp)
+end
diff --git a/noao/digiphot/ptools/ptutils/t_tbkeycol.x b/noao/digiphot/ptools/ptutils/t_tbkeycol.x
new file mode 100644
index 00000000..47923ca6
--- /dev/null
+++ b/noao/digiphot/ptools/ptutils/t_tbkeycol.x
@@ -0,0 +1,140 @@
+include <tbset.h>
+
+# T_TBKEYCOL -- For all the rows of a list of ST tables, copy the values of
+# selected table keywords into new columns of the same name. If the columns
+# already exist no action is taken.
+
+procedure t_tbkeycol ()
+
+int	tlist				# the tables list descriptor
+int	klist				# the keywords list descriptor
+
+bool	bval
+double	dval
+int	i, keytype, keyptr, nrows, keylength, ival
+pointer	sp, table, keyword, keyvalue, format, tp, colptr
+real	rval
+
+bool	itob()
+int	clpopnu(), clgfil(), clplen(), tbpsta(), strlen(), access()
+int	ctoi(), ctor(), ctod()
+pointer	tbtopn()
+errchk	tbtopn()
+
+begin
+	# Open the lists of tables and keywords.
+	tlist = clpopnu ("tables")
+	if (clplen (tlist) <= 0)
+	    return
+	klist = clpopnu ("keywords")
+	if (clplen (klist) <= 0)
+	    return
+
+	# Allocate working space.
+	call smark (sp)
+	call salloc (table, SZ_FNAME, TY_CHAR)
+	call salloc (keyword, SZ_KEYWORD, TY_CHAR)
+	call salloc (keyvalue, SZ_PARREC, TY_CHAR)
+	call salloc (format, SZ_COLFMT, TY_CHAR)
+
+	# Loop over the list of ST tables.
+	while (clgfil (tlist, Memc[table], SZ_FNAME) != EOF) {
+
+	    # If the file is not an ST table go to the next file in the list.
+	    if (access(Memc[table], 0, TEXT_FILE) == YES)
+		next
+	    iferr (tp = tbtopn (Memc[table], READ_WRITE, 0))
+		next
+	    if (tbpsta (tp, TBL_WHTYPE) == TBL_TYPE_TEXT)
+                next
+
+
+	    # Loop over the keywords.
+	    while (clgfil (klist, Memc[keyword], SZ_FNAME) != EOF) {
+
+		# If a column named keyword already exists in the table
+		# skip to the next keyword.
+		call tbcfnd (tp, Memc[keyword], colptr, 1)
+		if (colptr != NULL)
+		    next
+
+		# If keyword does not exist in the table skip to the
+		# next keyword.
+		call tbhfkr (tp, Memc[keyword], keytype, Memc[keyvalue],
+		    keyptr)
+		if (keyptr == 0)
+		    next
+
+		nrows = tbpsta (tp, TBL_NROWS)
+
+		# Decode the header value and copy it into all the rows
+		# of the table.
+		i = 1
+		switch (keytype) {
+		case TY_BOOL:
+		    call tbcdef (tp, colptr, Memc[keyword], "undefined",
+		        "%-3.3b", keytype, 1, 1)
+		    if (ctoi (Memc[keyvalue], i, ival) <= 0)
+			ival = NO
+		    bval = itob (ival)
+		    do i = 1, nrows 
+			call tbrptb (tp, colptr, bval, 1, i)
+		case TY_CHAR:
+		    keylength = strlen (Memc[keyvalue])
+		    call sprintf (Memc[format], SZ_COLFMT, "%*.*s")
+			call pargi (-keylength)
+			call pargi (keylength)
+		    call tbcdef (tp, colptr, Memc[keyword], "undefined",
+		        Memc[format], -keylength, 1, 1)
+		    do i = 1, nrows 
+			call tbrptt (tp, colptr, Memc[keyvalue], keylength,
+			    1, i)
+		case TY_INT:
+		    keylength  = ctoi (Memc[keyvalue], i, ival)
+		    if (keylength <= 0) {
+			ival = INDEFI
+			keylength = 6
+		    }
+		    call sprintf (Memc[format], SZ_COLFMT, "%%%d.%dd")
+			call pargi (-keylength)
+			call pargi (keylength)
+		    call tbcdef (tp, colptr, Memc[keyword], "undefined",
+		        Memc[format], keytype, 1, 1)
+		    do i = 1, nrows 
+			call tbrpti (tp, colptr, ival, 1, i)
+		case TY_REAL:
+		    keylength = ctor (Memc[keyvalue], i, rval)
+		    if (keylength <= 0) {
+			rval = INDEFR
+			keylength = 6
+		    }
+		    call sprintf (Memc[format], SZ_COLFMT, "%%%dg")
+			call pargi (-keylength)
+		    call tbcdef (tp, colptr, Memc[keyword], "undefined",
+		        Memc[format], keytype, 1, 1)
+		    do i = 1, nrows 
+			call tbrptr (tp, colptr, rval, 1, i)
+		case TY_DOUBLE:
+		    keylength = ctod (Memc[keyvalue], i, dval)
+		    if (keylength <= 0) {
+			dval = INDEFD
+			keylength = 6
+		    }
+		    call sprintf (Memc[format], SZ_COLFMT, "%%%dg")
+			call pargi (-keylength)
+		    call tbcdef (tp, colptr, Memc[keyword], "undefined",
+		        Memc[format], keytype, 1, 1)
+		    do i = 1, nrows 
+			call tbrptd (tp, colptr, dval, 1, i)
+		}
+
+	    }
+
+	    call tbtclo (tp)
+	    call clprew (klist)
+	}
+
+	call clpcls (klist)
+	call clpcls (tlist)
+	call sfree (sp)
+end