diff options
author | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
---|---|---|
committer | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
commit | fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch) | |
tree | bdda434976bc09c864f2e4fa6f16ba1952b1e555 /pkg/utilities/nttools/threed/titable | |
download | iraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz |
Initial commit
Diffstat (limited to 'pkg/utilities/nttools/threed/titable')
29 files changed, 3315 insertions, 0 deletions
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 |