aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/copyone/tabkey.x
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
commitfa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch)
treebdda434976bc09c864f2e4fa6f16ba1952b1e555 /pkg/utilities/nttools/copyone/tabkey.x
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'pkg/utilities/nttools/copyone/tabkey.x')
-rw-r--r--pkg/utilities/nttools/copyone/tabkey.x94
1 files changed, 94 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/copyone/tabkey.x b/pkg/utilities/nttools/copyone/tabkey.x
new file mode 100644
index 00000000..9efd2329
--- /dev/null
+++ b/pkg/utilities/nttools/copyone/tabkey.x
@@ -0,0 +1,94 @@
+include <tbset.h>
+include "filetype.h"
+define SZ_KEYWORD 64
+define USRERR 1
+
+# TABKEY -- Transfer a table element to a header keyword
+#
+# B.Simon 17-Aug-87 First Code
+# B.Simon 24-Jan-92 Added salloc for errtxt
+# Phil Hodge 15-May-2002 Add 'format' argument to gettabdat.
+
+procedure t_tabkey ()
+
+pointer table # Name of table
+pointer column # Name of column
+int row # Row number of element in the table
+pointer output # Name of file containing header keyword
+pointer keyword # Name of header keyword
+bool add # Is it OK to add a new keyword?
+
+bool undef
+bool format # Format the value using table print format?
+int ftype, eltype
+pointer sp, hd, value, errtxt
+
+string undeferr "Table element is undefined"
+string unfilerr "Header file name not found or ambiguous (%s)"
+
+bool clgetb()
+int clgeti(), filetype()
+pointer immap(), tbtopn()
+
+begin
+ # Allocate storage for character strings
+
+ call smark (sp)
+ call salloc (table, SZ_FNAME, TY_CHAR)
+ call salloc (column, SZ_COLNAME, TY_CHAR)
+ call salloc (output, SZ_FNAME, TY_CHAR)
+ call salloc (keyword, SZ_KEYWORD, TY_CHAR)
+ call salloc (value, SZ_KEYWORD, TY_CHAR)
+ call salloc (errtxt, SZ_LINE, TY_CHAR) # Added (BPS 01.24.92)
+
+ # Read input parameters
+
+ call clgstr ("table", Memc[table], SZ_FNAME)
+ call clgstr ("column", Memc[column], SZ_COLNAME)
+ row = clgeti ("row")
+ call clgstr ("output", Memc[output], SZ_FNAME)
+ call clgstr ("keyword", Memc[keyword], SZ_KEYWORD)
+ add = clgetb("add")
+
+ # Read the table element as a character string
+
+ format = false
+ hd = tbtopn (Memc[table], READ_ONLY, NULL)
+ call gettabdat (hd, Memc[column], row, SZ_KEYWORD, format,
+ Memc[value], undef, eltype)
+ call tbtclo (hd)
+
+ # It is an error to try to write an undefined value to the header
+
+ if (undef)
+ call error (USRERR, undeferr)
+
+ ftype = filetype (Memc[output])
+
+ if (ftype == IMAGE_FILE) {
+
+ # Write image header keyword
+
+ hd = immap (Memc[output], READ_WRITE, NULL)
+ call putimghdr (hd, Memc[keyword], Memc[value], eltype, add)
+ call imunmap (hd)
+
+ } else if (ftype == TABLE_FILE) {
+
+ # Write table header keyword
+
+ hd = tbtopn (Memc[output], READ_WRITE, NULL)
+ call puttabhdr (hd, Memc[keyword], Memc[value], eltype, add)
+ call tbtclo (hd)
+
+ } else {
+
+ call sprintf (Memc[errtxt], SZ_LINE, unfilerr)
+ call pargstr (Memc[output])
+ call error (USRERR, Memc[errtxt])
+
+ }
+
+ call sfree(sp)
+ return
+end