aboutsummaryrefslogtreecommitdiff
path: root/noao/digiphot/ptools/ptutils
diff options
context:
space:
mode:
Diffstat (limited to 'noao/digiphot/ptools/ptutils')
-rw-r--r--noao/digiphot/ptools/ptutils/mkpkg12
-rw-r--r--noao/digiphot/ptools/ptutils/t_istable.x71
-rw-r--r--noao/digiphot/ptools/ptutils/t_tbcrename.x73
-rw-r--r--noao/digiphot/ptools/ptutils/t_tbkeycol.x140
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
generated by cgit (git 2.34.1) at 2025-09-20 11:06:11 -0400