From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/utilities/nttools/keyselect/tab.x | 353 ++++++++++++++++++++++++++++++++++ 1 file changed, 353 insertions(+) create mode 100644 pkg/utilities/nttools/keyselect/tab.x (limited to 'pkg/utilities/nttools/keyselect/tab.x') diff --git a/pkg/utilities/nttools/keyselect/tab.x b/pkg/utilities/nttools/keyselect/tab.x new file mode 100644 index 00000000..1e4dd769 --- /dev/null +++ b/pkg/utilities/nttools/keyselect/tab.x @@ -0,0 +1,353 @@ +include +include +include "keyselect.h" + +#* HISTORY * +#* B.Simon 12-Mar-92 Original + +# CPY_TABLE -- Copy keywords from header to table row + +procedure cpy_table (im, tp, colptr, keywords) + +pointer im # i: image descriptor +pointer tp # i: table descriptor +pointer colptr # i: pointer to array of column descriptors +char keywords # i: list of header keywords +#-- +char cat, sep +int row, dtype, ic, jc, kc +pointer sp, cp, nlist, vlist, name, value + +data cat / CONCAT_CHAR / +data sep / SEP_CHAR / + +string nocolumn "cpy_table: not enough columns to store keywords" + +int tbpsta(), brk_list(), stridx(), gstrcpy() + +begin + call smark(sp) + call salloc (nlist, SZ_LINE, TY_CHAR) + call salloc (vlist, SZ_LINE, TY_CHAR) + call salloc (name, SZ_LINE, TY_CHAR) + call salloc (value, SZ_LINE, TY_CHAR) + + ic = 1 + cp = colptr + row = tbpsta (tp, TBL_NROWS) + 1 + + # Extract each keyword from the list of keywords + + while (brk_list (keywords, ic, sep, Memc[nlist], SZ_LINE) > 0) { + + # If the keyword is not a list of concatenated keywords + # copy its value into a string + + if (stridx (cat, Memc[nlist]) == 0) { + call get_keyword (im, Memc[nlist], dtype, + Memc[vlist], SZ_LINE) + + # Otherwise break the list of concatenated keywords + # and concatenate their values into a string + + } else { + jc = 1 + kc = 0 + while (brk_list (Memc[nlist], jc, cat, + Memc[name], SZ_LINE) > 0){ + + call get_keyword (im, Memc[name], dtype, + Memc[value], SZ_LINE) + + if (dtype != 0) { + kc = kc + gstrcpy (Memc[value], Memc[vlist+kc], + SZ_LINE-kc) + Memc[vlist+kc] = SEP_CHAR + kc = kc + 1 + } + } + kc = max (kc, 1) + Memc[vlist+kc-1] = EOS + } + + # Write the value into the table + + if (Memi[cp] == NULL) + call error (1, nocolumn) + + call tbeptt (tp, Memi[cp], row, Memc[vlist]) + cp = cp + 1 + } + + call sfree(sp) +end + +# FMT_TABLE -- Retrieve column format from column description file + +procedure fmt_table (cd, col, units, fmt, dtype) + +int cd # i: file descriptor of column description file +char col[ARB] # i: name of column to retrieve information for +char units[ARB] # o: column units +char fmt[ARB] # o: column format +int dtype # o: column data type +#-- +char star, comment +bool match +int idx, junk, length, typevals[5] +pointer sp, line, input, name, type, ftnfmt, errmsg + +string typestr "rdibc" +string badtype "Illegal datatype for column %s (%s)" +string badname "Warning: column not found in column description file (%s)\n" + +data star / '*' / +data comment / '#' / +data typevals /TY_REAL, TY_DOUBLE, TY_INT, TY_BOOL, TY_CHAR / + +bool streq() +int getline(), stridx(), ctoi + +begin + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (input, SZ_COLNAME, TY_CHAR) + call salloc (name, SZ_COLNAME, TY_CHAR) + call salloc (type, SZ_COLFMT, TY_CHAR) + call salloc (ftnfmt, SZ_COLFMT, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + call strcpy (col, Memc[input], SZ_COLNAME) + call strlwr (Memc[input]) + + match = false + call seek (cd, BOF) + while (! match && getline (cd, Memc[line]) != EOF) { + + # Remove trailing comments from line + + idx = stridx (comment, Memc[line]) + if (idx > 0) + Memc[line+idx-1] = EOS + + # Column name is the first word on the line + + call sscan (Memc[line]) + call gargwrd (Memc[name], SZ_COLNAME) + call strlwr (Memc[name]) + + # If the name matches the procedure argument + # read the remaining fields on the line + + match = streq (Memc[input], Memc[name]) + if (match) { + call gargwrd (Memc[type], SZ_COLFMT) + call gargwrd (Memc[ftnfmt], SZ_COLFMT) + call gargwrd (units, SZ_COLUNITS) + + call strlwr (Memc[type]) + call tbbftp (Memc[ftnfmt], fmt) + + # Convert the type string to the corresponding integer value + + if (Memc[type] == EOS) { + dtype = 0 + + } else { + idx = stridx (Memc[type], typestr) + if (idx == 0) { + call sprintf (Memc[errmsg], SZ_LINE, badtype) + call pargstr (Memc[name]) + call pargstr (Memc[type]) + call error (1, Memc[errmsg]) + } + + dtype = typevals[idx] + if (dtype == TY_CHAR) { + idx = stridx (star, Memc[type]) + if (idx > 0) { + idx = idx + 1 + junk = ctoi (Memc[type], idx, length) + if (length > 0) + dtype = - length + } + } + } + + } + } + + # Send warning message and set defaults if no match + + if (! match) { + dtype = 0 + fmt[1] = EOS + units[1] = EOS + + call eprintf (badname) + call pargstr (col) + } + + call sfree (sp) +end + +# OP_TABLE -- Open the output table + +pointer procedure op_table(im, output, keywords, columns, cdfile) + +pointer im # i: image descriptor +char output[ARB] # i: table name +char keywords[ARB] # i: list of header keywords +char columns[ARB] # i: list of column names +char cdfile[ARB] # i: optional column description file +#-- +bool append +char sep, cat +int ic, jc, dtype +pointer sp, tp, cp, cd, col, key, units, fmt, errmsg + +data sep / SEP_CHAR / +data cat / CONCAT_CHAR / + +string nocolumn "Column not found in existing output table (%s)" +string nokeyword "op_table: no matching keyword for column" +string notfound "Warning: keyword not found when creating table (%s)\n" + +bool isblank() +int open(), stridx(), imgftype(), brk_list(), type_keyword() +pointer tbtopn() + +begin + call smark (sp) + call salloc (col, SZ_COLNAME, TY_CHAR) + call salloc (key, SZ_LINE, TY_CHAR) + call salloc (units, SZ_COLUNITS, TY_CHAR) + call salloc (fmt, SZ_COLFMT, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + # Open column description file + + if (isblank (cdfile)) { + cd = NULL + } else { + cd = open (cdfile, READ_ONLY, TEXT_FILE) + } + + # Append rows to the table if the table already exists + # otherwise create a new table + + append = true + iferr (tp = tbtopn (output, READ_WRITE, NULL)) { + append = false + tp = tbtopn (output, NEW_FILE, NULL) + } + + ic = 1 + jc = 1 + while (brk_list (columns, ic, sep, Memc[col], SZ_COLNAME) > 0) { + + if (brk_list (keywords, jc, sep, Memc[key], SZ_LINE) == 0) + call error (1, nokeyword) + + # Verify that the columns exist if we are in append mode + # Define the new columns if we are not + + if (append) { + call tbcfnd (tp, Memc[col], cp, 1) + if (cp == NULL) { + call sprintf (Memc[errmsg], SZ_LINE, nocolumn) + call pargstr (Memc[col]) + call error (1, Memc[errmsg]) + } + + } else { + # Get column characteristics from the column description file + # or use defaults and image header keyword type + + if (cd != NULL) + call fmt_table (cd, Memc[col], + Memc[units], Memc[fmt], dtype) + + if (cd == NULL || dtype == 0) { + Memc[units] = EOS + Memc[fmt] = EOS + + if (stridx (cat, Memc[key]) != 0) { + dtype = - SZ_BIGCOL + + } else if (Memc[key] == '$'){ + dtype = type_keyword (Memc[key]) + + } else { + iferr { + dtype = imgftype (im, Memc[key]) + } then { + dtype = 0 + call eprintf (notfound) + call pargstr (Memc[key]) + } + } + } + + if (dtype == 0 || dtype == TY_CHAR) + dtype = - SZ_STRCOL + if (dtype == TY_SHORT || dtype == TY_LONG) + dtype = TY_INT + if (dtype == TY_REAL) + dtype = TY_DOUBLE + + call tbcdef (tp, cp, Memc[col], Memc[units], Memc[fmt], + dtype, 1, 1) + } + } + + # Create the new table if not in append mode + + if (! append) + call tbtcre (tp) + + call sfree (sp) + return (tp) +end + +# RD_TABLE -- Create an array of column pointers from the list of column names + +procedure rd_table (columns, tp, colptr) + +char columns[ARB] # i: list of column names +pointer tp # i: table descriptor +pointer colptr # o: pointer to array of column names +#-- +char sep +int nptr, ic +pointer sp, cp, col, errmsg + +data sep / SEP_CHAR / +string nocolumn "rd_table: column not found (%s)" + +int cnt_list(), brk_list() + +begin + call smark (sp) + call salloc (col, SZ_LINE, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + nptr = cnt_list (columns) + 1 + call malloc (colptr, nptr, TY_POINTER) + + ic = 1 + cp = colptr + while (brk_list (columns, ic, sep, Memc[col], SZ_LINE) > 0) { + call tbcfnd (tp, Memc[col], Memi[cp], 1) + if (cp == NULL) { + call sprintf (Memc[errmsg], SZ_LINE, nocolumn) + call pargstr (Memc[col]) + + call error (1, Memc[errmsg]) + } + cp = cp + 1 + } + + Memi[cp] = NULL + call sfree(sp) +end -- cgit