1 files changed, 118 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/copyone/putimghdr.x b/pkg/utilities/nttools/copyone/putimghdr.x
new file mode 100644
index 00000000..bc0b34c6
--- /dev/null
+++ b/pkg/utilities/nttools/copyone/putimghdr.x
@@ -0,0 +1,118 @@
+define	USRERR		1
+
+# PUTIMGHDR -- Put a keyword given as a string in an image header
+#
+# B.Simon	14-Aug-87	First Code
+# B.Simon	27-Jul-94	Fix bug in addition of double
+# B.Simon	21-Jul-97	Workaround for imgftype bug
+
+procedure putimghdr (hd, keyword, value, keytype, add)
+
+pointer	hd		# i: Image descriptor
+char	keyword[ARB]	# i: Keyword to put
+char	value[ARB]	# i: Keyword value
+int	keytype		# i: Keyword type
+bool	add		# i: Is adding a new keyword legal?
+#--
+bool	bvalue
+double	dvalue
+int	ip, junk, hdrtype
+pointer	sp, rp, keyval, errtxt
+
+string	badtyperr	"Type mismatch in header keyword (%s)"
+string	notadderr	"Keyword not found in header (%s)"
+
+int	ctod(), idb_findrecord(), imgftype(), stridx()
+
+begin
+
+	call smark (sp)
+	call salloc (keyval, SZ_FNAME, TY_CHAR)
+	call salloc (errtxt, SZ_LINE, TY_CHAR)
+
+	# Convert keyword value to a double
+
+	ip = 1
+	junk = ctod (value, ip, dvalue)
+
+	# If keyword is already in the image header
+
+	if (idb_findrecord (hd, keyword, rp) > 0) {
+
+	    hdrtype = imgftype (hd, keyword)
+
+	    # Extra test to work around bug in imgftype
+
+	    if (hdrtype == TY_BOOL) {
+		call imgstr(hd, keyword, Memc[keyval], SZ_FNAME)
+		if (Memc[keyval+1] != EOS)
+		    hdrtype = TY_CHAR
+	    }
+
+	    # Check for illegal type conversions
+
+	    if ((hdrtype == TY_BOOL && keytype != TY_BOOL) ||
+		(!(hdrtype == keytype || hdrtype == TY_CHAR) &&
+		  (keytype == TY_BOOL || keytype == TY_CHAR)   ) ) {
+
+		call sprintf (Memc[errtxt], SZ_LINE, badtyperr)
+		call pargstr (keyword)
+		call error (USRERR, Memc[errtxt])
+
+	    }
+
+	    # Use the proper procedure to write the new keyword value
+
+	    switch (hdrtype) {
+	    case TY_BOOL :
+		bvalue = stridx (value[1], "TtYy") > 0
+		call imputb (hd, keyword, bvalue)
+	    case TY_CHAR :
+		call impstr (hd, keyword, value)
+	    case TY_SHORT :
+		call imputs (hd, keyword, short(dvalue))
+	    case TY_INT :
+		call imputi (hd, keyword, int(dvalue))
+	    case TY_LONG :
+		call imputl (hd, keyword, long(dvalue))
+	    case TY_REAL :
+		call imputr (hd, keyword, real(dvalue))
+	    case TY_DOUBLE :
+		call imputd (hd, keyword, dvalue)
+	    }
+
+	} else {
+
+	    # Check to see if it legal to add a new keyword
+
+	    if (! add) {
+		call sprintf (Memc[errtxt], SZ_LINE, notadderr)
+		call pargstr (keyword)
+		call error (USRERR, Memc[errtxt])
+	    }
+
+	    # Create the new keyword and set its value
+
+	    switch (keytype) {
+	    case TY_BOOL :
+		bvalue = stridx (value[1], "TtYy") > 0
+		call imaddb (hd, keyword, bvalue)
+	    case TY_CHAR :
+		call imastr (hd, keyword, value)
+	    case TY_SHORT :
+		call imadds (hd, keyword, short(dvalue))
+	    case TY_INT :
+		call imaddi (hd, keyword, int(dvalue))
+	    case TY_LONG :
+		call imaddl (hd, keyword, long(dvalue))
+	    case TY_REAL :
+		call imaddr (hd, keyword, real(dvalue))
+	    case TY_DOUBLE :
+		call imaddd (hd, keyword, dvalue)
+	    }
+
+	}
+
+	call sfree (sp)
+	return
+end