aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/tbhad.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/tbtables/tbhad.x')
-rw-r--r--pkg/tbtables/tbhad.x232
1 files changed, 232 insertions, 0 deletions
diff --git a/pkg/tbtables/tbhad.x b/pkg/tbtables/tbhad.x
new file mode 100644
index 00000000..2ca4d038
--- /dev/null
+++ b/pkg/tbtables/tbhad.x
@@ -0,0 +1,232 @@
+include <tbset.h>
+include "tbtables.h"
+include "tblerr.h"
+
+# Add a keyword and value into the table header. If the keyword already
+# exists the value will be replaced; otherwise, a new keyword will be added.
+#
+# Phil Hodge, 7-Aug-1987 Subroutine created.
+# Phil Hodge, 28-Dec-1987 Different data types combined into one file.
+# Phil Hodge, 9-Mar-1989 Change dtype from char to int.
+# Phil Hodge, 21-Jul-1992 Change format in tbhadd to %25.16g.
+# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true.
+# Phil Hodge, 14-Jun-1995 Modify for FITS tables.
+
+# tbhadd -- add double header parameter
+
+procedure tbhadd (tp, keyword, value)
+
+pointer tp # i: Pointer to table descriptor
+double value # i: Value of parameter
+char keyword[ARB] # i: Name of parameter
+#--
+pointer sp
+pointer par # buffer for header record for parameter
+int dtype # data type
+int parnum # parameter number (> 0 if found)
+bool tbhisc()
+errchk tbhfkw, tbhpnp, tbhanp, tbfhpd
+
+begin
+ if (TB_READONLY(tp))
+ call error (ER_TBREADONLY, "can't write to table; it's readonly")
+ if (tbhisc (keyword))
+ call error (ER_TBDTYPECONFLICT,
+ "tbhadd: can't put numeric parameter as comment or history")
+
+ if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+ call tbfhpd (tp, keyword, value)
+ TB_MODIFIED(tp) = true
+ return
+ }
+
+ dtype = TY_DOUBLE
+ call smark (sp)
+ call salloc (par, SZ_PARREC, TY_CHAR)
+ call sprintf (Memc[par], SZ_PARREC, "%-25.16g")
+ call pargd (value)
+ call tbhfkw (tp, keyword, parnum) # find keyword
+ if (parnum > 0)
+ call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param.
+ else
+ call tbhanp (tp, keyword, dtype, Memc[par], parnum) # add new param.
+
+ TB_MODIFIED(tp) = true
+
+ call sfree (sp)
+end
+
+# tbhadr -- add real header parameter
+
+procedure tbhadr (tp, keyword, value)
+
+pointer tp # i: Pointer to table descriptor
+real value # i: Value of parameter
+char keyword[ARB] # i: Name of parameter
+#--
+pointer sp
+pointer par # buffer for header record for parameter
+int dtype # data type
+int parnum # parameter number (> 0 if found)
+bool tbhisc()
+errchk tbhfkw, tbhpnp, tbhanp, tbfhpr
+
+begin
+ if (TB_READONLY(tp))
+ call error (ER_TBREADONLY, "can't write to table; it's readonly")
+ if (tbhisc (keyword))
+ call error (ER_TBDTYPECONFLICT,
+ "tbhadr: can't put numeric parameter as comment or history")
+
+ if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+ call tbfhpr (tp, keyword, value)
+ TB_MODIFIED(tp) = true
+ return
+ }
+
+ dtype = TY_REAL
+ call smark (sp)
+ call salloc (par, SZ_PARREC, TY_CHAR)
+ call sprintf (Memc[par], SZ_PARREC, "%-15.7g")
+ call pargr (value)
+ call tbhfkw (tp, keyword, parnum) # find keyword
+ if (parnum > 0)
+ call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param.
+ else
+ call tbhanp (tp, keyword, dtype, Memc[par], parnum) # add new param.
+
+ TB_MODIFIED(tp) = true
+
+ call sfree (sp)
+end
+
+# tbhadi -- add integer header parameter
+
+procedure tbhadi (tp, keyword, value)
+
+pointer tp # i: Pointer to table descriptor
+int value # i: Value of parameter
+char keyword[ARB] # i: Name of parameter
+#--
+pointer sp
+pointer par # buffer for header record for parameter
+int dtype # data type
+int parnum # parameter number (> 0 if found)
+bool tbhisc()
+errchk tbhfkw, tbhpnp, tbhanp, tbfhpi
+
+begin
+ if (TB_READONLY(tp))
+ call error (ER_TBREADONLY, "can't write to table; it's readonly")
+ if (tbhisc (keyword))
+ call error (ER_TBDTYPECONFLICT,
+ "tbhadi: can't put numeric parameter as comment or history")
+
+ if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+ call tbfhpi (tp, keyword, value)
+ TB_MODIFIED(tp) = true
+ return
+ }
+
+ dtype = TY_INT
+ call smark (sp)
+ call salloc (par, SZ_PARREC, TY_CHAR)
+ call sprintf (Memc[par], SZ_PARREC, "%-11d")
+ call pargi (value)
+ call tbhfkw (tp, keyword, parnum) # find keyword
+ if (parnum > 0)
+ call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param.
+ else
+ call tbhanp (tp, keyword, dtype, Memc[par], parnum) # add new param.
+
+ TB_MODIFIED(tp) = true
+
+ call sfree (sp)
+end
+
+# tbhadb -- add Boolean header parameter
+
+procedure tbhadb (tp, keyword, value)
+
+pointer tp # i: Pointer to table descriptor
+bool value # i: Value of parameter
+char keyword[ARB] # i: Name of parameter
+#--
+pointer sp
+pointer par # buffer for header record for parameter
+int dtype # data type
+int parnum # parameter number (> 0 if found)
+int intval # buffer for writing value into string
+bool tbhisc()
+errchk tbhfkw, tbhpnp, tbhanp, tbfhpb
+
+begin
+ if (TB_READONLY(tp))
+ call error (ER_TBREADONLY, "can't write to table; it's readonly")
+ if (tbhisc (keyword))
+ call error (ER_TBDTYPECONFLICT,
+ "tbhadb: can't put Boolean parameter as comment or history")
+
+ if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+ call tbfhpb (tp, keyword, value)
+ TB_MODIFIED(tp) = true
+ return
+ }
+
+ dtype = TY_BOOL
+ call smark (sp)
+ call salloc (par, SZ_PARREC, TY_CHAR)
+ if (value)
+ intval = YES
+ else
+ intval = NO
+ call sprintf (Memc[par], SZ_PARREC, "%-11d")
+ call pargi (intval)
+ call tbhfkw (tp, keyword, parnum) # find keyword
+ if (parnum > 0)
+ call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param.
+ else
+ call tbhanp (tp, keyword, dtype, Memc[par], parnum) # add new param.
+
+ TB_MODIFIED(tp) = true
+
+ call sfree (sp)
+end
+
+# tbhadt -- add character header parameter
+
+procedure tbhadt (tp, keyword, text)
+
+pointer tp # i: Pointer to table descriptor
+char keyword[ARB] # i: Name of parameter
+char text[ARB] # i: Value of parameter
+#--
+int dtype # data type
+int parnum # parameter number (> 0 if found)
+bool tbhisc() # true if keyword is comment or history
+errchk tbhfkw, tbhpnp, tbhanp, tbfhpt
+
+begin
+ if (TB_READONLY(tp))
+ call error (ER_TBREADONLY, "can't write to table; it's readonly")
+
+ if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+ call tbfhpt (tp, keyword, text)
+ TB_MODIFIED(tp) = true
+ return
+ }
+
+ dtype = TY_CHAR
+
+ if (tbhisc (keyword)) { # comment or history?
+ call tbhanp (tp, keyword, dtype, text, parnum) # then add new
+ } else {
+ call tbhfkw (tp, keyword, parnum) # find keyword
+ if (parnum > 0)
+ call tbhpnp (tp, parnum, keyword, dtype, text) # put Nth param.
+ else
+ call tbhanp (tp, keyword, dtype, text, parnum) # add new param.
+ }
+
+ TB_MODIFIED(tp) = true
+end
generated by cgit (git 2.34.1) at 2025-09-20 07:20:24 -0400