1 files changed, 134 insertions, 0 deletions
diff --git a/sys/imio/db/idbcard.x b/sys/imio/db/idbcard.x
new file mode 100644
index 00000000..38ea36fb
--- /dev/null
+++ b/sys/imio/db/idbcard.x
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<imhdr.h>
+include	<imio.h>
+include	"idb.h"
+
+.help IDBCARD
+.nf -------------------------------------------------------------------------
+Card i/o package, for reading through the FITS area of the image header.
+
+	         idb = idb_open (im, ualen)
+       recno|EOF = idb_nextcard (idb, rp)
+		      idb_close (idb)
+
+This is a very simple package, used only to hide the details of how to
+access successive image header cards.  The main routine returns a char
+pointer to successive cards until the end of the header is reached.
+This is convenient for efficient read access to the header; direct i/o
+to the image header may be accomplished by using STROPEN to open the
+header buffer on a file descriptor.
+
+This entire interface assumes that the header is stored in FITS format,
+which is an implementation detail of the current IMIO interface.  Hence,
+this interface is internal to IMIO.
+.endhelp --------------------------------------------------------------------
+
+define	LEN_IDB		6
+define	IDB_IM		Memi[$1]		# image descriptor
+define	IDB_UA		Memi[$1+1]		# pointer to user area
+define	IDB_UALEN	Memi[$1+2]		# length of user area
+define	IDB_RECPTR	Memi[$1+3]		# current record pointer
+define	IDB_RECNO	Memi[$1+4]		# current record number
+define	IDB_BLOCKED	Memi[$1+5]		# cards blank filled?
+
+
+# IDB_OPEN -- Open the FITS area for for card i/o.
+
+pointer procedure idb_open (im, ualen)
+
+pointer	im			#I image descriptor
+int	ualen			#O size of storage area
+
+int	n
+pointer	idb, ip
+errchk	malloc
+
+begin
+	call malloc (idb, LEN_IDB, TY_STRUCT)
+
+	IDB_IM(idb) = im
+	IDB_UA(idb) = IM_USERAREA(im)
+	IDB_UALEN(idb) = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1
+	IDB_RECPTR(idb) = IM_USERAREA(im)
+	IDB_RECNO(idb) = 1
+
+	if (IM_UABLOCKED(im) < 0) {
+	    # At image open time this flag is set by IMMAP to -1 to indicate
+	    # that the user area record type is not known.  An IKI kernel may
+	    # subsequently set the flag to yes/no, else we determine the
+	    # record type by inspection the first time we are called.  If the
+	    # user area is empty the record type is set to blocked; IDB always
+	    # writes blocked records.
+
+	    IM_UABLOCKED(im) = YES
+	    for (ip=IM_USERAREA(im);  Memc[ip] != EOS;  ip=ip+1) {
+		for (n=0;  Memc[ip] != EOS;  n=n+1) {
+		    if (Memc[ip] == '\n')
+			break
+		    ip = ip + 1
+		}
+		if (n != IDB_RECLEN) {
+		    IM_UABLOCKED(im) = NO
+		    break
+		}
+	    }
+	}
+
+	IDB_BLOCKED(idb) = IM_UABLOCKED(im)
+	ualen = IDB_UALEN(idb)
+	return (idb)
+end
+
+
+# IDB_NEXTCARD -- Return a pointer to the next card in the FITS header.
+# EOF is returned at the end of the header.
+
+int procedure idb_nextcard (idb, recptr)
+
+pointer	idb			#I pointer to IDB descriptor
+pointer	recptr			#O pointer to card
+
+int	recno
+pointer	ip, i
+
+begin
+	# Reference current card.
+	recno = IDB_RECNO(idb)
+	recptr = IDB_RECPTR(idb)
+
+	# Advance to the next card.
+	ip = recptr
+	if (IDB_BLOCKED(idb) == NO) {
+	    if (Memc[ip] != EOS)		# skip blank lines
+		ip = ip + 1
+	    do i = ip, ip+IDB_RECLEN
+		if (Memc[i] == EOS) {
+		    ip = i
+		    break
+		} else if (Memc[i] == '\n') {
+		    ip = i + 1
+		    break
+		}
+	} else
+	    ip = ip + IDB_RECLEN + 1
+
+	IDB_RECNO(idb) = recno + 1
+	IDB_RECPTR(idb) = ip
+
+	if (Memc[recptr] == EOS || recptr >= IDB_UA(idb) + IDB_UALEN(idb))
+	    return (EOF)
+	else
+	    return (recno)
+end
+
+
+# IDB_CLOSE -- Free the IDB descriptor.
+
+procedure idb_close (idb)
+
+pointer	idb			#I pointer to IDB descriptor
+
+begin
+	call mfree (idb, TY_STRUCT)
+end