aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/threed/tximage
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/utilities/nttools/threed/tximage')
-rw-r--r--pkg/utilities/nttools/threed/tximage/mkpkg15
-rw-r--r--pkg/utilities/nttools/threed/tximage/txicpy.x61
-rw-r--r--pkg/utilities/nttools/threed/tximage/txihc.x53
-rw-r--r--pkg/utilities/nttools/threed/tximage/tximage.x117
-rw-r--r--pkg/utilities/nttools/threed/tximage/txione.x214
5 files changed, 460 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/threed/tximage/mkpkg b/pkg/utilities/nttools/threed/tximage/mkpkg
new file mode 100644
index 00000000..bc108e8a
--- /dev/null
+++ b/pkg/utilities/nttools/threed/tximage/mkpkg
@@ -0,0 +1,15 @@
+# Update the tximage application code in the threed package library.
+# Author: I.Busko, 26-Nov-1996
+
+$checkout libpkg.a ../
+$update libpkg.a
+$checkin libpkg.a ../
+$exit
+
+libpkg.a:
+ tximage.x <error.h>
+ txione.x <imhdr.h> <tbset.h>
+ txicpy.x <tbset.h>
+ txihc.x
+ ;
+
diff --git a/pkg/utilities/nttools/threed/tximage/txicpy.x b/pkg/utilities/nttools/threed/tximage/txicpy.x
new file mode 100644
index 00000000..1428ee9e
--- /dev/null
+++ b/pkg/utilities/nttools/threed/tximage/txicpy.x
@@ -0,0 +1,61 @@
+include <tbset.h>
+
+# TXICPY -- Copy data from single row and column in 3D table to
+# 1-D image.
+#
+#
+#
+#
+# Revision history:
+# ----------------
+#
+# 26-Nov-96 - Task created (I.Busko)
+
+procedure txicpy (itp, im, irow, icp, datatype, size)
+
+pointer itp # i: pointer to descriptor of input table
+pointer im # i: pointer to output image
+int irow # i: row in input table
+pointer icp # i: array of pointers for input columns
+int datatype # i: data type
+int size # i: array size
+#--
+int nbuf
+pointer sp, bufin, bufout, errmsg, colname
+
+string badtype "Unsupported column data type (%s)"
+
+pointer impl1s(), impl1i(), impl1r(), impl1d()
+begin
+ call smark (sp)
+ call salloc (bufin, size, datatype)
+
+ switch (datatype) {
+ case TY_SHORT:
+ call tcs_rdarys (itp, icp, irow, size, nbuf, Mems[bufin])
+ bufout = impl1s (im)
+ call amovs (Mems[bufin], Mems[bufout], size)
+ case TY_INT,TY_LONG:
+ call tcs_rdaryi (itp, icp, irow, size, nbuf, Memi[bufin])
+ bufout = impl1i (im)
+ call amovi (Memi[bufin], Memi[bufout], size)
+ case TY_REAL:
+ call tcs_rdaryr (itp, icp, irow, size, nbuf, Memr[bufin])
+ bufout = impl1r (im)
+ call amovr (Memr[bufin], Memr[bufout], size)
+ case TY_DOUBLE:
+ call tcs_rdaryd (itp, icp, irow, size, nbuf, Memd[bufin])
+ bufout = impl1d (im)
+ call amovd (Memd[bufin], Memd[bufout], size)
+ default:
+ # Unsupported type, write error message
+ call salloc (colname, SZ_COLNAME, TY_CHAR)
+ call salloc (errmsg, SZ_LINE, TY_CHAR)
+ call tcs_txtinfo (icp, 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/tximage/txihc.x b/pkg/utilities/nttools/threed/tximage/txihc.x
new file mode 100644
index 00000000..0f546b43
--- /dev/null
+++ b/pkg/utilities/nttools/threed/tximage/txihc.x
@@ -0,0 +1,53 @@
+#
+# TXIHC -- Write basic column info into image header.
+#
+#
+#
+#
+# Revision history:
+# ----------------
+#
+# 26-Nov-96 - Task created (I.Busko)
+# 03-Jan-97 - Revised after code review (IB)
+
+
+procedure txihc (im, colnum, colname, colunits, colfmt, lenfmt)
+
+pointer im # i: pointer to image
+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 lenfmt # i: length of format string
+#--
+pointer sp, cu, cf, text
+
+begin
+ call smark (sp)
+ call salloc (text, SZ_LINE, TY_CHAR)
+ call salloc (cu, SZ_LINE, TY_CHAR)
+ call salloc (cf, SZ_LINE, TY_CHAR)
+
+ # 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, "%d %s %s %s %d")
+ call pargi (colnum)
+ call pargstr (colname)
+ call pargstr (Memc[cu])
+ call pargstr (Memc[cf])
+ call pargi (lenfmt)
+
+ # Write keyword into header.
+ call imastr (im, "COLDATA", Memc[text])
+ call sfree (sp)
+end
+
diff --git a/pkg/utilities/nttools/threed/tximage/tximage.x b/pkg/utilities/nttools/threed/tximage/tximage.x
new file mode 100644
index 00000000..c8575950
--- /dev/null
+++ b/pkg/utilities/nttools/threed/tximage/tximage.x
@@ -0,0 +1,117 @@
+include <error.h>
+
+# TXIMAGE -- Extract image from 3D table row.
+
+# 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
+# images or a directory. Since one input table specification can generate
+# multiple output images, a naming scheme for these is defined as follows:
+#
+# - if output name is a directory:
+# output image 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 image 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:
+# ----------------
+#
+# 26-Nov-96 - Task created (I.Busko)
+# 03-Jan-97 - Revised after code review (IB)
+
+
+procedure t_tximage()
+
+char tablist1[SZ_LINE] # Input table list
+char imlist2[SZ_LINE] # Output image list
+bool verbose # Print operations ?
+
+char table1[SZ_PATHNAME] # Input table name
+char image2[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 ("output", imlist2, SZ_LINE)
+ verbose = clgetb ("verbose")
+
+ # Check if the output string is a directory.
+
+ if (isdirectory (imlist2, dirname, SZ_PATHNAME) > 0) {
+ 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, image2, SZ_PATHNAME)
+ root_len = fnldir (image2, rootname, SZ_PATHNAME)
+ call strcpy (image2[root_len + 1], rootname, SZ_PATHNAME)
+
+ call strcpy (dirname, image2, SZ_PATHNAME)
+ call strcat (rootname, image2, SZ_PATHNAME)
+
+ iferr (call txione (table1, image2, verbose))
+ call erract (EA_WARN)
+
+ call sfree (sp)
+ }
+ call imtclose (list1)
+
+ } else {
+ # Expand the input and output table lists.
+
+ list1 = imtopen (tablist1)
+ list2 = imtopen (imlist2)
+
+ if (imtlen (list1) != imtlen (list2)) {
+ call imtclose (list1)
+ call imtclose (list2)
+ call error (1, "Number of input and output files not the same")
+ }
+
+ # Expand each table.
+
+ while ((imtgetim (list1, table1, SZ_PATHNAME) != EOF) &&
+ (imtgetim (list2, image2, SZ_PATHNAME) != EOF)) {
+
+ call smark (sp)
+
+ if (streq (table1, image2)) {
+ call eprintf ("can't expand table to itself: %s\n")
+ call pargstr (table1)
+ next
+ }
+ iferr (call txione (table1, image2, verbose))
+ call erract (EA_WARN)
+
+ call sfree (sp)
+ }
+
+ call imtclose (list1)
+ call imtclose (list2)
+ }
+end
diff --git a/pkg/utilities/nttools/threed/tximage/txione.x b/pkg/utilities/nttools/threed/tximage/txione.x
new file mode 100644
index 00000000..fa03714d
--- /dev/null
+++ b/pkg/utilities/nttools/threed/tximage/txione.x
@@ -0,0 +1,214 @@
+include <tbset.h>
+include <imhdr.h>
+
+# TXIONE -- Extract images from a single input 3D table.
+#
+#
+#
+# This code is adapted from B.Simon's 04-Nov-94 version of tcopy.
+#
+#
+# Revision history:
+# ----------------
+#
+# 22-Nov-96 - Task created (I.Busko)
+# 16-Dec-96 - Add ORIG_ROW keyword (IB).
+# 03-Jan-97 - Revised after code review (IB)
+# 17-Mar-97 - Added selrows call (IB)
+# 8-Apr-02 - Remove the call to whatfile (P. Hodge)
+
+
+procedure txione (input, output, verbose)
+
+char input[ARB] # i: input table name
+char output[ARB] # i: output table name
+bool verbose # i: print operations ?
+#--
+int numrow, numcol, numptr, irow, nrows
+int colnum, datatype, lendata, lenfmt
+pointer sp, root, extend, rowselect, colselect, colname, colunits, colfmt
+pointer errmsg, icp, itp, im, colptr, pcode
+pointer newname
+bool suffix
+
+string noarray "No valid image data in %s"
+string nocols "Column name not found (%s)"
+string manycols "Too many columns (%s)"
+
+errchk tbtopn, trsopen, trseval
+
+bool trseval()
+int tbpsta(), tcs_totsize(), selrows()
+pointer tbtopn(), tcs_column, trsopen(), immap()
+
+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)
+
+ # 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.
+ nrows = selrows (itp, Memc[rowselect])
+ if (nrows == 1)
+ suffix = false
+ else
+ suffix = true
+
+ # Create array of column pointers from column selector.
+ # This is necessary to avoid segv in case more than one
+ # column selector is passed to the task.
+ call malloc (colptr, numcol, TY_INT)
+ call tcs_open (itp, Memc[colselect], Memi[colptr], numptr, numcol)
+
+ # Take an error exit if either no columns were matched or
+ # more than one column was matched.
+ if (numptr == 0) {
+ call sprintf (Memc[errmsg], SZ_LINE, nocols)
+ call pargstr (input)
+ call error (1, Memc[errmsg])
+ } else if (numptr != 1) {
+ call sprintf (Memc[errmsg], SZ_LINE, manycols)
+ call pargstr (input)
+ call error (1, Memc[errmsg])
+ }
+
+ # Loop over selected rows on input table,
+ # creating an image 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 txisuff (output, Memc[newname], irow)
+ else
+ call strcpy (output, Memc[newname], SZ_FNAME)
+
+ if (verbose) {
+ call eprintf ("%s row=%d -> %s\n")
+ call pargstr (input)
+ call pargi (irow)
+ call pargstr (Memc[newname])
+ }
+
+ # Get column information.
+ icp = tcs_column (Memi[colptr])
+ call tbcinf (icp, colnum, Memc[colname], Memc[colunits],
+ Memc[colfmt], datatype, lendata, lenfmt)
+
+ # Take error exit if scalar or invalid type.
+ if ((lendata < 2) || (datatype < 0) || (datatype == TY_BOOL)){
+ call sprintf (Memc[errmsg], SZ_LINE, noarray)
+ call pargstr (input)
+ call error (1, Memc[errmsg])
+ }
+
+ # Open output image
+ im = immap (Memc[newname], NEW_IMAGE, NULL)
+ IM_NDIM(im) = 1
+
+ # Copy array to image.
+ IM_LEN(im,1) = tcs_totsize (Memi[colptr])
+ IM_PIXTYPE(im) = datatype
+ call txicpy (itp, im, irow, Memi[colptr], datatype,
+ IM_LEN(im,1))
+
+ # Write column data into header.
+ call txihc (im, colnum, Memc[colname], Memc[colunits],
+ Memc[colfmt], lenfmt)
+
+ # Write row number into header.
+ call imaddi (im, "ORIG_ROW", irow)
+
+ # Close output.
+ call imunmap (im)
+ }
+ }
+
+ # Free memory associated with columns.
+ call tcs_close (Memi[colptr], numptr)
+ 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 image name.
+
+procedure txisuff (filename, newname, row)
+
+char filename[ARB] # i: output image name
+char newname[ARB] # o: output image name with suffix
+int row # i: row number
+
+pointer sp, ext, suffix
+int dot, i, j
+
+int strcmp(), strldxs(), strlen()
+
+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 .??h, .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 ( ((strlen (Memc[ext]) == 4) && (Memc[ext+3] == 'h')) ||
+ (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
generated by cgit (git 2.34.1) at 2025-09-20 11:18:44 -0400