diff options
Diffstat (limited to 'pkg/utilities/nttools/threed/txtable')
22 files changed, 1155 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/threed/txtable/generic/mkpkg b/pkg/utilities/nttools/threed/txtable/generic/mkpkg new file mode 100644 index 00000000..d82c36d2 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/mkpkg @@ -0,0 +1,22 @@ +# Update the generic routines. + +default: + $checkout libpkg.a ../../ + $update libpkg.a + $checkin libpkg.a ../../ +$exit + +libpkg.a: + txtcptb.x + txtcptc.x + txtcptd.x + txtcpti.x + txtcptr.x + txtcpts.x + txthvb.x + txthvc.x + txthvd.x + txthvi.x + txthvr.x + txthvs.x + ; diff --git a/pkg/utilities/nttools/threed/txtable/generic/txtcptb.x b/pkg/utilities/nttools/threed/txtable/generic/txtcptb.x new file mode 100644 index 00000000..6bed2c52 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txtcptb.x @@ -0,0 +1,34 @@ +# +# TXTCPT -- Copy data to output table. If array, copy into column. +# If scalar, either write as column or write into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-1996 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + +procedure txtcptb (otp, ocp, buf, start, nbuf, icol, compact) + +pointer otp # i: table descriptor +pointer ocp # i: column descriptor +bool buf[ARB] +int start # i: starting row in output table +int nbuf # i: number of elements to write into output +int icol # i: column number in input table +bool compact # i: write scalars as header keywords ? +#-- + +begin + if (ocp != NULL) { + + call tbcptb (otp, ocp, buf, start, nbuf) + + } else if (compact) { + + call txthvb (otp, icol, buf[1]) + } +end diff --git a/pkg/utilities/nttools/threed/txtable/generic/txtcptc.x b/pkg/utilities/nttools/threed/txtable/generic/txtcptc.x new file mode 100644 index 00000000..10cdc4cb --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txtcptc.x @@ -0,0 +1,35 @@ +# +# TXTCPT -- Copy data to output table. If array, copy into column. +# If scalar, either write as column or write into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-1996 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + +procedure txtcptt (otp, ocp, buf, maxch, start, nbuf, icol, compact) + +pointer otp # i: table descriptor +pointer ocp # i: column descriptor +char buf[maxch,ARB] # i: array of values +int maxch # i: max length of string +int start # i: starting row in output table +int nbuf # i: number of elements to write into output +int icol # i: column number in input table +bool compact # i: write scalars as header keywords ? +#-- + +begin + if (ocp != NULL) { + + call tbcptt (otp, ocp, buf, maxch, start, nbuf) + + } else if (compact) { + + call txthvt (otp, icol, buf) + } +end diff --git a/pkg/utilities/nttools/threed/txtable/generic/txtcptd.x b/pkg/utilities/nttools/threed/txtable/generic/txtcptd.x new file mode 100644 index 00000000..3af0d7ac --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txtcptd.x @@ -0,0 +1,34 @@ +# +# TXTCPT -- Copy data to output table. If array, copy into column. +# If scalar, either write as column or write into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-1996 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + +procedure txtcptd (otp, ocp, buf, start, nbuf, icol, compact) + +pointer otp # i: table descriptor +pointer ocp # i: column descriptor +double buf[ARB] +int start # i: starting row in output table +int nbuf # i: number of elements to write into output +int icol # i: column number in input table +bool compact # i: write scalars as header keywords ? +#-- + +begin + if (ocp != NULL) { + + call tbcptd (otp, ocp, buf, start, nbuf) + + } else if (compact) { + + call txthvd (otp, icol, buf[1]) + } +end diff --git a/pkg/utilities/nttools/threed/txtable/generic/txtcpti.x b/pkg/utilities/nttools/threed/txtable/generic/txtcpti.x new file mode 100644 index 00000000..552e1e7a --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txtcpti.x @@ -0,0 +1,34 @@ +# +# TXTCPT -- Copy data to output table. If array, copy into column. +# If scalar, either write as column or write into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-1996 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + +procedure txtcpti (otp, ocp, buf, start, nbuf, icol, compact) + +pointer otp # i: table descriptor +pointer ocp # i: column descriptor +int buf[ARB] +int start # i: starting row in output table +int nbuf # i: number of elements to write into output +int icol # i: column number in input table +bool compact # i: write scalars as header keywords ? +#-- + +begin + if (ocp != NULL) { + + call tbcpti (otp, ocp, buf, start, nbuf) + + } else if (compact) { + + call txthvi (otp, icol, buf[1]) + } +end diff --git a/pkg/utilities/nttools/threed/txtable/generic/txtcptr.x b/pkg/utilities/nttools/threed/txtable/generic/txtcptr.x new file mode 100644 index 00000000..956bc45e --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txtcptr.x @@ -0,0 +1,34 @@ +# +# TXTCPT -- Copy data to output table. If array, copy into column. +# If scalar, either write as column or write into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-1996 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + +procedure txtcptr (otp, ocp, buf, start, nbuf, icol, compact) + +pointer otp # i: table descriptor +pointer ocp # i: column descriptor +real buf[ARB] +int start # i: starting row in output table +int nbuf # i: number of elements to write into output +int icol # i: column number in input table +bool compact # i: write scalars as header keywords ? +#-- + +begin + if (ocp != NULL) { + + call tbcptr (otp, ocp, buf, start, nbuf) + + } else if (compact) { + + call txthvr (otp, icol, buf[1]) + } +end diff --git a/pkg/utilities/nttools/threed/txtable/generic/txtcpts.x b/pkg/utilities/nttools/threed/txtable/generic/txtcpts.x new file mode 100644 index 00000000..d8b805fa --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txtcpts.x @@ -0,0 +1,34 @@ +# +# TXTCPT -- Copy data to output table. If array, copy into column. +# If scalar, either write as column or write into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-1996 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + +procedure txtcpts (otp, ocp, buf, start, nbuf, icol, compact) + +pointer otp # i: table descriptor +pointer ocp # i: column descriptor +short buf[ARB] +int start # i: starting row in output table +int nbuf # i: number of elements to write into output +int icol # i: column number in input table +bool compact # i: write scalars as header keywords ? +#-- + +begin + if (ocp != NULL) { + + call tbcpts (otp, ocp, buf, start, nbuf) + + } else if (compact) { + + call txthvs (otp, icol, buf[1]) + } +end diff --git a/pkg/utilities/nttools/threed/txtable/generic/txthvb.x b/pkg/utilities/nttools/threed/txtable/generic/txthvb.x new file mode 100644 index 00000000..eb7af9ad --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txthvb.x @@ -0,0 +1,30 @@ +# +# TXTHV -- Write scalar value into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) + +procedure txthvb (otp, col, buf) + +pointer otp # i: table descriptor +int col # i: column number in input table +bool buf +#-- +pointer keyword + +begin + # Use original column number to build keyword name. + call malloc (keyword, SZ_LINE, TY_CHAR) + call sprintf (Memc[keyword], SZ_LINE, "TCV_%03d") + call pargi (col) + + call tbhadb (otp, Memc[keyword], buf) + + call mfree (keyword, TY_CHAR) +end + diff --git a/pkg/utilities/nttools/threed/txtable/generic/txthvc.x b/pkg/utilities/nttools/threed/txtable/generic/txthvc.x new file mode 100644 index 00000000..6ffb3773 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txthvc.x @@ -0,0 +1,30 @@ +# +# TXTHV -- Write scalar value into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) + +procedure txthvt (otp, col, buf) + +pointer otp # i: table descriptor +int col # i: column number in input table +char buf[ARB] # i: value to be written +#-- +pointer keyword + +begin + # Use original column number to build keyword name. + call malloc (keyword, SZ_LINE, TY_CHAR) + call sprintf (Memc[keyword], SZ_LINE, "TCV_%03d") + call pargi (col) + + call tbhadt (otp, Memc[keyword], buf) + + call mfree (keyword, TY_CHAR) +end + diff --git a/pkg/utilities/nttools/threed/txtable/generic/txthvd.x b/pkg/utilities/nttools/threed/txtable/generic/txthvd.x new file mode 100644 index 00000000..a074396a --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txthvd.x @@ -0,0 +1,30 @@ +# +# TXTHV -- Write scalar value into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) + +procedure txthvd (otp, col, buf) + +pointer otp # i: table descriptor +int col # i: column number in input table +double buf +#-- +pointer keyword + +begin + # Use original column number to build keyword name. + call malloc (keyword, SZ_LINE, TY_CHAR) + call sprintf (Memc[keyword], SZ_LINE, "TCV_%03d") + call pargi (col) + + call tbhadd (otp, Memc[keyword], buf) + + call mfree (keyword, TY_CHAR) +end + diff --git a/pkg/utilities/nttools/threed/txtable/generic/txthvi.x b/pkg/utilities/nttools/threed/txtable/generic/txthvi.x new file mode 100644 index 00000000..9df4ae94 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txthvi.x @@ -0,0 +1,30 @@ +# +# TXTHV -- Write scalar value into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) + +procedure txthvi (otp, col, buf) + +pointer otp # i: table descriptor +int col # i: column number in input table +int buf +#-- +pointer keyword + +begin + # Use original column number to build keyword name. + call malloc (keyword, SZ_LINE, TY_CHAR) + call sprintf (Memc[keyword], SZ_LINE, "TCV_%03d") + call pargi (col) + + call tbhadi (otp, Memc[keyword], buf) + + call mfree (keyword, TY_CHAR) +end + diff --git a/pkg/utilities/nttools/threed/txtable/generic/txthvr.x b/pkg/utilities/nttools/threed/txtable/generic/txthvr.x new file mode 100644 index 00000000..17c4693e --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txthvr.x @@ -0,0 +1,30 @@ +# +# TXTHV -- Write scalar value into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) + +procedure txthvr (otp, col, buf) + +pointer otp # i: table descriptor +int col # i: column number in input table +real buf +#-- +pointer keyword + +begin + # Use original column number to build keyword name. + call malloc (keyword, SZ_LINE, TY_CHAR) + call sprintf (Memc[keyword], SZ_LINE, "TCV_%03d") + call pargi (col) + + call tbhadr (otp, Memc[keyword], buf) + + call mfree (keyword, TY_CHAR) +end + diff --git a/pkg/utilities/nttools/threed/txtable/generic/txthvs.x b/pkg/utilities/nttools/threed/txtable/generic/txthvs.x new file mode 100644 index 00000000..847fbceb --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/generic/txthvs.x @@ -0,0 +1,30 @@ +# +# TXTHV -- Write scalar value into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) + +procedure txthvs (otp, col, buf) + +pointer otp # i: table descriptor +int col # i: column number in input table +short buf +#-- +pointer keyword + +begin + # Use original column number to build keyword name. + call malloc (keyword, SZ_LINE, TY_CHAR) + call sprintf (Memc[keyword], SZ_LINE, "TCV_%03d") + call pargi (col) + + call tbhadi (otp, Memc[keyword], int(buf)) + + call mfree (keyword, TY_CHAR) +end + diff --git a/pkg/utilities/nttools/threed/txtable/mkpkg b/pkg/utilities/nttools/threed/txtable/mkpkg new file mode 100644 index 00000000..b6c5e53a --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/mkpkg @@ -0,0 +1,34 @@ +# Update the txtable application code in the threed package library. +# Author: I.Busko, 22-Nov-1996 + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +# This module is called from the threed mkpkg. +generic: + $ifnfile (generic/txthvi.x) + $generic -k -p generic/ -t bcsird txthv.gx + $endif + $ifolder (generic/txthvi.x, txthv.gx) + $generic -k -p generic/ -t bcsird txthv.gx + $endif + $ifnfile (generic/txtcpti.x) + $generic -k -p generic/ -t bcsird txtcpt.gx + $endif + $ifolder (generic/txtcpti.x, txtcpt.gx) + $generic -k -p generic/ -t bcsird txtcpt.gx + $endif + ; + +libpkg.a: + @generic + txtable.x <error.h> + txtone.x <tbset.h> + txtcpy.x <tbset.h> + txtcpyco.x + txtcpysc.x + txthc.x + ; + diff --git a/pkg/utilities/nttools/threed/txtable/txtable.x b/pkg/utilities/nttools/threed/txtable/txtable.x new file mode 100644 index 00000000..f56db247 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/txtable.x @@ -0,0 +1,121 @@ +include <error.h> + +# TXTABLE -- Extract 2D tables from 3D table rows. + +# Input tables are given by a filename template list. All row/column +# selection on input tables is performed by bracket-enclosed selectors +# appended to the file name. The output is either a matching list of +# tables or a directory. Output table names cannot have row/column +# selectors. Since one input table specification can generate multiple +# output tables, a naming scheme for these is defined as follows: +# +# - if output name is a directory: +# output table names are built from input table names appended with +# a _rXXX suffix, where XXX is the row number in the input file +# where the data comes from. +# +# - if output file name comes from a paired root file name list: +# same suffixing scheme as above, but using the root file name +# extracted from the list. +# +# - if only one row is selected: +# no suffixing takes place. +# +# +# This code is a re-use of B.Simon's 04-Nov-94 version of tcopy. +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) +# 03-Jan-97 - Revised after code review (IB) + + +procedure t_txtable() + +char tablist1[SZ_LINE] # Input table list +char tablist2[SZ_LINE] # Output table list +bool compact # Put scalars in header ? +bool verbose # Print operations ? + +char table1[SZ_PATHNAME] # Input table name +char table2[SZ_PATHNAME] # Output table name +char rootname[SZ_PATHNAME] # Root name +char dirname[SZ_PATHNAME] # Directory name + +int list1, list2, root_len +pointer sp + +int imtopen(), imtgetim(), imtlen() +int fnldir(), isdirectory() +bool clgetb(), streq() + +begin + # Get input and output table template lists. + + call clgstr ("intable", tablist1, SZ_LINE) + call clgstr ("outtable", tablist2, SZ_LINE) + compact = clgetb ("compact") + verbose = clgetb ("verbose") + + # Check if the output string is a directory. + + if (isdirectory (tablist2, dirname, SZ_PATHNAME) > 0 && + !streq (tablist2, "STDOUT")) { + list1 = imtopen (tablist1) + while (imtgetim (list1, table1, SZ_PATHNAME) != EOF) { + call smark (sp) + + # Place the input table name without a directory in + # string rootname. + + call get_root (table1, table2, SZ_PATHNAME) + root_len = fnldir (table2, rootname, SZ_PATHNAME) + call strcpy (table2[root_len + 1], rootname, SZ_PATHNAME) + + call strcpy (dirname, table2, SZ_PATHNAME) + call strcat (rootname, table2, SZ_PATHNAME) + + iferr (call txtone (table1, table2, verbose, compact)) + call erract (EA_WARN) + + call sfree (sp) + } + call imtclose (list1) + + } else { + # Expand the input and output table lists. + + list1 = imtopen (tablist1) + list2 = imtopen (tablist2) + + if (imtlen (list1) != imtlen (list2)) { + call imtclose (list1) + call imtclose (list2) + call error (1, "Number of input and output tables not the same") + } + + # Expand each table. + + while ((imtgetim (list1, table1, SZ_PATHNAME) != EOF) && + (imtgetim (list2, table2, SZ_PATHNAME) != EOF)) { + + call smark (sp) + + if (streq (table1, table2)) { + call eprintf ("can't expand table to itself: %s\n") + call pargstr (table1) + next + } + iferr (call txtone (table1, table2, verbose, compact)) + call erract (EA_WARN) + + call sfree (sp) + } + + call imtclose (list1) + call imtclose (list2) + } +end diff --git a/pkg/utilities/nttools/threed/txtable/txtcpt.gx b/pkg/utilities/nttools/threed/txtable/txtcpt.gx new file mode 100644 index 00000000..9a8ae930 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/txtcpt.gx @@ -0,0 +1,53 @@ +# +# TXTCPT -- Copy data to output table. If array, copy into column. +# If scalar, either write as column or write into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-1996 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + +$if (datatype == c) +procedure txtcptt (otp, ocp, buf, maxch, start, nbuf, icol, compact) +$else +procedure txtcpt$t (otp, ocp, buf, start, nbuf, icol, compact) +$endif + +pointer otp # i: table descriptor +pointer ocp # i: column descriptor +$if (datatype == c) +char buf[maxch,ARB] # i: array of values +$else +PIXEL buf[ARB] +$endif +$if (datatype == c) +int maxch # i: max length of string +$endif +int start # i: starting row in output table +int nbuf # i: number of elements to write into output +int icol # i: column number in input table +bool compact # i: write scalars as header keywords ? +#-- + +begin + if (ocp != NULL) { + + $if (datatype == c) + call tbcptt (otp, ocp, buf, maxch, start, nbuf) + $else + call tbcpt$t (otp, ocp, buf, start, nbuf) + $endif + + } else if (compact) { + + $if (datatype == c) + call txthvt (otp, icol, buf) + $else + call txthv$t (otp, icol, buf[1]) + $endif + } +end diff --git a/pkg/utilities/nttools/threed/txtable/txtcpy.x b/pkg/utilities/nttools/threed/txtable/txtcpy.x new file mode 100644 index 00000000..9a54898a --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/txtcpy.x @@ -0,0 +1,94 @@ +include <tbset.h> + +# TXTCPY -- Copy data from single row in 3D table to columns +# in the output 2D table. +# +# +# This code is adapted from B.Simon's 04-Nov-94 version of tcopy. +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) + + +procedure txtcpy (itp, otp, irow, icp, ocp, ncols, compact) + +pointer itp # i: pointer to descriptor of input table +pointer otp # i: pointer to descriptor of output table +int irow # i: row in input table +pointer icp[ncols] # i: array of pointers for input columns +pointer ocp[ncols] # i: array of pointers for output columns +int ncols # i: number of columns in input table +bool compact # i: write scalars as header keywords ? +#-- +int icol, dlen, dtype, maxlen, maxch, nbuf +pointer sp, buf, errmsg, colname + +string badtype "Unsupported column data type (%s)" + +int tcs_intinfo(), tcs_totsize() + +begin + # Number of rows in output table must match the + # largest array size in input table. + maxlen = 0 + do icol = 1, ncols { + dlen = tcs_totsize (icp[icol]) + if (dlen > maxlen) + maxlen = dlen + } + + # Main loop: process each column. + do icol = 1, ncols { + + # Determine datatype of table column + # and allocate a buffer to match. + dtype = tcs_intinfo (icp[icol], TBL_COL_DATATYPE) + maxch = 1 + if (dtype < 0) { + maxch = - dtype + dtype = TY_CHAR + } + call smark (sp) + call salloc (buf, maxlen*(maxch + 1), dtype) + + # Read data from input table and + # write it to output table. + switch (dtype) { + case TY_BOOL: + call tcs_rdaryb (itp, icp[icol], irow, maxlen, nbuf, Memb[buf]) + call txtcptb (otp, ocp[icol], Memb[buf], 1, nbuf, icol, compact) + case TY_CHAR: + call tcs_rdaryt (itp, icp[icol], irow, maxch, maxlen, + nbuf, Memc[buf]) + call txtcptt (otp, ocp[icol], Memc[buf], maxch, 1, nbuf, + icol, compact) + case TY_SHORT: + call tcs_rdarys (itp, icp[icol], irow, maxlen, nbuf, Mems[buf]) + call txtcpts (otp, ocp[icol], Mems[buf], 1, nbuf, icol, compact) + case TY_INT, TY_LONG: + call tcs_rdaryi (itp, icp[icol], irow, maxlen, nbuf, Memi[buf]) + call txtcpti (otp, ocp[icol], Memi[buf], 1, nbuf, icol, compact) + case TY_REAL: + call tcs_rdaryr (itp, icp[icol], irow, maxlen, nbuf, Memr[buf]) + call txtcptr (otp, ocp[icol], Memr[buf], 1, nbuf, icol, compact) + case TY_DOUBLE: + call tcs_rdaryd (itp, icp[icol], irow, maxlen, nbuf, Memd[buf]) + call txtcptd (otp, ocp[icol], Memd[buf], 1, nbuf, icol, compact) + default: + # Unsupported type, write error message + call salloc (colname, SZ_COLNAME, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + call tcs_txtinfo (icp[icol], TBL_COL_NAME, + Memc[colname], SZ_COLNAME) + call sprintf (Memc[errmsg], SZ_LINE, badtype) + call pargstr (Memc[colname]) + call error (1, Memc[errmsg]) + } + + call sfree (sp) + } +end diff --git a/pkg/utilities/nttools/threed/txtable/txtcpyco.x b/pkg/utilities/nttools/threed/txtable/txtcpyco.x new file mode 100644 index 00000000..c74943d4 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/txtcpyco.x @@ -0,0 +1,45 @@ + +# TXTCPYCO -- Copy column information +# +# +# +# +# +# Revision history: +# ---------------- +# +# 03-Jan-97 - Implemented after code review (IB) + + +procedure txtcpyco (otp, colptr, newcol, numptr, colname, colunits, colfmt, + compact) + +pointer otp, colptr, newcol, colname, colunits, colfmt +int numptr +bool compact +#-- +pointer ocp +int iptr, colnum, datatype, lendata, lenfmt + +pointer tcs_column() + +begin + do iptr = 1, numptr { + ocp = tcs_column (Memi[colptr+iptr-1]) + call tbcinf (ocp, colnum, Memc[colname], Memc[colunits], + Memc[colfmt], datatype, lendata, lenfmt) + + # All columns in output are scalar-type ! + # Column info for input scalars depends on compact mode. + # If compact=no, just leave output column as scalar. + # If compact=yes, signal input scalar by setting column + # pointer to NULL. + if (compact && (lendata == 1)) { + Memi[newcol+iptr-1] = NULL + } else { + call tbcdef (otp, ocp, Memc[colname], Memc[colunits], + Memc[colfmt], datatype, 1, 1) + Memi[newcol+iptr-1] = ocp + } + } +end diff --git a/pkg/utilities/nttools/threed/txtable/txtcpysc.x b/pkg/utilities/nttools/threed/txtable/txtcpysc.x new file mode 100644 index 00000000..f35f7c54 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/txtcpysc.x @@ -0,0 +1,34 @@ + +# TXTCPYSC -- Copy scalar columns in compact mode +# +# +# +# +# +# Revision history: +# ---------------- +# +# 03-Jan-97 - Implemented after code review (IB) + + +procedure txtcpysc (otp, colptr, newcol, numptr, colname, colunits, colfmt) + +pointer otp, colptr, newcol, colname, colunits, colfmt +int numptr + +pointer icp +int iptr, colnum, datatype, lendata, lenfmt + +pointer tcs_column + +begin + do iptr = 1, numptr { + if (Memi[newcol+iptr-1] == NULL) { + icp = tcs_column (Memi[colptr+iptr-1]) + call tbcinf (icp, colnum, Memc[colname], Memc[colunits], + Memc[colfmt], datatype, lendata, lenfmt) + call txthc (otp, colnum, Memc[colname], Memc[colunits], + Memc[colfmt], datatype, lenfmt) + } + } +end diff --git a/pkg/utilities/nttools/threed/txtable/txthc.x b/pkg/utilities/nttools/threed/txtable/txthc.x new file mode 100644 index 00000000..3e6f8555 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/txthc.x @@ -0,0 +1,85 @@ +# +# TXTHC -- Write basic column info into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 25-Nov-96 - Task created (I.Busko) +# 03-Jan-97 - Revised after code review (IB) + + +procedure txthc (otp, colnum, colname, colunits, colfmt, + datatype, lenfmt) + +pointer otp # i: pointer to descriptor of output table +int colnum # i: column number in input table +char colname[ARB] # i: column name +char colunits[ARB] # i: column units +char colfmt[ARB] # i: column format +int datatype # i: data type +int lenfmt # i: length of format string +#-- +pointer sp, cu, cf, keyword, text, dtype +int lenstr + +begin + call smark (sp) + call salloc (keyword, SZ_LINE, TY_CHAR) + call salloc (text, SZ_LINE, TY_CHAR) + call salloc (dtype, SZ_LINE, TY_CHAR) + call salloc (cu, SZ_LINE, TY_CHAR) + call salloc (cf, SZ_LINE, TY_CHAR) + + # Use original column number to build keyword name. + call sprintf (Memc[keyword], SZ_LINE, "TCD_%03d") + call pargi (colnum) + + # Data type is encoded as a human-readable character string. + if (datatype < 0) { + lenstr = -datatype + datatype = TY_CHAR + } + switch (datatype) { + case TY_BOOL: + call strcpy ("boolean", Memc[dtype], SZ_LINE) + case TY_SHORT: + call strcpy ("short", Memc[dtype], SZ_LINE) + case TY_INT: + call strcpy ("integer", Memc[dtype], SZ_LINE) + case TY_LONG: + call strcpy ("long", Memc[dtype], SZ_LINE) + case TY_REAL: + call strcpy ("real", Memc[dtype], SZ_LINE) + case TY_DOUBLE: + call strcpy ("double", Memc[dtype], SZ_LINE) + case TY_CHAR: + call sprintf (Memc[dtype], SZ_LINE, "character_%d") + call pargi (lenstr) + } + + # Empty units or format string are encoded as "default". + if (colunits[1] == EOS) + call strcpy ("default", Memc[cu], SZ_LINE) + else + call strcpy (colunits, Memc[cu], SZ_LINE) + if (colfmt[1] == EOS) + call strcpy ("default", Memc[cf], SZ_LINE) + else + call strcpy (colfmt, Memc[cf], SZ_LINE) + + # Assemble keyword value. + call sprintf (Memc[text], SZ_LINE, "%s %s %s %s %d") + call pargstr (colname) + call pargstr (Memc[cu]) + call pargstr (Memc[cf]) + call pargstr (Memc[dtype]) + call pargi (lenfmt) + + # Write keyword into header. + call tbhadt (otp, Memc[keyword], Memc[text]) + call sfree (sp) +end + diff --git a/pkg/utilities/nttools/threed/txtable/txthv.gx b/pkg/utilities/nttools/threed/txtable/txthv.gx new file mode 100644 index 00000000..d965f704 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/txthv.gx @@ -0,0 +1,55 @@ +# +# TXTHV -- Write scalar value into header. +# +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-96 - Task created (I.Busko) + +$if (datatype == c) +procedure txthvt (otp, col, buf) +$else +procedure txthv$t (otp, col, buf) +$endif + +pointer otp # i: table descriptor +int col # i: column number in input table +$if (datatype == c) +char buf[ARB] # i: value to be written +$else +PIXEL buf +$endif +#-- +pointer keyword + +begin + # Use original column number to build keyword name. + call malloc (keyword, SZ_LINE, TY_CHAR) + call sprintf (Memc[keyword], SZ_LINE, "TCV_%03d") + call pargi (col) + + $if (datatype == c) + call tbhadt (otp, Memc[keyword], buf) + $endif + $if (datatype == i) + call tbhadi (otp, Memc[keyword], buf) + $endif + $if (datatype == s) + call tbhadi (otp, Memc[keyword], int(buf)) + $endif + $if (datatype == b) + call tbhadb (otp, Memc[keyword], buf) + $endif + $if (datatype == r) + call tbhadr (otp, Memc[keyword], buf) + $endif + $if (datatype == d) + call tbhadd (otp, Memc[keyword], buf) + $endif + + call mfree (keyword, TY_CHAR) +end + diff --git a/pkg/utilities/nttools/threed/txtable/txtone.x b/pkg/utilities/nttools/threed/txtable/txtone.x new file mode 100644 index 00000000..d286523d --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable/txtone.x @@ -0,0 +1,227 @@ +include <tbset.h> + +# TXTONE -- Extract 2D tables from a single input 3D table. +# +# +# This code is adapted from B.Simon's 04-Nov-94 version of tcopy. +# +# +# +# Revision history: +# ---------------- +# +# 22-Nov-1996 - Task created (I.Busko) +# 16-Dec-1996 - Add ORIG_ROW keyword (IB). +# 03-Jan-1997 - Revised after code review (IB) +# 17-Mar-1997 - Added selrows call (IB) +# 8-Apr-1999 - Call tbfpri (Phil Hodge) +# 8-Apr-2002 - Remove the call to whatfile (P. Hodge) + + +procedure txtone (input, output, verbose, compact) + +char input[ARB] # i: input table name +char output[ARB] # i: output table name +bool compact # i: put scalars in header ? +bool verbose # i: print operations ? +#-- +int numrow, numcol, numptr, type, irow, nrows +int phu_copied # set by tbfpri and ignored +pointer sp, root, extend, rowselect, colselect, colname, colunits, colfmt +pointer errmsg, itp, otp, colptr, newcol, pcode +pointer newname +bool suffix + +string nosect "Sections not permitted on output table name (%s)" +string nocols "Column names not found (%s)" + +errchk tbfpri, tbtopn, tctexp, tbracket, trsopen, trseval + +bool trseval(), streq() +int tbpsta(), selrows() +pointer tbtopn(), trsopen() + +begin + # Allocate memory for temporary strings. + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (newname, SZ_FNAME, TY_CHAR) + call salloc (extend, SZ_FNAME, TY_CHAR) + call salloc (rowselect, SZ_FNAME, TY_CHAR) + call salloc (colselect, SZ_FNAME, TY_CHAR) + call salloc (colname, SZ_COLNAME, TY_CHAR) + call salloc (colunits, SZ_COLUNITS, TY_CHAR) + call salloc (colfmt, SZ_COLFMT, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + # Selectors are forbbiden on output. + call rdselect (output, Memc[root], Memc[rowselect], + Memc[colselect], SZ_FNAME) + if (Memc[rowselect] != EOS || Memc[colselect] != EOS) { + call sprintf (Memc[errmsg], SZ_LINE, nosect) + call pargstr (output) + call error (1, Memc[errmsg]) + } + + # Break input file name into bracketed selectors. + call rdselect (input, Memc[root], Memc[rowselect], + Memc[colselect], SZ_FNAME) + + # Open input table and get some info about it. + itp = tbtopn (Memc[root], READ_ONLY, NULL) + numrow = tbpsta (itp, TBL_NROWS) + numcol = tbpsta (itp, TBL_NCOLS) + + # Find how many rows were requested by row selector. + # If only one, turn off suffixing. Also do it in case + # ASCII output was requested. + nrows = selrows (itp, Memc[rowselect]) + if (nrows == 1) + suffix = false + else + suffix = true + if (streq (output, "STDOUT")) + suffix = false + + # Create array of column pointers from column selector. + call malloc (colptr, numcol, TY_INT) + call malloc (newcol, numcol, TY_INT) + call tcs_open (itp, Memc[colselect], Memi[colptr], numptr, numcol) + + # Take an error exit if no columns were matched. + if (numptr == 0) { + call sprintf (Memc[errmsg], SZ_LINE, nocols) + call pargstr (input) + call error (1, Memc[errmsg]) + } + + # Loop over selected rows on input table, creating + # a 2D output table for each row. + pcode = trsopen (itp, Memc[rowselect]) + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + + # Append suffix to output name. + if (suffix) + call txtsuff (output, Memc[newname], irow) + else + call strcpy (output, Memc[newname], SZ_FNAME) + + if (verbose) { + call printf ("%s row=%d -> %s\n") + call pargstr (input) + call pargi (irow) + call pargstr (Memc[newname]) + call flush (STDOUT) + } + + # Open output table and set its type. + call tbfpri (Memc[root], Memc[newname], phu_copied) + otp = tbtopn (Memc[newname], NEW_FILE, NULL) + type = tbpsta (itp, TBL_WHTYPE) + if (streq (output, "STDOUT")) # ASCII output. + type = TBL_TYPE_TEXT + call tbpset (otp, TBL_WHTYPE, type) + + # Copy column information from input to output. + call txtcpyco (otp, colptr, newcol, numptr, colname, + colunits, colfmt, compact) + + # Create table and copy header. + call tbtcre (otp) + call tbhcal (itp, otp) + + # Copy row number into header. + call tbhadi (otp, "ORIG_ROW", irow) + + # Copy scalar columns into header. + if (compact) + call txtcpysc (otp, colptr, newcol, numptr, colname, + colunits, colfmt) + + # Copy number of columns into header. This is used + # by task that reads back 2D tables into 3D format. + if (compact) + call tbhadi (otp, "TCTOTAL", numptr) + + # Copy data to output table. + call txtcpy (itp, otp, irow, Memi[colptr], Memi[newcol], + numptr, compact) + + # Close output. + call tbtclo (otp) + } + } + + # Free arrays associated with columns. + call tcs_close (Memi[colptr], numptr) + call mfree (newcol, TY_INT) + call mfree (colptr, TY_INT) + + # Close row selector structure and input table. + call trsclose (pcode) + call tbtclo (itp) + + call sfree (sp) +end + + + + +# Appends sufix to output file name. + +procedure txtsuff (filename, newname, row) + +char filename[ARB] # i: output table name +char newname[ARB] # o: output table name with suffix +int row # i: row number + +pointer sp, ext, suffix +int dot, i, j + +int strcmp(), strldxs() + +begin + call smark (sp) + call salloc (suffix, SZ_LINE, TY_CHAR) + call salloc (ext, SZ_LINE, TY_CHAR) + + # Get rid of any appendages except the extension. + call imgcluster (filename, newname, SZ_FNAME) + + # Valid extensions are .tab, .fit and .fits + # Everything else is part of the root file name. + + # Detect extension. + Memc[ext] = EOS + dot = strldxs (".", newname) + if (dot != 0) { + i = dot + j = 0 + while (newname[i] != EOS) { + Memc[ext+j] = newname[i] + j = j + 1 + i = i + 1 + } + Memc[ext+j] = EOS + } + + # If valid extension, remove it from name. + if ( (strcmp (Memc[ext], ".tab") == 0) || + (strcmp (Memc[ext], ".fit") == 0) || + (strcmp (Memc[ext], ".fits") == 0) ) + newname[dot] = EOS + else + Memc[ext] = EOS + + # Build suffix. + call sprintf (Memc[suffix], SZ_LINE, "_r%04d") + call pargi (row) + + # Append suffix and extension to root name. + call strcat (Memc[suffix], newname, SZ_FNAME) + call strcat (Memc[ext], newname, SZ_FNAME) + + call sfree (sp) +end + |