Initial commit

1 files changed, 268 insertions, 0 deletions

diff --git a/pkg/tbtables/tbhpt.x b/pkg/tbtables/tbhpt.x
new file mode 100644
index 00000000..82a0bb10
--- /dev/null
+++ b/pkg/tbtables/tbhpt.x
@@ -0,0 +1,268 @@
+include <tbset.h>
+include "tbtables.h"
+include "tblerr.h"
+
+# Put a keyword and value into the table header.  It is an error (except
+# for FITS tables) if the keyword does not already exist.
+#
+# Phil Hodge,  7-Aug-1987  Do not allow adding new parameter.
+# 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 tbhptd to %25.16g.
+# Phil Hodge, 30-Mar-1995  Include keyword name in error message.
+# Phil Hodge,  3-Apr-1995  Set TB_MODIFIED to true.
+# Phil Hodge, 13-Jun-1995  Modify for FITS tables.
+
+# tbhptd -- put double header parameter
+
+procedure tbhptd (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
+pointer errmess			# scratch for possible error message
+int	dtype			# data type
+int	parnum			# parameter number (> 0 if found)
+bool	tbhisc()
+errchk	tbhfkw, tbhpnp, 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,
+		"tbhptd:  may not put numeric parameter as comment or history")
+
+	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+	    call tbfhpd (tp, keyword, value)
+	    TB_MODIFIED(tp) = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (par, SZ_PARREC, TY_CHAR)
+
+	call tbhfkw (tp, keyword, parnum)			# find keyword
+	if (parnum > 0) {
+	    dtype = TY_DOUBLE
+	    call sprintf (Memc[par], SZ_PARREC, "%-25.16g")
+		call pargd (value)
+	    call tbhpnp (tp, parnum, keyword, dtype, Memc[par])	# put Nth param.
+	} else {
+	    call salloc (errmess, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[errmess], SZ_LINE,
+		"tbhptd:  `%s' not found; use tbhadd to add new parameter")
+		call pargstr (keyword)
+	    call error (ER_TBPARNOTFND, Memc[errmess])
+	}
+
+	TB_MODIFIED(tp) = true
+
+	call sfree (sp)
+end
+
+# tbhptr -- put real header parameter
+
+procedure tbhptr (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
+pointer errmess			# scratch for possible error message
+int	dtype			# data type
+int	parnum			# parameter number (> 0 if found)
+bool	tbhisc()
+errchk	tbhfkw, tbhpnp, 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,
+		"tbhptr:  may not put numeric parameter as comment or history")
+
+	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+	    call tbfhpr (tp, keyword, value)
+	    TB_MODIFIED(tp) = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (par, SZ_PARREC, TY_CHAR)
+
+	call tbhfkw (tp, keyword, parnum)			# find keyword
+	if (parnum > 0) {
+	    dtype = TY_REAL
+	    call sprintf (Memc[par], SZ_PARREC, "%-15.7g")
+		call pargr (value)
+	    call tbhpnp (tp, parnum, keyword, dtype, Memc[par])	# put Nth param.
+	} else {
+	    call salloc (errmess, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[errmess], SZ_LINE,
+		"tbhptr:  `%s' not found; use tbhadr to add new parameter")
+		call pargstr (keyword)
+	    call error (ER_TBPARNOTFND, Memc[errmess])
+	}
+
+	TB_MODIFIED(tp) = true
+
+	call sfree (sp)
+end
+
+# tbhpti -- put integer header parameter
+
+procedure tbhpti (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
+pointer errmess			# scratch for possible error message
+int	dtype			# data type
+int	parnum			# parameter number (> 0 if found)
+bool	tbhisc()
+errchk	tbhfkw, tbhpnp, 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,
+		"tbhpti:  may not put numeric parameter as comment or history")
+
+	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+	    call tbfhpi (tp, keyword, value)
+	    TB_MODIFIED(tp) = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (par, SZ_PARREC, TY_CHAR)
+
+	call tbhfkw (tp, keyword, parnum)			# find keyword
+	if (parnum > 0) {
+	    dtype = TY_INT
+	    call sprintf (Memc[par], SZ_PARREC, "%-11d")
+		call pargi (value)
+	    call tbhpnp (tp, parnum, keyword, dtype, Memc[par])	# put Nth param.
+	} else {
+	    call salloc (errmess, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[errmess], SZ_LINE,
+		"tbhpti:  `%s' not found; use tbhadi to add new parameter")
+		call pargstr (keyword)
+	    call error (ER_TBPARNOTFND, Memc[errmess])
+	}
+
+	TB_MODIFIED(tp) = true
+
+	call sfree (sp)
+end
+
+procedure tbhptb (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
+pointer errmess			# scratch for possible error message
+int	dtype			# data type
+int	parnum			# parameter number (> 0 if found)
+int	intval			# buffer for writing value into string
+bool	tbhisc()
+errchk	tbhfkw, tbhpnp, 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,
+		"tbhptb:  may not put Boolean parameter as comment or history")
+
+	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
+	    call tbfhpb (tp, keyword, value)
+	    TB_MODIFIED(tp) = true
+	    return
+	}
+
+	call smark (sp)
+	call salloc (par, SZ_PARREC, TY_CHAR)
+
+	call tbhfkw (tp, keyword, parnum)			# find keyword
+	if (parnum > 0) {
+	    dtype = TY_BOOL
+	    if (value)
+		intval = YES
+	    else
+		intval = NO
+	    call sprintf (Memc[par], SZ_PARREC, "%-11d")
+	    call pargi (intval)
+	    call tbhpnp (tp, parnum, keyword, dtype, Memc[par])	# put Nth param.
+	} else {
+	    call salloc (errmess, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[errmess], SZ_LINE,
+		"tbhptb:  `%s' not found; use tbhadb to add new parameter")
+		call pargstr (keyword)
+	    call error (ER_TBPARNOTFND, Memc[errmess])
+	}
+
+	TB_MODIFIED(tp) = true
+
+	call sfree (sp)
+end
+
+# tbhptt -- put character header parameter
+
+procedure tbhptt (tp, keyword, text)
+
+pointer tp			# i: Pointer to table descriptor
+char	keyword[ARB]		# i: Name of parameter
+char	text[ARB]		# i: Value of parameter
+#--
+pointer sp
+pointer errmess			# scratch for possible error message
+int	dtype			# data type
+int	parnum			# parameter number (> 0 if found)
+bool	tbhisc()		# true if keyword is comment or history
+errchk	tbhfkw, tbhpnp, 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 error (ER_TBMUSTADD,
+		"use tbhadt, not tbhptt, to add new comment or history")
+	} else {
+	    call tbhfkw (tp, keyword, parnum)			# find keyword
+	    if (parnum > 0) {
+		call tbhpnp (tp, parnum, keyword, dtype, text)	# put Nth param.
+	    } else {
+		call smark (sp)
+		call salloc (errmess, SZ_LINE, TY_CHAR)
+		call sprintf (Memc[errmess], SZ_LINE,
+		"tbhptt:  `%s' not found; use tbhadt to add new parameter")
+		    call pargstr (keyword)
+		call error (ER_TBPARNOTFND, Memc[errmess])
+	    }
+	}
+
+	TB_MODIFIED(tp) = true
+end