diff options
Diffstat (limited to 'noao/digiphot/ptools/ptutils/t_tbkeycol.x')
| -rw-r--r-- | noao/digiphot/ptools/ptutils/t_tbkeycol.x | 140 |
1 files changed, 140 insertions, 0 deletions
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 |