diff options
Diffstat (limited to 'pkg/utilities/nttools/threed')
95 files changed, 8281 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/threed/doc/selectors.hlp b/pkg/utilities/nttools/threed/doc/selectors.hlp new file mode 100644 index 00000000..fd5390a7 --- /dev/null +++ b/pkg/utilities/nttools/threed/doc/selectors.hlp @@ -0,0 +1,91 @@ +.help selectors Nov96 tables +.ih +NAME +selectors -- Table row/column selector syntax. +.ih +BASIC SYNTAX +Selectors are appended to table names using a bracket notation. The +construct "[c:......]" appended to a table name tells that a column +selector exists. In a similar way, the construct "[r:......]" indicates +a row selector. +.ih +COLUMN SELECTOR +The basic structure of a column selector is a list of column patterns +separated by commas. The column pattern is either a column name, a file +name containing a list of column names, or a pattern using the usual IRAF +pattern matching syntax. For example, the string +.nf + [c:a[1-9], b, time*, @column.lis] +.fi + +would be expanded as the column names a1 through a9, b, any column +name beginning with "time", and all the column names in the file +column.lis. If the column list is entirely whitespace, all columns are +selected. If the first non-white character is the negation character (~), +the selected columns will include all columns not matched by the list. +The negation character only has this meaning at the beginning of the list. +.ih +ROW SELECTOR +Rows are selected according to a qpoe filter. The filter is evaluated +at each table row, and the row is selected if the filter is true. + +For sake of an example, suppose we have a star catalog with the +columns Name, Ra, Dec, V, B-V, and U-B. The simplest sort of filter is +the equality test. The name of the column appears on the left of an +equals sign and the column value appears on the right. For example, +[name=eta_uma]. (The brackets in this and the following example are +not actually part of the filter.) Column numbers can be used in place +of the column name. This is especially useful for ascii +tables. Values can be either numbers or strings. It is usually not +necessary to place strings in quotes. However, any string (including +a column name) contains embedded blanks or characters significant to +the qpoe filter, such a equal signs, commas, or colons, it should be +placed in quotes. + +Ranges of values can be specified by giving the endpoints of the +ranges separated by a colon. For example, [r:v=10:15] selects all rows +with visual magnitude between 10 and 15. Ranges include their +endpoints. Ranges can also be used with strings as well as +numbers. Ranges can also be one sided. The filter [r:dec=80:] selects +all rows with declination greater than or equal to eighty degress and +the filter [r:dec=:-40] selects all declinations less than or equal to +forty degrees south. A filter can contain a list of single values and +ranges. The values in the list should be enclosed in parentheses. For +example, [r:name=(eta_uma,alpha_lyr)] or [r:b-v=(-1:0,0.5:1)]. + +Individual values or ranges can be negated by placing a ! in front of +them. For example, [r:name=!eta_uma] selects every row except the star +named eta_uma and [r:ra=!0:6] selects all rows except those with right +ascension between zero and six hours. An entire list can be negated by +placing a ! in front of the column name or the parentheses enclosing +the list. The filters [r:!name=(eta_uma,alpha_lyr)] and +[r:name=!(eta_uma,alpha_lyr)] and [r:name=(!eta_uma,!alpha_lyr)] are all +equivalent. + +Filters can test more than one column in a table. The individual tests +are separated by commas or semicolons. All tests in the filter must +succeed for the filter to be accepted. For example, +[r:ra=1.3:1.4,dec=40:42] selects a rectangular region in the catalog. A +range of row numbers can also be selected by placing the word row on +the left side of the equals sign. For example, [r:row=10:20] selects +rows from ten to twenty inclusive and [r:row=50:] selects all rows from +fifty on. Row selection can be combined with any other test in a +filter. A filter, can also be placed in an include file, for example +[r:@filter.lis]. Include files can be a part of a larger expression +and include files can contain other files, up to seven levels deep. +.ih +EXAMPLES +.nf +1. "[c:WAVELENGTH,FLUX]" selects columns named "WAVELENGTH" and + "FLUX" + +2. "[r:WAVELENGTH=(4000:5000)]" selects all rows in which the WAVELENGTH + column assumes values in between 4000 and + 5000. + +3. "[c:FLUX][r:row=(25:30)]" selects column FLUX and all rows from 25 + to 30. +.fi +.ih +SEE ALSO +.endhelp diff --git a/pkg/utilities/nttools/threed/doc/tiimage.hlp b/pkg/utilities/nttools/threed/doc/tiimage.hlp new file mode 100644 index 00000000..1319d2e0 --- /dev/null +++ b/pkg/utilities/nttools/threed/doc/tiimage.hlp @@ -0,0 +1,108 @@ +.help tiimage Jan97 tables +.ih +NAME +tiimage -- Inserts images into rows of a 3-D table. +.ih +USAGE +tiimage input outtable +.ih +DESCRIPTION +This task performs the inverse operation of task tximage: it inserts one or +more images into rows of a 3-D table The input may be a filename template, +including wildcard characters, or the name of a file (preceded by an @ sign) +containing image names. The output is a single 3-D table name. +Each image in the input list is inserted as an array into a single cell at +the specified row in the output table. Any dimensionality information existent +in the input image is lost in the process, that is, the image will be always +inserted as a 1-D array, regardless of its number of axis. + +If the output table exists, insertion will be done in place. Alternatively, +the task can create a 3-D table from information taken either from a template +3-D table, or, if this table is not supplied, from the input images themselves. +This task supports a column selector in table names. This selector may be +used to select a single column in the table. If no selector is used, all +columns will be processed. Type 'help selectors' to see a description of +the selector syntax. + +If the output table exists, insertion may take place in two ways. If the +output table name contains a column selector that selects a single column +in the table, all input images will be inserted in that column, starting +at the row pointed by task parameter "row". +If "row" is negative or INDEF the task will look for the ORIG_ROW +keyword in the image header and use that keyword value for row number. +The second mode of insertion in an existing table is used if no matching +column selector is found in the output table name. In this case the task +will look for the columnar information written in the input image header by +task tximage, and use that information to place the image in the proper +column. If no columnar information exists in the header, or if the column +name in there does not match any column in the output table, the image is +skipped and the user warned. The "row" parameter processing works the same +way in this second mode. + +If the output table does not exist, the task will look for a template table +where to take column information from. If the template exists, the insertion +operation will be performed in an analogous way as above. Notice that the +result may be a single-column table if the template has a valid (matching) +column selector in its name, or a sparse table if not, because only the +actual input images will be stored in an otherwise empty table (the template +data is not copied into the output, only the column descriptors). + +If the template is missing, the task will attempt to retrieve columnar +information from the input image headers and build the output table with +enough columns and rows to fit all images in the list. Only images that +have columnar information in their headers can be processed, though. If +no images are found with the proper header keywords, no output takes place. + +NOTE: Both the output and template table names must always be supplied +complete, including their extension. Otherwise the task may get confused +on the existence of an already existing table. + +The column matching criterion is based on the column name. An error results +when data types in input image and output column do not agree. + +If the maximum array size in a target column in the output 3-D table is +larger than the number of pixels in the input image, the array will be filled +up starting from its first element, and the empty elements at the end will +be set to INDEF. If the maximum array size is smaller than the number of +pixels, insertion begins by the first pixel up to the maximum allowable size, +the remaining pixels being ignored. +.ih +PARAMETERS +.ls input [image name list/template] +A list of one or more images to be inserted. +.le +.ls outtable [table name] +Name of 3-D output table, including extension. No support exists for +"STDOUT" (ASCII output). +.le +.ls (template = "") [table name] +Name of 3-D table to be used as template when creating a new output table. +.le +.ls (row = INDEF) [int] +Row where insertion begins. If set to INDEF or a negative value, the row +number will be looked for in the input image header. +.le +.ls (verbose = yes) [boolean] +Display names as files are processed ? +.le +.ih +EXAMPLES +Insert images into a 3-D table at column named FLUX: + +.nf +cl> tiimage flux*.hhh "otable.tab[c:FLUX]" +.fi +.ih +BUGS +The output and template table names must be supplied in full, including +the extension (e.g. ".tab"). If the output table name is not typed in full, +the task will create a new table in place of the existing one, with only +the rows actually inserted. This behavior relates to the way the underlying +"access" routine in IRAF's fio library works. +.ih +REFERENCES +This task was written by I. Busko. +.ih +SEE ALSO +tximage, selectors +.endhelp diff --git a/pkg/utilities/nttools/threed/doc/titable.hlp b/pkg/utilities/nttools/threed/doc/titable.hlp new file mode 100644 index 00000000..f0479b6b --- /dev/null +++ b/pkg/utilities/nttools/threed/doc/titable.hlp @@ -0,0 +1,100 @@ +.help titable Mar97 tables +.ih +NAME +titable -- Inserts 2-D tables into rows of a 3-D table. +.ih +USAGE +titable intable outtable +.ih +DESCRIPTION +This task performs the inverse operation of task txtable: it inserts one or +more 2-D tables into rows of a 3-D table The input may be a filename +template, including wildcard characters, or the name of a file (preceded by +an @ sign) containing table names. The output is a single 3-D table name. +If the output table exists, insertion will be done in place. If the output +table does not exist, it will be created. The input and output tables must +not be the same. + +This task supports row/column selectors in the input table names. These +may be used to select subsets of both rows and columns from the input table. +If no selectors are used, all columns and rows will be processed, +Type 'help selectors' to see a description of the selector syntax. + +When creating a new output table, the information describing its columns +can be taken from two sources. If parameter 'template' has the name of an +existing 3-D table, the column descriptions, including maximum array sizes, +will be taken from that table. If 'template' has an invalid or null ("") +value, the column-defining information will be take from the first table +in the input list, where its number of rows will define the maximum array +size allowed in the table being created. Column selectors are allowed in +the template table. + +NOTE: Both the output and template table names must always be supplied +complete, including their extension. Otherwise the task may get confused +on the existence of an already existing table. + +Insertion is performed by first verifying if column names in both input +and output tables match. If a match is found, values taken from that column +and all selected rows from the input table will be stored as a 1-dimensional +array in a single cell in the corresponding column in the output 3-D table. +The row in this table where the insertion takes place is selected by the +"row" task parameter. It points to the row where the first table in the input +list will be inserted, subsequent tables in the list will be inserted into +subsequent rows. This mechanism is superseded if the "row" parameter is set +to INDEF or a negative value, and the keyword "ORIG_ROW" is found in the +header of the input table. This keyword is created by task txtable and its +value supersedes the row counter in the task. + +If the maximum array size in a target column in the output 3-D table is +larger than the number of selected input rows, the array will be filled +up starting from its first element, and the empty elements at the end will +be set to INDEF (or "" if it is a character string column). If the maximum +array size is smaller than the number of selected rows, insertion begins by +the first selected row up to the maximum allowable size, the remaining rows +being ignored. + +This task correctly handles scalars stored in the input table header +by task txtable. Since the selector mechanism does not work with these +scalars, the task will always insert them into the output table, provided +there is a match in column names. +.ih +PARAMETERS +.ls intable [file name list/template] +A list of one or more tables to be inserted. Row/column selectors are supported. +.le +.ls outtable [table name] +Name of 3-D output table, including extension. No support exists for +"STDOUT" (ASCII output). +.le +.ls (template = "") [table name] +Name of 3-D table to be used as template when creating a new output table. +.le +.ls (row = INDEF) [int] +Row where insertion begins. If set to INDEF or a negative value, the row +number will be looked for in the input table header. +.le +.ls (verbose = yes) [boolean] +Display names of input and output tables as files are processed ? +.le +.ih +EXAMPLES +Insert columns named FLUX and WAVELENGTH from input tables into a 3-D table: + +.nf +cl> titable "itable*.tab[c:FLUX,WAVELENGTH]" otable.tab +.fi + +.ih +BUGS +The output and template table names must be supplied in full, including +the extension (e.g. ".tab"). If the output table name is not typed in full, +the task will create a new table in place of the existing one, with only the +rows actually inserted. This behavior relates to the way the underlying +"access" routine in IRAF's fio library works. +.ih +REFERENCES +This task was written by I. Busko. +.ih +SEE ALSO +txtable, selectors +.endhelp diff --git a/pkg/utilities/nttools/threed/doc/tscopy.hlp b/pkg/utilities/nttools/threed/doc/tscopy.hlp new file mode 100644 index 00000000..144b483a --- /dev/null +++ b/pkg/utilities/nttools/threed/doc/tscopy.hlp @@ -0,0 +1,94 @@ +.help tscopy Nov96 tables +.ih +NAME +tscopy -- Copy tables. +.ih +USAGE +tscopy intable outtable +.ih +DESCRIPTION +This task is used to copy tables. The input may be a filename +template, including wildcard characters or the name of a file (preceded +by an @ sign) containing table names. The output may be either a directory +specification or a list of table names. If the output is a list of tables +then there must be the same number of names in the input and output lists, +and the names are taken in pairs, one from input and one from output. +The input and output tables must not be the same. + +This task supports row/column selectors in the input table name. These +may be used to select subsets of both rows and columns from the input table. +Type 'help selectors' to see a description of the selector syntax. + +NOTE: Be careful when using a wildcard for the extension. +If you have the files 'table.tab' and 'table.lis' in the current directory, +for example, then the command "tscopy tab* test/" would copy both files to the subdirectory +'test'. +.ih +PARAMETERS +.ls intable [file name template] +A list of one or more tables to be copied. Row/column selectors are supported. +.le +.ls outtable [file name template] +Either a directory name or a list of output table names. The standard +value "STDOUT" generates ASCII output that can be redirected to a file. +.le +.ls (verbose = yes) [boolean] +Display names of input and output tables as files are copied? +.le +.ih +EXAMPLES +1. To simply copy a table: + +.nf + cl> tscopy table tablecopy +.fi + +2. To copy a table into an ASCII table: + +.nf + cl> tscopy table STDOUT > table.txt +.fi + +3. To copy several tables: + +.nf + cl> tscopy table1,table2,tab67 a,b,c + cl> tscopy tab*.tab a,b,c +.fi +In the latter case the extension is given explicitly in case there +are other files beginning with "tab" that are not tables; there must +be exactly three tables beginning with "tab" because the output list +has three names. + +4. To copy a set of tables to a new directory: + +.nf + cl> tscopy table*.tab directory + or + cl> tscopy table*.tab directory$ + or + cl> tscopy table*.tab osdirectory +.fi + +where "directory" is an IRAF environment variable for a directory name, +and "osdirectory" is an operating system directory name +(e.g., "/user/me/" in UNIX). + +5. To copy a subset of rows and columns: + +.nf + cl> tscopy "table.tab[c:wave,flux][r:wave=(4000:5000)]" tableout +.fi + +This command will copy only columns named "wave" and "flux" from the input +table to the output. It will also select and copy only the rows in which +the "wave" value lies between 4000 and 5000. +.ih +BUGS +.ih +REFERENCES +This task was written by Bernie Simon. +.ih +SEE ALSO +selectors +.endhelp diff --git a/pkg/utilities/nttools/threed/doc/tximage.hlp b/pkg/utilities/nttools/threed/doc/tximage.hlp new file mode 100644 index 00000000..9f331958 --- /dev/null +++ b/pkg/utilities/nttools/threed/doc/tximage.hlp @@ -0,0 +1,85 @@ +.help tximage Jan97 tables +.ih +NAME +tximage -- Extract 1-D images from cells of a 3-D table. +.ih +USAGE +tximage intable output +.ih +DESCRIPTION +This task extracts one or more 1-D images from cells of a 3-D table. +The input may be a filename template, including wildcard characters, +or the name of a file (preceded by an @ sign) containing table names. +The output may be either a directory specification or a list of image names. +If the output is a list of images then there must be the same number of names +in the input and output lists, and the names are taken in pairs, one from +input and one from output. + +Images can be extracted only from a single column in the input table. +That column must be designated by an appropriate column selector appended to +the table name. Type 'help selectors' to get more information on row/column +selector syntax. + +Row selectors may be used to select subsets of rows from the input table. +If no row selector is used, all rows will be extracted, and the number +of output images will be the number of rows in the input table. + +Since one input table may generate several output images, the task adopts +the following naming scheme for these output images: their names are +built by appending a suffix to the name given in parameter "output". +The suffix has the form "_rXXXX", where XXXX stands for the row number +in the input table. The suffix is appended before the file name extension. +The task recognizes as valid image name extensions the values ".??h", +".fits" and ".fit". Any other extension is assumed to be part of the root +file name. If only one row is extracted, no suffixing takes place. + +NOTE: Be careful when using a wildcard for the extension. +If you have the files "table.tab" and "table.lis" in the current directory, +for example, then the command "tximage tab* test/" would expand both files +to the subdirectory "test". + +Basic column information describing the column where the image came from +is written into the image header in the "COLDATA" keyword. This information +can be used later by task 'tiimage' to re-insert the image into a cell of +a 3-D table. + +The task does not propagate array dimensionality when extracting arrays +into images. If dimensionality information exists in the 3-D table, that +information is lost, that is, the table cell from the input table is written +as a structureless, plain 1-D image. + +The input row number is written to the header of the output image in +keyword ORIG_ROW. This allows 'tiimage' to put the data back where +'tximage' got them from. +.ih +PARAMETERS +.ls intable [file name list/template] +A list of one or more tables to be expanded. A column selector selecting +a single column is mandatory. Row selectors are supported as well. +.le +.ls output [file name template] +Either a directory name or a list of output image names. +.le +.ls (verbose = yes) [boolean] +Display names of input and output files ? +.le +.ih +EXAMPLES +Extract 1-D images from a column named FLUX from rows 11 to 13 of a 3-D +table: + +.nf +cl> tximage "table.tab[c:FLUX][r:row=(11:13)]" image +.fi + +This will generate three images named "image_r0011", "image_r0012" +and "image_r0013". +.ih +BUGS +.ih +REFERENCES +This task was written by I. Busko. +.ih +SEE ALSO +tiimage, selectors +.endhelp diff --git a/pkg/utilities/nttools/threed/doc/txtable.hlp b/pkg/utilities/nttools/threed/doc/txtable.hlp new file mode 100644 index 00000000..462b8b95 --- /dev/null +++ b/pkg/utilities/nttools/threed/doc/txtable.hlp @@ -0,0 +1,89 @@ +.help txtable Jan97 tables +.ih +NAME +txtable -- Extract rows from a 3-D table into separate 2-D tables. +.ih +USAGE +txtable intable outtable +.ih +DESCRIPTION +This task extracts one or more rows from a 3-D table and writes each row +as a 2-D table. The input may be a filename template, including +wildcard characters, or the name of a file (preceded by an @ sign) containing +table names. The output may be either a directory specification or a list +of table names. If the output is a list of tables then there must be the same +number of names in the input and output lists, and the names are taken in +pairs, one from input and one from output. The input and output tables must +not be the same. + +This task supports row/column selectors in the input table name. These +may be used to select subsets of both rows and columns from the input table. +If no selectors are used, all columns will be extracted, and the number +of output tables will be the number of rows in the input table. +Type 'help selectors' to see a description of the selector syntax. + +Since one input table may generate several output tables, the task adopts +the following naming scheme for these output tables: their names are +built by appending a suffix to the name given in parameter "outtable". +The suffix has the form "_rXXXX", where XXXX stands for the row number +in the input table. The suffix is appended before the file name extension. +The task recognizes as valid table name extensions the values ".tab", +".fits" and ".fit". Any other extension is assumed to be part of the root +file name. If only one row is extracted, or in case of ASCII output, no +suffixing takes place. + +NOTE: Be careful when using a wildcard for the extension. +If you have the files "table.tab" and "table.lis" in the current directory, +for example, then the command "txtable tab* test/" would expand both files +to the subdirectory "test". + +There are two forms of handling scalar columns in the input table. If +task parameter "compact" is set to 'no', the corresponding column in the +output table will have the scalar value in its first row, and all other +rows will be filled with INDEF. If parameter "compact" is set to 'yes', +scalar columns will be written into the header as a set of header keywords. +These keywords can be used later by task 'titable' to re-insert the +scalars as cell elements of a 3-D table. + +The task does not propagate array dimensionality when extracting arrays +into columns in the output table. If dimensionality information exists +in the 3-D table, that information is lost, that is, the table cell from +the input table is written as a structureless, plain table column. + +The input row number is written to the header of the output table in +keyword ORIG_ROW. This allows 'titable' to put the data back where +'txtable' got them from. +.ih +PARAMETERS +.ls intable [file name list/template] +A list of one or more tables to be expanded. Row/column selectors are supported. +.le +.ls outtable [file name template] +Either a directory name or a list of output table names. The standard +value "STDOUT" generates ASCII output that can be redirected to a file. +.le +.ls (compact = yes) [boolean] +Write scalars as header keywords ? +.le +.ls (verbose = yes) [boolean] +Display names of input and output tables as files are processed ? +.le +.ih +EXAMPLES +Extract columns named FLUX and WAVELENGTH from rows 11 to 13 of a 3-D table: + +.nf +cl> txtable "table.tab[c:FLUX,WAVELENGTH][r:row=(11:13)]" tableout +.fi + +This will generate three tables named "tableout_r0011", "tableout_r0012" +and "tableout_r0013". +.ih +BUGS +.ih +REFERENCES +This task was written by I. Busko. +.ih +SEE ALSO +titable, selectors +.endhelp diff --git a/pkg/utilities/nttools/threed/mkpkg b/pkg/utilities/nttools/threed/mkpkg new file mode 100644 index 00000000..ee093810 --- /dev/null +++ b/pkg/utilities/nttools/threed/mkpkg @@ -0,0 +1,25 @@ +# Make the threed package +# I.Busko, 21-Nov-1996 +# +# Special keywords recognized by IRAF mkpkg files: +# +# mkpkg relink update object library and link +# mkpkg linkonly skip object library updates and just link +# mkpkg install move executable to lib$ +# mkpkg update update object library, link, and move to lib$ + + +$call libpkg.a +$exit + +libpkg.a: + $call generic@tiimage + $call generic@titable + $call generic@txtable + + @tscopy + @txtable + @tximage + @titable + @tiimage + ; diff --git a/pkg/utilities/nttools/threed/tblerr.h b/pkg/utilities/nttools/threed/tblerr.h new file mode 100644 index 00000000..cbf6ac36 --- /dev/null +++ b/pkg/utilities/nttools/threed/tblerr.h @@ -0,0 +1,27 @@ +# tblerr.h -- error codes for table I/O routines +# +# Phil Hodge, 30-Sep-87 Change numbers and reorganize. +# Phil Hodge, 2-Jun-89 Remove 4867 from error numbers. + +define ER_TBNAMTOOLONG 01 # file name (incl extension) is too long +define ER_TBBADMODE 02 # I/O mode is not supported for a table +define ER_TBREADONLY 03 # attempt to modify a readonly table + +define ER_TBTOOLATE 31 # too late, table is already open +define ER_TBNOTOPEN 32 # table must be open for this option +define ER_TBBADOPTION 33 # invalid option for tbpset +define ER_TBUNKPARAM 34 # unknown parameter for tbpsta + +define ER_TBCOLEXISTS 41 # column already exists +define ER_TBBADTYPE 42 # invalid data type for a table column + +define ER_TBBEYONDEOF 51 # requested row is beyond EOF + +define ER_TBPARNOTFND 61 # header parameter not found +define ER_TBMUSTADD 62 # new parameter must be added, not put +define ER_TBDTYPECONFLICT 63 # can't put numeric parameter as comment + +define ER_TBCORRUPTED 81 # table or memory is corrupted +define ER_TBCOLBADTYP 82 # bad data type (memory corrupted?) +define ER_TBFILEMPTY 83 # table data file is empty +define ER_TBCINFMISSING 84 # EOF while reading column info diff --git a/pkg/utilities/nttools/threed/tbtables.h b/pkg/utilities/nttools/threed/tbtables.h new file mode 100644 index 00000000..60e79159 --- /dev/null +++ b/pkg/utilities/nttools/threed/tbtables.h @@ -0,0 +1,123 @@ +# tbtables.h -- Internal definitions for the table I/O package. + +# Software version number. +# Version 0 corresponds to STSDAS and TABLES versions 1.2.3 and earlier. +# The row length was restricted to integral multiples of the size of a +# real number. +# Version 1 begins with STSDAS and TABLES version 1.3. Short integer +# datatype was introduced, and character strings were rounded up to a +# multiple of the number of bytes in a char. The row length is allowed +# to be any integral multiple of SZ_CHAR. +# Version 2 allows header parameters to have comments. +# This change was made after TABLES version 1.3.3 was released. +define TBL_CURRENT_VERSION 2 + +# Default maximum number of user parameters. The current value is TB_MAXPAR. +define DEFMAXPAR 5 + +# Default maximum number of columns. The current value is TB_MAXCOLS. +define DEFMAXCOLS 5 + +# This section describes the size information record. +define LEN_SIZINFO 12 # unit = SZ_INT32 +define SZ_SIZINFO (LEN_SIZINFO * SZ_INT32) +define S_NPAR $1[1] # Number of user parameters +define S_MAXPAR $1[2] # Max number of user parameters +define S_NROWS $1[3] # Number of rows +define S_ALLROWS $1[4] # Number of rows allocated +define S_NCOLS $1[5] # Number of columns defined +define S_MAXCOLS $1[6] # Current max number of columns +define S_COLUSED $1[7] # Chars used by defined columns +define S_ROWLEN $1[8] # Total row length alloc (chars) +define S_TYPE $1[9] # Type (row or column ordered) +define S_VERSION $1[10] # Software version number + +# This is the size of the table-descriptor structure. +define LEN_TBLSTRUCT (28) + +# General descriptive information. (R) means relevant only for row-ordered +# tables, while (C) means relevant only for column-ordered tables. +define TB_TYPE Memi[$1] # what type of table +define TB_NPAR Memi[$1+1] # number of user paramters +define TB_MAXPAR Memi[$1+2] # max number of user paramters +define TB_NROWS Memi[$1+3] # number of rows +define TB_ALLROWS Memi[$1+4] # (C) allocated number of rows +define TB_NCOLS Memi[$1+5] # number of columns +define TB_MAXCOLS Memi[$1+6] # current max number of columns +define TB_COLUSED Memi[$1+7] # (R) chars used by columns +define TB_ROWLEN Memi[$1+8] # (R) row length = chars alloc +define TB_VERSION Memi[$1+9] # Software version number +define TB_BOD Meml[$1+10] # L beg of data (in SZ_CHAR) +define TB_IOMODE Memi[$1+11] # I/O mode + +# Flags +define TB_IS_OPEN Memb[$1+12] # Table is open? +define TB_READONLY Memb[$1+13] # Readonly? +define TB_MODIFIED Memb[$1+14] # Actually been changed? + +# File descriptor for the table file +define TB_FILE Memi[$1+15] + +# Pointers. TB_INDEF is only used for row-ordered tables. +define TB_INDEF Memi[$1+16] # Pointer to indef record buffer +define TB_COLPTR Memi[$1+17] # Ptr to array of column ptrs + +# These are for tables in CDF files or FITS files. +define TB_F_TYPE Memi[$1+18] # CDF, FITS, or ordinary file +define TB_HDU Memi[$1+19] # number of HDU in FITS file +define TB_EXTVER Memi[$1+20] # version number +define TB_OVERWRITE Memi[$1+21] # +1 --> yes, 0 --> no +define TB_HDUTYPE Memi[$1+22] # 1--> ascii; 2 --> binary +define TB_CD Memi[$1+23] # returned by cd_open() +define TB_EXTNAME_PTR Memi[$1+24] # pointer to CDF name or EXTNAME +define TB_EXTNAME Memc[TB_EXTNAME_PTR($1)] + +# These two are for text tables. +define TB_COMMENT Memi[$1+25] # pointer to comment string +define TB_SZ_COMMENT Memi[$1+26] # size of comment string + +# Table name +define TB_NAME_PTR Memi[$1+27] # pointer to table name string +define TB_NAME Memc[TB_NAME_PTR($1)] + + +# Array of pointers to column information. This array can be reallocated +# to allow more columns; the current size at any time is TB_MAXCOLS. +define TB_COLINFO Memi[TB_COLPTR($1)+$2-1] + + + +# Column information structure. +define LEN_COLSTRUCT 16 # unit = SZ_STRUCT +define SZ_COLSTRUCT (LEN_COLSTRUCT * SZ_STRUCT) + +define COL_NUMBER Memi[$1] # Column number +define COL_OFFSET Memi[$1+1] # Offset from start of row +define COL_LEN Memi[$1+2] # Chars for data element +define COL_DTYPE Memi[$1+3] # Data type +define COL_NAME Memc[P2C($1+4)] # Column name 19 +define COL_UNITS Memc[P2C($1+9)] # Units 19 +define COL_FMT Memc[P2C($1+14)] # Print format 7 +# Next available field is ($1 + 16). + + +# Definitions of data types. These agree with iraf.h. +define TBL_TY_BOOL 1 +define TBL_TY_CHAR 2 +define TBL_TY_SHORT 3 +define TBL_TY_INT 4 +define TBL_TY_REAL 6 +define TBL_TY_DOUBLE 7 + +# Undefined double for tables. This agrees with the pre-IRAF 2.11 INDEFD. +define TBL_INDEFD 1.6d38 +define TBL_IS_INDEFD (($1)==TBL_INDEFD) + +# These two (which are in tbset.h) are used for the file type TB_F_TYPE +# as well as table type TB_TYPE. +# (moved) define TBL_TYPE_FITS 14 # FITS table +# (moved) define TBL_TYPE_CDF 15 # common datafile format +# These two are modifiers for the table type in case it's a FITS table. +# They are the value of TB_HDUTYPE. +define TBL_FITS_ASCII 1 # FITS ASCII table +define TBL_FITS_BINARY 2 # FITS BINTABLE diff --git a/pkg/utilities/nttools/threed/tiimage.par b/pkg/utilities/nttools/threed/tiimage.par new file mode 100644 index 00000000..27b9c861 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage.par @@ -0,0 +1,7 @@ +input,s,a,"",,,">Input images" +outtable,s,a,"",,,">Output table" +template,s,h,"",,,">Template table" +row,i,h,INDEF,,,">Begin insertion in row" +verbose,b,h,yes,,,">Print operations performed ?" +version,s,h,"30Jan97",,, +mode,s,h,"al",,, diff --git a/pkg/utilities/nttools/threed/tiimage/design1.txt b/pkg/utilities/nttools/threed/tiimage/design1.txt new file mode 100644 index 00000000..8726f475 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/design1.txt @@ -0,0 +1,353 @@ + + + Design of 3-D table translator for image insertion + -------------------------------------------------- + + + Author: I. Busko + + + Revision history: + 01/16/97 - First version. + + + +1. Specifications / requirements: + +This task will perform the inverse operation performed by task tximage. +It will insert (in the tainsert task sense) one or more 1-D images into +rows of an existing 3-D table. Alternatively, it will create a 3-D table +from information taken either from a template 3-D table, or, if this table +is not supplied, from the input images themselves. Each image in the input +list is inserted as an array into a single cell at the specified row in the output table. + +Actions necessary to process the most complicated cases (e.g. when the +image length does not match the table array size) will be similar to the +ones described for task titable. + +If the output table does exist, insertion may take place in two ways. If the +output table name contains a column selector that selects a single column +in the table, all input images will be inserted in that column, starting +at the row pointed by task parameter "row". In a similar way as in task +titable, if "row" is negative or INDEF the task will look for the ORIG_ROW +keyword in the image header and use that keyword value for row number. +The second mode of insertion in an existing table is used if no matching +column selector is found in the output table name. In this case the task +will look for the columnar information written in the input image header by +task tximage, and use that information to place the image in the proper +column. If no columnar information exists in the header, or if the column +name in there does not match any column in the output table, the image is +skipped and the user warned. The "row" parameter processing works the same +way in this second mode. + +If the output table does not exist, the task will look for a template table +where to take column information from. If the template exists, the insertion +operation will be performed in an analogous way as above. Notice that the +result may be a single-column table if the template has a valid (matching) +column selector in its name, or a sparse table if not, because only the +actual input images will be stored in an otherwise empty table (the template +data is not copied into the output, only the column descriptors). + +If the template is missing, the task will attempt to retrieve columnar +information from the input image headers and build the output table with +enough columns and rows to fit all images in the list. Only images that +have columnar information in their headers can be processed, though. If +no images are found with the proper header keywords, no output takes place. +Notice that this task will not be able to handle the most generic case in +which a number of unspecified 1-D images with no proper header keywords +are input to create a 3-D table from scratch (without a template). + +The basic matching criterion is based on the column name. An error results +when datatypes in input image and output column do not agree. + +The task will be named "tiimage" following a former proposal for naming +the 3-D table utilities. + + + +2. Language: + +SPP, to allow the use of the generic datatype compiling facility, and to +reuse significant amounts of code already developed for other tasks in this +suite. + + + +3. Task parameters: + +Name Type What + +input image list/template list of 1D image names +outtable file name 3-D table name with optional column selector + (modified in place or created from scratch). +template file name template 3-D table name with optional column + selector +row int row in output table where to begin insertion. + + + +4. Data structures: + +The main data structure is a pointer-type column descriptor array. This +array is filled by information taken from the several possible sources +described above, and used by the tbtables routines to create and fill up +the output. + + + +5. Code structure: + +MAIN PROCEDURE: +- Read task parameters (clget). +- Decide which mode to use: mode = TMMODE (output name, template name) +- SWITCH mode +- CASE 1, 2: Output table exists. + - Break output table name into bracketed selectors (rdselect). + - Open output table (tbtopn with root name, READ_WRITE). + - Create array with either the single selected column pointer or all + column pointers (malloc, tcs_open). + - Alloc array of column pointers for output table. + - LOOP over all matched columns in tcs_ column array + - Translate pointer from tcs_ format to tbtables format (tcs_column) + - ENDLOOP + - TMLOOP (table pointer, column pointer array, rowpar, image list, mode). + - Close output table (tbtclo) + - Free array (mfree) +- END CASE +- CASE 3, 4: Output table does not exist but template table does exist. + - Break output table name into bracketed selectors (rdselect). + - Open output table (tbtopn with root name, NEW_FILE). + - Break template table name into bracketed selectors (rdselect). + - Open template table (tbtopn with root name, READ_ONLY). + - Create array with either the single selected column pointer or all + column pointers from template table (malloc, tcs_open). + - Alloc array of column pointers for output table. + - LOOP over all matched columns in template tcs_ column array + - Create column in output table (tcs_column, tbcinf, tbcdef) + - ENDLOOP + - Create output table (tbtcre). + - TMLOOP (table pointer, column pointer array, rowpar, image list, mode) + - Close template table (tbtclo) + - Close output table (tbtclo) + - Free arrays (mfree) +- CASE 5: Neither output nor template table exist. + - Alloc memory for strings. + - Alloc memory for column pointer array, assuming the worst case of each + input image in the list belonging to a separate, independent column. + - Open output table (tbtopn with root name, NEW_FILE). + - IFNOTERROR TMSCAN (table pointer, column pointer array, image list) + - Set mode = 2 to force TMLOOP to read column data from headers. + - Create output table (tbtcre). + - TMLOOP (table pointer, column pointer array, rowpar, image list, mode) + - ENDIF + - Close output table (tbtclo) + - Free arrays (mfree) +- END CASE +- CASE -1 + - Print error msg. + - Abort. +- END SWITCH +END MAIN + + + +PROCEDURE TMMODE: Detect mode of operation. + Input parameters: file name, template name (in full) + Return value: mode + + - IF output exists (access) + - mode = TMM1 (output file name, output type) + - IF mode == -1 + - Print error msg. + - return mode = -1 (error) + - ENDIF + - ELSE IF template does exist (access) + - mode = TMM1 (template file name, template type) + - IF mode == -1 + - Print error msg. + - return mode = -1 (error) + - ENDIF + - ELSE + mode = 5 + - ENDIF + return mode +END PROCEDURE + + + +PROCEDURE TMM1: Verify status of file and column selector. + Input parameters: file name, file type (output or template) + Return value: mode + + - IF file is not a table (whatfile). + - return mode = -1 (error) + - ENDIF + - Get bracket selector from file name (rdselect). + - Open table (tbtopn with root name, READ_ONLY). + - Get its total number of columns (tbpsta). + - Create array of column pointers from column selector (malloc, tcs_open). + - Close output table (tbtclo) + - Free array (mfree) + - IF output file type + - IF one column matched + - return mode = 1 + - ELSE + - return mode = 2 + - ENDIF + - ELSE IF template file type + - IF one column matched + - return mode = 3 + - ELSE + - return mode = 4 + - ENDIF + - ENDIF + return mode = -1 (error) +END PROCEDURE + + + +PROCEDURE TMLOOP: Scan input list and insert each image in turn. + Input parameters: table pointer, column pointer array,row, image list,mode + + - Initialize row counter. + - Initialize successful image counter. + - Open input list (imtopen) + - LOOP over input list (imtlen). + - Get image name (imtgetim). + - IFERROR Open input image (immap). + - Warn user. + - Skip image. + - ENDIF + - IF mode == 2 or mode == 4, look into image header for columnar info + and do the copy. + - IFERROR TMHC (table pointer, column pointer array, row, rowpar, + imio pointer) + - Close and skip image. + - ENDIF + - bump row and image counters. + - ELSE IF mode == 1 or mode == 3, just copy into single, fixed column. + - IFERROR TMCOPY (table pointer, column pointer, row, rowpar, + imio pointer) + - Warn user. + - Close and skip image. + - ENDIF + - bump row and image counters. + - ENDIF + - Close image (imunmap) + - ENDLOOP + - IF successful image counter == 0 + - Print error msg. + - ENDIF + - Close input list (imtclose) +END PROCEDURE + + + +PROCEDURE TMSCAN: Scan input list and create column pointer array from + information stored in image headers. + Input parameters: table pointer, column pointer array, its size, image list + Output parameter: actual number of matched columns. + + - Initialize column counter. + - Open input list (imtopen) + - LOOP over input list (imtlen). + - Get image name (imtgetim). + - IFERROR Open input image (immap). + - Warn user. + - Skip image. + - ENDIF + - IFERROR TMHEADER (imio pointer, column name, units, fmt, datatype, + lendata + - Warn user. + - Skip image. + - ENDIF + - IF there are defined columns (column counter > 0): + - match = false + - LOOP over defined columns + - Get column name (tbcinf) + - IF column name from table matches column name from header: + - match = true + - break + - ENDIF + - ENDLOOP + - IF no match, this is a new column: + - Define new column in array (tbcdef) + - Bump column counter + - ENDIF + - ELSE + - Define first new column in array (tbcdef) + - Bump column counter + - ENDIF + - ENDLOOP + - Close input list (imtclose) + - IF column counter == 0 + - Error. + - Create output table (tbtcre). +END PROCEDURE + + + +PROCEDURE TMHC: Get column name from image header and copy image into table. + Input parameters: table pointer, column pointer array, row, rowpar, + imio pointer + + - salloc space for column name. + - IFERROR TMHEADER (imio pointer, column name, etc.) + - Warn, return + - ENDIF + - match = false + - LOOP over table columns. + - IF column names match: + - IFERROR TMCOPY (table pointer, column pointer, row, rowpar, + imio pointer) + - Warn, return. + - ENDIF + - match = true + - ENDIF + - ENDLOOP + - IF no match + - Warn, return. + - ENDIF + - sfree +END PROCEDURE + + + +PROCEDURE TMCOPY: Copy image into designated row/column. + Input parameters: table pointer, column pointer, row, rowpar, imio pointer + + - Get table (tbcigi) and image (IM_PIXTYPE) pixel type. + - IF pixel type mismatch: + - Warn, return + - ENDIF + - Look for ORIG_ROW keyword (imaccf, imgeti). If found, and if "row" + parameter is negative or INDEF, supersede row counter. + - Get column array size (tbcinf) and image size (IM_NDIM, IM_LEN). + - Choose the minimum of these as the array size to be written to table. + - Read pixels in buffer (imgl1$t). ^ + - Write buffer into designated row/column (tbapt$t). | + - IF image is larger than array: | This goes into + - Warn user. | a generic data + - ELSE IF image is smaller than array: | type procedure + - Set remaining elements to INDEF (tbapt$t). | + - Warn user. | + - ENDIF v +END PROCEDURE + + + +PROCEDURE TMHEADER: Decode column info in image header. + Input parameter: imio pointer + Output parameter: column name, units, fmt, datatype, lendata + + - Look for COLDATA keyword (imaccf, imgstr). + - IF not found: + return error. + - ENDIF + - Parse and get parameters (sscan, gargwrd, gargi) + - IF error in nscan value: + return error. + - ENDIF +END PROCEDURE + + diff --git a/pkg/utilities/nttools/threed/tiimage/generic/mkpkg b/pkg/utilities/nttools/threed/tiimage/generic/mkpkg new file mode 100644 index 00000000..51bd24bb --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/generic/mkpkg @@ -0,0 +1,14 @@ +# Update the generic routines. + +default: + $checkout libpkg.a ../../ + $update libpkg.a + $checkin libpkg.a ../../ +$exit + +libpkg.a: + tmcp1s.x + tmcp1i.x + tmcp1r.x + tmcp1d.x + ; diff --git a/pkg/utilities/nttools/threed/tiimage/generic/tmcp1d.x b/pkg/utilities/nttools/threed/tiimage/generic/tmcp1d.x new file mode 100644 index 00000000..9670c6a6 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/generic/tmcp1d.x @@ -0,0 +1,54 @@ + +# TM_CP1 -- Fill pixel buffer and copy into table. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_cp1d (im, tp, cp, row, lena, leni) + +pointer im # imio pointer +pointer tp # table pointer +pointer cp # column pointer +int row # row where to begin insertion +int lena # array length +int leni # image length +#-- +pointer buf +double undefd +real undefr +int undefi, i, len +short undefs + +pointer imgl1d() + +begin + # Read pixels into buffer. + buf = imgl1d (im) + + # Choose the minimum between image and table array + # lengths as the array size to be written to table. + len = min (lena, leni) + + # Write buffer into array cell element. + call tbaptd (tp, cp, row, Memd[buf], 1, len) + + # If image is smaller than array, set + # remaining elements to INDEF. + if (leni < lena) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = len+1, lena + call tbaptd (tp, cp, row, undefd, i, 1) + } +end + + + + diff --git a/pkg/utilities/nttools/threed/tiimage/generic/tmcp1i.x b/pkg/utilities/nttools/threed/tiimage/generic/tmcp1i.x new file mode 100644 index 00000000..7e271952 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/generic/tmcp1i.x @@ -0,0 +1,54 @@ + +# TM_CP1 -- Fill pixel buffer and copy into table. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_cp1i (im, tp, cp, row, lena, leni) + +pointer im # imio pointer +pointer tp # table pointer +pointer cp # column pointer +int row # row where to begin insertion +int lena # array length +int leni # image length +#-- +pointer buf +double undefd +real undefr +int undefi, i, len +short undefs + +pointer imgl1i() + +begin + # Read pixels into buffer. + buf = imgl1i (im) + + # Choose the minimum between image and table array + # lengths as the array size to be written to table. + len = min (lena, leni) + + # Write buffer into array cell element. + call tbapti (tp, cp, row, Memi[buf], 1, len) + + # If image is smaller than array, set + # remaining elements to INDEF. + if (leni < lena) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = len+1, lena + call tbapti (tp, cp, row, undefi, i, 1) + } +end + + + + diff --git a/pkg/utilities/nttools/threed/tiimage/generic/tmcp1r.x b/pkg/utilities/nttools/threed/tiimage/generic/tmcp1r.x new file mode 100644 index 00000000..00594521 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/generic/tmcp1r.x @@ -0,0 +1,54 @@ + +# TM_CP1 -- Fill pixel buffer and copy into table. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_cp1r (im, tp, cp, row, lena, leni) + +pointer im # imio pointer +pointer tp # table pointer +pointer cp # column pointer +int row # row where to begin insertion +int lena # array length +int leni # image length +#-- +pointer buf +double undefd +real undefr +int undefi, i, len +short undefs + +pointer imgl1r() + +begin + # Read pixels into buffer. + buf = imgl1r (im) + + # Choose the minimum between image and table array + # lengths as the array size to be written to table. + len = min (lena, leni) + + # Write buffer into array cell element. + call tbaptr (tp, cp, row, Memr[buf], 1, len) + + # If image is smaller than array, set + # remaining elements to INDEF. + if (leni < lena) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = len+1, lena + call tbaptr (tp, cp, row, undefr, i, 1) + } +end + + + + diff --git a/pkg/utilities/nttools/threed/tiimage/generic/tmcp1s.x b/pkg/utilities/nttools/threed/tiimage/generic/tmcp1s.x new file mode 100644 index 00000000..3d308f13 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/generic/tmcp1s.x @@ -0,0 +1,54 @@ + +# TM_CP1 -- Fill pixel buffer and copy into table. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_cp1s (im, tp, cp, row, lena, leni) + +pointer im # imio pointer +pointer tp # table pointer +pointer cp # column pointer +int row # row where to begin insertion +int lena # array length +int leni # image length +#-- +pointer buf +double undefd +real undefr +int undefi, i, len +short undefs + +pointer imgl1s() + +begin + # Read pixels into buffer. + buf = imgl1s (im) + + # Choose the minimum between image and table array + # lengths as the array size to be written to table. + len = min (lena, leni) + + # Write buffer into array cell element. + call tbapts (tp, cp, row, Mems[buf], 1, len) + + # If image is smaller than array, set + # remaining elements to INDEF. + if (leni < lena) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = len+1, lena + call tbapts (tp, cp, row, undefs, i, 1) + } +end + + + + diff --git a/pkg/utilities/nttools/threed/tiimage/list.tex b/pkg/utilities/nttools/threed/tiimage/list.tex new file mode 100644 index 00000000..05eb3592 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/list.tex @@ -0,0 +1,789 @@ +\documentstyle{article} +\topmargin -30mm +\textheight 250mm +\oddsidemargin -5mm +\evensidemargin -5mm +\textwidth 170mm + +\begin{document} + +\tableofcontents + +\newpage + +\addcontentsline{toc}{section}{loc.txt} +\begin{verbatim} + +Filename Total Blanks Comments Help Execute Nonexec +============================================================================ + tiimage.h 9 1 0 0 0 8 + tiimage.x 141 36 31 0 53 21 + tmloop.x 96 23 15 0 40 18 + tmmode.x 108 24 24 0 30 30 + tmscan.x 92 21 15 0 38 18 + tmheader.x 59 19 8 0 19 13 + tmhc.x 54 16 9 0 15 14 + tmcopy.x 63 18 9 0 23 13 + tmcp1.gx 53 17 11 0 10 15 +TOTAL 834 226 155 0 258 195 +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tiimage.h} +\begin{verbatim} + +define OUTPUT_TYPE 1 # Output-type file +define TEMPLATE_TYPE 2 # Template-type file + +define MODE_OUT_SINGLE 1 # Output with single column +define MODE_OUT_ALL 2 # Output with all columns +define MODE_TEM_SINGLE 3 # Template with single column +define MODE_TEM_ALL 4 # Template with all columns +define MODE_SCRATCH 5 # No output nor template, create from scratch +define MODE_ERROR -1 +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tiimage.x} +\begin{verbatim} + +include <tbset.h> +include "tiimage.h" + +# TIIMAGE -- Insert 1D images into 3D table rows. +# +# Input images are given by a filename template list. The output is a +# 3D table with optional column selector. +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure t_tiimage() + +char imlist[SZ_LINE] # Input image list +char output[SZ_PATHNAME] # Output table name +char template[SZ_PATHNAME] # Template table name +int row # Row where to begin insertion +bool verbose # Print operations ? +#-- +char root[SZ_FNAME] # String storage areas used +char rs[SZ_FNAME] # by row/column selector +char cs[SZ_FNAME] # mechanism +char cn[SZ_COLNAME] +char cu[SZ_COLUNITS] +char cf[SZ_COLFMT] +pointer sp, otp, ttp, ocp, tcp, newocp, tempp, list +int nocp, mode, numcol, dtyp, lend, lenf, cnum, i + +pointer tbtopn(), tcs_column(), imtopen() +int clgeti(), tbpsta(), tm_mode(), imtlen() +bool clgetb(), streq() + +begin + # Get task parameters. + call clgstr ("input", imlist, SZ_LINE) + call clgstr ("outtable", output, SZ_PATHNAME) + call clgstr ("template", template, SZ_PATHNAME) + row = clgeti ("row") + verbose = clgetb ("verbose") + + # Abort if invalid output name. + if (streq (output, "STDOUT")) + call error (1, "Invalid output file name.") + + # Decide which mode to use. + mode = tm_mode (output, template, root, rs, cs, cn, cu, cf) + + call smark (sp) + switch (mode) { + + case MODE_OUT_SINGLE,MODE_OUT_ALL: + + # Break output table name into bracketed selectors. + call rdselect (output, root, rs, cs, SZ_PATHNAME) + + # Open output table. + otp = tbtopn (root, READ_WRITE, 0) + + # Create arrays with selected column pointer(s). + numcol = tbpsta (otp, TBL_NCOLS) + call salloc (ocp, numcol, TY_INT) + call salloc (newocp, numcol, TY_INT) + call tcs_open (otp, cs, Memi[ocp], nocp, numcol) + + # Translate pointer to tbtables-compatible format. + do i = 1, nocp + Memi[newocp+i-1] = tcs_column (Memi[ocp+i-1]) + + # Do the insertion by looping over all input images. + call tm_loop (otp, newocp, nocp, row, imlist, mode, output, + verbose) + + # Close output table. + call tbtclo (otp) + + case MODE_TEM_SINGLE,MODE_TEM_ALL: + + # Get output table root name and open it. + call rdselect (output, root, rs, cs, SZ_PATHNAME) + otp = tbtopn (root, NEW_FILE, 0) + + # Break template table name into bracketed + # selectors and open it. + call rdselect (template, root, rs, cs, SZ_PATHNAME) + ttp = tbtopn (root, READ_ONLY, 0) + + # Create arrays with selected column pointer(s). + numcol = tbpsta (ttp, TBL_NCOLS) + call salloc (tcp, numcol, TY_INT) + call salloc (newocp, numcol, TY_INT) + call tcs_open (ttp, cs, Memi[tcp], nocp, numcol) + + # Copy column info from template to output table. + do i = 1, nocp { + tempp = tcs_column (Memi[tcp+i-1]) + call tbcinf (tempp, cnum, cn, cu, cf, dtyp, lend, lenf) + call tbcdef (otp, tempp, cn, cu, cf, dtyp, lend, 1) + Memi[newocp+i-1] = tempp + } + + # Create output and close template. + call tbtcre (otp) + call tbtclo (ttp) + + # Do the insertion by looping over all input images. + call tm_loop (otp, newocp, nocp, row, imlist, mode, output, + verbose) + + # Close output table. + call tbtclo (otp) + + case MODE_SCRATCH: + + # Alloc memory for column pointer array, assuming + # the worst case of each input image in the list + # belonging to a separate column. + list = imtopen (imlist) + numcol = imtlen (list) + call imtclose (list) + call salloc (newocp, numcol, TY_INT) + + # Open output table. + call rdselect (output, root, rs, cs, SZ_PATHNAME) + otp = tbtopn (root, NEW_FILE, 0) + + # Build column descriptor array from info in image headers. + ifnoerr (call tm_scan (otp, newocp, numcol, nocp, imlist)) { + + # Pretend that template table exists and do the insertion. + mode = MODE_TEM_ALL + call tm_loop (otp, newocp, nocp, row, imlist, mode, output, + verbose) + } + + # Close output table. + call tbtclo (otp) + + case MODE_ERROR: + call error (1, "Cannot process.") + } + + call sfree (sp) +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tmloop.x} +\begin{verbatim} + +include <error.h> +include "tiimage.h" + +# TM_LOOP -- Scan input list and insert each image in turn. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_loop (tp, cp, ncp, row, imlist, mode, outname, verbose) + +pointer tp # table pointer +pointer cp # column pointer array +int ncp # size of column pointer array +int row # row where to begin insertion +char imlist[ARB] # input image list +int mode # operating mode +char outname[ARB] # output table name (for listing only) +bool verbose # print info ? +#-- +pointer sp, im, list, fname +int i, rowc, imc, image +bool rflag + +errchk immap, tm_hc, tm_copy + +pointer immap(), imtopen() +int imtlen(), imtgetim() + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + + # Initialize row counter. + rowc = row + rflag = false + if (rowc <= 0 || IS_INDEFI(rowc)) rflag = true + + # Initialize successful image counter. + imc = 0 + + # Open input list. + list = imtopen (imlist) + + # Loop over input list. + do image = 1, imtlen(list) { + + # Get input image name and open it. Skip if error. + i = imtgetim (list, Memc[fname], SZ_PATHNAME) + iferr (im = immap (Memc[fname], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + if (verbose) { + call printf ("%s ") + call pargstr (Memc[fname]) + call flush (STDOUT) + } + + # Look into image header for columnar info and do the copy. + if (mode == MODE_OUT_ALL || mode == MODE_TEM_ALL) { + iferr (call tm_hc (tp, cp, ncp, rowc, rflag, im)) { + call erract (EA_WARN) + call imunmap (im) + next + } + + # Bump row and image counters. + rowc = rowc + 1 + imc = imc + 1 + + # Just copy into single column. + } else if (mode == MODE_OUT_SINGLE || mode == MODE_TEM_SINGLE) { + iferr (call tm_copy (tp, Memi[cp], rowc, rflag, im)) { + call erract (EA_WARN) + call imunmap (im) + next + } + + # Bump row and image counters. + rowc = rowc + 1 + imc = imc + 1 + } + + if (verbose) { + call printf ("-> %s row=%d \n") + call pargstr (outname) + call pargi (rowc-1) + call flush (STDOUT) + } + + # Close current image. + call imunmap (im) + } + + call imtclose (list) + call sfree (sp) + if (imc == 0) + call error (1, "No images were inserted.") +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tmmode.x} +\begin{verbatim} + +include <tbset.h> +include "../whatfile.h" +include "tiimage.h" + +# TM_MODE -- Detect mode of operation. +# +# There are five possible modes: +# 1 - Output table exists and one column was selected. +# 2 - Output table exists and no valid column was selected. +# 3 - Output table does not exist but template exists and one column was +# selected. +# 4 - Output table does not exist but template exists and no valid column +# was selected. +# 5 - New table has to be created from scratch. +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +int procedure tm_mode (output, template, root, rs, cs, cn, cu, cf) + +char output[SZ_PATHNAME] +char template[SZ_PATHNAME] +char root[SZ_FNAME] +char rs[SZ_FNAME] +char cs[SZ_FNAME] +char cn[SZ_COLNAME] +char cu[SZ_COLUNITS] +char cf[SZ_COLFMT] +#- +int mode + +int access(), tm_m1() + +begin + # Process output name. Notice that routine access() must be + # supplied with only the root name in order to succeed. + call rdselect (output, root, rs, cs, SZ_PATHNAME) + if (access (root, READ_WRITE, 0) == YES) { + mode = tm_m1 (OUTPUT_TYPE, root,rs,cs,cn,cu,cf) + if (mode == MODE_ERROR) + call error (1, "Cannot use output file.") + + # If no valid output, try with template name. + } else { + call rdselect (template, root, rs, cs, SZ_PATHNAME) + if (access (root, READ_ONLY, 0) == YES) { + mode = tm_m1 (TEMPLATE_TYPE, root, rs, cs, cn, cu, cf) + if (mode == MODE_ERROR) + call error (1, "Cannot use template file.") + } else { + mode = MODE_SCRATCH + } + } + + return (mode) +end + + +# TM_M1 -- Verify status of file and column selector. + +int procedure tm_m1 (type, root, rs, cs, cn, cu, cf) + +int type +char root[SZ_FNAME] +char rs[SZ_FNAME] +char cs[SZ_FNAME] +char cn[SZ_COLNAME] +char cu[SZ_COLUNITS] +char cf[SZ_COLFMT] +#- +pointer tp, cp +int numcol, ncp + +pointer tbtopn() +int whatfile(), tbpsta() + +begin + # Test if it is a valid table. + if (whatfile (root) != IS_TABLE) + return (MODE_ERROR) + + # Open table + tp = tbtopn (root, READ_ONLY) + + # Get its total number of columns. + numcol = tbpsta (tp, TBL_NCOLS) + + # Create array of column pointers from column selector. + # This is just to get the actual number of selected columns. + call malloc (cp, numcol, TY_INT) + call tcs_open (tp, cs, Memi[cp], ncp, numcol) + call tbtclo (tp) + call mfree (cp) + + # Decide mode. + if (type == OUTPUT_TYPE) { + if (ncp == 1) + return (MODE_OUT_SINGLE) + else + return (MODE_OUT_ALL) + } else if (type == TEMPLATE_TYPE) { + if (ncp == 1) + return (MODE_TEM_SINGLE) + else + return (MODE_TEM_ALL) + } + return (MODE_ERROR) +end + + +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tmscan.x} +\begin{verbatim} + +include <error.h> +include <imhdr.h> +include <tbset.h> + +# TM_SCAN -- Scan input image list and create column pointer array +# and table from information stored in image headers. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_scan (otp, ocp, ocpsize, nocp, imlist) + +pointer otp # i: output table pointer +pointer ocp # io: output table column pointer array +int ocpsize # i: size of above array +int nocp # o: actual number of columns in array +char imlist[ARB] # i: input image list +#-- +pointer sp, im, list +pointer imname, cn, cn1, cu, cf, duma +int image, column, lendata, dumi, i +bool match + +errchk tm_header + +pointer imtopen(), immap() +int imtlen(), imtgetim() +bool streq() + +begin + call smark (sp) + call salloc (imname, SZ_PATHNAME, TY_CHAR) + call salloc (cn, SZ_COLNAME, TY_CHAR) + call salloc (cn1, SZ_COLNAME, TY_CHAR) + call salloc (cu, SZ_COLUNITS, TY_CHAR) + call salloc (cf, SZ_COLFMT, TY_CHAR) + call salloc (duma, max(SZ_COLUNITS,SZ_COLFMT),TY_CHAR) + + # Open input list and initialize number of columns. + list = imtopen (imlist) + nocp = 0 + + # Scan input list. + do image = 1, imtlen(list) { + + # Open image. + i = imtgetim (list, Memc[imname], SZ_PATHNAME) + iferr (im = immap (Memc[imname], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + + # Get column data from image header. + iferr (call tm_header (im, Memc[cn], Memc[cu], Memc[cf])) { + call erract (EA_WARN) + next + } + + # Array size is full image size. + lendata = 0 + do i = 1, IM_NDIM(im) + lendata = lendata + IM_LEN(im,i) + + if (nocp > 0) { + + # See if column name from header matches any name + # already stored in column pointer array. + match = false + do column = 1, nocp { + call tbcinf (Memi[ocp+column-1], dumi, Memc[cn1], + Memc[duma], Memc[duma], dumi, dumi, dumi) + if (streq (Memc[cn1], Memc[cn])) { + match = true + break + } + } + if (!match) { + + # No names matched, efine new column. + call tbcdef (otp, Memi[ocp+nocp], Memc[cn], Memc[cu], + Memc[cf], IM_PIXTYPE(im), lendata, 1) + nocp = nocp + 1 + } + } else { + + # Array is empty, define first column. + call tbcdef (otp, Memi[ocp], Memc[cn], Memc[cu], Memc[cf], + IM_PIXTYPE(im), lendata, 1) + nocp = 1 + } + } + + call imtclose (list) + call sfree (sp) + if (nocp == 0) + call error (1, "No images with column data in header.") + call tbtcre (otp) +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tmheader.x} +\begin{verbatim} + +include <tbset.h> + +# TM_HEADER -- Decode column info in image header. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_header (im, colname, colunits, colfmt) + +pointer im # image pointer +char colname[SZ_COLNAME] # column name +char colunits[SZ_COLUNITS] # column units +char colfmt[SZ_COLFMT] # column print format +#-- +pointer sp, kwval +int colnum + +string corrupt "Corrupted header in input image." + +bool streq() +int imaccf(), nscan() + +begin + if (imaccf (im, "COLDATA") == NO) + call error (1, "No column information in image header.") + + call smark (sp) + call salloc (kwval, SZ_LINE, TY_CHAR) + + # Get keyword value. + call imgstr (im, "COLDATA", Memc[kwval], SZ_LINE) + + # Read fields. + call sscan (Memc[kwval]) + call gargi (colnum) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colname, SZ_COLNAME) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colunits, SZ_COLUNITS) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colfmt, SZ_COLFMT) + if (nscan() < 1) call error (1, corrupt) + + # Decode custom-encoded values. + if (streq (colunits, "default")) + call strcpy ("", colunits, SZ_COLUNITS) + if (streq (colfmt, "default")) + call strcpy ("", colfmt, SZ_COLFMT) + + call sfree (sp) +end + + + +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tmhc.x} +\begin{verbatim} + +include <tbset.h> + +# TM_HC -- Get column name from image header and copy image into table. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_hc (tp, cp, ncp, row, rflag, im) + +pointer tp # table pointer +pointer cp # column pointer array +int ncp # size of column pointer array +int row # row where to begin insertion +bool rflag # use row number in header ? +pointer im # image pointer +#-- +pointer sp, colname, cn, duma +int i, dumi +bool match + +errchk tm_header, tm_copy + +bool streq() + +begin + call smark (sp) + call salloc (colname, SZ_COLNAME, TY_CHAR) + call salloc (cn, SZ_COLNAME, TY_CHAR) + call salloc (duma, max(SZ_COLUNITS,SZ_COLFMT),TY_CHAR) + + # Get column name from image header. + call tm_header (im, Memc[colname], Memc[duma], Memc[duma]) + + # Loop over table columns. + match = false + do i = 1, ncp { + + # Get column name from table. + call tbcinf (Memi[cp+i-1], dumi, Memc[cn], Memc[duma], + Memc[duma], dumi, dumi, dumi) + + # Copy array if names match. + if (streq (Memc[colname], Memc[cn])) { + call tm_copy (tp, Memi[cp+i-1], row, rflag, im) + match = true + } + } + if (!match) + call error (1, "No column matched.") + + call sfree (sp) +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tmcopy.x} +\begin{verbatim} + +include <imhdr.h> +include <tbset.h> + +# TM_COPY -- Copy image into designated row/column. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_copy (tp, cp, row, rflag, im) + +pointer tp # table pointer +pointer cp # column pointer +int row # row where to begin insertion +bool rflag # use row number in image header ? +pointer im # imio pointer +#-- +pointer sp, duma +int i, lena, leni, dumi + +int tbcigi(), imgeti(), imaccf() + +begin + # See if table and image pixel types match. + if (tbcigi (tp, TBL_COL_DATATYPE) == IM_PIXTYPE(im)) + call error (1, "Pixel type mismatch.") + + # Look for row information in image header. + if (imaccf (im, "ORIG_ROW") == YES) { + if (rflag) + row = imgeti (im, "ORIG_ROW") + } + + # Get column array size and image size. + call smark (sp) + call salloc (duma, max(max(SZ_COLNAME,SZ_COLUNITS),SZ_COLFMT),TY_CHAR) + call tbcinf (cp, dumi, Memc[duma], Memc[duma], Memc[duma], dumi, + lena, dumi) + call sfree (sp) + leni = 0 + do i = 1, IM_NDIM(im) + leni = leni + IM_LEN(im,i) + + # Copy. + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + call tm_cp1s (im, tp, cp, row, lena, leni) + case TY_INT: + call tm_cp1i (im, tp, cp, row, lena, leni) + case TY_REAL: + call tm_cp1r (im, tp, cp, row, lena, leni) + case TY_DOUBLE: + call tm_cp1d (im, tp, cp, row, lena, leni) + default: + call error (1, "Non-supported data type.") + } + +end + + + + +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tmcp1.gx} +\begin{verbatim} + + +# TM_CP1 -- Fill pixel buffer and copy into table. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_cp1$t (im, tp, cp, row, lena, leni) + +pointer im # imio pointer +pointer tp # table pointer +pointer cp # column pointer +int row # row where to begin insertion +int lena # array length +int leni # image length +#-- +pointer buf +double undefd +real undefr +int undefi, i, len +short undefs + +pointer imgl1$t() + +begin + # Read pixels into buffer. + buf = imgl1$t (im) + + # Choose the minimum between image and table array + # lengths as the array size to be written to table. + len = min (lena, leni) + + # Write buffer into array cell element. + call tbapt$t (tp, cp, row, Mem$t[buf], 1, len) + + # If image is smaller than array, set + # remaining elements to INDEF. + if (leni < lena) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = len+1, lena + call tbapt$t (tp, cp, row, undef$t, i, 1) + } +end + + + + +\end{verbatim} +\newpage +\end{document} diff --git a/pkg/utilities/nttools/threed/tiimage/list.toc b/pkg/utilities/nttools/threed/tiimage/list.toc new file mode 100644 index 00000000..06d86919 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/list.toc @@ -0,0 +1,10 @@ +\contentsline {section}{loc.txt}{2} +\contentsline {section}{tiimage.h}{3} +\contentsline {section}{tiimage.x}{4} +\contentsline {section}{tmloop.x}{7} +\contentsline {section}{tmmode.x}{9} +\contentsline {section}{tmscan.x}{11} +\contentsline {section}{tmheader.x}{13} +\contentsline {section}{tmhc.x}{15} +\contentsline {section}{tmcopy.x}{16} +\contentsline {section}{tmcp1.gx}{18} diff --git a/pkg/utilities/nttools/threed/tiimage/loc.txt b/pkg/utilities/nttools/threed/tiimage/loc.txt new file mode 100644 index 00000000..43db97fc --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/loc.txt @@ -0,0 +1,12 @@ +Filename Total Blanks Comments Help Execute Nonexec +============================================================================ + tiimage.h 9 1 0 0 0 8 + tiimage.x 141 36 31 0 53 21 + tmloop.x 96 23 15 0 40 18 + tmmode.x 108 24 24 0 30 30 + tmscan.x 92 21 15 0 38 18 + tmheader.x 59 19 8 0 19 13 + tmhc.x 54 16 9 0 15 14 + tmcopy.x 63 18 9 0 23 13 + tmcp1.gx 53 17 11 0 10 15 +TOTAL 834 226 155 0 258 195 diff --git a/pkg/utilities/nttools/threed/tiimage/mkpkg b/pkg/utilities/nttools/threed/tiimage/mkpkg new file mode 100644 index 00000000..6a3588af --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/mkpkg @@ -0,0 +1,29 @@ +# Update the tiimage application code in the threed package library. +# Author: I.Busko, 30-Jan-1997 + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +# This module is called from the threed mkpkg. +generic: + $ifnfile (generic/tmcp1i.x) + $generic -k -p generic/ -t sird tmcp1.gx + $endif + $ifolder (generic/tmcp1i.x, tmcp1.gx) + $generic -k -p generic/ -t sird tmcp1.gx + $endif + ; + +libpkg.a: + @generic + tiimage.x <tbset.h> tiimage.h + tmcopy.x <imhdr.h> <tbset.h> + tmhc.x <tbset.h> + tmheader.x <tbset.h> + tmloop.x <error.h> tiimage.h + tmmode.x <tbset.h> tiimage.h + tmscan.x <error.h> <imhdr.h> <tbset.h> + ; + diff --git a/pkg/utilities/nttools/threed/tiimage/tiimage.h b/pkg/utilities/nttools/threed/tiimage/tiimage.h new file mode 100644 index 00000000..86e0d000 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tiimage.h @@ -0,0 +1,9 @@ +define OUTPUT_TYPE 1 # Output-type file +define TEMPLATE_TYPE 2 # Template-type file + +define MODE_OUT_SINGLE 1 # Output with single column +define MODE_OUT_ALL 2 # Output with all columns +define MODE_TEM_SINGLE 3 # Template with single column +define MODE_TEM_ALL 4 # Template with all columns +define MODE_SCRATCH 5 # No output nor template, create from scratch +define MODE_ERROR -1 diff --git a/pkg/utilities/nttools/threed/tiimage/tiimage.x b/pkg/utilities/nttools/threed/tiimage/tiimage.x new file mode 100644 index 00000000..85aab676 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tiimage.x @@ -0,0 +1,147 @@ +include <tbset.h> +include "tiimage.h" + +# TIIMAGE -- Insert 1D images into 3D table rows. +# +# Input images are given by a filename template list. The output is a +# 3D table with optional column selector. +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure t_tiimage() + +char imlist[SZ_LINE] # Input image list +char output[SZ_PATHNAME] # Output table name +char template[SZ_PATHNAME] # Template table name +int row # Row where to begin insertion +bool verbose # Print operations ? +#-- +char root[SZ_FNAME] # String storage areas used +char rs[SZ_FNAME] # by row/column selector +char cs[SZ_FNAME] # mechanism +char cn[SZ_COLNAME] +char cu[SZ_COLUNITS] +char cf[SZ_COLFMT] +pointer sp, otp, ttp, ocp, tcp, newocp, tempp, list +int nocp, mode, numcol, dtyp, lend, lenf, cnum, i + +pointer tbtopn(), tcs_column(), imtopen() +int clgeti(), tbpsta(), tm_mode(), imtlen() +bool clgetb(), streq() + +begin + # Get task parameters. + call clgstr ("input", imlist, SZ_LINE) + call clgstr ("outtable", output, SZ_PATHNAME) + call clgstr ("template", template, SZ_PATHNAME) + row = clgeti ("row") + verbose = clgetb ("verbose") + + # Abort if invalid output name. + if (streq (output, "STDOUT")) + call error (1, "Invalid output file name.") + + # Decide which mode to use. + mode = tm_mode (output, template, root, rs, cs, cn, cu, cf) + + call smark (sp) + switch (mode) { + + case MODE_OUT_SINGLE,MODE_OUT_ALL: + + # Break output table name into bracketed selectors. + call rdselect (output, root, rs, cs, SZ_PATHNAME) + + # Open output table. + otp = tbtopn (root, READ_WRITE, 0) + + # Create arrays with selected column pointer(s). + numcol = tbpsta (otp, TBL_NCOLS) + call salloc (ocp, numcol, TY_INT) + call salloc (newocp, numcol, TY_INT) + call tcs_open (otp, cs, Memi[ocp], nocp, numcol) + + # Translate pointer to tbtables-compatible format. + do i = 1, nocp + Memi[newocp+i-1] = tcs_column (Memi[ocp+i-1]) + + # Do the insertion by looping over all input images. + call tm_loop (otp, newocp, nocp, row, imlist, mode, output, + verbose) + + # Close output table. + call tbtclo (otp) + + case MODE_TEM_SINGLE,MODE_TEM_ALL: + + # Get output table root name and open it. + call rdselect (output, root, rs, cs, SZ_PATHNAME) + otp = tbtopn (root, NEW_FILE, 0) + + # Break template table name into bracketed + # selectors and open it. + call rdselect (template, root, rs, cs, SZ_PATHNAME) + ttp = tbtopn (root, READ_ONLY, 0) + + # Create arrays with selected column pointer(s). + numcol = tbpsta (ttp, TBL_NCOLS) + call salloc (tcp, numcol, TY_INT) + call salloc (newocp, numcol, TY_INT) + call tcs_open (ttp, cs, Memi[tcp], nocp, numcol) + + # Copy column info from template to output table. + do i = 1, nocp { + tempp = tcs_column (Memi[tcp+i-1]) + call tbcinf (tempp, cnum, cn, cu, cf, dtyp, lend, lenf) + call tbcdef (otp, tempp, cn, cu, cf, dtyp, lend, 1) + Memi[newocp+i-1] = tempp + } + + # Create output and close template. + call tbtcre (otp) + call tbtclo (ttp) + + # Do the insertion by looping over all input images. + call tm_loop (otp, newocp, nocp, row, imlist, mode, output, + verbose) + + # Close output table. + call tbtclo (otp) + + case MODE_SCRATCH: + + # Alloc memory for column pointer array, assuming + # the worst case of each input image in the list + # belonging to a separate column. + list = imtopen (imlist) + numcol = imtlen (list) + call imtclose (list) + call salloc (newocp, numcol, TY_INT) + + # Open output table. + call rdselect (output, root, rs, cs, SZ_PATHNAME) + otp = tbtopn (root, NEW_FILE, 0) + + # Build column descriptor array from info in image headers. + ifnoerr (call tm_scan (otp, newocp, numcol, nocp, imlist)) { + + # Pretend that template table exists and do the insertion. + mode = MODE_TEM_ALL + call tm_loop (otp, newocp, nocp, row, imlist, mode, output, + verbose) + } + + # Close output table. + call tbtclo (otp) + + case MODE_ERROR: + call error (1, "Cannot process.") + } + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/tiimage/tmcopy.x b/pkg/utilities/nttools/threed/tiimage/tmcopy.x new file mode 100644 index 00000000..8d2673c5 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tmcopy.x @@ -0,0 +1,67 @@ +include <imhdr.h> +include <tbset.h> + +# TM_COPY -- Copy image into designated row/column. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) +# 21-May-97 - Changes from code review (IB) + + +procedure tm_copy (tp, cp, row, rflag, im) + +pointer tp # table pointer +pointer cp # column pointer +int row # row where to begin insertion +bool rflag # use row number in image header ? +pointer im # imio pointer +#-- +pointer sp, duma +int i, lena, leni, dumi + +int tbcigi(), imgeti(), imaccf() + +begin + # See if table and image pixel types match. + if (tbcigi (tp, TBL_COL_DATATYPE) == IM_PIXTYPE(im)) + call error (1, "Pixel type mismatch.") + + # Look for row information in image header. + if (imaccf (im, "ORIG_ROW") == YES) { + if (rflag) + row = imgeti (im, "ORIG_ROW") + } + + # Get column array size and image size. + call smark (sp) + call salloc (duma, max(max(SZ_COLNAME,SZ_COLUNITS),SZ_COLFMT),TY_CHAR) + call tbcinf (cp, dumi, Memc[duma], Memc[duma], Memc[duma], dumi, + lena, dumi) + call sfree (sp) + leni = 1 + do i = 1, IM_NDIM(im) + leni = leni * IM_LEN(im,i) + + # Copy. + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + call tm_cp1s (im, tp, cp, row, lena, leni) + case TY_INT: + call tm_cp1i (im, tp, cp, row, lena, leni) + case TY_REAL: + call tm_cp1r (im, tp, cp, row, lena, leni) + case TY_DOUBLE: + call tm_cp1d (im, tp, cp, row, lena, leni) + default: + call error (1, "Non-supported data type.") + } + +end + + + + diff --git a/pkg/utilities/nttools/threed/tiimage/tmcp1.gx b/pkg/utilities/nttools/threed/tiimage/tmcp1.gx new file mode 100644 index 00000000..b90ca406 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tmcp1.gx @@ -0,0 +1,54 @@ + +# TM_CP1 -- Fill pixel buffer and copy into table. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_cp1$t (im, tp, cp, row, lena, leni) + +pointer im # imio pointer +pointer tp # table pointer +pointer cp # column pointer +int row # row where to begin insertion +int lena # array length +int leni # image length +#-- +pointer buf +double undefd +real undefr +int undefi, i, len +short undefs + +pointer imgl1$t() + +begin + # Read pixels into buffer. + buf = imgl1$t (im) + + # Choose the minimum between image and table array + # lengths as the array size to be written to table. + len = min (lena, leni) + + # Write buffer into array cell element. + call tbapt$t (tp, cp, row, Mem$t[buf], 1, len) + + # If image is smaller than array, set + # remaining elements to INDEF. + if (leni < lena) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = len+1, lena + call tbapt$t (tp, cp, row, undef$t, i, 1) + } +end + + + + diff --git a/pkg/utilities/nttools/threed/tiimage/tmhc.x b/pkg/utilities/nttools/threed/tiimage/tmhc.x new file mode 100644 index 00000000..30ad4eb3 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tmhc.x @@ -0,0 +1,57 @@ +include <tbset.h> + +# TM_HC -- Get column name from image header and copy image into table. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_hc (tp, cp, ncp, row, rflag, im) + +pointer tp # table pointer +pointer cp # column pointer array +int ncp # size of column pointer array +int row # row where to begin insertion +bool rflag # use row number in header ? +pointer im # image pointer +#-- +pointer sp, colname, cn, duma +int i, dumi +bool match + +errchk tm_header, tm_copy + +bool streq() + +begin + call smark (sp) + call salloc (colname, SZ_COLNAME, TY_CHAR) + call salloc (cn, SZ_COLNAME, TY_CHAR) + call salloc (duma, max(SZ_COLUNITS,SZ_COLFMT),TY_CHAR) + + # Get column name from image header. + call tm_header (im, Memc[colname], Memc[duma], Memc[duma]) + + # Loop over table columns. + match = false + do i = 1, ncp { + + # Get column name from table. + call tbcinf (Memi[cp+i-1], dumi, Memc[cn], Memc[duma], + Memc[duma], dumi, dumi, dumi) + + # Copy array if names match. + if (streq (Memc[colname], Memc[cn])) { + call tm_copy (tp, Memi[cp+i-1], row, rflag, im) + match = true + } + } + if (!match) + call error (1, "No column matched.") + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/tiimage/tmheader.x b/pkg/utilities/nttools/threed/tiimage/tmheader.x new file mode 100644 index 00000000..b6481fa4 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tmheader.x @@ -0,0 +1,60 @@ +include <tbset.h> + +# TM_HEADER -- Decode column info in image header. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) +# 21-May-97 - Changes from code review (IB) + + +procedure tm_header (im, colname, colunits, colfmt) + +pointer im # image pointer +char colname[SZ_COLNAME] # column name +char colunits[SZ_COLUNITS] # column units +char colfmt[SZ_COLFMT] # column print format +#-- +pointer sp, kwval +int colnum + +string corrupt "Corrupted header in input image." + +bool streq() +int imaccf(), nscan() + +begin + if (imaccf (im, "COLDATA") == NO) + call error (1, "No column information in image header.") + + call smark (sp) + call salloc (kwval, SZ_LINE, TY_CHAR) + + # Get keyword value. + call imgstr (im, "COLDATA", Memc[kwval], SZ_LINE) + + # Read fields. + call sscan (Memc[kwval]) + call gargi (colnum) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colname, SZ_COLNAME) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colunits, SZ_COLUNITS) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colfmt, SZ_COLFMT) + if (nscan() < 1) call error (1, corrupt) + + # Decode custom-encoded values. + if (streq (colunits, "default")) + colunits[1] = EOS + if (streq (colfmt, "default")) + colfmt[1] = EOS + + call sfree (sp) +end + + + diff --git a/pkg/utilities/nttools/threed/tiimage/tmloop.x b/pkg/utilities/nttools/threed/tiimage/tmloop.x new file mode 100644 index 00000000..e99d8e8b --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tmloop.x @@ -0,0 +1,104 @@ +include <error.h> +include "tiimage.h" + +# TM_LOOP -- Scan input list and insert each image in turn. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) + + +procedure tm_loop (tp, cp, ncp, row, imlist, mode, outname, verbose) + +pointer tp # table pointer +pointer cp # column pointer array +int ncp # size of column pointer array +int row # row where to begin insertion +char imlist[ARB] # input image list +int mode # operating mode +char outname[ARB] # output table name (for listing only) +bool verbose # print info ? +#-- +pointer sp, im, list, fname +int i, rowc, imc, image +bool rflag + +errchk immap, tm_hc, tm_copy + +pointer immap(), imtopen() +int imtlen(), imtgetim() + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + + # Initialize row counter. + rowc = row + rflag = false + if (rowc <= 0 || IS_INDEFI(rowc)) rflag = true + + # Initialize successful image counter. + imc = 0 + + # Open input list. + list = imtopen (imlist) + + # Loop over input list. + do image = 1, imtlen(list) { + + # Get input image name and open it. Skip if error. + i = imtgetim (list, Memc[fname], SZ_PATHNAME) + iferr (im = immap (Memc[fname], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + if (verbose) { + call printf ("%s ") + call pargstr (Memc[fname]) + call flush (STDOUT) + } + + # Look into image header for columnar info and do the copy. + if (mode == MODE_OUT_ALL || mode == MODE_TEM_ALL) { + iferr (call tm_hc (tp, cp, ncp, rowc, rflag, im)) { + call erract (EA_WARN) + call imunmap (im) + next + } + + # Bump row and image counters. + rowc = rowc + 1 + imc = imc + 1 + + # Just copy into single column. + } else if (mode == MODE_OUT_SINGLE || mode == MODE_TEM_SINGLE) { + iferr (call tm_copy (tp, Memi[cp], rowc, rflag, im)) { + call erract (EA_WARN) + call imunmap (im) + next + } + + # Bump row and image counters. + rowc = rowc + 1 + imc = imc + 1 + } + + if (verbose) { + call printf ("-> %s row=%d \n") + call pargstr (outname) + call pargi (rowc-1) + call flush (STDOUT) + } + + # Close current image. + call imunmap (im) + } + + call imtclose (list) + call sfree (sp) + if (imc == 0) + call error (1, "No images were inserted.") +end diff --git a/pkg/utilities/nttools/threed/tiimage/tmmode.x b/pkg/utilities/nttools/threed/tiimage/tmmode.x new file mode 100644 index 00000000..0f159763 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tmmode.x @@ -0,0 +1,108 @@ +include <tbset.h> +include "tiimage.h" + +# TM_MODE -- Detect mode of operation. +# +# There are five possible modes: +# 1 - Output table exists and one column was selected. +# 2 - Output table exists and no valid column was selected. +# 3 - Output table does not exist but template exists and one column was +# selected. +# 4 - Output table does not exist but template exists and no valid column +# was selected. +# 5 - New table has to be created from scratch. +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) +# 8-Apr-02 - Remove the call to whatfile (P. Hodge) + + +int procedure tm_mode (output, template, root, rs, cs, cn, cu, cf) + +char output[SZ_PATHNAME] +char template[SZ_PATHNAME] +char root[SZ_FNAME] +char rs[SZ_FNAME] +char cs[SZ_FNAME] +char cn[SZ_COLNAME] +char cu[SZ_COLUNITS] +char cf[SZ_COLFMT] +#- +int mode + +int access(), tm_m1() + +begin + # Process output name. Notice that routine access() must be + # supplied with only the root name in order to succeed. + call rdselect (output, root, rs, cs, SZ_PATHNAME) + if (access (root, READ_WRITE, 0) == YES) { + mode = tm_m1 (OUTPUT_TYPE, root,rs,cs,cn,cu,cf) + if (mode == MODE_ERROR) + call error (1, "Cannot use output file.") + + # If no valid output, try with template name. + } else { + call rdselect (template, root, rs, cs, SZ_PATHNAME) + if (access (root, READ_ONLY, 0) == YES) { + mode = tm_m1 (TEMPLATE_TYPE, root, rs, cs, cn, cu, cf) + if (mode == MODE_ERROR) + call error (1, "Cannot use template file.") + } else { + mode = MODE_SCRATCH + } + } + + return (mode) +end + + +# TM_M1 -- Verify status of file and column selector. + +int procedure tm_m1 (type, root, rs, cs, cn, cu, cf) + +int type +char root[SZ_FNAME] +char rs[SZ_FNAME] +char cs[SZ_FNAME] +char cn[SZ_COLNAME] +char cu[SZ_COLUNITS] +char cf[SZ_COLFMT] +#- +pointer tp, cp +int numcol, ncp + +pointer tbtopn() +int tbpsta() + +begin + # Open table + tp = tbtopn (root, READ_ONLY, 0) + + # Get its total number of columns. + numcol = tbpsta (tp, TBL_NCOLS) + + # Create array of column pointers from column selector. + # This is just to get the actual number of selected columns. + call malloc (cp, numcol, TY_INT) + call tcs_open (tp, cs, Memi[cp], ncp, numcol) + call tbtclo (tp) + call mfree (cp, TY_INT) + + # Decide mode. + if (type == OUTPUT_TYPE) { + if (ncp == 1) + return (MODE_OUT_SINGLE) + else + return (MODE_OUT_ALL) + } else if (type == TEMPLATE_TYPE) { + if (ncp == 1) + return (MODE_TEM_SINGLE) + else + return (MODE_TEM_ALL) + } + return (MODE_ERROR) +end diff --git a/pkg/utilities/nttools/threed/tiimage/tmscan.x b/pkg/utilities/nttools/threed/tiimage/tmscan.x new file mode 100644 index 00000000..31af8c02 --- /dev/null +++ b/pkg/utilities/nttools/threed/tiimage/tmscan.x @@ -0,0 +1,96 @@ +include <error.h> +include <imhdr.h> +include <tbset.h> + +# TM_SCAN -- Scan input image list and create column pointer array +# and table from information stored in image headers. +# +# +# +# +# Revision history: +# ---------------- +# 30-Jan-97 - Task created (I.Busko) +# 21-May-97 - Changes from code review (IB) + + +procedure tm_scan (otp, ocp, ocpsize, nocp, imlist) + +pointer otp # i: output table pointer +pointer ocp # io: output table column pointer array +int ocpsize # i: size of above array +int nocp # o: actual number of columns in array +char imlist[ARB] # i: input image list +#-- +pointer sp, im, list +pointer imname, cn, cn1, cu, cf, duma +int image, column, lendata, dumi, i +bool match + +errchk tm_header + +pointer imtopen(), immap() +int imtlen(), imtgetim() +bool streq() + +begin + call smark (sp) + call salloc (imname, SZ_PATHNAME, TY_CHAR) + call salloc (cn, SZ_COLNAME, TY_CHAR) + call salloc (cn1, SZ_COLNAME, TY_CHAR) + call salloc (cu, SZ_COLUNITS, TY_CHAR) + call salloc (cf, SZ_COLFMT, TY_CHAR) + call salloc (duma, max(SZ_COLUNITS,SZ_COLFMT),TY_CHAR) + + # Open input list and initialize number of columns. + list = imtopen (imlist) + nocp = 0 + + # Scan input list. + do image = 1, imtlen(list) { + + # Open image. + i = imtgetim (list, Memc[imname], SZ_PATHNAME) + iferr (im = immap (Memc[imname], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + + # Get column data from image header. + iferr (call tm_header (im, Memc[cn], Memc[cu], Memc[cf])) { + call erract (EA_WARN) + next + } + + # Array size is full image size. + lendata = 1 + do i = 1, IM_NDIM(im) + lendata = lendata * IM_LEN(im,i) + + + # See if column name from header matches any name + # already stored in column pointer array. + match = false + do column = 1, nocp { + call tbcinf (Memi[ocp+column-1], dumi, Memc[cn1], + Memc[duma], Memc[duma], dumi, dumi, dumi) + if (streq (Memc[cn1], Memc[cn])) { + match = true + break + } + } + if (!match) { + + # No names matched, define new column. + call tbcdef (otp, Memi[ocp+nocp], Memc[cn], Memc[cu], + Memc[cf], IM_PIXTYPE(im), lendata, 1) + nocp = nocp + 1 + } + } + + call imtclose (list) + call sfree (sp) + if (nocp == 0) + call error (1, "No images with column data in header.") + call tbtcre (otp) +end diff --git a/pkg/utilities/nttools/threed/titable.par b/pkg/utilities/nttools/threed/titable.par new file mode 100644 index 00000000..41ae759a --- /dev/null +++ b/pkg/utilities/nttools/threed/titable.par @@ -0,0 +1,7 @@ +intable,s,a,"",,,"Input tables" +outtable,s,a,"",,,"Output table" +template,s,h,"",,,"Template table" +row,i,h,INDEF,,,"Begin insertion in row" +verbose,b,h,yes,,,"Print operations performed ?" +version,s,h,"7Feb2000",,, +mode,s,h,"al",,, diff --git a/pkg/utilities/nttools/threed/titable/design1.txt b/pkg/utilities/nttools/threed/titable/design1.txt new file mode 100644 index 00000000..a4040192 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/design1.txt @@ -0,0 +1,224 @@ + + + Design of 3-D table insertion task + ---------------------------------- + + + Author: I. Busko + + + Revision history: + 12/16/96 - First version. + + + + +1. Specifications / requirements: + +This task will perform the inverse operation performed by task txtable. +It will insert (in the tainsert task sense) one or more 2-D tables into +rows of a 3-D table. Alternatively, it will create a 3-D table from the +2-D input tables. Each column in the input 2-D table is inserted as an +array into a single cell at the specified row in the output table. +Additional scalar columns, stored in the headers of the input table by +txtable, will also be processed. + +This design proposes a first, non-sophisticated version of the task. The +emphasis is on simplicity rather than providing support for all possible +situations. For instance, what to do if the size of a given column in one +of the input tables is larger than the corresponding array size in an +existing output table ? Throw away extra elements ? Resize output table ? +But what rules to follow in order to fill back the now resized arrays ? This +design will solve problems like these by resorting to the simplest (from the +code viewpoint) solution (in this case, just ignore the extra elements). + +If the output table does not exist, the first input table in the list +will define both the column information for the output table, as well as +its maximum array size. Columns in the input and output table will be +matched by column name. If a given column in an input table does not exist +in a previously existing output table, it will be ignored. + +The task will be named "titable" following a former proposal for naming +the 3-D table utilities. + + + +2. Language: + +SPP, to allow the use of the generic datatype compiling facility, and to +reuse significant amounts of code already developed for txtable, tximage +and tainsert. + + + +3. Task parameters: + +Name Type What + +input file list/template list of 2D table names with optional + row/column bracket selectors. +output file name 3-D table name with no row/column selectors + (modified in place or created from scratch). +row int row in output table where to begin insertion. + + + +4. Data structures: + +The main data structures are two pointer-type column descriptor arrays, in +the sense defined by the tcs_ routines in the selector library. One array +is associated with the output table, and the other array is associated +with the current input table. + +The output table array is sized to store column information from both the +actual columnar data in the input tables, as well as any scalar data +stored in the input table headers by the txtable task. If the output table +already exists, it will define the array size and contents completely. +If it is being created by the task, the first input table in the list will +define the size and content of the output descriptor array. Thus if other +tables in the input list have additional columns (both physical or in the +form of header-stored scalars), these additional columns will be ignored. + + + +5. Code structure: + +The listing below shows only the most important subroutines; lower-level +functions such as decoding header keywords are not explicited. + +The first section deals with creating the main column descriptor array +for the output table. If the table does not exist, column information +must be read from the input table columns themselves AND from eventual +scalar columns stored in the header by txtable. + +The second section scans the input list and performs the actual insertion +operation. Again, a separate piece of code exists for the cases where a +physical column exists in the input table, or an header-stored scalar +instead. The innermost loop takes care of reading only the selected rows +from the input table. + +- Read task parameters (clget). +- Alloc work memory (malloc, calloc). +- Strip output name from eventual bracket selectors (rdselect). +- Open input list (imtopen). +- If output table already exists (access). + **> Procedure TIUPDATE: + - Open output table (tbtopn). + - Create array of column pointers from output table (malloc, tcs_open). + **> End TIUPDATE. +- Else + **> Procedure TINEW: + - Get first table name from input list (imtgetim). + - Check if it is a table (whatfile). Exit if not. + - Break name into bracketed selectors (rdselect). + - Open input table (tbtopn). + - Get its total (selected and unselected) number of rows (tbpsta). + + - Scalars in input table are signaled by TCTOTAL keyword in input table + header. Look for it (tbhfkr) and increase number of output columns by + the value of TCTOTAL. + + - Create array of column pointers from input column selector and TCTOTAL + info (malloc, tcs_open). + - If no columns were matched, and no TCTOTAL keyword was found, exit. + - Open output table (no STDOUT allowed) (tbtopn). + **> Procedure TISETC: + - Loop over input column pointer array, if it exists. + - Copy column information from input to output (tbcinf, tbcdef), + setting the output array size to be the input number of rows. + - End loop. + - Loop over all possible keyword sets (from 1 to TCTOTAL). + - Look for TCD_xxx keyword (tbhfkr). + - If found: + - Decode TCD keyword into column data (name, datatype, format) + - Create scalar column in output table's column array (tbcdef). + - End if. + - End loop. + **> End TISETC: + - Create output table (tbtcre). + - Close input table (tbtclo). + - Rewind input list (imtrew). + **> End TINEW: +- End if. +- Initialize row counter with "row" parameter value (clgeti). Set flag if row + parameter is negative or INDEF. +**> Procedure TINSERT: + - Loop over input list (imtlen). + - Get table name (imtgetim). + - Check if it is a table (whatfile). Skip and warn user if not. + - Break name into bracketed selectors (rdselect). + - Open input table (tbtopn). + - Look for ORIG_ROW keyword (tbhfkr). If found, and if "row" parameter + is negative or INDEF, supersede row counter with keyword value. + - Find how many rows were requested by row selector (trsopen, trseval, + trsclose). + - Create array of column pointers from column selector. If no columns + were matched, exit (malloc, tcs_open). + **> Procedure TICOPY: + - Loop over output table column pointers. + - Get column info from output table (tcs_column, tbcinf) + - loop over input table column pointers. + - Get column info from input table (tcs_column, tbcinf) + - If column names match: + **> Procedure TICC: + - Get output array size (tcs_totsize). + - Choose the minimum in between this array size and the + number of rows selected from input table. If less rows + than array elements, warn user. + - Get data types of both input and output columns + (tcs_intinfo). + If character-type, get string size too. + **> Procedure TIROWS (generic data type): + - Alloc buffer of appropriate type and with size + given by the minimum size computed above (malloc). + - Copy selected rows from input table into buffer + (trsopen, trseval, tbcgt, trsclose). + - Copy buffer into designated row/column (tbapt). + - If output exists and array is larger than buffer: + - Set remaining elements to INDEF. + - End if. + - Free buffer (mfree). + **> End TIROWS. + **> End TICC. + - Else (no match), look for scalar data in input header: + **> Procedure TIHC: + - Look for TCTOTAL keyword (tbhfkr). If found: + - Loop over all possible keyword sets (from 1 to + TCTOTAL). + - Look for TCD_xxx keyword (tbhfkr). + - Decode TCD keyword to extract column name. + - If column name from header matches with output + column name: + - Look for TCV_xxx keyword (tbhfkr). If found: + **> Procedure TIWRSC (generic data type): + - Write scalar data (tbcpt). + **> End TIWRSC. + - Else + - Warn user that input table header is + corrupted. + - End if. + - End if. + - End loop. + - End if. + **> End TIHC. + - End if. + - End loop. + - End loop. + **> End TICOPY. + - Free input table's array of column pointers (tcs_close, mfree). + - Close input table (tbtclo). + - Bump output row counter. + - End loop. +**> End TINSERT: +- Free output table's array of column pointers (tcs_close, mfree). +- Close output table (tbtclo). +- Close input list (imtclose). +- Free work memory (mfree). + + + + + + + + diff --git a/pkg/utilities/nttools/threed/titable/design2.txt b/pkg/utilities/nttools/threed/titable/design2.txt new file mode 100644 index 00000000..99ceb57f --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/design2.txt @@ -0,0 +1,244 @@ + + + Design of 3-D table insertion task + ---------------------------------- + + + Author: I. Busko + + + Revision history: + 12/16/96 - First version. + 01/15/97 - Revised after design review. + 01/20/97 - Matches version 1.0 of code. + + Revision content: + 01/20/97: (i) internal flow control of TICOPY routine; (ii) the two main + data structures now store "regular" column pointers (in the + tbtable sense) instead of column pointers in the tcs_ sense; + (iii) inclusion of a template table. + + + +1. Specifications / requirements: + +This task will perform the inverse operation performed by task txtable. +It will insert (in the tainsert task sense) one or more 2-D tables into +rows of a 3-D table. Alternatively, it will create a 3-D table from the +2-D input tables. Each column in the input 2-D table is inserted as an +array into a single cell at the specified row in the output table. +Additional scalar columns, stored in the headers of the input table by +txtable, will also be processed. Row/column selectors in the input table +names will be supported. + +This design proposes a first, non-sophisticated version of the task. The +emphasis is on simplicity rather than providing support for all possible +situations. For instance, what to do if the size of a given column in one +of the input tables is larger than the corresponding array size in an +existing output table ? Throw away the extra elements ? Resize output table ? +But what rules to follow in order to fill back the now resized arrays ? This +design will solve problems like these by resorting to the simplest (from the +code viewpoint) solution (in this case, just ignore the extra elements). + +If the output table does not exist, the first input table in the list +will define both the column information for the output table, as well as +its maximum array size. Columns in the input and output table will be +matched by column name. If a given column in an input table does not exist +in a previously existing output table, it will be ignored. + +From design review: an existing table can be used as a template when creating +a new 3-D output table. If no template is supplied, the first table in the +input list becomes the template. + +Because the selector mechanism does not work with scalars stored in the +input tables' headers by task txtable, these scalars, if existent, will +be always inserted in the output table, provided column names match. + +An error results when: +- an array is found in a cell in any of the input tables, +- datatypes in input and output columns do not agree. + +The task will be named "titable" following a former proposal for naming +the 3-D table utilities. + + + +2. Language: + +SPP, to allow the use of the generic datatype compiling facility, and to +reuse significant amounts of code already developed for txtable, tximage +and tainsert. + + + +3. Task parameters: + +Name Type What + +input file list/template list of 2D table names with optional + row/column bracket selectors. +output file name 3-D table name with no row/column selectors + (modified in place or created from scratch). +template file name 3-D template table with column selectors +row int row in output table where to begin insertion. + + + +4. Data structures: + +The main data structures are two pointer-type column descriptor arrays. +One array is associated with the output table, and the other array is +associated with the current input table. + +The output table array is sized to store column information from both the +actual columnar data in the input tables, as well as any scalar data +stored in the input table headers by the txtable task. If the output table +already exists, it will define the array size and contents completely. +If it is being created by the task, the first input table in the list will +define the size and content of the output descriptor array. Thus if other +tables in the input list have additional columns (both physical or in the +form of header-stored scalars), these additional columns will be ignored. + + + +5. Code structure: + +The listing below shows only the most important subroutines; lower-level +functions such as decoding header keywords are not explicited. + +The first section deals with creating the main column descriptor array +for the output table. If the table does not exist, column information +must be read from the input table columns themselves AND from eventual +scalar columns stored in the header by txtable. + +The second section scans the input list and performs the actual insertion +operation. Again, a separate piece of code exists for the cases where a +physical column exists in the input table, or an header-stored scalar +instead. The innermost loop takes care of reading only the selected rows +from the input table. + +- Read task parameters (clget). +- Alloc work memory (malloc, calloc). +- Strip output name from eventual bracket selectors (rdselect). +- Open input list (imtopen). +- If output table already exists (access). + **> Procedure TIUPDATE: + - Open output table (tbtopn). + - Create array of column pointers from output table (malloc, tcs_open). + - Get column pointers from tcs structure. + **> End TIUPDATE. +- Else + **> Procedure TINEW: + - If template table is not valid: + - Get first table name from input list (imtgetim). + - End if. + - Check if it is a table (whatfile). Exit if not. + - Break name into bracketed selectors (rdselect). + - Open template table (tbtopn). + - Get its total (selected and unselected) number of rows (tbpsta). + - Scalars in input table are signaled by TCTOTAL keyword in input table + header. Look for it (tbhfkr) and increase number of output columns. + - Create array of column pointers from input column selector and TCTOTAL + info (malloc, tcs_open). + - If no columns were matched, and no TCTOTAL keyword was found, exit. + - Open output table (no STDOUT allowed) (tbtopn). + **> Procedure TISETC: + - Loop over input column pointer array, if it exists. + - Copy column information from input to output (tbcinf, tbcdef), + setting the output array size to be the input number of rows + in the case of a 2-D template, or keeping it the same size + in the case of a 3-D template. + - End loop. + - Loop over all possible keyword sets (from 1 to TCTOTAL). + - Look for TCD_xxx keyword (tbhfkr). + - If found: + - Decode TCD keyword into column data (name, datatype, format) + - Create scalar column in output table's column array (tbcdef). + - End if. + - End loop. + **> End TISETC: + - Create output table (tbtcre). + - Close input table (tbtclo). + - Rewind input list (imtrew). + **> End TINEW: +- End if. +- Initialize row counter with "row" parameter value (clgeti). Set flag if row + parameter is negative or INDEF. +**> Procedure TINSERT: + - Loop over input list (imtlen). + - Get table name (imtgetim). + - Check if it is a table (whatfile). Skip and warn user if not. + - Break name into bracketed selectors (rdselect). + - Open input table (tbtopn). + - Look for ORIG_ROW keyword (tbhfkr). If found, and if "row" parameter + is negative or INDEF, supersede row counter with keyword value. + - Find how many rows were requested by row selector (trsopen, trseval, + trsclose). + - Create array of column pointers from column selector (malloc,tcs_open). + **> Procedure TICOPY: + - Loop over output table column pointers. + - Get column info from output table (tbcinf) + - Choose the minimum in between this array size and the number + of rows selected from input table (tbalen). + - If there are matched columns, loop over input table column + pointers. + - Get column info from input table (tcs_column, tbcinf) + - If column names match: + - If data types do not match, abort. + **> Procedure TICC: + - If character-type, get string size. + given by the minimum size computed above (malloc). + **> Procedure TIROWS (generic data type): + - Alloc buffer of appropriate type and with size + - Copy selected rows from input table into buffer + (trsopen, trseval, tbcgt, trsclose). + - Copy buffer into designated row/column (tbapt). + - If output exists and array is larger than buffer: + - Set remaining elements to INDEF. + - End if. + **> End TIROWS. + **> End TICC. + - Else (no match), look for scalar data in input header: + - Look for TCTOTAL keyword (tbhfkr). If found: + - Loop over all possible keyword sets (from 1 to + TCTOTAL). + - Look for TCD_xxx keyword (tbhfkr). + - Decode TCD keyword to extract column name. + - If column name from header matches with output + column name: + **> Procedure TICH (generic datatype): + - Look for TCV_xxx keyword (tbhfkr). If found: + - Read value. + - Write scalar data (tbcpt). + - Else + - Warn user that input table header is + corrupted. + - End if. + **> End TICH. + - End if. + - End loop. + - End if. + - End if (Notice that a no-match case, both from columns and + header scalars, is not an error since the output or + template table may have columns that do not exist + among the selected columns in the input table). + - End loop. + - End loop. + **> End TICOPY. + - Free input table's array of column pointers (tcs_close, mfree). + - Close input table (tbtclo). + - Bump output row counter. + - End loop. +**> End TINSERT: +- Free output table's array of column pointers (tcs_close, mfree). +- Close output table (tbtclo). +- Close input list (imtclose). +- Free work memory (mfree). + + + + + + + + diff --git a/pkg/utilities/nttools/threed/titable/generic/mkpkg b/pkg/utilities/nttools/threed/titable/generic/mkpkg new file mode 100644 index 00000000..f65f2f1c --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/mkpkg @@ -0,0 +1,22 @@ +# Update the generic routines. + +default: + $checkout libpkg.a ../../ + $update libpkg.a + $checkin libpkg.a ../../ +$exit + +libpkg.a: + tirowsb.x <tbset.h> + tirowsc.x <tbset.h> + tirowsd.x <tbset.h> + tirowsi.x <tbset.h> + tirowsr.x <tbset.h> + tirowss.x <tbset.h> + tichb.x <tbset.h> + tichc.x <tbset.h> + tichd.x <tbset.h> + tichi.x <tbset.h> + tichr.x <tbset.h> + tichs.x <tbset.h> + ; diff --git a/pkg/utilities/nttools/threed/titable/generic/tichb.x b/pkg/utilities/nttools/threed/titable/generic/tichb.x new file mode 100644 index 00000000..895c6aab --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tichb.x @@ -0,0 +1,52 @@ +include <tbset.h> + +# TICH -- Copy data from input header into scalar cell in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tichb (itp, ihc, otp, ocp, orow) + +pointer itp # i: input table descriptor +int ihc # i: header keyword index +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int orow # i: row where to insert +#-- +bool buf +pointer sp, kwname, kwval +int datatype, parnum + +string corrupt "Corrupted header in input table." + +int nscan() + +begin + call smark (sp) + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (kwval, SZ_PARREC, TY_CHAR) + + # Build keyword name and look for it. + call sprintf (Memc[kwname], SZ_LINE, "TCV_%03d") + call pargi (ihc) + call tbhfkr (itp, Memc[kwname], datatype, Memc[kwval], parnum) + + # Parse and read value. We assume that the keyword existence + # was confirmed by previously finding the paired TCD_ keyword. + if (parnum > 0) { + call sscan (Memc[kwval]) + call gargb (buf) + if (nscan() < 1) call error (1, corrupt) + } else + call error (1, corrupt) + + # Write value into scalar cell. + call tbcptb (otp, ocp, buf, orow, orow) + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tichc.x b/pkg/utilities/nttools/threed/titable/generic/tichc.x new file mode 100644 index 00000000..0685918e --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tichc.x @@ -0,0 +1,54 @@ +include <tbset.h> + +# TICH -- Copy data from input header into scalar cell in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure ticht (itp, ihc, otp, ocp, orow, maxch) + +pointer itp # i: input table descriptor +int ihc # i: header keyword index +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int orow # i: row where to insert +int maxch +#-- +pointer buf +pointer sp, kwname, kwval +int datatype, parnum + +string corrupt "Corrupted header in input table." + +int nscan() + +begin + call smark (sp) + call salloc (buf, maxch + 1, TY_CHAR) + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (kwval, SZ_PARREC, TY_CHAR) + + # Build keyword name and look for it. + call sprintf (Memc[kwname], SZ_LINE, "TCV_%03d") + call pargi (ihc) + call tbhfkr (itp, Memc[kwname], datatype, Memc[kwval], parnum) + + # Parse and read value. We assume that the keyword existence + # was confirmed by previously finding the paired TCD_ keyword. + if (parnum > 0) { + call sscan (Memc[kwval]) + call gargwrd (buf, maxch) + if (nscan() < 1) call error (1, corrupt) + } else + call error (1, corrupt) + + # Write value into scalar cell. + call tbcptt (otp, ocp, buf, maxch, orow, orow) + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tichd.x b/pkg/utilities/nttools/threed/titable/generic/tichd.x new file mode 100644 index 00000000..331b9813 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tichd.x @@ -0,0 +1,52 @@ +include <tbset.h> + +# TICH -- Copy data from input header into scalar cell in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tichd (itp, ihc, otp, ocp, orow) + +pointer itp # i: input table descriptor +int ihc # i: header keyword index +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int orow # i: row where to insert +#-- +double buf +pointer sp, kwname, kwval +int datatype, parnum + +string corrupt "Corrupted header in input table." + +int nscan() + +begin + call smark (sp) + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (kwval, SZ_PARREC, TY_CHAR) + + # Build keyword name and look for it. + call sprintf (Memc[kwname], SZ_LINE, "TCV_%03d") + call pargi (ihc) + call tbhfkr (itp, Memc[kwname], datatype, Memc[kwval], parnum) + + # Parse and read value. We assume that the keyword existence + # was confirmed by previously finding the paired TCD_ keyword. + if (parnum > 0) { + call sscan (Memc[kwval]) + call gargd (buf) + if (nscan() < 1) call error (1, corrupt) + } else + call error (1, corrupt) + + # Write value into scalar cell. + call tbcptd (otp, ocp, buf, orow, orow) + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tichi.x b/pkg/utilities/nttools/threed/titable/generic/tichi.x new file mode 100644 index 00000000..fe01a4ac --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tichi.x @@ -0,0 +1,52 @@ +include <tbset.h> + +# TICH -- Copy data from input header into scalar cell in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tichi (itp, ihc, otp, ocp, orow) + +pointer itp # i: input table descriptor +int ihc # i: header keyword index +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int orow # i: row where to insert +#-- +int buf +pointer sp, kwname, kwval +int datatype, parnum + +string corrupt "Corrupted header in input table." + +int nscan() + +begin + call smark (sp) + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (kwval, SZ_PARREC, TY_CHAR) + + # Build keyword name and look for it. + call sprintf (Memc[kwname], SZ_LINE, "TCV_%03d") + call pargi (ihc) + call tbhfkr (itp, Memc[kwname], datatype, Memc[kwval], parnum) + + # Parse and read value. We assume that the keyword existence + # was confirmed by previously finding the paired TCD_ keyword. + if (parnum > 0) { + call sscan (Memc[kwval]) + call gargi (buf) + if (nscan() < 1) call error (1, corrupt) + } else + call error (1, corrupt) + + # Write value into scalar cell. + call tbcpti (otp, ocp, buf, orow, orow) + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tichr.x b/pkg/utilities/nttools/threed/titable/generic/tichr.x new file mode 100644 index 00000000..b81dd97b --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tichr.x @@ -0,0 +1,52 @@ +include <tbset.h> + +# TICH -- Copy data from input header into scalar cell in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tichr (itp, ihc, otp, ocp, orow) + +pointer itp # i: input table descriptor +int ihc # i: header keyword index +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int orow # i: row where to insert +#-- +real buf +pointer sp, kwname, kwval +int datatype, parnum + +string corrupt "Corrupted header in input table." + +int nscan() + +begin + call smark (sp) + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (kwval, SZ_PARREC, TY_CHAR) + + # Build keyword name and look for it. + call sprintf (Memc[kwname], SZ_LINE, "TCV_%03d") + call pargi (ihc) + call tbhfkr (itp, Memc[kwname], datatype, Memc[kwval], parnum) + + # Parse and read value. We assume that the keyword existence + # was confirmed by previously finding the paired TCD_ keyword. + if (parnum > 0) { + call sscan (Memc[kwval]) + call gargr (buf) + if (nscan() < 1) call error (1, corrupt) + } else + call error (1, corrupt) + + # Write value into scalar cell. + call tbcptr (otp, ocp, buf, orow, orow) + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tichs.x b/pkg/utilities/nttools/threed/titable/generic/tichs.x new file mode 100644 index 00000000..5dbce604 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tichs.x @@ -0,0 +1,52 @@ +include <tbset.h> + +# TICH -- Copy data from input header into scalar cell in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tichs (itp, ihc, otp, ocp, orow) + +pointer itp # i: input table descriptor +int ihc # i: header keyword index +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int orow # i: row where to insert +#-- +short buf +pointer sp, kwname, kwval +int datatype, parnum + +string corrupt "Corrupted header in input table." + +int nscan() + +begin + call smark (sp) + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (kwval, SZ_PARREC, TY_CHAR) + + # Build keyword name and look for it. + call sprintf (Memc[kwname], SZ_LINE, "TCV_%03d") + call pargi (ihc) + call tbhfkr (itp, Memc[kwname], datatype, Memc[kwval], parnum) + + # Parse and read value. We assume that the keyword existence + # was confirmed by previously finding the paired TCD_ keyword. + if (parnum > 0) { + call sscan (Memc[kwval]) + call gargs (buf) + if (nscan() < 1) call error (1, corrupt) + } else + call error (1, corrupt) + + # Write value into scalar cell. + call tbcpts (otp, ocp, buf, orow, orow) + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tirowsb.x b/pkg/utilities/nttools/threed/titable/generic/tirowsb.x new file mode 100644 index 00000000..f87a0861 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tirowsb.x @@ -0,0 +1,71 @@ +include <tbset.h> + +# +# TIROWS -- Expand row selector into array and copy it into output +# table cell. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-1997 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + + +procedure tirowsb (itp, icp, otp, ocp, rowsel, orow, len, buf) + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +char rowsel[ARB] # i: row selector +int orow # i: row in output table where to write into +int len # i: buffer length +bool buf[ARB] +#-- +double undefd +real undefr +pointer pcode +int undefi, i, nelem, irow, numrow, alength +short undefs + +pointer trsopen() +int tbpsta(), tbalen() +bool trseval() + +begin + # Loop over selected rows on input table. + pcode = trsopen (itp, rowsel) + numrow = tbpsta (itp, TBL_NROWS) + nelem = 0 + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + nelem = nelem + 1 + if (nelem > len) { + nelem = len + break + } + # Get element and store in buffer. + call tbegtb (itp, icp, irow, buf[nelem]) + } + } + call trsclose (pcode) + + # Write buffer into array cell element. + call tbaptb (otp, ocp, orow, buf, 1, nelem) + + # If number of selected rows in current input table + # is smaller than output table array length, fill + # remaining array elements with INDEF. + alength = tbalen (ocp) + if (alength > nelem) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = nelem+1, alength { + call tbaptb (otp, ocp, orow, false, i, 1) + } + } +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tirowsc.x b/pkg/utilities/nttools/threed/titable/generic/tirowsc.x new file mode 100644 index 00000000..01d11000 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tirowsc.x @@ -0,0 +1,72 @@ +include <tbset.h> + +# +# TIROWS -- Expand row selector into array and copy it into output +# table cell. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-1997 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + + +procedure tirowst (itp, icp, otp, ocp, rowsel, orow, maxch, len, buf) + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +char rowsel[ARB] # i: row selector +int orow # i: row in output table where to write into +int maxch # i: max length of string +int len # i: buffer length +char buf[maxch,ARB] # i: work buffer +#-- +double undefd +real undefr +pointer pcode +int undefi, i, nelem, irow, numrow, alength +short undefs + +pointer trsopen() +int tbpsta(), tbalen() +bool trseval() + +begin + # Loop over selected rows on input table. + pcode = trsopen (itp, rowsel) + numrow = tbpsta (itp, TBL_NROWS) + nelem = 0 + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + nelem = nelem + 1 + if (nelem > len) { + nelem = len + break + } + # Get element and store in buffer. + call tbegtt (itp, icp, irow, buf[1,nelem], maxch) + } + } + call trsclose (pcode) + + # Write buffer into array cell element. + call tbaptt (otp, ocp, orow, buf, maxch, 1, nelem) + + # If number of selected rows in current input table + # is smaller than output table array length, fill + # remaining array elements with INDEF. + alength = tbalen (ocp) + if (alength > nelem) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = nelem+1, alength { + call tbaptt (otp, ocp, orow, "", maxch, i, 1) + } + } +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tirowsd.x b/pkg/utilities/nttools/threed/titable/generic/tirowsd.x new file mode 100644 index 00000000..3af5468c --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tirowsd.x @@ -0,0 +1,71 @@ +include <tbset.h> + +# +# TIROWS -- Expand row selector into array and copy it into output +# table cell. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-1997 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + + +procedure tirowsd (itp, icp, otp, ocp, rowsel, orow, len, buf) + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +char rowsel[ARB] # i: row selector +int orow # i: row in output table where to write into +int len # i: buffer length +double buf[ARB] +#-- +double undefd +real undefr +pointer pcode +int undefi, i, nelem, irow, numrow, alength +short undefs + +pointer trsopen() +int tbpsta(), tbalen() +bool trseval() + +begin + # Loop over selected rows on input table. + pcode = trsopen (itp, rowsel) + numrow = tbpsta (itp, TBL_NROWS) + nelem = 0 + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + nelem = nelem + 1 + if (nelem > len) { + nelem = len + break + } + # Get element and store in buffer. + call tbegtd (itp, icp, irow, buf[nelem]) + } + } + call trsclose (pcode) + + # Write buffer into array cell element. + call tbaptd (otp, ocp, orow, buf, 1, nelem) + + # If number of selected rows in current input table + # is smaller than output table array length, fill + # remaining array elements with INDEF. + alength = tbalen (ocp) + if (alength > nelem) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = nelem+1, alength { + call tbaptd (otp, ocp, orow, undefd, i, 1) + } + } +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tirowsi.x b/pkg/utilities/nttools/threed/titable/generic/tirowsi.x new file mode 100644 index 00000000..6cf4b069 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tirowsi.x @@ -0,0 +1,71 @@ +include <tbset.h> + +# +# TIROWS -- Expand row selector into array and copy it into output +# table cell. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-1997 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + + +procedure tirowsi (itp, icp, otp, ocp, rowsel, orow, len, buf) + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +char rowsel[ARB] # i: row selector +int orow # i: row in output table where to write into +int len # i: buffer length +int buf[ARB] +#-- +double undefd +real undefr +pointer pcode +int undefi, i, nelem, irow, numrow, alength +short undefs + +pointer trsopen() +int tbpsta(), tbalen() +bool trseval() + +begin + # Loop over selected rows on input table. + pcode = trsopen (itp, rowsel) + numrow = tbpsta (itp, TBL_NROWS) + nelem = 0 + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + nelem = nelem + 1 + if (nelem > len) { + nelem = len + break + } + # Get element and store in buffer. + call tbegti (itp, icp, irow, buf[nelem]) + } + } + call trsclose (pcode) + + # Write buffer into array cell element. + call tbapti (otp, ocp, orow, buf, 1, nelem) + + # If number of selected rows in current input table + # is smaller than output table array length, fill + # remaining array elements with INDEF. + alength = tbalen (ocp) + if (alength > nelem) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = nelem+1, alength { + call tbapti (otp, ocp, orow, undefi, i, 1) + } + } +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tirowsr.x b/pkg/utilities/nttools/threed/titable/generic/tirowsr.x new file mode 100644 index 00000000..c6754eaf --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tirowsr.x @@ -0,0 +1,71 @@ +include <tbset.h> + +# +# TIROWS -- Expand row selector into array and copy it into output +# table cell. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-1997 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + + +procedure tirowsr (itp, icp, otp, ocp, rowsel, orow, len, buf) + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +char rowsel[ARB] # i: row selector +int orow # i: row in output table where to write into +int len # i: buffer length +real buf[ARB] +#-- +double undefd +real undefr +pointer pcode +int undefi, i, nelem, irow, numrow, alength +short undefs + +pointer trsopen() +int tbpsta(), tbalen() +bool trseval() + +begin + # Loop over selected rows on input table. + pcode = trsopen (itp, rowsel) + numrow = tbpsta (itp, TBL_NROWS) + nelem = 0 + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + nelem = nelem + 1 + if (nelem > len) { + nelem = len + break + } + # Get element and store in buffer. + call tbegtr (itp, icp, irow, buf[nelem]) + } + } + call trsclose (pcode) + + # Write buffer into array cell element. + call tbaptr (otp, ocp, orow, buf, 1, nelem) + + # If number of selected rows in current input table + # is smaller than output table array length, fill + # remaining array elements with INDEF. + alength = tbalen (ocp) + if (alength > nelem) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = nelem+1, alength { + call tbaptr (otp, ocp, orow, undefr, i, 1) + } + } +end diff --git a/pkg/utilities/nttools/threed/titable/generic/tirowss.x b/pkg/utilities/nttools/threed/titable/generic/tirowss.x new file mode 100644 index 00000000..91c678c3 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/generic/tirowss.x @@ -0,0 +1,71 @@ +include <tbset.h> + +# +# TIROWS -- Expand row selector into array and copy it into output +# table cell. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-1997 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + + +procedure tirowss (itp, icp, otp, ocp, rowsel, orow, len, buf) + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +char rowsel[ARB] # i: row selector +int orow # i: row in output table where to write into +int len # i: buffer length +short buf[ARB] +#-- +double undefd +real undefr +pointer pcode +int undefi, i, nelem, irow, numrow, alength +short undefs + +pointer trsopen() +int tbpsta(), tbalen() +bool trseval() + +begin + # Loop over selected rows on input table. + pcode = trsopen (itp, rowsel) + numrow = tbpsta (itp, TBL_NROWS) + nelem = 0 + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + nelem = nelem + 1 + if (nelem > len) { + nelem = len + break + } + # Get element and store in buffer. + call tbegts (itp, icp, irow, buf[nelem]) + } + } + call trsclose (pcode) + + # Write buffer into array cell element. + call tbapts (otp, ocp, orow, buf, 1, nelem) + + # If number of selected rows in current input table + # is smaller than output table array length, fill + # remaining array elements with INDEF. + alength = tbalen (ocp) + if (alength > nelem) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = nelem+1, alength { + call tbapts (otp, ocp, orow, undefs, i, 1) + } + } +end diff --git a/pkg/utilities/nttools/threed/titable/help.txt b/pkg/utilities/nttools/threed/titable/help.txt new file mode 100644 index 00000000..77289bc5 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/help.txt @@ -0,0 +1,117 @@ +TITABLE (Jan97) threed TITABLE (Jan97) + + + +NAME + titable -- Inserts 2-D tables into rows of a 3-D table. + + +USAGE + titable intable outtable + + +DESCRIPTION + This task performs the inverse operation of task txtable: it + inserts one or more 2-D tables into rows of a 3-D table The input + may be a filename template, including wildcard characters, or the + name of a file (preceded by an @ sign) containing table names. The + output is a single 3-D table name. If the output table exists, + insertion will be done in place. If the output table does not + exist, it will be created. The input and output tables must not be + the same. + + This task supports row/column selectors in the input table names. + These may be used to select subsets of both rows and columns from + the input table. If no selectors are used, all columns and rows + will be processed, Type 'help selectors' to see a description of + the selector syntax. + + When creating a new output table, the information describing its + columns can be taken from two sources. If parameter 'template' has + the name of an existing 3-D table, the column descriptions, + including maximum array sizes, will be taken from that table. If + 'template' has an invalid or null ("") value, the column-defining + information will be take from the first table in the input list, + where its number of rows will define the maximum array size allowed + in the table being created. Column selectors are allowed in the + template table. + + NOTE: Both the output and template table names must always be + supplied complete, including their extension. Otherwise the task + may get confused on the existence of an already existing table. + + Insertion is performed by first verifying if column names in both + input and output tables match. If a match is found, values taken + from that column and all selected rows from the input table will be + stored as a 1-dimensional array in a single cell in the + corresponding column in the output 3-D table. The row in this + table where the insertion takes place is selected by the "row" task + parameter. It points to the row where the first table in the input + list will be inserted, subsequent tables in the list will be + inserted into subsequent rows. This mechanism is superseded if the + "row" parameter is set to INDEF or a negative value, and the + keyword "ORIG_ROW" is found in the header of the input table. This + keyword is created by task txtable and its value supersedes the row + counter in the task. + If the maximum array size in a target column in the output 3-D + table is larger than the number of selected input rows, the array + will be filled up starting from its first element, and the empty + elements at the end will be set to INDEF (or "" if it is a + character string column). If the maximum array size is smaller than + the number of selected rows, insertion begins by the first selected + row up to the maximum allowable size, the remaining rows being + ignored. + + This task correctly handles scalars stored in the input table header + by task txtable. Since the selector mechanism does not work with + these scalars, the task will always insert them into the output + table, provided there is a match in column names. + + +PARAMETERS + + intable [file name list/template] + A list of one or more tables to be inserted. Row/column + selectors are supported. + + outtable [table name] + Name of 3-D output table, including extension. No support + exists for "STDOUT" (ASCII output). + + (template = "") [table name] + Name of 3-D table to be used as template when creating a new + output table. + + (row = INDEF) [int] + Row where insertion begins. If set to INDEF or a negative + value, the row number will be looked for in the input table + header. + + (verbose = yes) [boolean] + Display names of input and output tables as files are processed + ? + + +EXAMPLES + Insert columns named FLUX and WAVELENGTH from input tables into a + 3-D table: + + cl> titable itable*.tab[c:FLUX,WAVELENGTH] otable.tab + + + +BUGS + The output and template table names must be supplied in full, + including the extension (e.g. ".tab"). If the output table name is + not typed in full, the task will create a new table in place of the + existing one, with only the rows actually inserted. This behavior + relates to the way the underlying "access" routine in IRAF's fio + library works. + + +REFERENCES + This task was written by I. Busko. + + +SEE ALSO + txtable, selectors diff --git a/pkg/utilities/nttools/threed/titable/list.tex b/pkg/utilities/nttools/threed/titable/list.tex new file mode 100644 index 00000000..4b78ed5d --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/list.tex @@ -0,0 +1,979 @@ +\documentstyle{article} +\topmargin -30mm +\textheight 250mm +\oddsidemargin -5mm +\evensidemargin -5mm +\textwidth 170mm + +\begin{document} + +\tableofcontents + +\newpage + +\addcontentsline{toc}{section}{help.txt} +\begin{verbatim} + +TITABLE (Jan97) threed TITABLE (Jan97) + + + +NAME + titable -- Inserts 2-D tables into rows of a 3-D table. + + +USAGE + titable intable outtable + + +DESCRIPTION + This task performs the inverse operation of task txtable: it + inserts one or more 2-D tables into rows of a 3-D table The input + may be a filename template, including wildcard characters, or the + name of a file (preceded by an @ sign) containing table names. The + output is a single 3-D table name. If the output table exists, + insertion will be done in place. If the output table does not + exist, it will be created. The input and output tables must not be + the same. + + This task supports row/column selectors in the input table names. + These may be used to select subsets of both rows and columns from + the input table. If no selectors are used, all columns and rows + will be processed, Type 'help selectors' to see a description of + the selector syntax. + + When creating a new output table, the information describing its + columns can be taken from two sources. If parameter 'template' has + the name of an existing 3-D table, the column descriptions, + including maximum array sizes, will be taken from that table. If + 'template' has an invalid or null ("") value, the column-defining + information will be take from the first table in the input list, + where its number of rows will define the maximum array size allowed + in the table being created. Column selectors are allowed in the + template table. + + NOTE: Both the output and template table names must always be + supplied complete, including their extension. Otherwise the task + may get confused on the existence of an already existing table. + + Insertion is performed by first verifying if column names in both + input and output tables match. If a match is found, values taken + from that column and all selected rows from the input table will be + stored as a 1-dimensional array in a single cell in the + corresponding column in the output 3-D table. The row in this + table where the insertion takes place is selected by the "row" task + parameter. It points to the row where the first table in the input + list will be inserted, subsequent tables in the list will be + inserted into subsequent rows. This mechanism is superseded if the + "row" parameter is set to INDEF or a negative value, and the + keyword "ORIG_ROW" is found in the header of the input table. This + keyword is created by task txtable and its value supersedes the row + counter in the task. + If the maximum array size in a target column in the output 3-D + table is larger than the number of selected input rows, the array + will be filled up starting from its first element, and the empty + elements at the end will be set to INDEF (or "" if it is a + character string column). If the maximum array size is smaller than + the number of selected rows, insertion begins by the first selected + row up to the maximum allowable size, the remaining rows being + ignored. + + This task correctly handles scalars stored in the input table header + by task txtable. Since the selector mechanism does not work with + these scalars, the task will always insert them into the output + table, provided there is a match in column names. + + +PARAMETERS + + intable [file name list/template] + A list of one or more tables to be inserted. Row/column + selectors are supported. + + outtable [table name] + Name of 3-D output table, including extension. No support + exists for "STDOUT" (ASCII output). + + (template = "") [table name] + Name of 3-D table to be used as template when creating a new + output table. + + (row = INDEF) [int] + Row where insertion begins. If set to INDEF or a negative + value, the row number will be looked for in the input table + header. + + (verbose = yes) [boolean] + Display names of input and output tables as files are processed + ? + + +EXAMPLES + Insert columns named FLUX and WAVELENGTH from input tables into a + 3-D table: + + cl> titable itable*.tab[c:FLUX,WAVELENGTH] otable.tab + + + +BUGS + The output and template table names must be supplied in full, + including the extension (e.g. ".tab"). If the output table name is + not typed in full, the task will create a new table in place of the + existing one, with only the rows actually inserted. This behavior + relates to the way the underlying "access" routine in IRAF's fio + library works. + + +REFERENCES + This task was written by I. Busko. + + +SEE ALSO + txtable, selectors +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{loc.txt} +\begin{verbatim} + +Filename Total Blanks Comments Help Execute Nonexec +============================================================================ + titable.x 81 18 16 0 23 24 + tiupdate.x 42 13 11 0 7 11 + tinew.x 96 24 21 0 30 21 + tinsert.x 104 23 17 0 41 23 + tisetc.x 70 17 14 0 20 19 + ticopy.x 107 23 16 0 45 23 + ticc.x 53 11 7 0 22 13 + tiheader.x 189 57 27 0 62 43 +TOTAL 742 186 129 0 250 177 +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{titable.x} +\begin{verbatim} + +include <tbset.h> + +# TITABLE -- Insert 2D tables into 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 a 3-D table with no row/column +# selectors. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure t_titable() + +char tablist[SZ_LINE] # Input table list +char output[SZ_PATHNAME] # Output table name +char template[SZ_PATHNAME] # Template table name +int row # Row where to begin insertion +bool verbose # Print operations ? +#-- +char root[SZ_FNAME] +char rowselect[SZ_FNAME] +char colselect[SZ_FNAME] +char colname[SZ_COLNAME] +char colunits[SZ_COLUNITS] +char colfmt[SZ_COLFMT] +pointer cpo +pointer otp, list +int ncpo, rowc +bool rflag + +string nocols "Column name not found (%s)" +string nofile "Input file is not a table (%s)" + +pointer imtopen() +int clgeti(), access() +bool clgetb(), streq() + +begin + # Get task parameters. + + call clgstr ("intable", tablist, SZ_LINE) + call clgstr ("outtable", output, SZ_PATHNAME) + call clgstr ("template", template, SZ_PATHNAME) + row = clgeti ("row") + verbose = clgetb ("verbose") + + # Abort if invalid output name.. + if (streq (output, "STDOUT")) + call error (1, "Invalid output file name.") + call rdselect (output, root, rowselect, colselect, SZ_FNAME) + if (rowselect[1] != EOS || colselect[1] != EOS) + call error (1, "Sections not permitted on output table name.") + + # Open input list. + list = imtopen (tablist) + + # Open/create the output table. + if (access (output, READ_WRITE, 0) == YES) + call tiupdate (root, otp, cpo, ncpo) + else + call tinew (template, list, root, rowselect, colselect, colname, + colunits, colfmt, otp, cpo, ncpo) + + # Initialize row counter. + rowc = row + rflag = false + if (rowc <= 0 || IS_INDEF(rowc)) rflag = true + + # Do the insertion. + call tinsert (list, output, otp, cpo, ncpo, rowc, rflag, verbose, + rowselect, colselect, colname, colunits, colfmt) + + # Cleanup. The cpo array was allocated by tiupdate/tinew. + call tcs_close (Memi[cpo], ncpo) + call mfree (cpo, TY_INT) + call tbtclo (otp) + call imtclose (list) +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tiupdate.x} +\begin{verbatim} + +include <tbset.h> + +# TIUPDATE -- Opens an already existing output table for update. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tiupdate (output, otp, cpo, ncpo) + +char output[ARB] # i: table name +pointer otp # o: table descriptor +pointer cpo # o: column descriptor +int ncpo # o: number of columns +#-- +int i, dummy + +errchk tbtopn + +pointer tbtopn(), tcs_column() +int tbpsta() + +begin + # Open table and get its size. + otp = tbtopn (output, READ_WRITE, NULL) + ncpo = tbpsta (otp, TBL_NCOLS) + + # Alloc column descriptor array. This + # must be freed by caller. + call malloc (cpo, ncpo, TY_INT) + + # Fill array with column info. The empty string + # forces the opening of all columns. + call tcs_open (otp, "", Memi[cpo], dummy, ncpo) + + # Get column pointers from tcs structure. + do i = 1, ncpo + Memi[cpo+i-1] = tcs_column (Memi[cpo+i-1]) +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tinew.x} +\begin{verbatim} + +include <tbset.h> +include "../whatfile.h" + +# TINEW -- Opens and creates a new output table. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tinew (template, list, output, rowsel, colsel, colname, colunits, + colfmt, otp, cpo, ncpo) + +char template[ARB] # i: template table name +pointer list # i: input list +char output[ARB] # i: output table name +char rowsel[ARB] # i: work array for row selectors +char colsel[ARB] # i: work array for column selectors +char colname[ARB] # i: work array for column names +char colunits[ARB] # i: work array for column units +char colfmt[ARB] # i: work array for column format +pointer otp # o: table descriptor +pointer cpo # o: column descriptor +int ncpo # o: number of columns +#-- +pointer sp, itp, newcpo, root +int nrows, ncols, nscalar +bool is_temp + +errchk tbtopen, tisetc + +pointer tbtopn() +int tbpsta(), whatfile(), imtgetim(), tihnsc(), access() + +begin + call smark (sp) + call salloc (root, SZ_PATHNAME, TY_CHAR) + + # See if there is a template table. + is_temp = true + if (access (template, READ_ONLY, 0) == NO) { + + # Get first table in input list as the template. + if (imtgetim (list, template, SZ_PATHNAME) == EOF) + call error (1, "Input list is empty.") + call imtrew (list) + is_temp = false + } + + if (whatfile (template) != IS_TABLE) + call error (1, "Template/input file is not a table.") + + # Break template file name into bracketed selectors. + call rdselect (template, Memc[root], rowsel, colsel, SZ_FNAME) + + # Open template table and get some info. + itp = tbtopn (Memc[root], READ_ONLY, NULL) + nrows = tbpsta (itp, TBL_NROWS) + ncols = tbpsta (itp, TBL_NCOLS) + + # There might be header-stored scalars that don't show up + # with tbpsta, if the template is coming from the input list. + # Examine the header to find how many of them there are and + # increment number of output columns. + nscalar = tihnsc (itp) + ncols = ncols + nscalar + + # Create arrays with colum info. Must be freed by caller. + call malloc (cpo, ncols, TY_INT) + call malloc (newcpo, ncols, TY_INT) + call tcs_open (itp, colsel, Memi[cpo], ncpo, ncols) + + # Exit if no column matches and no scalars. + if (ncpo == 0 && nscalar == 0) + call error (1, "No columns selected.") + + # Open output table. + otp = tbtopn (output, NEW_FILE, 0) + + # Copy column information from input to output. + call tisetc (cpo, newcpo, ncpo, nscalar, itp, otp, colname, colunits, + colfmt, nrows, is_temp) + + # Point to new column array. + call mfree (cpo, TY_INT) + cpo = newcpo + + # Number of columns now is (selected columns from input) + scalars. + ncpo = ncpo + nscalar + + # Create output table. + call tbtcre (otp) + + # Cleanup. + call tbtclo (itp) + call sfree (sp) +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tinsert.x} +\begin{verbatim} + +include <tbset.h> +include "../whatfile.h" + +# TINSERT -- Perform the actual insertion. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tinsert (list, output, otp, cpo, ncpo, row, rflag, verbose, + rowsel, colsel, colname, colunits, colfmt) + +pointer list # i: input list +char output[ARB] # i: output table name +pointer otp # i: output table descriptor +pointer cpo # i: output column descriptors +int ncpo # i: output number of columns +int row # i: row where to begin insertion +bool rflag # i: read row from header ? +bool verbose # i: print info ? +char rowsel[ARB] # i: work string for row selector +char colsel[ARB] # i: work string for column selector +char colname[ARB] # i: work string for column names +char colunits[ARB] # i: work string for column units +char colfmt[ARB] # i: work string for column formats +#-- +pointer sp, itp, fname, root, pcode, cpi +int i, file, hrow, numrow, numcol, nrows, ncpi + +errchk ticopy + +pointer trsopen(), tbtopn() +int imtgetim(), imtlen(), whatfile(), tihrow(), tbpsta() +bool trseval() + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (root, SZ_FNAME, TY_CHAR) + + # Loop over input list. + do file = 1, imtlen(list) { + + # Get input table name and validate file type. + i = imtgetim (list, Memc[fname], SZ_PATHNAME) + if (whatfile (Memc[fname]) != IS_TABLE) { + call eprintf ("Input file is not a table (%s)\n") + call pargstr (Memc[fname]) + call flush (STDERR) + break + } + + # Break input file name into bracketed selectors. + call rdselect (Memc[fname], Memc[root], rowsel, colsel, SZ_FNAME) + + # Open input table and get some info. + itp = tbtopn (Memc[fname], READ_ONLY, NULL) + numrow = tbpsta (itp, TBL_NROWS) + numcol = tbpsta (itp, TBL_NCOLS) + + # See if original row information is stored in header. + # If so, and user asked for, use it. + hrow = tihrow (itp) + if (rflag) { + if (hrow > 0) + row = hrow + else + call error (1, "No valid row.") + } + + # Find how many rows were requested by row selector. + nrows = 0 + pcode = trsopen (itp, rowsel) + do i = 1, numrow { + if (trseval (itp, i, pcode)) + nrows = nrows + 1 + } + call trsclose (pcode) + + # Create array of column pointers from column selector. + call malloc (cpi, numcol, TY_INT) + call tcs_open (itp, colsel, Memi[cpi], ncpi, numcol) + + if (verbose) { + call printf ("%s -> %s row=%d \n") + call pargstr (Memc[fname]) + call pargstr (output) + call pargi (row) + call flush (STDOUT) + } + + # Copy current input table into current row of output table. + call ticopy (itp, cpi, ncpi, otp, cpo, ncpo, rowsel, row, nrows, + colname, colunits, colfmt) + + # Free input table's array of column pointers. + call tcs_close (Memi[cpi], ncpi) + call mfree (cpi, TY_INT) + + # Close input table. + call tbtclo (itp) + + # Bump row counter. + row = row + 1 + } + + call sfree (sp) +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tisetc.x} +\begin{verbatim} + + +# TISETC -- Set column info in new output table. +# +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure tisetc (cpo, newcpo, ncpo, nscalar, itp, otp, colname, colunits, + colfmt, csize, template) + +pointer cpo # i: array of column descriptors +pointer newcpo # io: new array of column descriptors +int ncpo # i: number of columns matched by selector +int nscalar # i: number of scalar columns +char colname[ARB] # i: work array for column names +char colunits[ARB] # i: work array for column units +char colfmt[ARB] # i: work array for column format +pointer itp,otp # io: template and output table descriptors +int csize # i: cell size in output table +bool template # i: is there a template ? +#-- +pointer ocp +int i, j, colnum, ntot +int datatype, lendata, lenfmt + +errchk tihdec + +pointer tcs_column() +int tihmax() +bool tihdec() + +begin + # First copy column information from template/input + # table into output table. + if (ncpo > 0) { + do i = 1, ncpo { + ocp = tcs_column (Memi[cpo+i-1]) + if (!template) { + + # Template wasn't supplied; copy column info from 2-D + # input table into 3-D output table, taking care of + # resetting the array size. + call tbcinf (ocp, colnum, colname, colunits, colfmt, + datatype, lendata, lenfmt) + if (lendata > 1) + call error (1, "Input table has array element !") + call tbcdef (otp, ocp, colname, colunits, colfmt, + datatype, csize, 1) + } else { + + # Copy with same array size configuration, since + # template is supposedly a 3-D table. + call tbcinf (ocp, colnum, colname, colunits, colfmt, + datatype, lendata, lenfmt) + call tbcdef (otp, ocp, colname, colunits, colfmt, + datatype, lendata, 1) + } + + # Save column pointer. + Memi[newcpo+i-1] = ocp + } + } + + # If header-stored scalars exist, define new columns for them. + if (nscalar > 0) { + ntot = tihmax (itp) + i = ncpo + do j = 1, ntot { + if (tihdec (itp, j, colname, colunits, colfmt, datatype, + lenfmt)) { + call tbcdef (otp, ocp, colname, colunits, colfmt, + datatype, 1, 1) + Memi[newcpo+i] = ocp + i = i + 1 + } + } + } +end + +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{ticopy.x} +\begin{verbatim} + +include <tbset.h> + +# TICOPY -- Copy input table into row of output table +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure ticopy (itp, cpi, ncpi, otp, cpo, ncpo, rowsel, row, nrows, + coln, colu, colf) + +pointer itp # i: input table descriptor +pointer cpi # i: input column descriptor array +int ncpi # i: input number of columns +pointer otp # i: output table descriptor +pointer cpo # i: output column descriptor array +int ncpo # i: output number of columns +char rowsel[ARB] # i: work string for row selector +int row # i: row where to begin insertion +int nrows # i: number of selected rows +char coln[ARB] # i: work string for column names +char colu[ARB] # i: work string for column units +char colf[ARB] # i: work string for column formats +#-- +pointer sp, coln2, colu2, colf2, icp, ocp +int icpi, icpo, dum, dtypi, dtypo, maxlen +int ihc, maxhc +bool found + +errchk ticc + +pointer tcs_column() +int tbalen(), tihmax() +bool streq(), tihdec() + +begin + call smark (sp) + call salloc (coln2, SZ_COLNAME, TY_CHAR) + call salloc (colu2, SZ_COLUNITS, TY_CHAR) + call salloc (colf2, SZ_COLFMT, TY_CHAR) + + # Loop over output table column pointers. + do icpo = 1, ncpo { + + # Get column name and data type from output table. + ocp = Memi[cpo+icpo-1] + call tbcinf (ocp, dum, coln, colu, colf, dtypo, dum, dum) + + # Array length must be the minimum in between table array + # size and the number of rows selected from input table. + maxlen = min (tbalen(ocp), nrows) + + # If there are matched columns, loop over + # input table column pointers. + found = false + if (ncpi > 0) { + do icpi = 1, ncpi { + + # Get column name and data type from input table. + icp = tcs_column (Memi[cpi+icpi-1]) + call tbcinf (icp,dum,Memc[coln2],colu,colf,dtypi,dum,dum) + + # If column names match, copy from table to table. + if (streq (coln, Memc[coln2])) { + # For now, abort if datatypes do not match. + if (dtypo != dtypi) + call error (1, "Data types do not match.") + call ticc (itp,icp,otp,ocp,dtypo,maxlen,rowsel,row) + found = true + } + } + } + + # If column was not found, look into header. + if (!found) { + maxhc = tihmax (itp) + if (maxhc > 0) { + do ihc = 1, maxhc { + if (tihdec (itp, ihc, Memc[coln2], Memc[colu2], + Memc[colf2], dtypi, dum)) { + if (streq (coln, Memc[coln2])) { + + # For now, abort if datatypes do not match. + if (dtypo != dtypi) + call error (1, "Data types do not match.") + if (dtypo < 0) + dtypo = TY_CHAR + + switch (dtypo) { + case TY_CHAR: + call ticht (itp, ihc, otp, ocp, row, -dtypi) + case TY_BOOL: + call tichb (itp, ihc, otp, ocp, row) + case TY_SHORT: + call tichs (itp, ihc, otp, ocp, row) + case TY_INT,TY_LONG: + call tichi (itp, ihc, otp, ocp, row) + case TY_REAL: + call tichr (itp, ihc, otp, ocp, row) + case TY_DOUBLE: + call tichd (itp, ihc, otp, ocp, row) + default: + call error (1, "Non-supported data type.") + } + } + } + } + } + } + } + + call sfree (sp) +end + + +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{ticc.x} +\begin{verbatim} + + +# TICC -- Copy data from column in input to cell array in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure ticc (itp, icp, otp, ocp, dtype, maxlen, rowsel, row) + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int dtype # i: data type of both input and output columns +int maxlen # i: array length +char rowsel[ARB] # i: work string for row selector +int row # i: row where to insert +#-- +pointer sp, buf +int maxch + +begin + # Alloc buffer of apropriate length and type. + maxch = 1 + if (dtype < 0) { + maxch = - dtype + dtype = TY_CHAR + } + call smark (sp) + call salloc (buf, maxlen*(maxch + 1), dtype) + + # Copy. + switch (dtype) { + case TY_CHAR: + call tirowst (itp, icp, otp, ocp, rowsel, row, maxch, maxlen, + Memc[buf]) + case TY_BOOL: + call tirowsb (itp, icp, otp, ocp, rowsel, row, maxlen, Memb[buf]) + case TY_SHORT: + call tirowss (itp, icp, otp, ocp, rowsel, row, maxlen, Mems[buf]) + case TY_INT, TY_LONG: + call tirowsi (itp, icp, otp, ocp, rowsel, row, maxlen, Memi[buf]) + case TY_REAL: + call tirowsr (itp, icp, otp, ocp, rowsel, row, maxlen, Memr[buf]) + case TY_DOUBLE: + call tirowsd (itp, icp, otp, ocp, rowsel, row, maxlen, Memd[buf]) + default: + call error (1, "Non-supported data type.") + } + + call sfree (sp) +end +\end{verbatim} +\newpage +\addcontentsline{toc}{section}{tiheader.x} +\begin{verbatim} + +include <tbset.h> + +# TIHEADER -- Routines for retrieving header-stored scalars. +# +# Details such as keyword names and encoding are defined by the +# way task txtable creates the same keywords. +# +# +# +# TIHKI -- Look for keyword and return integer value, or 0 if not found. +# TIHMAX -- Return maximum number of header-stored scalars. +# TIHNSC -- Return actual number of scalars in header. +# TIHROW -- Return original row value stored by txtable task. +# TIHDEC -- Decode column description in header keyword. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + + +# TIHMAX -- Return maximum number of header-stored scalars. + +int procedure tihmax (tp) + +pointer tp # table pointer + +int tihki() + +begin + return (tihki (tp, "TCTOTAL")) +end + + + + +# TIHROW -- Return original row value (stored by txtable task). + +int procedure tihrow (tp) + +pointer tp # table pointer + +int tihki() + +begin + return (tihki (tp, "ORIG_ROW")) +end + + + + +# TIHNSC -- Return actual number of scalars in header. + +int procedure tihnsc (tp) + +pointer tp # table pointer +#-- +pointer sp, kwname, kwval +int dtype, parnum +int i, ntot, nscalar + +int tihmax() + +begin + call smark (sp) + call salloc (kwval, SZ_PARREC, TY_CHAR) + call salloc (kwname, SZ_LINE, TY_CHAR) + nscalar = 0 + + ntot = tihmax (tp) + if (ntot > 0) { + do i = 1, ntot { + call sprintf (kwname, SZ_LINE, "TCD_%03d") + call pargi (i) + call tbhfkr (tp, kwname, dtype, kwval, parnum) + if (parnum > 0) + nscalar = nscalar + 1 + } + } + + call sfree (sp) + return (nscalar) +end + + + + + +# TIHDEC -- Decode column description in header keyword. The detailed +# format depends on how task txtable does the encoding. + +bool procedure tihdec (tp, kn, colname, colunits, colfmt, datatype, lenfmt) + +pointer tp # i: table pointer +int kn # i: keyword number +char colname[ARB] # o: column name +char colunits[ARB] # o: column units +char colfmt[ARB] # o: column print format +int datatype # o: column data type +int lenfmt # o: format lenght +#-- +pointer sp, kwname, kwval, dtype +int parnum +bool found + +string corrupt "Corrupted header in input table." + +int nscan(), strncmp() +bool streq() + +begin + call smark (sp) + call salloc (kwval, SZ_PARREC, TY_CHAR) + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (dtype, SZ_LINE, TY_CHAR) + + # Build column description keyword name. + call sprintf (Memc[kwname], SZ_LINE, "TCD_%03d") + call pargi (kn) + + # Look for it. + call tbhfkr (tp, Memc[kwname], datatype, Memc[kwval], parnum) + + if (parnum > 0) { + + # Found; parse the 5 fields. + call sscan (Memc[kwval]) + call gargwrd (colname, SZ_COLNAME) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colunits, SZ_COLUNITS) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colfmt, SZ_COLFMT) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (Memc[dtype], SZ_LINE) + if (nscan() < 1) call error (1, corrupt) + call gargi (lenfmt) + if (nscan() < 1) call error (1, corrupt) + + # Translate from human-readable encoding to sdas table encoding. + if (streq (colunits, "default")) + call strcpy ("", colunits, SZ_COLUNITS) + if (streq (colfmt, "default")) + call strcpy ("", colfmt, SZ_COLFMT) + if (streq (Memc[dtype], "boolean")) datatype = TY_BOOL + if (streq (Memc[dtype], "short")) datatype = TY_SHORT + if (streq (Memc[dtype], "integer")) datatype = TY_INT + if (streq (Memc[dtype], "long")) datatype = TY_LONG + if (streq (Memc[dtype], "real")) datatype = TY_REAL + if (streq (Memc[dtype], "double")) datatype = TY_DOUBLE + if (strncmp (Memc[dtype], "character_", 10) == 0) { + call sscan (Memc[dtype+10]) + call gargi (datatype) + datatype = -datatype + } + found = true + } else + found = false + + call sfree (sp) + return (found) +end + + + + +# TIHKI -- Look for keyword and return integer value, or 0 if not found. +# Zero is never expected as a valid result because this routine +# is used to retrieve either the maximum number of header-stored +# scalars (zero means no scalars) or the original table row number. + +int procedure tihki (tp, keyword) + +pointer tp # table pointer +char keyword[ARB] # keyword +#-- +pointer sp, kwval +int dtype, parnum, par + +int tbhgti() + +begin + call smark (sp) + call salloc (kwval, SZ_PARREC, TY_CHAR) + call tbhfkr (tp, keyword, dtype, kwval, parnum) + if (parnum > 0) + par = tbhgti (tp, keyword) + else + par = 0 + call sfree (sp) + return (par) +end +\end{verbatim} +\newpage +\end{document} diff --git a/pkg/utilities/nttools/threed/titable/loc.txt b/pkg/utilities/nttools/threed/titable/loc.txt new file mode 100644 index 00000000..1621316e --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/loc.txt @@ -0,0 +1,11 @@ +Filename Total Blanks Comments Help Execute Nonexec +============================================================================ + titable.x 81 18 16 0 23 24 + tiupdate.x 42 13 11 0 7 11 + tinew.x 96 24 21 0 30 21 + tinsert.x 104 23 17 0 41 23 + tisetc.x 70 17 14 0 20 19 + ticopy.x 107 23 16 0 45 23 + ticc.x 53 11 7 0 22 13 + tiheader.x 189 57 27 0 62 43 +TOTAL 742 186 129 0 250 177 diff --git a/pkg/utilities/nttools/threed/titable/mkpkg b/pkg/utilities/nttools/threed/titable/mkpkg new file mode 100644 index 00000000..c84da84b --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/mkpkg @@ -0,0 +1,36 @@ +# Update the titable application code in the threed package library. +# Author: I.Busko, 14-Jan-1997 + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +# This module is called from the threed mkpkg. +generic: + $ifnfile (generic/tirowsi.x) + $generic -k -p generic/ -t bcsird tirows.gx + $endif + $ifolder (generic/tirowsi.x, tirows.gx) + $generic -k -p generic/ -t bcsird tirows.gx + $endif + $ifnfile (generic/tichi.x) + $generic -k -p generic/ -t bcsird tich.gx + $endif + $ifolder (generic/tichi.x, tich.gx) + $generic -k -p generic/ -t bcsird tich.gx + $endif + ; + +libpkg.a: + @generic + ticc.x + ticopy.x <tbset.h> + tiheader.x <tbset.h> + tinew.x <tbset.h> + tinsert.x <tbset.h> + tisetc.x + titable.x <tbset.h> + tiupdate.x <tbset.h> + ; + diff --git a/pkg/utilities/nttools/threed/titable/ticc.x b/pkg/utilities/nttools/threed/titable/ticc.x new file mode 100644 index 00000000..81283904 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/ticc.x @@ -0,0 +1,56 @@ + +# TICC -- Copy data from column in input to cell array in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +procedure ticc (itp, icp, otp, ocp, dtype, maxlen, rowsel, row) + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int dtype # i: data type of both input and output columns +int maxlen # i: array length +char rowsel[ARB] # i: work string for row selector +int row # i: row where to insert +#-- +pointer sp, buf +int maxch + +begin + # Alloc buffer of apropriate length and type. + maxch = 1 + if (dtype < 0) { + maxch = - dtype + dtype = TY_CHAR + } + call smark (sp) + call salloc (buf, maxlen*(maxch + 1), dtype) + + # Copy. + switch (dtype) { + case TY_CHAR: + call tirowst (itp, icp, otp, ocp, rowsel, row, maxch, maxlen, + Memc[buf]) + case TY_BOOL: + call tirowsb (itp, icp, otp, ocp, rowsel, row, maxlen, Memb[buf]) + case TY_SHORT: + call tirowss (itp, icp, otp, ocp, rowsel, row, maxlen, Mems[buf]) + case TY_INT, TY_LONG: + call tirowsi (itp, icp, otp, ocp, rowsel, row, maxlen, Memi[buf]) + case TY_REAL: + call tirowsr (itp, icp, otp, ocp, rowsel, row, maxlen, Memr[buf]) + case TY_DOUBLE: + call tirowsd (itp, icp, otp, ocp, rowsel, row, maxlen, Memd[buf]) + default: + call error (1, "Non-supported data type.") + } + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/tich.gx b/pkg/utilities/nttools/threed/titable/tich.gx new file mode 100644 index 00000000..bcc83fef --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/tich.gx @@ -0,0 +1,74 @@ +include <tbset.h> + +# TICH -- Copy data from input header into scalar cell in output. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) + + +$if (datatype == c) +procedure ticht (itp, ihc, otp, ocp, orow, maxch) +$else +procedure tich$t (itp, ihc, otp, ocp, orow) +$endif + +pointer itp # i: input table descriptor +int ihc # i: header keyword index +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +int orow # i: row where to insert +$if (datatype == c) +int maxch +$endif +#-- +$if (datatype == c) +pointer buf +$else +PIXEL buf +$endif +pointer sp, kwname, kwval +int datatype, parnum + +string corrupt "Corrupted header in input table." + +int nscan() + +begin + call smark (sp) + $if (datatype == c) + call salloc (buf, maxch + 1, TY_CHAR) + $endif + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (kwval, SZ_PARREC, TY_CHAR) + + # Build keyword name and look for it. + call sprintf (Memc[kwname], SZ_LINE, "TCV_%03d") + call pargi (ihc) + call tbhfkr (itp, Memc[kwname], datatype, Memc[kwval], parnum) + + # Parse and read value. We assume that the keyword existence + # was confirmed by previously finding the paired TCD_ keyword. + if (parnum > 0) { + call sscan (Memc[kwval]) + $if (datatype == c) + call gargwrd (buf, maxch) + $else + call garg$t (buf) + $endif + if (nscan() < 1) call error (1, corrupt) + } else + call error (1, corrupt) + + # Write value into scalar cell. + $if (datatype == c) + call tbcptt (otp, ocp, buf, maxch, orow, orow) + $else + call tbcpt$t (otp, ocp, buf, orow, orow) + $endif + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/ticopy.x b/pkg/utilities/nttools/threed/titable/ticopy.x new file mode 100644 index 00000000..505a80ce --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/ticopy.x @@ -0,0 +1,116 @@ +include <tbset.h> + +# TICOPY -- Copy input table into row of output table +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) +# 17-Mar-97 - Revised after code review (IB) + + +procedure ticopy (itp, cpi, ncpi, otp, cpo, ncpo, rowsel, row, nrows, + coln, colu, colf) + +pointer itp # i: input table descriptor +pointer cpi # i: input column descriptor array +int ncpi # i: input number of columns +pointer otp # i: output table descriptor +pointer cpo # i: output column descriptor array +int ncpo # i: output number of columns +char rowsel[ARB] # i: work string for row selector +int row # i: row where to begin insertion +int nrows # i: number of selected rows +char coln[ARB] # i: work string for column names +char colu[ARB] # i: work string for column units +char colf[ARB] # i: work string for column formats +#-- +pointer sp, coln2, colu2, colf2, icp, ocp +int icpi, icpo, dum, dtypi, dtypo, maxlen +int ihc, maxhc +bool found + +errchk ticc + +pointer tcs_column() +int tbalen(), tihmax() +bool streq(), tihdec() + +begin + call smark (sp) + call salloc (coln2, SZ_COLNAME, TY_CHAR) + call salloc (colu2, SZ_COLUNITS, TY_CHAR) + call salloc (colf2, SZ_COLFMT, TY_CHAR) + + # Loop over output table column pointers. + do icpo = 1, ncpo { + + # Get column name and data type from output table. + ocp = Memi[cpo+icpo-1] + call tbcinf (ocp, dum, coln, colu, colf, dtypo, dum, dum) + + # Array length must be the minimum in between table array + # size and the number of rows selected from input table. + maxlen = min (tbalen(ocp), nrows) + + # If there are matched columns, loop over + # input table column pointers. + found = false + do icpi = 1, ncpi { + + # Get column name and data type from input table. + icp = tcs_column (Memi[cpi+icpi-1]) + call tbcinf (icp,dum,Memc[coln2],colu,colf,dtypi,dum,dum) + + # If column names match, copy from table to table. + if (streq (coln, Memc[coln2])) { + # For now, abort if datatypes do not match. + if (dtypo != dtypi) + call error (1, "Data types do not match.") + call ticc (itp,icp,otp,ocp,dtypo,maxlen,rowsel,row) + found = true + } + } + + # If column was not found, look into header. + if (!found) { + maxhc = tihmax (itp) + do ihc = 1, maxhc { + if (tihdec (itp, ihc, Memc[coln2], Memc[colu2], + Memc[colf2], dtypi, dum)) { + if (streq (coln, Memc[coln2])) { + + # For now, abort if datatypes do not match. + if (dtypo != dtypi) + call error (1, "Data types do not match.") + if (dtypo < 0) + dtypo = TY_CHAR + + switch (dtypo) { + case TY_CHAR: + call ticht (itp, ihc, otp, ocp, row, -dtypi) + case TY_BOOL: + call tichb (itp, ihc, otp, ocp, row) + case TY_SHORT: + call tichs (itp, ihc, otp, ocp, row) + case TY_INT,TY_LONG: + call tichi (itp, ihc, otp, ocp, row) + case TY_REAL: + call tichr (itp, ihc, otp, ocp, row) + case TY_DOUBLE: + call tichd (itp, ihc, otp, ocp, row) + default: + call error (1, "Non-supported data type.") + } + } + } + } + } + } + + call sfree (sp) +end + + diff --git a/pkg/utilities/nttools/threed/titable/tiheader.x b/pkg/utilities/nttools/threed/titable/tiheader.x new file mode 100644 index 00000000..4918b625 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/tiheader.x @@ -0,0 +1,192 @@ +include <tbset.h> + +# TIHEADER -- Routines for retrieving header-stored scalars. +# +# Details such as keyword names and encoding are defined by the +# way task txtable creates the same keywords. +# +# +# +# TIHKI -- Look for keyword and return integer value, or 0 if not found. +# TIHMAX -- Return maximum number of header-stored scalars. +# TIHNSC -- Return actual number of scalars in header. +# TIHROW -- Return original row value stored by txtable task. +# TIHDEC -- Decode column description in header keyword. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) +# 17-Mar-97 - Revised after code review (IB) + + + +# TIHMAX -- Return maximum number of header-stored scalars. + +int procedure tihmax (tp) + +pointer tp # table pointer + +int tihki() + +begin + return (tihki (tp, "TCTOTAL")) +end + + + + +# TIHROW -- Return original row value (stored by txtable task). + +int procedure tihrow (tp) + +pointer tp # table pointer + +int tihki() + +begin + return (tihki (tp, "ORIG_ROW")) +end + + + + +# TIHNSC -- Return actual number of scalars in header. + +int procedure tihnsc (tp) + +pointer tp # table pointer +#-- +pointer sp, kwname, kwval +int dtype, parnum +int i, ntot, nscalar + +int tihmax() + +begin + call smark (sp) + call salloc (kwval, SZ_PARREC, TY_CHAR) + call salloc (kwname, SZ_LINE, TY_CHAR) + nscalar = 0 + + ntot = tihmax (tp) + do i = 1, ntot { + call sprintf (kwname, SZ_LINE, "TCD_%03d") + call pargi (i) + call tbhfkr (tp, kwname, dtype, kwval, parnum) + if (parnum > 0) + nscalar = nscalar + 1 + } + + call sfree (sp) + return (nscalar) +end + + + + + +# TIHDEC -- Decode column description in header keyword. The detailed +# format depends on how task txtable does the encoding. + +bool procedure tihdec (tp, kn, colname, colunits, colfmt, datatype, lenfmt) + +pointer tp # i: table pointer +int kn # i: keyword number +char colname[ARB] # o: column name +char colunits[ARB] # o: column units +char colfmt[ARB] # o: column print format +int datatype # o: column data type +int lenfmt # o: format lenght +#-- +pointer sp, kwname, kwval, dtype +int parnum +bool found + +string corrupt "Corrupted header in input table." + +int nscan(), strncmp() +bool streq() + +begin + call smark (sp) + call salloc (kwval, SZ_PARREC, TY_CHAR) + call salloc (kwname, SZ_LINE, TY_CHAR) + call salloc (dtype, SZ_LINE, TY_CHAR) + + # Build column description keyword name. + call sprintf (Memc[kwname], SZ_LINE, "TCD_%03d") + call pargi (kn) + + # Look for it. + call tbhfkr (tp, Memc[kwname], datatype, Memc[kwval], parnum) + + if (parnum > 0) { + + # Found; parse the 5 fields. + call sscan (Memc[kwval]) + call gargwrd (colname, SZ_COLNAME) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colunits, SZ_COLUNITS) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (colfmt, SZ_COLFMT) + if (nscan() < 1) call error (1, corrupt) + call gargwrd (Memc[dtype], SZ_LINE) + if (nscan() < 1) call error (1, corrupt) + call gargi (lenfmt) + if (nscan() < 1) call error (1, corrupt) + + # Translate from human-readable encoding to sdas table encoding. + if (streq (colunits, "default")) + call strcpy ("", colunits, SZ_COLUNITS) + if (streq (colfmt, "default")) + call strcpy ("", colfmt, SZ_COLFMT) + if (streq (Memc[dtype], "boolean")) datatype = TY_BOOL + if (streq (Memc[dtype], "short")) datatype = TY_SHORT + if (streq (Memc[dtype], "integer")) datatype = TY_INT + if (streq (Memc[dtype], "long")) datatype = TY_LONG + if (streq (Memc[dtype], "real")) datatype = TY_REAL + if (streq (Memc[dtype], "double")) datatype = TY_DOUBLE + if (strncmp (Memc[dtype], "character_", 10) == 0) { + call sscan (Memc[dtype+10]) + call gargi (datatype) + datatype = -datatype + } + found = true + } else + found = false + + call sfree (sp) + return (found) +end + + + + +# TIHKI -- Look for keyword and return integer value, or 0 if not found. +# Zero is never expected as a valid result because this routine +# is used to retrieve either the maximum number of header-stored +# scalars (zero means no scalars) or the original table row number. + +int procedure tihki (tp, keyword) + +pointer tp # table pointer +char keyword[ARB] # keyword +#-- +pointer sp, kwval +int dtype, parnum, par + +int tbhgti() + +begin + call smark (sp) + call salloc (kwval, SZ_PARREC, TY_CHAR) + call tbhfkr (tp, keyword, dtype, kwval, parnum) + if (parnum > 0) + par = tbhgti (tp, keyword) + else + par = 0 + call sfree (sp) + return (par) +end diff --git a/pkg/utilities/nttools/threed/titable/tinew.x b/pkg/utilities/nttools/threed/titable/tinew.x new file mode 100644 index 00000000..afc63bcb --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/tinew.x @@ -0,0 +1,101 @@ +include <tbset.h> + +# TINEW -- Opens and creates a new output table. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-1997 - Task created (I.Busko) +# 8-Apr-1999 - Call tbfpri (Phil Hodge) +# 8-Apr-2002 - Remove the call to whatfile (P. Hodge) +# 8-Dec-2003 - Call tcs_close for cpo. + + +procedure tinew (template, list, output, rowsel, colsel, colname, colunits, + colfmt, otp, cpo, ncpo) + +char template[ARB] # i: template table name +pointer list # i: input list +char output[ARB] # i: output table name +char rowsel[ARB] # i: work array for row selectors +char colsel[ARB] # i: work array for column selectors +char colname[ARB] # i: work array for column names +char colunits[ARB] # i: work array for column units +char colfmt[ARB] # i: work array for column format +pointer otp # o: table descriptor +pointer cpo # o: column descriptor +int ncpo # o: number of columns +#-- +pointer sp, itp, newcpo, root +int nrows, ncols, nscalar +int phu_copied # set by tbfpri and ignored +bool is_temp + +errchk tbfpri, tbtopn, tisetc + +pointer tbtopn() +int tbpsta(), imtgetim(), tihnsc(), access() + +begin + call smark (sp) + call salloc (root, SZ_PATHNAME, TY_CHAR) + + # See if there is a template table. + is_temp = true + if (access (template, READ_ONLY, 0) == NO) { + + # Get first table in input list as the template. + if (imtgetim (list, template, SZ_PATHNAME) == EOF) + call error (1, "Input list is empty.") + call imtrew (list) + is_temp = false + } + + # Break template file name into bracketed selectors. + call rdselect (template, Memc[root], rowsel, colsel, SZ_FNAME) + + # Open template table and get some info. + itp = tbtopn (Memc[root], READ_ONLY, NULL) + nrows = tbpsta (itp, TBL_NROWS) + ncols = tbpsta (itp, TBL_NCOLS) + + # There might be header-stored scalars that don't show up + # with tbpsta, if the template is coming from the input list. + # Examine the header to find how many of them there are and + # increment number of output columns. + nscalar = tihnsc (itp) + ncols = ncols + nscalar + + # Create arrays with colum info. Must be freed by caller. + call malloc (cpo, ncols, TY_INT) + call malloc (newcpo, ncols, TY_INT) + call tcs_open (itp, colsel, Memi[cpo], ncpo, ncols) + + # Exit if no column matches and no scalars. + if (ncpo == 0 && nscalar == 0) + call error (1, "No columns selected.") + + # Open output table. + call tbfpri (Memc[root], output, phu_copied) + otp = tbtopn (output, NEW_FILE, 0) + + # Copy column information from input to output. + call tisetc (cpo, newcpo, ncpo, nscalar, itp, otp, colname, colunits, + colfmt, nrows, is_temp) + + # Point to new column array. + call tcs_close (Memi[cpo], ncpo) + call mfree (cpo, TY_INT) + cpo = newcpo + + # Number of columns now is (selected columns from input) + scalars. + ncpo = ncpo + nscalar + + # Create output table. + call tbtcre (otp) + + # Cleanup. + call tbtclo (itp) + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/tinsert.x b/pkg/utilities/nttools/threed/titable/tinsert.x new file mode 100644 index 00000000..9580a66b --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/tinsert.x @@ -0,0 +1,99 @@ +include <tbset.h> + +# TINSERT -- Perform the actual insertion. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) +# 17-Mar-97 - Added selrows function (IB) +# 8-Apr-02 - Remove the call to whatfile (P. Hodge) + + +procedure tinsert (list, output, otp, cpo, ncpo, row, rflag, verbose, + rowsel, colsel, colname, colunits, colfmt) + +pointer list # i: input list +char output[ARB] # i: output table name +pointer otp # i: output table descriptor +pointer cpo # i: output column descriptors +int ncpo # i: output number of columns +int row # i: row where to begin insertion +bool rflag # i: read row from header ? +bool verbose # i: print info ? +char rowsel[ARB] # i: work string for row selector +char colsel[ARB] # i: work string for column selector +char colname[ARB] # i: work string for column names +char colunits[ARB] # i: work string for column units +char colfmt[ARB] # i: work string for column formats +#-- +pointer sp, itp, fname, root, cpi +int i, file, hrow, numrow, numcol, nrows, ncpi + +errchk ticopy + +pointer tbtopn() +int imtgetim(), imtlen(), tihrow(), tbpsta(), selrows() + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (root, SZ_FNAME, TY_CHAR) + + # Loop over input list. + do file = 1, imtlen(list) { + + # Get input table name. + i = imtgetim (list, Memc[fname], SZ_PATHNAME) + + # Break input file name into bracketed selectors. + call rdselect (Memc[fname], Memc[root], rowsel, colsel, SZ_FNAME) + + # Open input table and get some info. + itp = tbtopn (Memc[fname], READ_ONLY, NULL) + numrow = tbpsta (itp, TBL_NROWS) + numcol = tbpsta (itp, TBL_NCOLS) + + # See if original row information is stored in header. + # If so, and user asked for, use it. + hrow = tihrow (itp) + if (rflag) { + if (hrow > 0) + row = hrow + else + call error (1, "No valid row.") + } + + # Find how many rows were requested by row selector. + nrows = selrows (itp, rowsel) + + # Create array of column pointers from column selector. + call malloc (cpi, numcol, TY_INT) + call tcs_open (itp, colsel, Memi[cpi], ncpi, numcol) + + if (verbose) { + call printf ("%s -> %s row=%d \n") + call pargstr (Memc[fname]) + call pargstr (output) + call pargi (row) + call flush (STDOUT) + } + + # Copy current input table into current row of output table. + call ticopy (itp, cpi, ncpi, otp, cpo, ncpo, rowsel, row, nrows, + colname, colunits, colfmt) + + # Free input table's array of column pointers. + call tcs_close (Memi[cpi], ncpi) + call mfree (cpi, TY_INT) + + # Close input table. + call tbtclo (itp) + + # Bump row counter. + row = row + 1 + } + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/titable/tirows.gx b/pkg/utilities/nttools/threed/titable/tirows.gx new file mode 100644 index 00000000..161b39ce --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/tirows.gx @@ -0,0 +1,98 @@ +include <tbset.h> + +# +# TIROWS -- Expand row selector into array and copy it into output +# table cell. +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-1997 - Task created (I.Busko) +# 7-Feb-2000 - For datatype = 'c', make buf an array of strings (P.Hodge) + + +$if (datatype == c) +procedure tirowst (itp, icp, otp, ocp, rowsel, orow, maxch, len, buf) +$else +procedure tirows$t (itp, icp, otp, ocp, rowsel, orow, len, buf) +$endif + +pointer itp # i: input table descriptor +pointer icp # i: input column descriptor +pointer otp # i: output table descriptor +pointer ocp # i: output column descriptor +char rowsel[ARB] # i: row selector +int orow # i: row in output table where to write into +$if (datatype == c) +int maxch # i: max length of string +$endif +int len # i: buffer length +$if (datatype == c) +char buf[maxch,ARB] # i: work buffer +$else +PIXEL buf[ARB] +$endif +#-- +double undefd +real undefr +pointer pcode +int undefi, i, nelem, irow, numrow, alength +short undefs + +pointer trsopen() +int tbpsta(), tbalen() +bool trseval() + +begin + # Loop over selected rows on input table. + pcode = trsopen (itp, rowsel) + numrow = tbpsta (itp, TBL_NROWS) + nelem = 0 + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + nelem = nelem + 1 + if (nelem > len) { + nelem = len + break + } + # Get element and store in buffer. + $if (datatype == c) + call tbegtt (itp, icp, irow, buf[1,nelem], maxch) + $else + call tbegt$t (itp, icp, irow, buf[nelem]) + $endif + } + } + call trsclose (pcode) + + # Write buffer into array cell element. + $if (datatype == c) + call tbaptt (otp, ocp, orow, buf, maxch, 1, nelem) + $else + call tbapt$t (otp, ocp, orow, buf, 1, nelem) + $endif + + # If number of selected rows in current input table + # is smaller than output table array length, fill + # remaining array elements with INDEF. + alength = tbalen (ocp) + if (alength > nelem) { + undefd = INDEFD + undefr = INDEFR + undefi = INDEFI + undefs = INDEFS + do i = nelem+1, alength { + $if (datatype == c) + call tbaptt (otp, ocp, orow, "", maxch, i, 1) + $endif + $if (datatype == b) + call tbaptb (otp, ocp, orow, false, i, 1) + $endif + $if (datatype == dris) + call tbapt$t (otp, ocp, orow, undef$t, i, 1) + $endif + } + } +end diff --git a/pkg/utilities/nttools/threed/titable/tisetc.x b/pkg/utilities/nttools/threed/titable/tisetc.x new file mode 100644 index 00000000..38acd306 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/tisetc.x @@ -0,0 +1,83 @@ + +# TISETC -- Set column info in new output table. +# +# +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) +# 17-Mar-97 - Revised after code review (IB) + + +procedure tisetc (cpo, newcpo, ncpo, nscalar, itp, otp, colname, colunits, + colfmt, csize, template) + +pointer cpo # i: array of column descriptors +pointer newcpo # io: new array of column descriptors +int ncpo # i: number of columns matched by selector +int nscalar # i: number of scalar columns +char colname[ARB] # i: work array for column names +char colunits[ARB] # i: work array for column units +char colfmt[ARB] # i: work array for column format +pointer itp,otp # io: template and output table descriptors +int csize # i: cell size in output table +bool template # i: is there a template ? +#-- +pointer ocp +int i, j, colnum, ntot +int datatype, lendata, lenfmt + +errchk tihdec + +pointer tcs_column() +int tihmax() +bool tihdec() + +begin + # First copy column information from template/input + # table into output table. + do i = 1, ncpo { + ocp = tcs_column (Memi[cpo+i-1]) + if (!template) { + + # Template wasn't supplied; copy column info from 2-D + # input table into 3-D output table, taking care of + # resetting the array size. + call tbcinf (ocp, colnum, colname, colunits, colfmt, + datatype, lendata, lenfmt) + if (lendata > 1) + call error (1, "Input table has array element !") + call tbcdef (otp, ocp, colname, colunits, colfmt, + datatype, csize, 1) + } else { + + # Copy with same array size configuration, since + # template is supposedly a 3-D table. + call tbcinf (ocp, colnum, colname, colunits, colfmt, + datatype, lendata, lenfmt) + call tbcdef (otp, ocp, colname, colunits, colfmt, + datatype, lendata, 1) + } + + # Save column pointer. + Memi[newcpo+i-1] = ocp + } + + # If header-stored scalars exist, define new columns for them. + if (nscalar > 0) { + ntot = tihmax (itp) + i = ncpo + do j = 1, ntot { + if (tihdec (itp, j, colname, colunits, colfmt, datatype, + lenfmt)) { + call tbcdef (otp, ocp, colname, colunits, colfmt, + datatype, 1, 1) + Memi[newcpo+i] = ocp + i = i + 1 + } + } + } +end + diff --git a/pkg/utilities/nttools/threed/titable/titable.x b/pkg/utilities/nttools/threed/titable/titable.x new file mode 100644 index 00000000..476f00ef --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/titable.x @@ -0,0 +1,83 @@ +include <tbset.h> + +# TITABLE -- Insert 2D tables into 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 a 3-D table with no row/column +# selectors. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) +# 17-Mar-97 - Revised after code review (IB) +# 8-Apr-02 - Remove the unused strings for error messages (P. Hodge) +# 8-Dec-03 - Use tbtacc() instead of access() to test for a new table; +# use mfree instead of tcs_close for cpo. + + +procedure t_titable() + +char tablist[SZ_LINE] # Input table list +char output[SZ_PATHNAME] # Output table name +char template[SZ_PATHNAME] # Template table name +int row # Row where to begin insertion +bool verbose # Print operations ? +#-- +char root[SZ_FNAME] +char rowselect[SZ_FNAME] +char colselect[SZ_FNAME] +char colname[SZ_COLNAME] +char colunits[SZ_COLUNITS] +char colfmt[SZ_COLFMT] +pointer cpo +pointer otp, list +int ncpo, rowc +bool rflag + +pointer imtopen() +int clgeti(), tbtacc() +bool clgetb(), streq() + +begin + # Get task parameters. + + call clgstr ("intable", tablist, SZ_LINE) + call clgstr ("outtable", output, SZ_PATHNAME) + call clgstr ("template", template, SZ_PATHNAME) + row = clgeti ("row") + verbose = clgetb ("verbose") + + # Abort if invalid output name.. + if (streq (output, "STDOUT")) + call error (1, "Invalid output file name.") + call rdselect (output, root, rowselect, colselect, SZ_FNAME) + if (rowselect[1] != EOS || colselect[1] != EOS) + call error (1, "Sections not permitted on output table name.") + + # Open input list. + list = imtopen (tablist) + + # Open/create the output table. + if (tbtacc (output) == YES) + call tiupdate (root, otp, cpo, ncpo) + else + call tinew (template, list, root, rowselect, colselect, colname, + colunits, colfmt, otp, cpo, ncpo) + + # Initialize row counter. + rowc = row + rflag = false + if (rowc <= 0 || IS_INDEFI(rowc)) rflag = true + + # Do the insertion. + call tinsert (list, output, otp, cpo, ncpo, rowc, rflag, verbose, + rowselect, colselect, colname, colunits, colfmt) + + # Cleanup. The cpo array was allocated by tiupdate/tinew. + call mfree (cpo, TY_INT) + call tbtclo (otp) + call imtclose (list) +end diff --git a/pkg/utilities/nttools/threed/titable/tiupdate.x b/pkg/utilities/nttools/threed/titable/tiupdate.x new file mode 100644 index 00000000..ebfe9b75 --- /dev/null +++ b/pkg/utilities/nttools/threed/titable/tiupdate.x @@ -0,0 +1,39 @@ +include <tbset.h> + +# TIUPDATE -- Opens an already existing output table for update. +# +# +# +# Revision history: +# ---------------- +# 20-Jan-97 - Task created (I.Busko) +# 17-Mar-97 - Replaced code by tbcnum call (IB) + + +procedure tiupdate (output, otp, cpo, ncpo) + +char output[ARB] # i: table name +pointer otp # o: table descriptor +pointer cpo # o: column descriptor +int ncpo # o: number of columns +#-- +int i + +errchk tbtopn + +pointer tbtopn(), tbcnum() +int tbpsta() + +begin + # Open table and get its size. + otp = tbtopn (output, READ_WRITE, NULL) + ncpo = tbpsta (otp, TBL_NCOLS) + + # Alloc column descriptor array. This + # must be freed by caller. + call malloc (cpo, ncpo, TY_INT) + + # Fill array with column info. + do i = 1, ncpo + Memi[cpo+i-1] = tbcnum (otp, i) +end diff --git a/pkg/utilities/nttools/threed/tscopy.par b/pkg/utilities/nttools/threed/tscopy.par new file mode 100644 index 00000000..d365da3e --- /dev/null +++ b/pkg/utilities/nttools/threed/tscopy.par @@ -0,0 +1,5 @@ +intable,s,a,"",,,"input tables" +outtable,s,a,"",,,"output tables or directory" +verbose,b,h,yes,,,"print operations performed?" +version,s,h,"test",,, +mode,s,h,"al",,, diff --git a/pkg/utilities/nttools/threed/tscopy/mkpkg b/pkg/utilities/nttools/threed/tscopy/mkpkg new file mode 100644 index 00000000..21136d98 --- /dev/null +++ b/pkg/utilities/nttools/threed/tscopy/mkpkg @@ -0,0 +1,14 @@ +# Update the tcopy application code in the threed package library. +# Author: I.Busko, 21-Nov-1996 + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + tscopy.x <error.h> + tcpyone.x <tbset.h> + tcpyrow.x <tbset.h> + ; + diff --git a/pkg/utilities/nttools/threed/tscopy/tbracket.x b/pkg/utilities/nttools/threed/tscopy/tbracket.x new file mode 100644 index 00000000..5c9364c4 --- /dev/null +++ b/pkg/utilities/nttools/threed/tscopy/tbracket.x @@ -0,0 +1,105 @@ +#* HISTORY * +#* B.Simon 07-Nov-94 original + +# TBRACKET -- Break a table name into bracket delimeted substrings + +procedure tbracket (table, root, rowselect, colselect, maxch) + +char table[ARB] # i: Table name +char root[ARB] # o: Name minus bracketed sections +char rowselect[ARB] # o: Row selector section +char colselect[ARB] # o: Column selector section +int maxch # i: Maximum length of output strings +#-- +bool found +char eq +int ic, nc + +data eq / '=' / + +errchk tsplitter +bool tsplitter() +int stridx() + +begin + # Search for the first unescaped bracket + + for (ic = 1; table[ic] != EOS; ic = ic + 1) { + if (table[ic] == '\\' && table[ic+1] != EOS) { + ic = ic + 1 + } else if (table[ic] == '['){ + break + } + } + + nc = min (ic-1, maxch) + call strcpy (table, root, nc) + + # Get bracketed sections from table name. If there is only + # a single section, disambiguate by looking for an equals + # sign, which indicates a row selector. + + found = tsplitter (table, ic, rowselect, maxch) + + if (! tsplitter (table, ic, colselect, maxch)) { + if (stridx (eq, rowselect) == 0) { + call strcpy (rowselect, colselect, maxch) + rowselect[1] = EOS + } + } + +end + +# TSPLITTER -- Splits table filename into sections + +bool procedure tsplitter (table, ic, section, maxch) + +char table[ARB] # i: table name +int ic # u: index to char within name +char section[ARB] # o: section extracted from name +int maxch # i: maximum length of section +#-- +int jc, level +pointer sp, errmsg + +string badsect "No closing bracket (%s)" + +begin + if (table[ic] != '[') { + section[1] = EOS + return (false) + } else { + level = 1 + ic = ic + 1 + } + + call smark (sp) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + jc = 1 + while (level > 0 && table[ic] != EOS) { + if (table[ic] == '[' && table[ic-1] != '\\') { + level = level + 1 + } else if (table[ic] == ']' && table[ic-1] != '\\') { + level = level - 1 + } + + if (level > 0 && jc <= maxch) { + section[jc] = table[ic] + jc = jc + 1 + } + + ic = ic + 1 + } + + section[jc] = EOS + + if (level > 0) { + call sprintf (Memc[errmsg], SZ_LINE, badsect) + call pargstr (table) + call error (1, Memc[errmsg]) + } + + call sfree (sp) + return (true) +end diff --git a/pkg/utilities/nttools/threed/tscopy/tcpyone.x b/pkg/utilities/nttools/threed/tscopy/tcpyone.x new file mode 100644 index 00000000..23c86316 --- /dev/null +++ b/pkg/utilities/nttools/threed/tscopy/tcpyone.x @@ -0,0 +1,141 @@ +include <tbset.h> + +#* HISTORY * +#* B.Simon 07-Nov-1994 original +# Phil Hodge 8-Apr-1999 call tbfpri + +# TCPYONE -- Copy a single table to the output table + +procedure tcpyone (input, output) + +char input[ARB] # i: input table name +char output[ARB] # i: output table name +#-- +int numrow, numcol, numptr, type, iptr, irow, jrow +int colnum, datatype, lendata, lenfmt +int phu_copied # returned by tbfpri and ignored +pointer sp, root, extend, rowselect, colselect, colname, colunits, colfmt +pointer errmsg, icp, ocp, itp, otp, colptr, newcol, pcode + +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(), tcs_totsize() +pointer tbtopn(), tcs_column, trsopen() + +begin + # Allocate memory for temporary strings + + call smark (sp) + call salloc (root, 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) + + # Check output table name for sections + +# call getsects (output, Memc[root], Memc[extend], Memc[rowselect], +# Memc[colselect], SZ_FNAME) + +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 names into bracketed sections + +# call getsects (input, Memc[root], Memc[extend], Memc[rowselect], +# Memc[colselect], SZ_FNAME) + +call rdselect (input, Memc[root], Memc[rowselect], Memc[colselect], SZ_FNAME) + + if (Memc[rowselect] == EOS && Memc[colselect] == EOS) { + # Perform straight file copy if no sections on input name + + call tbfpri (input, output, phu_copied) + call tbtcpy (input, output) + + } else { + # Open the tables and set output table type + +# call strcat (Memc[extend], Memc[root], SZ_FNAME) + + itp = tbtopn (Memc[root], READ_ONLY, NULL) + call tbfpri (Memc[root], output, phu_copied) + otp = tbtopn (output, NEW_FILE, NULL) + + type = tbpsta (itp, TBL_WHTYPE) + # Support for ASCII output (11/20/96, IB) + if (streq (output, "STDOUT")) + type = TBL_TYPE_TEXT + call tbpset (otp, TBL_WHTYPE, type) + + # Create an array of column pointers from the column template + + numrow = tbpsta (itp, TBL_NROWS) + numcol = tbpsta (itp, TBL_NCOLS) + + call salloc (colptr, numcol, TY_INT) + call salloc (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]) + } + + # Copy column information from the input table to the output table + + do iptr = 1, numptr { + icp = tcs_column (Memi[colptr+iptr-1]) + call tbcinf (icp, colnum, Memc[colname], Memc[colunits], + Memc[colfmt], datatype, lendata, lenfmt) + + if (lendata > 1) + lendata = tcs_totsize (Memi[colptr+iptr-1]) + + call tbcdef (otp, ocp, Memc[colname], Memc[colunits], + Memc[colfmt], datatype, lendata, 1) + Memi[newcol+iptr-1] = ocp + } + + # Copy header keywords + + call tbtcre (otp) + call tbhcal (itp, otp) + + # Copy selected rows from input to output table + + jrow = 1 + pcode = trsopen (itp, Memc[rowselect]) + + do irow = 1, numrow { + if (trseval (itp, irow, pcode)) { + call tcpyrow (itp, otp, Memi[colptr], Memi[newcol], + irow, jrow, numptr) + jrow = jrow + 1 + } + } + + call trsclose (pcode) + call tcs_close (Memi[colptr], numptr) + call tbtclo (itp) + call tbtclo (otp) + } + + call sfree (sp) +end diff --git a/pkg/utilities/nttools/threed/tscopy/tcpyrow.x b/pkg/utilities/nttools/threed/tscopy/tcpyrow.x new file mode 100644 index 00000000..3eeb8c99 --- /dev/null +++ b/pkg/utilities/nttools/threed/tscopy/tcpyrow.x @@ -0,0 +1,79 @@ +include <tbset.h> + +# TCPYROW -- Copy a single row from the input to output table + +procedure tcpyrow (itp, otp, icp, ocp, irow, orow, ncols) + +pointer itp # i: pointer to descriptor of input table +pointer otp # i: pointer to descriptor of output table +pointer icp[ncols] # i: array of pointers for input columns +pointer ocp[ncols] # i: array of pointers for output columns +int irow # i: row number in input table +int orow # i: row number in output table +int ncols # i: number of columns to be copied +#-- +int icol, dlen, dtype, maxch, nbuf +pointer sp, buf, errmsg, colname + +string badtype "Unsupported column data type (%s)" + +int tcs_intinfo(), tcs_totsize() + +begin + do icol = 1, ncols { + # Determine the length and datatype of the table column + # and allocate a buffer to match + + dlen = tcs_totsize (icp[icol]) + dtype = tcs_intinfo (icp[icol], TBL_COL_DATATYPE) + + maxch = 1 + if (dtype < 0) { + maxch = - dtype + dtype = TY_CHAR + } + + call smark (sp) + call salloc (buf, dlen*(maxch + 1), dtype) + + # Read the data from the input table and write it + # to the output table + + switch (dtype) { + case TY_BOOL: + call tcs_rdaryb (itp, icp[icol], irow, dlen, nbuf, Memb[buf]) + call tbaptb (otp, ocp[icol], orow, Memb[buf], 1, nbuf) + case TY_CHAR: + call tcs_rdaryt (itp, icp[icol], irow, maxch, dlen, + nbuf, Memc[buf]) + call tbaptt (otp, ocp[icol], orow, Memc[buf], maxch, 1, nbuf) + case TY_SHORT: + call tcs_rdarys (itp, icp[icol], irow, dlen, nbuf, Mems[buf]) + call tbapts (otp, ocp[icol], orow, Mems[buf], 1, nbuf) + case TY_INT, TY_LONG: + call tcs_rdaryi (itp, icp[icol], irow, dlen, nbuf, Memi[buf]) + call tbapti (otp, ocp[icol], orow, Memi[buf], 1, nbuf) + case TY_REAL: + call tcs_rdaryr (itp, icp[icol], irow, dlen, nbuf, Memr[buf]) + call tbaptr (otp, ocp[icol], orow, Memr[buf], 1, nbuf) + case TY_DOUBLE: + call tcs_rdaryd (itp, icp[icol], irow, dlen, nbuf, Memd[buf]) + call tbaptd (otp, ocp[icol], orow, Memd[buf], 1, nbuf) + 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/tscopy/tscopy.x b/pkg/utilities/nttools/threed/tscopy/tscopy.x new file mode 100644 index 00000000..30629f6c --- /dev/null +++ b/pkg/utilities/nttools/threed/tscopy/tscopy.x @@ -0,0 +1,110 @@ +include <error.h> + +# tcopy -- Copy table(s) + +# The input tables are given by an filename template list. The output +# is either a matching list of tables or a directory. The number of +# input tables may be either one or match the number of output tables. +# This is based on the t_imcopy procedure. +# +# Phil Hodge, 21-Aug-87 Task created. +# Phil Hodge, 7-Sep-88 Change parameter names for tables. +# Phil Hodge, 28-Dec-89 Use iferr with call to tbtcpy. +# Phil Hodge, 26-Mar-92 Remove calls to tbtext. +# B.Simon, 04-Nov-94 Replace call to tbtcpy with tcpyone +# I.Busko, 20-Nov-95 Add support for ASCII output. + +procedure t_tcopy() + +char tablist1[SZ_LINE] # Input table list +char tablist2[SZ_LINE] # Output table list +bool verbose # Print operations? + +char table1[SZ_PATHNAME] # Input table name +char table2[SZ_PATHNAME] # Output table name +char dirname1[SZ_PATHNAME] # Directory name +char dirname2[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) + verbose = clgetb ("verbose") + + # Check if the output string is a directory. + + if (isdirectory (tablist2, dirname2, 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 dirname1. + + call get_root (table1, table2, SZ_PATHNAME) + root_len = fnldir (table2, dirname1, SZ_PATHNAME) + call strcpy (table2[root_len + 1], dirname1, SZ_PATHNAME) + + call strcpy (dirname2, table2, SZ_PATHNAME) + call strcat (dirname1, table2, SZ_PATHNAME) + + if (verbose) { + call eprintf ("%s -> %s\n") + call pargstr (table1) + call pargstr (table2) + } + iferr (call tcpyone (table1, table2)) + 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") + } + + # Copy 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 copy table to itself: %s\n") + call pargstr (table1) + next + } + if (verbose) { + call eprintf ("%s -> %s\n") + call pargstr (table1) + call pargstr (table2) + } + iferr (call tcpyone (table1, table2)) + call erract (EA_WARN) + + call sfree (sp) + } + + call imtclose (list1) + call imtclose (list2) + } +end diff --git a/pkg/utilities/nttools/threed/tximage.par b/pkg/utilities/nttools/threed/tximage.par new file mode 100644 index 00000000..e27bebd5 --- /dev/null +++ b/pkg/utilities/nttools/threed/tximage.par @@ -0,0 +1,5 @@ +intable,s,a,"",,,">Input tables" +output,s,a,"",,,">Output images or directory" +verbose,b,h,yes,,,">Print operations performed ?" +version,s,h,"03Jan97",,, +mode,s,h,"al",,, 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 diff --git a/pkg/utilities/nttools/threed/txtable.par b/pkg/utilities/nttools/threed/txtable.par new file mode 100644 index 00000000..5f784362 --- /dev/null +++ b/pkg/utilities/nttools/threed/txtable.par @@ -0,0 +1,6 @@ +intable,s,a,"",,,"Input tables" +outtable,s,a,"",,,"Output tables or directory" +compact,b,h,yes,,,"Write scalars into header ?" +verbose,b,h,yes,,,"Print operations performed ?" +version,s,h,"7Feb2000",,, +mode,s,h,"al",,, 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 + diff --git a/pkg/utilities/nttools/threed/x_threed.x b/pkg/utilities/nttools/threed/x_threed.x new file mode 100644 index 00000000..ed67f6b7 --- /dev/null +++ b/pkg/utilities/nttools/threed/x_threed.x @@ -0,0 +1,5 @@ +task tscopy = t_tcopy, + txtable = t_txtable, + tximage = t_tximage, + titable = t_titable, + tiimage = t_tiimage |