diff options
Diffstat (limited to 'sys/imio/db')
38 files changed, 2095 insertions, 0 deletions
diff --git a/sys/imio/db/README b/sys/imio/db/README new file mode 100644 index 00000000..cf7f9c1c --- /dev/null +++ b/sys/imio/db/README @@ -0,0 +1,105 @@ + Image Header Database Interface + dct 16-Apr-85 + +1. Overview + + This directory contains the first version of the image header database +interface. In this implementation the image header is a variable length fixed +format binary structure. The first, fixed format, part of the image header +contains the standard fields in binary and is fixed in size. This is followed +by the so called "user area", a string buffer containing a sequence of +variable length, newline delimited FITS format keyword=value header cards. +When an image is open a large user area is allocated to permit the addition +of new parameters without filling up the buffer. When the header is +subsequently updated on disk only as much disk space is used as is needed to +store the actual header. + +This format header is upwards compatible with the old image header format, +hence old images and programs do not have to be modified to use the IMIO +release supporting database accesss. In the future image headers will be +maintained under DBIO, but the routines in the image header database interface +are not exected to change. The actual disk format of images will of course +change when we switch over to the DBIO headers. + + + +2. Functions + + get,g - get the value of a field + put,p - set the value of a field + add,a - add a new field to a database + acc - determine if the named field exists + + +3. Procedures + + value = imget[bcsilrdx] (im, "field") + imgstr (im, "field", outstr, maxch) + imput[bcsilrdx] (im, "field", value) + impstr (im, "field", value) + imadd[bcsilrdx] (im, "field", def_value) + imastr (im, "field", def_value) + imaddf (im, "field", "datatype") + y/n = imaccf (im, "field") + + list = imofnl[su] (im, template) + nch = imgnfn (im, outstr, maxch) + imcfnl (im) + + + +4. Description + + New parameters will typically be added to the image header with either +one of the typed procedures IMADD_ or with the lower level procedure IMADDF. +The former procedures permit the parameter to be created and the value +initialized all in one call, while the latter only creates the parameter. +In addition, the typed IMADD_ procedures may be used to update the values +of existing parameters (it is not considered an error if the parameter +already exists). The principal limitation of the typed procedures is that +they may only be used to add or set parameters of a standard datatype. +The IMADDF procedure will permit creation of parameters with more descriptive +datatypes (domains) when the interface is recut upon DBIO. + +The value of any parameter may be fetched with one of the IMGET functions. +The IMACCF function may be used (like ACCESS for a file) to determine +whether a parameter exists. + +The database interface may be used to access any field of the image header, +including the following standard fields. Note that the nomenclature has +been changed slightly to make it more consistent with FITS. Additional +standard fields will be defined in the future. + + + keyword type description + + i_naxis i number of axes (dimensionality) + i_naxis[1-7] l length of an axis ("i_naxis1", etc.) + i_pixtype i pixel datatype (SPP integer code) + i_minpixval r minimum pixel value + i_maxpixval r maximum pixel value + i_ctime l time of image creation + i_mtime l time of last modify + i_limtime l time when limits (minmax) were last updated + i_title s title string + + +The names of the standard fields share an "i_" prefix to reduce the possibility +of collisions with data dependent keywords, to identify the standard fields in +sorted listings, to allow use of pattern matching to discriminate between the +standard fields and user fields, and so on. For the convenience of the user, +the "i_" prefix may be omitted provided the resultant name does not match the +name of a user parameter. It is however recommended that the full name be +used in all applications software. + + +5. Restrictions + + The use of FITS format as the internal format for storing fields in this +version of the interface places restrictions on the size of field names and +of the string value of string valued parameters. Field names are currently +limited to eight characters or less and case is ignored (since FITS requires +upper case). The eight character limit does not apply to the standard fields. +String values are limited to at most 68 characters. If put string is passed +a longer string it will be silently truncated. Trailing whitespace and +newlines are chopped when a string value is read. diff --git a/sys/imio/db/idb.h b/sys/imio/db/idb.h new file mode 100644 index 00000000..327ce3d2 --- /dev/null +++ b/sys/imio/db/idb.h @@ -0,0 +1,24 @@ +# IDB.H -- Image header database interface. In this version of the interface +# the standard image header fields are maintained in binary in a fixed +# structure and the user fields are maintained in FITS format (text) in the +# a string buffer following the binary image header. + +define IDB_RECLEN 80 # length of a FITS record (card) +define IDB_STARTVALUE 10 # first column of value field +define IDB_ENDVALUE 30 # last column of value field +define IDB_LENNUMERICRECORD 80 # length of new numeric records +define IDB_LENSTRINGRECORD 80 # length of new string records +define IDB_SZFITSKEY 8 # max length FITS keyword + +# Standard header keywords accessible via the database interface. + +define I_CTIME 1 +define I_HISTORY 2 +define I_LIMTIME 3 +define I_MAXPIXVAL 4 +define I_MINPIXVAL 5 +define I_MTIME 6 +define I_NAXIS 7 +define I_PIXFILE 8 +define I_PIXTYPE 9 +define I_TITLE 10 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 diff --git a/sys/imio/db/idbfind.x b/sys/imio/db/idbfind.x new file mode 100644 index 00000000..f98acb7e --- /dev/null +++ b/sys/imio/db/idbfind.x @@ -0,0 +1,145 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imio.h> +include "idb.h" + +# IDB_FINDRECORD -- Search the image database for a particular record given +# the key. The record number (a positive nonzero integer) is returned if +# the record is found, else 0. + +int procedure idb_findrecord (im, key, rp) + +pointer im # image descriptor +char key[ARB] # record key +pointer rp # char record pointer (output) + +pointer sp, pat, patbuf, ukey, lkey, ip, ua +int recno, nchars, lch, uch, ch, junk, n, i +int patmake(), patmatch(), stridxs(), gstrcpy() + +begin + call smark (sp) + call salloc (pat, SZ_FNAME, TY_CHAR) + call salloc (ukey, SZ_FNAME, TY_CHAR) + call salloc (lkey, SZ_FNAME, TY_CHAR) + call salloc (patbuf, SZ_LINE, TY_CHAR) + + # Prepare U/L FITS keywords, truncated to 8 chars. + nchars = gstrcpy (key, Memc[lkey], IDB_SZFITSKEY) + call strlwr (Memc[lkey]) + nchars = gstrcpy (key, Memc[ukey], IDB_SZFITSKEY) + call strupr (Memc[ukey]) + + # Search for the FIRST occurrence of a record with the given key. + # If the key is abbreviated and multiple keys are matched, the first + # record matched is used. + + ua = IM_USERAREA(im) + rp = NULL + recno = 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=ua; 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 + } + } + } + + if (IM_UABLOCKED(im) == NO) { + # Variable length, newline terminated records, EOS terminated + # record group. + + call sprintf (Memc[pat], SZ_FNAME, "^{%s}[ =]") + call pargstr (Memc[ukey]) + junk = patmake (Memc[pat], Memc[patbuf], SZ_LINE) + + for (ip=ua; Memc[ip] != EOS; ip=ip+1) { + if (patmatch (Memc[ip], Memc[patbuf]) > 0) { + rp = ip + break + } + #if (Memc[ip] != EOS) + # ip = ip + 1 + while (Memc[ip] != '\n' && Memc[ip] != EOS) + ip = ip + 1 + recno = recno + 1 + } + + } else { + # Fixed length (80 character), newline terminated records, EOS + # terminated record group. + + if (stridxs ("*?[]", Memc[ukey]) > 0) { + # Pattern matching search. + call sprintf (Memc[pat], SZ_FNAME, "^{%s}[ =]") + call pargstr (Memc[ukey]) + junk = patmake (Memc[pat], Memc[patbuf], SZ_LINE) + + for (ip=ua; Memc[ip] != EOS; ip=ip+IDB_RECLEN+1) { + if (patmatch (Memc[ip], Memc[patbuf]) > 0) { + rp = ip + break + } + recno = recno + 1 + } + + } else { + # Simple fast search, fixed length records. Case insensitive + # keyword match. + + lch = Memc[lkey] + uch = Memc[ukey] + + for (ip=ua; Memc[ip] != EOS; ip=ip+IDB_RECLEN+1) { + ch = Memc[ip] + if (ch == EOS) + break + else if (ch != lch && ch != uch) + next + else { + # Abbreviations are not permitted. + ch = Memc[ip+nchars] + if (ch != ' ' && ch != '=') + next + } + + # First char matches; check rest of string. + do i = 1, nchars-1 { + ch = Memc[ip+i] + if (ch != Memc[lkey+i] && ch != Memc[ukey+i]) { + ch = 0 + break + } + } + if (ch != 0) { + rp = ip # match + break + } + + recno = recno + 1 + } + } + } + + call sfree (sp) + if (rp == NULL) + return (0) + else + return (recno) +end diff --git a/sys/imio/db/idbfstr.x b/sys/imio/db/idbfstr.x new file mode 100644 index 00000000..1087ca02 --- /dev/null +++ b/sys/imio/db/idbfstr.x @@ -0,0 +1,40 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> + + +# IDB_FILSTR -- Filter a string, removing any tabs or control characters. +# This is used to clean up strings we want to put in image headers. A count +# of the output, filtered string is returned as the function value. Tabs or +# newlines in the input are replaced by blanks. Illegal or unprintable +# control characters in the input are deleted. + +int procedure idb_filstr (s1, s2, maxch) + +char s1[ARB] #I input string +char s2[ARB] #O output string +int maxch #I max chars out + +int op, ch, i + +begin + op = 1 + + do i = 1, ARB { + ch = s1[i] + if (ch == EOS) + break + else if (ch == '\t' || ch == '\n') + ch = ' ' + else if (!IS_PRINT (ch)) + next + + s2[op] = ch + op = op + 1 + if (op > maxch) + break + } + + s2[op] = EOS + return (op - 1) +end diff --git a/sys/imio/db/idbgstr.x b/sys/imio/db/idbgstr.x new file mode 100644 index 00000000..ffa43ff9 --- /dev/null +++ b/sys/imio/db/idbgstr.x @@ -0,0 +1,85 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <imhdr.h> +include "idb.h" + +define TY_STRING (-1) + +# IDB_GETSTRING -- Get the string value of a standard header parameter. If the +# actual type of the parameter is not string the value is encoded as a string. +# The length of the string is returned as the function value. ERR is returned +# if the string cannot be found. + +int procedure idb_getstring (im, key, outstr, maxch) + +pointer im # image descriptor +char key[ARB] # parameter to be returned +char outstr[ARB] # output string to receive parameter value +int maxch + +long lval +real rval +int dtype, axis, ip +int gstrcpy(), idb_kwlookup(), strncmp(), ltoc(), strlen() +define encode_ 91 + +begin + # A standard keyword is recognized with or without the "i_" prefix. + if (key[1] == 'i' && key[2] == '_') + ip = 3 + else + ip = 1 + + # The keywords "naxis1", "naxis2", etc. are treated as a special case. + if (strncmp (key[ip], "naxis", 5) == 0) + if (IS_DIGIT(key[ip+5]) && key[ip+6] == EOS) { + dtype = TY_LONG + axis = TO_INTEG(key[ip+5]) + lval = IM_LEN(im,axis) + goto encode_ + } + + switch (idb_kwlookup (key[ip])) { + case I_CTIME: + dtype = TY_LONG + lval = IM_CTIME(im) + case I_HISTORY: + dtype = TY_STRING + return (gstrcpy (IM_HISTORY(im), outstr, maxch)) + case I_LIMTIME: + dtype = TY_LONG + lval = IM_LIMTIME(im) + case I_MAXPIXVAL: + dtype = TY_REAL + rval = IM_MAX(im) + case I_MINPIXVAL: + dtype = TY_REAL + rval = IM_MIN(im) + case I_MTIME: + dtype = TY_LONG + lval = IM_MTIME(im) + case I_NAXIS: + dtype = TY_LONG + lval = IM_NDIM(im) + case I_PIXFILE: + return (gstrcpy (IM_PIXFILE(im), outstr, maxch)) + case I_PIXTYPE: + dtype = TY_LONG + lval = IM_PIXTYPE(im) + case I_TITLE: + return (gstrcpy (IM_TITLE(im), outstr, maxch)) + default: + outstr[1] = EOS + return (ERR) + } + +encode_ + if (dtype == TY_LONG) + return (ltoc (lval, outstr, maxch)) + else { + call sprintf (outstr, maxch, "%g") + call pargr (rval) + return (strlen (outstr)) + } +end diff --git a/sys/imio/db/idbkwlu.x b/sys/imio/db/idbkwlu.x new file mode 100644 index 00000000..5b3ee553 --- /dev/null +++ b/sys/imio/db/idbkwlu.x @@ -0,0 +1,51 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <imhdr.h> + +# IDB_KWLOOKUP -- Look up a keyword in the dictionary of standard header +# keywords, returning the magic integer code of the keyword or zero. + +int procedure idb_kwlookup (key) + +char key[ARB] # keyword to be looked up +int index, ip, ch +pointer sp, kwname +int strdic(), strncmp(), strlen() +string keywords "|ctime|history|limtime|maxpixval|minpixval|mtime|naxis\ +|pixfile|pixtype|title|" + +begin + call smark (sp) + call salloc (kwname, SZ_FNAME, TY_CHAR) + + # Look the string up in the dictionary of standard keywords. Note that + # the "i_" prefix is omitted in the dictionary. The order of the + # keywords in the dictionary must agree with the defined codes in the + # header file. A standard keyword is recognized with or without the + # "i_" prefix. + + if (key[1] == 'i' && key[2] == '_') + ip = 3 + else + ip = 1 + + # Check for a reference to one of the NAXIS keywords. + if (key[ip] == 'n') + if (strncmp (key[ip], "naxis", 5) == 0) { + ch = key[ip+5] + if (ch == EOS || (IS_DIGIT(ch) && key[ip+6] == EOS)) { + call sfree (sp) + return (7) + } + } + + # Look up keyword in dictionary. Abbreviations are not permitted. + index = strdic (key[ip], Memc[kwname], SZ_FNAME, keywords) + if (index != 0) + if (strlen(key[ip]) != strlen(Memc[kwname])) + index = 0 + + call sfree (sp) + return (index) +end diff --git a/sys/imio/db/idbpstr.x b/sys/imio/db/idbpstr.x new file mode 100644 index 00000000..e2facd75 --- /dev/null +++ b/sys/imio/db/idbpstr.x @@ -0,0 +1,101 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <mach.h> +include <ctype.h> +include <imhdr.h> +include "idb.h" + +# IDB_PUTSTRING -- Set the value of a standard header parameter given the new +# value of the parameter encoded as a string. If actual type of the parameter +# is non string the value must be decoded. ERR is returned if the key is not +# a standard header parameter. An error action is taken if the key is known +# but the value cannot be decoded. + +int procedure idb_putstring (im, key, strval) + +pointer im # image descriptor +char key[ARB] # parameter to be returned +char strval[ARB] # string value of parameter + +double dval +bool numeric +int ip, axis +int strncmp(), gstrcpy(), idb_kwlookup(), ctod(), strlen() + +begin + # Determine if the given string value is numeric. This is true if + # it consists of a single numeric token of a reasonable length. + + ip = 1 + numeric = false + if (strlen (strval) < MAX_DIGITS) + if (ctod (strval, ip, dval) > 0) { + while (IS_WHITE (strval[ip]) || strval[ip] == '\n') + ip = ip + 1 + numeric = (strval[ip] == EOS) + } + + # A standard keyword is recognized with or without the "i_" prefix. + if (key[1] == 'i' && key[2] == '_') + ip = 3 + else + ip = 1 + + # The keywords "naxis1", "naxis2", etc. are treated as a special case. + if (strncmp (key[ip], "naxis", 5) == 0) + if (IS_DIGIT(key[ip+5]) && key[ip+6] == EOS) { + axis = TO_INTEG(key[ip+5]) + if (numeric && axis >= 1 && axis <= IM_NDIM(im)) { + IM_LEN(im,axis) = nint(dval) + return (OK) + } else + call syserrs (SYS_IDBTYPE, key) + } + + # Lookup the keyword in the dictionary and set the value of the + # header parameter. If the parameter is string valued copy the + # string value and return immediately. + + switch (idb_kwlookup (key[ip])) { + case I_CTIME: + if (numeric) + IM_CTIME(im) = nint(dval) + case I_HISTORY: + return (gstrcpy (strval, IM_HISTORY(im), SZ_IMHIST)) + case I_LIMTIME: + if (numeric) + IM_LIMTIME(im) = nint(dval) + case I_MAXPIXVAL: + if (numeric) + IM_MAX(im) = dval + case I_MINPIXVAL: + if (numeric) + IM_MIN(im) = dval + case I_MTIME: + if (numeric) + IM_MTIME(im) = nint(dval) + case I_NAXIS: + if (numeric) + IM_NDIM(im) = nint(dval) + case I_PIXFILE: + return (gstrcpy (strval, IM_PIXFILE(im), SZ_IMPIXFILE)) + case I_PIXTYPE: + if (numeric) + IM_PIXTYPE(im) = nint(dval) + case I_TITLE: + return (gstrcpy (strval, IM_TITLE(im), SZ_IMTITLE)) + default: + return (ERR) + } + + # If we make it through the switch, i.e., do not execute a return + # statement, then the key was recognized and is of a numeric datatype. + # If the value was successfully decoded as numeric then all is well, + # else the value could not be decoded and we have an error. + + if (!numeric) + call syserrs (SYS_IDBTYPE, key) + else + return (OK) +end diff --git a/sys/imio/db/imaccf.x b/sys/imio/db/imaccf.x new file mode 100644 index 00000000..60e4e9f3 --- /dev/null +++ b/sys/imio/db/imaccf.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMACCF -- Test if the named field exists. NO is returned if the key is not +# found, YES otherwise. + +int procedure imaccf (im, key) + +pointer im # image descriptor +char key[ARB] # name of the new parameter +int idb_kwlookup(), idb_findrecord() +pointer rp + +begin + if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0)) + return (YES) + else + return (NO) +end diff --git a/sys/imio/db/imaddb.x b/sys/imio/db/imaddb.x new file mode 100644 index 00000000..f60f435a --- /dev/null +++ b/sys/imio/db/imaddb.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMADDB -- Add a new field to the image header and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imaddb (im, key, value) + +pointer im # image descriptor +char key[ARB] # parameter or field value +bool value # new or initial value of parameter + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "b") + call imputb (im, key, value) +end diff --git a/sys/imio/db/imaddd.x b/sys/imio/db/imaddd.x new file mode 100644 index 00000000..f5811b79 --- /dev/null +++ b/sys/imio/db/imaddd.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMADDD -- Add a new field to the image header and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imaddd (im, key, value) + +pointer im # image descriptor +char key[ARB] # parameter or field value +double value # new or initial value of parameter + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "d") + call imputd (im, key, value) +end diff --git a/sys/imio/db/imaddf.x b/sys/imio/db/imaddf.x new file mode 100644 index 00000000..e2328f78 --- /dev/null +++ b/sys/imio/db/imaddf.x @@ -0,0 +1,96 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <fset.h> +include <imhdr.h> +include <imio.h> +include "idb.h" + +# IMADDF -- Add a user field to the image header. It is an error if the named +# field already exists. + +procedure imaddf (im, key, datatype) + +pointer im #I image descriptor +char key[ARB] #I name of the new parameter +char datatype[ARB] #I string permits generalization to domains + +pointer rp, sp, keyname, ua, ip +int fd, max_lenuserarea, curlen, buflen, nchars +int idb_kwlookup(), idb_findrecord() +int stropen(), strlen(), idb_filstr(), nowhite() +errchk syserrs, stropen, fprintf, pargstr, pargi + +begin + call smark (sp) + call salloc (keyname, SZ_FNAME, TY_CHAR) + + # FITS format requires that the keyword name be upper case, not to + # exceed 8 characters in length. [Nov97 - This is not entirely + # correct, FITS does not require upper case, however we don't want + # to change this at this time.] + + nchars = idb_filstr (key, Memc[keyname], IDB_SZFITSKEY) + nchars = nowhite (Memc[keyname], Memc[keyname], IDB_SZFITSKEY) + call strupr (Memc[keyname]) + + # Check for a redefinition. + if ((idb_kwlookup (key) > 0) || (idb_findrecord (im, key, rp) > 0)) + call syserrs (SYS_IDBREDEF, key) + + # Open the user area string for appending. 'buflen' is the malloc-ed + # buffer length in struct units; IMU is the struct offset to the user + # area, i.e., the size of that part of the image descriptor preceding + # the user area. If the buffer fills we must allow one extra char for + # the EOS delimiter; since storage for the image descriptor was + # allocated in struct units the storage allocator will not have + # allocated space for the extra EOS char. + + ua = IM_USERAREA(im) + curlen = strlen (Memc[ua]) + buflen = LEN_IMDES + IM_LENHDRMEM(im) + max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1 + + # If the user area is not empty the last character must be the newline + # record delimiter, else the new record we add will be invalid. + + if (curlen > 0 && Memc[ua+curlen-1] != '\n') + if (curlen >= max_lenuserarea) + call syserrs (SYS_IDBOVFL, key) + else { + Memc[ua+curlen] = '\n' + curlen = curlen + 1 + Memc[ua+curlen] = EOS + } + + fd = stropen (Memc[ua+curlen], max_lenuserarea-curlen, APPEND) + + # Append the new record with an uninitialized value field. + iferr { + call fprintf (fd, "%-8s= %s%*t\n") + call pargstr (Memc[keyname]) + if (datatype[1] == 'c') { + call pargstr ("' '") + call pargi (IDB_LENSTRINGRECORD + 1) + } else { + call pargstr ("") + call pargi (IDB_LENNUMERICRECORD + 1) + } + + } then { + # Out of space in the user area. Discard the truncated card at the + # end of the buffer by backing up to the last newline and writing + # an EOS. + + call close (fd) + for (ip=ua+max_lenuserarea-1; ip > ua; ip=ip-1) + if (Memc[ip] == '\n') { + Memc[ip+1] = EOS + break + } + call syserrs (SYS_IDBOVFL, key) + } + + call close (fd) + call sfree (sp) +end diff --git a/sys/imio/db/imaddi.x b/sys/imio/db/imaddi.x new file mode 100644 index 00000000..76653e66 --- /dev/null +++ b/sys/imio/db/imaddi.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMADDI -- Add a new field to the image header and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imaddi (im, key, value) + +pointer im # image descriptor +char key[ARB] # parameter or field value +int value # new or initial value of parameter + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "i") + call imputi (im, key, value) +end diff --git a/sys/imio/db/imaddl.x b/sys/imio/db/imaddl.x new file mode 100644 index 00000000..9064f6c4 --- /dev/null +++ b/sys/imio/db/imaddl.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMADDL -- Add a new field to the image header and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imaddl (im, key, value) + +pointer im # image descriptor +char key[ARB] # parameter or field value +long value # new or initial value of parameter + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "l") + call imputl (im, key, value) +end diff --git a/sys/imio/db/imaddr.x b/sys/imio/db/imaddr.x new file mode 100644 index 00000000..e07dbb53 --- /dev/null +++ b/sys/imio/db/imaddr.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMADDR -- Add a new field to the image header and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imaddr (im, key, value) + +pointer im # image descriptor +char key[ARB] # parameter or field value +real value # new or initial value of parameter + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "r") + call imputr (im, key, value) +end diff --git a/sys/imio/db/imadds.x b/sys/imio/db/imadds.x new file mode 100644 index 00000000..e1b9f1a1 --- /dev/null +++ b/sys/imio/db/imadds.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMADDS -- Add a new field to the image header and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imadds (im, key, value) + +pointer im # image descriptor +char key[ARB] # parameter or field value +short value # new or initial value of parameter + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "s") + call imputs (im, key, value) +end diff --git a/sys/imio/db/imastr.x b/sys/imio/db/imastr.x new file mode 100644 index 00000000..d87c1828 --- /dev/null +++ b/sys/imio/db/imastr.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMASTR -- Add a new field to the image header and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imastr (im, key, value) + +pointer im # image descriptor +char key[ARB] # parameter or field value +char value[ARB] # new or initial value of parameter + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "c") + call impstr (im, key, value) +end diff --git a/sys/imio/db/imdelf.x b/sys/imio/db/imdelf.x new file mode 100644 index 00000000..e8365e22 --- /dev/null +++ b/sys/imio/db/imdelf.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <imhdr.h> +include "idb.h" + +# IMDELF -- Delete a user field from the image header. It is an error if the +# named field does not exist. + +procedure imdelf (im, key) + +pointer im # image descriptor +char key[ARB] # name of the new parameter + +int off +pointer rp, sp, keyname +int idb_kwlookup(), idb_findrecord(), stridxs() +errchk syserrs + +begin + call smark (sp) + call salloc (keyname, SZ_FNAME, TY_CHAR) + + # FITS format requires that the keyword name be upper case. + call strcpy (key, Memc[keyname], IDB_SZFITSKEY) + call strupr (Memc[keyname]) + + # Cannot delete standard header keywords. + if (idb_kwlookup (key) > 0) + call syserrs (SYS_IDBNODEL, key) + + # Verify that the named user field exists. + if (idb_findrecord (im, key, rp) <= 0) + call syserrs (SYS_IDBDELNXKW, key) + + # Delete the field. + off = stridxs ("\n", Memc[rp]) + if (off > 0) + call strcpy (Memc[rp+off], Memc[rp], ARB) + else + Memc[rp] = EOS + + call sfree (sp) +end diff --git a/sys/imio/db/imgetb.x b/sys/imio/db/imgetb.x new file mode 100644 index 00000000..cd7ed03f --- /dev/null +++ b/sys/imio/db/imgetb.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include "idb.h" + +# IMGETB -- Get an image header parameter of type boolean. False is returned +# if the parameter cannot be found or if the value is not true. + +bool procedure imgetb (im, key) + +pointer im # image descriptor +char key[ARB] # parameter to be returned + +pointer rp +pointer idb_findrecord() + +begin + if (idb_findrecord (im, key, rp) == 0) + call syserrs (SYS_IDBKEYNF, key) + else + return (Memc[rp+IDB_ENDVALUE-1] == 'T') +end diff --git a/sys/imio/db/imgetc.x b/sys/imio/db/imgetc.x new file mode 100644 index 00000000..f56ecb9d --- /dev/null +++ b/sys/imio/db/imgetc.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMGETC -- Get an image header parameter of type char. + +char procedure imgetc (im, key) + +pointer im # image descriptor +char key[ARB] # parameter to be returned +long imgetl() + +begin + return (imgetl (im, key)) +end diff --git a/sys/imio/db/imgetd.x b/sys/imio/db/imgetd.x new file mode 100644 index 00000000..01a71cb1 --- /dev/null +++ b/sys/imio/db/imgetd.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include "idb.h" + +# IMGETD -- Get an image header parameter of type double floating. If the +# named parameter is a standard parameter return the value directly, +# else scan the user area for the named parameter and decode the value. + +double procedure imgetd (im, key) + +pointer im # image descriptor +char key[ARB] # parameter to be returned + +int ip +double dval +pointer sp, sval +int ctod() +errchk syserrs, imgstr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + + ip = 1 + call imgstr (im, key, Memc[sval], SZ_LINE) + if (ctod (Memc[sval], ip, dval) == 0) + call syserrs (SYS_IDBTYPE, key) + + call sfree (sp) + return (dval) +end diff --git a/sys/imio/db/imgeti.x b/sys/imio/db/imgeti.x new file mode 100644 index 00000000..8da2878e --- /dev/null +++ b/sys/imio/db/imgeti.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMGETI -- Get an image header parameter of type integer. + +int procedure imgeti (im, key) + +pointer im # image descriptor +char key[ARB] # parameter to be returned + +long lval, imgetl() +errchk imgetl + +begin + lval = imgetl (im, key) + if (IS_INDEFL(lval)) + return (INDEFI) + else + return (lval) +end diff --git a/sys/imio/db/imgetl.x b/sys/imio/db/imgetl.x new file mode 100644 index 00000000..817715c0 --- /dev/null +++ b/sys/imio/db/imgetl.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMGETL -- Get an image header parameter of type long integer. + +long procedure imgetl (im, key) + +pointer im # image descriptor +char key[ARB] # parameter to be returned + +double dval, imgetd() +errchk imgetd + +begin + dval = imgetd (im, key) + if (IS_INDEFD(dval)) + return (INDEFL) + else + return (nint (dval)) +end diff --git a/sys/imio/db/imgetr.x b/sys/imio/db/imgetr.x new file mode 100644 index 00000000..b1c6c67a --- /dev/null +++ b/sys/imio/db/imgetr.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMGETR -- Get an image header parameter of type real. + +real procedure imgetr (im, key) + +pointer im # image descriptor +char key[ARB] # parameter to be returned + +double dval, imgetd() +errchk imgetd + +begin + dval = imgetd (im, key) + if (IS_INDEFD(dval)) + return (INDEFR) + else + return (dval) +end diff --git a/sys/imio/db/imgets.x b/sys/imio/db/imgets.x new file mode 100644 index 00000000..39f2fcfd --- /dev/null +++ b/sys/imio/db/imgets.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMGETS -- Get an image header parameter of type short integer. + +short procedure imgets (im, key) + +pointer im # image descriptor +char key[ARB] # parameter to be returned + +long lval, imgetl() +errchk imgetl + +begin + lval = imgetl (im, key) + if (IS_INDEFL(lval)) + return (INDEFS) + else + return (lval) +end diff --git a/sys/imio/db/imgftype.x b/sys/imio/db/imgftype.x new file mode 100644 index 00000000..12ee9048 --- /dev/null +++ b/sys/imio/db/imgftype.x @@ -0,0 +1,71 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <ctype.h> +include "idb.h" + +# IMGFTYPE -- Get the datatype of a particular field of an image header. Since +# the internal format is FITS, there are four primary datatypes, boolean (T|F), +# string (quoted), integer and real. + +int procedure imgftype (im, key) + +pointer im # image descriptor +char key[ARB] # parameter to be set + +pointer rp +int ch, ip +int idb_findrecord(), idb_kwlookup() +errchk syserrs + +begin + # Check for a standard header keyword. + switch (idb_kwlookup (key)) { + case I_CTIME: + return (TY_LONG) + case I_HISTORY: + return (TY_CHAR) + case I_LIMTIME: + return (TY_LONG) + case I_MAXPIXVAL: + return (TY_REAL) + case I_MINPIXVAL: + return (TY_REAL) + case I_MTIME: + return (TY_LONG) + case I_NAXIS: + return (TY_LONG) + case I_PIXFILE: + return (TY_CHAR) + case I_PIXTYPE: + return (TY_LONG) + case I_TITLE: + return (TY_CHAR) + } + + # If we get here then the named parameter is not a standard header + # keyword. + + if (idb_findrecord (im, key, rp) > 0) { + # Check for quoted string. + ch = Memc[rp+IDB_STARTVALUE] + if (ch == '\'') + return (TY_CHAR) + + # Check for boolean field. + ch = Memc[rp+IDB_ENDVALUE-1] + if (ch == 'T' || ch == 'F') + return (TY_BOOL) + + # If field contains only digits it must be an integer. + for (ip=IDB_STARTVALUE; ip <= IDB_ENDVALUE; ip=ip+1) { + ch = Memc[rp+ip-1] + if (! (IS_DIGIT(ch) || IS_WHITE(ch))) + return (TY_REAL) + } + + return (TY_INT) + } + + call syserrs (SYS_IDBKEYNF, key) +end diff --git a/sys/imio/db/imgnfn.x b/sys/imio/db/imgnfn.x new file mode 100644 index 00000000..2dca4d9f --- /dev/null +++ b/sys/imio/db/imgnfn.x @@ -0,0 +1,339 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <ctype.h> +include <imhdr.h> +include <imio.h> +include "idb.h" + +.help imgnfn +.nf -------------------------------------------------------------------------- +IMGNFN -- Template expansion for image header keywords. + + list = imofnl[su] (im, template) # open list + nch = imgnfn (im, outstr, maxch) # get next field name + imcfnl (im) # close list + +IMOFNLS opens the list sorted, whereas IMOFNLU opens it unsorted. Both std. +and user header keywords are included in the list. +.endhelp --------------------------------------------------------------------- + +define MAX_FIELDS 1024 +define SZ_SBUF 8192 +define LEN_FNSTRUCT (10+MAX_FIELDS) + +define FN_NENTRIES Memi[$1] # number of field names in list +define FN_NEXT Memi[$1+1] # next string to be returned +define FN_SBUF Memi[$1+2] # pointer to string buffer + # open +define FN_STRP Memi[$1+10+$2-1] # array of str ptrs +define FN_FIELDNAME Memc[FN_STRP($1,$2)] # reference a string + + +# IMGNFN -- Get the next field name matching the given template from an image +# header database. Sorting of the field list is optional. A prior call to +# IMOFNL[SU] is necessary to open the sorted or unsorted list. + +int procedure imgnfn (fn, outstr, maxch) + +pointer fn # field name list descriptor +char outstr[ARB] # output string +int maxch + +int strnum +int gstrcpy() + +begin + strnum = FN_NEXT(fn) + if (strnum > FN_NENTRIES(fn)) + return (EOF) + FN_NEXT(fn) = strnum + 1 + + return (gstrcpy (FN_FIELDNAME(fn,strnum), outstr, maxch)) +end + + +# IMOFNLS -- Open a sorted field name list. + +pointer procedure imofnls (im, template) + +pointer im # image descriptor +char template[ARB] # field name template +pointer imofnl() + +begin + return (imofnl (im, template, YES)) +end + + +# IMOFNLU -- Open an unsorted field name list. + +pointer procedure imofnlu (im, template) + +pointer im # image descriptor +char template[ARB] # field name template +pointer imofnl() + +begin + return (imofnl (im, template, NO)) +end + + +# IMCFNL -- Close the image header field name list and return all associated +# storage. + +procedure imcfnl (fn) + +pointer fn # field name list descriptor + +begin + call mfree (FN_SBUF(fn), TY_CHAR) + call mfree (fn, TY_STRUCT) +end + + +# IMOFNL -- Open an image header field name list, either sorted or unsorted. +# A template is a list of patterns delimited by commas. + +pointer procedure imofnl (im, template, sort) + +pointer im # image descriptor +char template[ARB] # field name template +int sort # sort flag + +bool escape +int tp, nstr, ch, junk, first_string, nstrings, nmatch, i +pointer sp, ip, op, fn, kwname, sbuf, pattern, patcode, nextch +int patmake(), patmatch(), strlen() +errchk syserr + +begin + call smark (sp) + call salloc (kwname, SZ_FNAME, TY_CHAR) + call salloc (pattern, SZ_FNAME, TY_CHAR) + call salloc (patcode, SZ_LINE, TY_CHAR) + + # Allocate field list descriptor. + call calloc (fn, LEN_FNSTRUCT, TY_STRUCT) + call malloc (sbuf, SZ_SBUF, TY_CHAR) + + FN_SBUF(fn) = sbuf + nextch = sbuf + nstr = 0 + tp = 1 + + # Extract each comma delimited template, expand upon image header + # field list, sort if desired, and add strings to list. + + while (template[tp] != EOS && template[tp] != '\n') { + # Advance to next field. + while (IS_WHITE(template[tp]) || template[tp] == ',') + tp = tp + 1 + + # Extract pattern. Enclose pattern in ^{} so that the match will + # occur only at the beginning of each line and will be case + # insensitive (req'd for FITS format). + + op = pattern + Memc[op] = '^' + op = op + 1 + Memc[op] = '{' + op = op + 1 + + # A field name of the form "$", "$x", etc. is not matched against + # the actual image field list, but is included in the output field + # list as a literal. + + ch = template[tp] + escape = (ch == '$') + + while (! (IS_WHITE(ch) || ch == '\n' || ch == ',' || ch == EOS)) { + # Map "*" into "?*". + if (ch == '*') { + Memc[op] = '?' + op = op + 1 + } + + Memc[op] = ch + op = op + 1 + tp = tp + 1 + ch = template[tp] + } + + Memc[op] = '}' + op = op + 1 + Memc[op] = EOS + + # If the pattern is a literal, put it in the output list without + # matching it against the image field list. + + if (escape) { + # Omit the leading "^{" and the trailing "}". + ip = pattern + 2 + op = op - 1 + Memc[op] = EOS + call imfn_putkey (Memc[ip], FN_STRP(fn,1), nstr, nextch, sbuf) + + } else { + # Encode pattern. + junk = patmake (Memc[pattern], Memc[patcode], SZ_LINE) + + # Scan database and extract all field names matching the + # pattern. Mark number of first string for the sort. + + first_string = nstr + 1 + + # First find any standard header keywords matching the pattern. + call imfn_stdkeys (im, Memc[patcode], FN_STRP(fn,1), nstr, + nextch, sbuf) + + # Now scan the user area. + for (ip=IM_USERAREA(im); Memc[ip] != EOS; ip=ip+1) { + # Skip entries that are not keywords. + if (Memc[ip+8] == '=') { + + # Extract keyword name. + Memc[kwname+8] = EOS + do i = 1, 8 { + ch = Memc[ip+i-1] + if (ch == ' ') { + Memc[kwname+i-1] = EOS + break + } else + Memc[kwname+i-1] = ch + } + + # Check for a match. + if (Memc[kwname] != EOS) { + # Put key in list if it matches. + nmatch = patmatch (Memc[kwname], Memc[patcode]) - 1 + if (nmatch > 0 && nmatch == strlen(Memc[kwname])) + call imfn_putkey (Memc[ip], + FN_STRP(fn,1), nstr, nextch, sbuf) + } + } + + # Advance to the next record. + if (IM_UABLOCKED(im) == YES) + ip = ip + IDB_RECLEN + else { + while (Memc[ip] != '\n' && Memc[ip] != EOS) + ip = ip + 1 + } + + if (Memc[ip] == EOS) + break + } + + # Sort the newly added keywords. + nstrings = nstr - first_string + 1 + if (sort == YES && nstrings > 1) + call strsrt (FN_STRP(fn,first_string), Memc, nstrings) + } + } + + FN_NENTRIES(fn) = nstr + FN_NEXT(fn) = 1 + + call sfree (sp) + return (fn) +end + + +# IMFN_STDKEYS -- Match a pattern (encoded) against the list of standard header +# keywords, both with and without the "i_" prefix. Add the full name (with i_ +# prefix) of each name matched to the keyword list. + +procedure imfn_stdkeys (im, patcode, strp, nstr, nextch, sbuf) + +pointer im # image descriptor +char patcode[ARB] # encoded pattern +pointer strp[ARB] # array of string pointers +int nstr # current number of strings +pointer nextch # next available char in string buffer +pointer sbuf # string buffer + +pointer sp, op, key +bool validfield, match +int ip, index, nmatch +int patmatch(), strlen() + +string keywords "|ctime|history|limtime|maxpixval|minpixval|mtime|naxis\ +|naxis1|naxis2|naxis3|naxis4|naxis5|naxis6|naxis7|pixfile|pixtype|title|" +errchk imfn_putkey + +begin + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + + call strcpy ("i_", Memc[key], SZ_FNAME) + index = 1 + + for (ip=2; keywords[ip] != EOS; ip=ip+1) { + # Do not put dimensions NAXIS1, NAXIS2, etc. higher than the + # actual image dimension into the matched list. + + validfield = true + if (index >= 8 && index <= 14) + validfield = (index - 7 <= IM_NDIM(im)) + + # Extract keyword into buffer, after the "i_". + for (op=key+2; keywords[ip] != '|'; op=op+1) { + Memc[op] = keywords[ip] + ip = ip + 1 + } + Memc[op] = EOS + + if (validfield) { + nmatch = patmatch (Memc[key], patcode) - 1 + match = (nmatch > 0 && nmatch == strlen(Memc[key])) + if (!match) { + nmatch = patmatch (Memc[key+2], patcode) - 1 + match = (nmatch > 0 && nmatch == strlen(Memc[key+2])) + } + if (match) + call imfn_putkey (Memc[key], strp, nstr, nextch, sbuf) + } + + index = index + 1 + } + + call sfree (sp) +end + + +# IMFN_PUTKEY -- Put a keyword into the keyword list. + +procedure imfn_putkey (key, strp, nstr, nextch, sbuf) + +char key[ARB] # keyword name (etc.) +pointer strp[ARB] # array of string pointers +int nstr # current number of strings +pointer nextch # next available char in string buffer +pointer sbuf # string buffer + +int ch, ip +errchk syserr + +begin + # Append keyword to the string buffer. + nstr = nstr + 1 + if (nstr > MAX_FIELDS) + call syserr (SYS_IMFNOVFL) + strp[nstr] = nextch + + ip = 1 + ch = key[ip] + + while (ch != '=' && ch != ' ' && ch != EOS) { + Memc[nextch] = ch + nextch = nextch + 1 + if (nextch >= sbuf + SZ_SBUF) + call syserr (SYS_IMFNOVFL) + ip = ip + 1 + ch = key[ip] + } + + Memc[nextch] = EOS + nextch = nextch + 1 +end diff --git a/sys/imio/db/imgstr.x b/sys/imio/db/imgstr.x new file mode 100644 index 00000000..53a77d4c --- /dev/null +++ b/sys/imio/db/imgstr.x @@ -0,0 +1,52 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <ctype.h> +include "idb.h" + +# IMGSTR -- Get an image header parameter of type string. If the named +# parameter is a standard parameter return the value directly, else scan +# the user area for the named parameter and decode the value. A special +# check is required for embedded single quotes as per the FITS standard. + +procedure imgstr (im, key, outstr, maxch) + +pointer im # image descriptor +char key[ARB] # parameter to be returned +char outstr[ARB] # output string to receive parameter value +int maxch + +pointer rp +int ip, op +int idb_getstring(), idb_findrecord(), ctowrd(), strlen() +errchk syserrs + +begin + # Check for a standard header parameter first. + if (idb_getstring (im, key, outstr, maxch) != ERR) + return + + # Find the record. + if (idb_findrecord (im, key, rp) == 0) + call syserrs (SYS_IDBKEYNF, key) + + ip = IDB_STARTVALUE + if (ctowrd (Memc[rp], ip, outstr, maxch) > 0) { + # Check for embedded single quotes which are represented as ''. + repeat { + if (Memc[rp+ip-1] != '\'') + break + call strcat ("'", outstr, maxch) + op = strlen (outstr) + 1 + if (ctowrd (Memc[rp], ip, outstr[op], maxch-op) == 0) + break + } + + # Strip trailing whitespace. + op = strlen (outstr) + while (op > 0 && (IS_WHITE(outstr[op]) || outstr[op] == '\n')) + op = op - 1 + outstr[op+1] = EOS + } else + outstr[1] = EOS +end diff --git a/sys/imio/db/impstr.x b/sys/imio/db/impstr.x new file mode 100644 index 00000000..4f4985cf --- /dev/null +++ b/sys/imio/db/impstr.x @@ -0,0 +1,120 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include "idb.h" + +# IMPSTR -- Put an image header parameter of type string. If the named +# parameter is a standard parameter of type other than string, decode the +# string and set the binary value of the parameter. If the parameter is +# a nonstandard one we can do a simple string edit, since user parameters +# are stored in the user area in string form. The datatype of the parameter +# must be preserved by the edit, i.e., parameters of actual datatype string +# must be quoted and left justified and other parameters must be unquoted +# and right justified in the value field. + +procedure impstr (im, key, value) + +pointer im #I image descriptor +char key[ARB] #I parameter to be set +char value[ARB] #I new parameter value + +bool string_valued +int nchars, ch, i +pointer rp, ip, op, sp, val, start, text, cmmt +int idb_putstring(), idb_findrecord(), idb_filstr() +errchk syserrs + +begin + call smark (sp) + call salloc (val, SZ_LINE, TY_CHAR) + call salloc (text, SZ_LINE, TY_CHAR) + call salloc (cmmt, SZ_LINE, TY_CHAR) + + # Filter the value string to remove any undesirable characters. + nchars = idb_filstr (value, Memc[text], SZ_LINE) + + # Check for a standard header parameter first. + if (idb_putstring (im, key, Memc[text]) != ERR) { + call sfree (sp) + return + } + + # Find the record. + if (idb_findrecord (im, key, rp) == 0) + call syserrs (SYS_IDBKEYNF, key) + + # Determine the actual datatype of the parameter. String valued + # parameters will have an apostrophe in the first nonblank column + # of the value field. Skip the value and treat the rest of + # the line as a comment to be preserved. + + string_valued = false + for (ip=IDB_STARTVALUE; ip <= IDB_ENDVALUE; ip=ip+1) { + # Skip leading whitespace. + for (; Memc[rp+ip-1] == ' '; ip=ip+1) + ; + + if (Memc[rp+ip-1] == '\'') { + # Skip string value. + do i = ip, IDB_RECLEN { + ch = Memc[rp+i] + if (ch == '\n') + break + Memc[rp+i] = ' ' + if (ch == '\'') + break + } + + string_valued = true + break + + } else { + # Skip numeric value. + do i = ip, IDB_RECLEN { + ch = Memc[rp+i-1] + if (ch == '\n' || ch == ' ' || ch == '/') + break + Memc[rp+i-1] = ' ' + } + break + } + } + + # Skip whitespace before any comment. + for (ip = i; Memc[rp+ip-1] == ' '; ip=ip+1) + ; + + # Save comment. Include a leading space and add a / if missing. + Memc[cmmt] = ' ' + for (i = 1; Memc[rp+ip-1] != '\n'; ip=ip+1) { + if (i == 1 && Memc[rp+ip-1] != '/') { + Memc[cmmt+i] = '/' + i = i + 1 + } + Memc[cmmt+i] = Memc[rp+ip-1] + Memc[rp+ip-1] = ' ' + i = i + 1 + } + Memc[cmmt+i] = EOS + + # Encode the new value of the parameter. + if (string_valued) { + call sprintf (Memc[val], SZ_LINE, " '%-0.68s%11t'%22t%-0.68s") + call pargstr (Memc[text]) + call pargstr (Memc[cmmt]) + } else { + call sprintf (Memc[val], SZ_LINE, "%21s%-0.68s") + call pargstr (Memc[text]) + call pargstr (Memc[cmmt]) + } + + # Update the parameter value. + op = rp + IDB_STARTVALUE - 1 + start = op + for (ip=val; Memc[ip] != EOS && Memc[op] != '\n'; ip=ip+1) { + Memc[op] = Memc[ip] + op = op + 1 + } + + call sfree (sp) +end diff --git a/sys/imio/db/imputb.x b/sys/imio/db/imputb.x new file mode 100644 index 00000000..a211f464 --- /dev/null +++ b/sys/imio/db/imputb.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMPUTB -- Put an image header parameter of type boolean. + +procedure imputb (im, key, bval) + +pointer im # image descriptor +char key[ARB] # parameter to be set +bool bval # parameter value +char sval[2] + +begin + if (bval) + sval[1] = 'T' + else + sval[1] = 'F' + sval[2] = EOS + + call impstr (im, key, sval) +end diff --git a/sys/imio/db/imputd.x b/sys/imio/db/imputd.x new file mode 100644 index 00000000..ccd5339a --- /dev/null +++ b/sys/imio/db/imputd.x @@ -0,0 +1,38 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# IMPUTD -- Put an image header parameter of type double. + +procedure imputd (im, key, dval) + +pointer im # image descriptor +char key[ARB] # parameter to be set +double dval # double precision value + +pointer sp, sval +int i, strlen() + +begin + call smark (sp) + call salloc (sval, SZ_FNAME, TY_CHAR) + + # Reduce the precision of the encoded value if necessary to fit in + # the FITS value field. Start with NDIGITS_DP-1 as the precision + # estimate NDIGITS_DP is only approximate, and if we make up half a + # digit of precision the result can be 1.00000000000000001 instead + # of 1.0. + + for (i=NDIGITS_DP-1; i >= NDIGITS_RP; i=i-1) { + call sprintf (Memc[sval], SZ_FNAME, "%0.*g") + call pargi (i) + call pargd (dval) + if (strlen (Memc[sval]) < 20) + break + } + + # Write the new value to the header. + call impstr (im, key, Memc[sval]) + + call sfree (sp) +end diff --git a/sys/imio/db/imputh.x b/sys/imio/db/imputh.x new file mode 100644 index 00000000..39467366 --- /dev/null +++ b/sys/imio/db/imputh.x @@ -0,0 +1,161 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <ctype.h> +include <imhdr.h> +include <imio.h> +include "idb.h" + +define LEN_HISTSTR 70 # length of a history string on a FITS card + +# IMPUTH -- Add a FITS-like history/comment field to the image header. +# Only keywords HISTORY, COMMENT, or " " (eight spaces) are allowed! +# (At least for the present - in the future this routine will probably +# append FITS cards to a distinct FITS-table appearing as a table parameter +# in the generalized image header. Also, since it is not yet decided how +# image history will be handled in the future, there is no guarantee that +# this routine will remain unchanged - it may change or be obsoleted.) + +procedure imputh (im, key, text) + +pointer im #I image descriptor +char key[ARB] #I name of the new parameter +char text[ARB] #I the history string to be added + +pointer sp, keyname, instr, outstr, ua +int fd, max_lenuserarea, curlen, buflen, nchars +int ip, op, in_last_blank, out_last_blank + +bool streq() +int stropen(), strlen(), idb_filstr() +errchk syserrs, stropen, fprintf + +begin + call smark (sp) + call salloc (instr, SZ_LINE, TY_CHAR) + call salloc (keyname, SZ_FNAME, TY_CHAR) + call salloc (outstr, LEN_HISTSTR, TY_CHAR) + + # FITS format requires that the keyword name be upper case. + call strcpy (key, Memc[keyname], SZ_FNAME) + call strupr (Memc[keyname]) + + # Only standard FITS HISTORY keywords are allowed. + if (!(streq(Memc[keyname],"HISTORY") || + streq(Memc[keyname],"COMMENT") || + streq(Memc[keyname]," "))) { + + call eprintf ("IMPUTH: Invalid history keyword `%s' ignored\n") + call pargstr (key) + call sfree (sp) + return + } + + # Open the user area string for appending. 'buflen' is the malloc-ed + # buffer length in struct units; IMU is the struct offset to the user + # area, i.e., the size of that part of the image descriptor preceding + # the user area. If the buffer fills we must allow one extra char for + # the EOS delimiter; since storage for the image descriptor was + # allocated in struct units the storage allocator will not have + # allocated space for the extra EOS char. + + ua = IM_USERAREA(im) + curlen = strlen (Memc[ua]) + buflen = LEN_IMDES + IM_LENHDRMEM(im) + max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1 + + # If the user area is not empty the last character must be the newline + # record delimiter, else the new record we add will be invalid. + + if (curlen > 0 && Memc[ua+curlen-1] != '\n') + if (curlen >= max_lenuserarea) + call syserrs (SYS_IDBOVFL, key) + else { + Memc[ua+curlen] = '\n' + curlen = curlen + 1 + Memc[ua+curlen] = EOS + } + + # Open a file descriptor on the userarea buffer. + fd = stropen (Memc[ua+curlen], max_lenuserarea-curlen, APPEND) + + # Filter the input string to remove any undesirable characters. + nchars = idb_filstr (text, Memc[instr], SZ_LINE) + + # Append the HISTORY or COMMENT record to the user area. + iferr { + if (nchars <= LEN_HISTSTR ) { + # This is the easy case: the HISTORY string will fit in + # one record. + + call fprintf (fd, "%-8s %s%*t\n") + call pargstr (Memc[keyname]) + call pargstr (Memc[instr]) + call pargi (IDB_LENSTRINGRECORD + 1) + + } else { + # Not the simple case; break up the string into pieces that + # will fit into LEN_HISTSTR, preferably on word boundaries. + + for (ip=1; Memc[instr+ip-1] != EOS; ) { + # If no blanks are found in HISTORY string, make sure + # all of it gets output anyway. + + in_last_blank = ip + LEN_HISTSTR - 1 + out_last_blank = LEN_HISTSTR + + # Copy the string to the output buffer, marking the + # last blank found. + + do op = 1, LEN_HISTSTR { + if (IS_WHITE (Memc[instr+ip-1])) { + in_last_blank = ip + out_last_blank = op + } else if (Memc[instr+ip-1] == EOS) + break + + Memc[outstr+op-1] = Memc[instr+ip-1] + ip = ip + 1 + } + + # The output string is full; close it off properly + # and get ready for the next round (if any). + + Memc[outstr+op-1] = EOS + if (Memc[instr+ip-1] != EOS) { + # Break at last word boundary if in a word. + if (!IS_WHITE (Memc[instr+ip-1])) { + Memc[outstr+out_last_blank] = EOS + ip = in_last_blank + 1 + } + + # Skip leading whitespace on next line. + while (IS_WHITE(Memc[instr+ip-1])) + ip = ip + 1 + } + + # Write out the FITS HISTORY card. + call fprintf (fd, "%-8s %s%*t\n") + call pargstr (Memc[keyname]) + call pargstr (Memc[outstr]) + call pargi (IDB_LENSTRINGRECORD + 1) + } + } + + } then { + # Out of space in the user area. Discard the truncated card + # at the end of the buffer by backing up to the last newline and + # writing an EOS. + + call close (fd) + for (ip=ua+max_lenuserarea-1; ip > ua; ip=ip-1) + if (Memc[ip] == '\n') { + Memc[ip+1] = EOS + break + } + call syserrs (SYS_IDBOVFL, key) + } + + call close (fd) + call sfree (sp) +end diff --git a/sys/imio/db/imputi.x b/sys/imio/db/imputi.x new file mode 100644 index 00000000..8be50d16 --- /dev/null +++ b/sys/imio/db/imputi.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMPUTI -- Put an image header parameter of type integer. + +procedure imputi (im, key, ival) + +pointer im # image descriptor +char key[ARB] # parameter to be set +int ival # parameter value +pointer sp, sval + +begin + call smark (sp) + call salloc (sval, SZ_FNAME, TY_CHAR) + + call sprintf (Memc[sval], SZ_FNAME, "%d") + call pargi (ival) + call impstr (im, key, Memc[sval]) + + call sfree (sp) +end diff --git a/sys/imio/db/imputl.x b/sys/imio/db/imputl.x new file mode 100644 index 00000000..3bc0d64c --- /dev/null +++ b/sys/imio/db/imputl.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMPUTL -- Put an image header parameter of type long integer. + +procedure imputl (im, key, lval) + +pointer im # image descriptor +char key[ARB] # parameter to be set +long lval # parameter value +pointer sp, sval + +begin + call smark (sp) + call salloc (sval, SZ_FNAME, TY_CHAR) + + call sprintf (Memc[sval], SZ_FNAME, "%d") + call pargl (lval) + call impstr (im, key, Memc[sval]) + + call sfree (sp) +end diff --git a/sys/imio/db/imputr.x b/sys/imio/db/imputr.x new file mode 100644 index 00000000..13a5e0c3 --- /dev/null +++ b/sys/imio/db/imputr.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# IMPUTR -- Put an image header parameter of type real. + +procedure imputr (im, key, rval) + +pointer im # image descriptor +char key[ARB] # parameter to be set +real rval # parameter value +pointer sp, sval + +begin + call smark (sp) + call salloc (sval, SZ_FNAME, TY_CHAR) + + call sprintf (Memc[sval], SZ_FNAME, "%0.*g") + call pargi (NDIGITS_RP) + call pargr (rval) + call impstr (im, key, Memc[sval]) + + call sfree (sp) +end diff --git a/sys/imio/db/imputs.x b/sys/imio/db/imputs.x new file mode 100644 index 00000000..98fd61d8 --- /dev/null +++ b/sys/imio/db/imputs.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMPUTS -- Put an image header parameter of type short integer. + +procedure imputs (im, key, value) + +pointer im # image descriptor +char key[ARB] # parameter to be set +short value # parameter value +pointer sp, sval + +begin + call smark (sp) + call salloc (sval, SZ_FNAME, TY_CHAR) + + call sprintf (Memc[sval], SZ_FNAME, "%d") + call pargs (value) + call impstr (im, key, Memc[sval]) + + call sfree (sp) +end diff --git a/sys/imio/db/imrenf.x b/sys/imio/db/imrenf.x new file mode 100644 index 00000000..3b1bf7a6 --- /dev/null +++ b/sys/imio/db/imrenf.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <imhdr.h> +include "idb.h" + +# IMRENF -- Rename a user field keyword. It is an error if the +# named field does not exist. + +procedure imrenf (im, oldkey, newkey) + +pointer im # image descriptor +char oldkey[ARB] # old keyword +char newkey[ARB] # new keyword + +int off +pointer rp, sp, keyname +int idb_kwlookup(), idb_findrecord(), stridxs() +errchk syserrs + +begin + call smark (sp) + call salloc (keyname, SZ_FNAME, TY_CHAR) + + # FITS format requires that the keyword name be upper case. + call strcpy (oldkey, Memc[keyname], IDB_SZFITSKEY) + call strupr (Memc[keyname]) + + # Cannot delete standard header keywords. + if (idb_kwlookup (oldkey) > 0) + call syserrs (SYS_IDBNODEL, oldkey) + + # Verify that the named user field exists. + if (idb_findrecord (im, oldkey, rp) <= 0) + call syserrs (SYS_IDBDELNXKW, oldkey) + + # Rename the keyword. + call sprintf (Memc[keyname], IDB_SZFITSKEY, "%-8.8s") + call pargstr (newkey) + call strupr (Memc[keyname]) + call amovc (Memc[keyname], Memc[rp], 8) + + call sfree (sp) +end diff --git a/sys/imio/db/mkpkg b/sys/imio/db/mkpkg new file mode 100644 index 00000000..2d8888df --- /dev/null +++ b/sys/imio/db/mkpkg @@ -0,0 +1,44 @@ +# Update the image header database interface. + +$checkout libex.a lib$ +$update libex.a +$checkin libex.a lib$ +$exit + +libex.a: + idbcard.x idb.h <imhdr.h> <imio.h> + idbfind.x idb.h <imhdr.h> <imio.h> + idbfstr.x <ctype.h> + idbgstr.x idb.h <ctype.h> <imhdr.h> + idbkwlu.x <ctype.h> <imhdr.h> + idbpstr.x idb.h <ctype.h> <imhdr.h> <mach.h> + imaccf.x + imaddb.x + imaddd.x + imaddf.x idb.h <fset.h> <imhdr.h> <imio.h> + imaddi.x + imaddl.x + imaddr.x + imadds.x + imastr.x + imdelf.x idb.h <imhdr.h> + imgetb.x idb.h + imgetc.x + imgetd.x idb.h + imgeti.x + imgetl.x + imgetr.x + imgets.x + imgftype.x idb.h <ctype.h> + imgnfn.x idb.h <ctype.h> <imhdr.h> <imio.h> + imgstr.x idb.h <ctype.h> + impstr.x idb.h + imputb.x + imputd.x <mach.h> + imputh.x idb.h <ctype.h> <imhdr.h> <imio.h> + imputi.x + imputl.x + imputr.x <mach.h> + imputs.x + imrenf.x idb.h <imhdr.h> + ; |