diff options
Diffstat (limited to 'sys/imio/dbc')
30 files changed, 1329 insertions, 0 deletions
diff --git a/sys/imio/dbc/README b/sys/imio/dbc/README new file mode 100644 index 00000000..4e6a89ac --- /dev/null +++ b/sys/imio/dbc/README @@ -0,0 +1,29 @@ +October 4, 2004 + +These routines represent an extension to the imio header routines manipulation. +Most of them have a new parameter which is the FITS header comment field. +The routine names have changed slighly to avoid collision and to have some +meaning; e.g. the ending 'c' for comment. + +There are a couple of new routines to handle only comments. + +Nelson Zarate + + +imakbc.x:# IMAKBC -- Add a new field to the image header and initialize to the value +imakdc.x:# IMAKDC -- Add a new field to the image header and initialize to the value +imakic.x:# IMAKIC -- Add a new field to the image header and initialize to the value +imaklc.x:# IMAKLC -- Add a new field to the image header and initialize to the value +imakrc.x:# IMAKRC -- Add a new field to the image header and initialize to the value +imaksc.x:# IMAKSC -- Add a new field to the image header and initialize to the value +imastrc.x:# IMASTRC -- Add a new field to the image header and initialize to the value +imgcom.x:# IMGCOM -- Get the comment field for a keyword. +impcom.x:# IMPCOM -- Change the comment field for a keyword. +impkbc.x:# IMPKBC -- Put an image header parameter of type boolean. +impkdc.x:# IMPKDDC -- Put an image header parameter of type double. +impkic.x:# IMPKIC -- Put an image header parameter of type integer. +impklc.x:# IMPKLC -- Put an image header parameter of type long integer. +impkrc.x:# IMPKRC -- Put an image header parameter of type real. +imdrmcom.x:# IMDRMCOM -- Remove the comment field for a keyword. +impksc.x:# IMPKSC -- Put an image header parameter of type short integer. +impstrc.x:# IMPSTRC -- Put an image header parameter of type string. If the named diff --git a/sys/imio/dbc/idbc.h b/sys/imio/dbc/idbc.h new file mode 100644 index 00000000..3c254469 --- /dev/null +++ b/sys/imio/dbc/idbc.h @@ -0,0 +1,27 @@ +# 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 + +define BEFORE 1 +define AFTER 2 diff --git a/sys/imio/dbc/imakbc.x b/sys/imio/dbc/imakbc.x new file mode 100644 index 00000000..2871370d --- /dev/null +++ b/sys/imio/dbc/imakbc.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKBC -- 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 imakbc (im, key, value, comment) + +pointer im # image descriptor +char key[ARB] # parameter or field value +bool value # new or initial value of parameter +char comment[ARB] # comment + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "b") + call impkbc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imakbci.x b/sys/imio/dbc/imakbci.x new file mode 100644 index 00000000..3fe64116 --- /dev/null +++ b/sys/imio/dbc/imakbci.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKBCI -- Insert a new field to the image header after the given keyword +# and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imakbci (im, key, value, comment, pkey, baf) + +pointer im # image descriptor +char key[ARB] # parameter or field value +bool value # new or initial value of parameter +char comment[ARB] # comment +char pkey[ARB] # Pivot keyword to insert 'key' +int baf # I Insert BEFORE or AFTER + +int imaccf() +errchk imaccf, iminfi + +begin + if (imaccf (im, key) == NO) + call iminfi (im, key, pkey, "b", baf) + call impkbc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imakdc.x b/sys/imio/dbc/imakdc.x new file mode 100644 index 00000000..787c496d --- /dev/null +++ b/sys/imio/dbc/imakdc.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKDC -- 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 imakdc (im, key, value, comment) + +pointer im # image descriptor +char key[ARB] # parameter or field value +double value # new or initial value of parameter +char comment[ARB] # comment + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "d") + call impkdc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imakdci.x b/sys/imio/dbc/imakdci.x new file mode 100644 index 00000000..c63a9a5a --- /dev/null +++ b/sys/imio/dbc/imakdci.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKDCI -- Insert a new field to the image header after the given keyword +# and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imakdci (im, key, value, comment, pkey, baf) + +pointer im # image descriptor +char key[ARB] # parameter or field value +double value # new or initial value of parameter +char comment[ARB] # comment +char pkey[ARB] # Pivot keyword to insert 'key' +int baf # I Insert BEFORE or AFTER + +int imaccf() +errchk imaccf, iminfi + +begin + if (imaccf (im, key) == NO) + call iminfi (im, key, pkey, "d", baf) + call impkdc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imakic.x b/sys/imio/dbc/imakic.x new file mode 100644 index 00000000..10594d2a --- /dev/null +++ b/sys/imio/dbc/imakic.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKIC -- 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 imakic (im, key, value, comment) + +pointer im # image descriptor +char key[ARB] # parameter or field value +int value # new or initial value of parameter +char comment[ARB] + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "i") + call impkic (im, key, value, comment) +end diff --git a/sys/imio/dbc/imakici.x b/sys/imio/dbc/imakici.x new file mode 100644 index 00000000..02177184 --- /dev/null +++ b/sys/imio/dbc/imakici.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKICI -- Insert a new field to the image header after the given keyword +# and initialize to the value given. It is not an error if the parameter +# already exists. + +procedure imakici (im, key, value, comment, pkey, baf) + +pointer im # image descriptor +char key[ARB] # parameter or field value +int value # new or initial value of parameter +char comment[ARB] +char pkey[ARB] # Pivot keyword to insert 'key' +int baf # I Insert BEFORE or AFTER + +int imaccf() +errchk imaccf, iminfi + +begin + if (imaccf (im, key) == NO) + call iminfi (im, key, pkey, "i", baf) + call impkic (im, key, value, comment) +end diff --git a/sys/imio/dbc/imaklc.x b/sys/imio/dbc/imaklc.x new file mode 100644 index 00000000..3cb323c1 --- /dev/null +++ b/sys/imio/dbc/imaklc.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKLC -- 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 imaklc (im, key, value, comment) + +pointer im # image descriptor +char key[ARB] # parameter or field value +long value # new or initial value of parameter +char comment[ARB] + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "l") + call impklc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imaklci.x b/sys/imio/dbc/imaklci.x new file mode 100644 index 00000000..9b74c82f --- /dev/null +++ b/sys/imio/dbc/imaklci.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKLCI -- Insert a new field to the image header after the given keyword +# and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imaklci (im, key, value, comment, pkey, baf) + +pointer im # image descriptor +char key[ARB] # parameter or field value +long value # new or initial value of parameter +char comment[ARB] +char pkey[ARB] # Pivot keyword to insert 'key' +int baf # I Insert BEFORE or AFTER + +int imaccf() +errchk imaccf, iminfi + +begin + if (imaccf (im, key) == NO) + call iminfi (im, key, pkey, "l", baf) + call impklc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imakrc.x b/sys/imio/dbc/imakrc.x new file mode 100644 index 00000000..ff13efdf --- /dev/null +++ b/sys/imio/dbc/imakrc.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKRC -- 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 imakrc (im, key, value, comment) + +pointer im # image descriptor +char key[ARB] # parameter or field value +real value # new or initial value of parameter +char comment[ARB] + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "r") + call impkrc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imakrci.x b/sys/imio/dbc/imakrci.x new file mode 100644 index 00000000..74114d90 --- /dev/null +++ b/sys/imio/dbc/imakrci.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKRCI -- Insert a new field to the image header after the given keyword +# and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imakrci (im, key, value, comment, pkey, baf) + +pointer im # image descriptor +char key[ARB] # parameter or field value +real value # new or initial value of parameter +char comment[ARB] +char pkey[ARB] # Pivot keyword to insert 'key' +int baf # I Insert BEFORE or AFTER + +int imaccf() +errchk imaccf, iminfi + +begin + if (imaccf (im, key) == NO) + call iminfi (im, key, pkey, "r", baf) + call impkrc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imaksc.x b/sys/imio/dbc/imaksc.x new file mode 100644 index 00000000..e6f2c4ac --- /dev/null +++ b/sys/imio/dbc/imaksc.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKSC -- 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 imaksc (im, key, value, comment) + +pointer im # image descriptor +char key[ARB] # parameter or field value +short value # new or initial value of parameter +char comment[ARB] + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "s") + call impksc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imaksci.x b/sys/imio/dbc/imaksci.x new file mode 100644 index 00000000..2bed12b0 --- /dev/null +++ b/sys/imio/dbc/imaksci.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMAKSCI -- Insert a new field to the image header after the given keyword +# and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imaksci (im, key, value, comment, pkey, baf) + +pointer im # image descriptor +char key[ARB] # parameter or field value +short value # new or initial value of parameter +char comment[ARB] +char pkey[ARB] # Pivot keyword to insert 'key' +int baf # I Insert BEFORE or AFTER + +int imaccf() +errchk imaccf, iminfi + +begin + if (imaccf (im, key) == NO) + call iminfi (im, key, pkey, "s", baf) + call impksc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imastrc.x b/sys/imio/dbc/imastrc.x new file mode 100644 index 00000000..4620db46 --- /dev/null +++ b/sys/imio/dbc/imastrc.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMASTRC -- 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 imastrc (im, key, value, comment) + +pointer im # image descriptor +char key[ARB] # parameter or field value +char value[ARB] # new or initial value of parameter +char comment[ARB] # + +int imaccf() +errchk imaccf, imaddf + +begin + if (imaccf (im, key) == NO) + call imaddf (im, key, "c") + call impstrc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imastrci.x b/sys/imio/dbc/imastrci.x new file mode 100644 index 00000000..f5154906 --- /dev/null +++ b/sys/imio/dbc/imastrci.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMASTRCI -- Insert a new field to the image header after the given keyword +# and initialize to the value +# given. It is not an error if the parameter already exists. + +procedure imastrci (im, key, value, comment, pkey, baf) + +pointer im # image descriptor +char key[ARB] # parameter or field value +char value[ARB] # new or initial value of parameter +char comment[ARB] # +char pkey[ARB] # Pivot keyword to insert 'key' +int baf # I Insert BEFORE or AFTER + +int imaccf() +errchk imaccf, iminfi + +begin + if (imaccf (im, key) == NO) + call iminfi (im, key, pkey, "c", baf) + call impstrc (im, key, value, comment) +end diff --git a/sys/imio/dbc/imdrmcom.x b/sys/imio/dbc/imdrmcom.x new file mode 100644 index 00000000..4a10f2df --- /dev/null +++ b/sys/imio/dbc/imdrmcom.x @@ -0,0 +1,96 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include "idbc.h" + +# IMDRMCOM -- Remove the comment field for a keyword. + +procedure imdrmcom (im, key) + +pointer im #I image descriptor +char key[ARB] #I parameter to be set + +bool string_valued +int ch, i, ti, j, n +pointer rp, ip, op, sp, val, start, text, cmmt +int idb_findrecord() +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) + + # Find the record. + if (idb_findrecord (im, key, rp) == 0) + call syserrs (SYS_IDBKEYNF, key) + + for (i=0; i<SZ_LINE; i=i+1) + Memc[text+i] = ' ' + Memc[text+SZ_LINE] = EOS + + # Determine the actual datatype of the parameter. String valued + # parameters will have an apostrophe in the first nonblank column + # of the value field. + + string_valued = false + ti = text + for (ip=IDB_STARTVALUE; ip <= IDB_ENDVALUE; ip=ip+1) { + # Skip leading whitespace. + for (; Memc[rp+ip-1] == ' '; ip=ip+1) { + Memc[ti] = Memc[rp+ip-1] + ti = ti + 1 + } + if (Memc[rp+ip-1] == '\'') { + # Get string value. + Memc[ti] = Memc[rp+ip-1] + ti = ti + 1 + do i = ip, IDB_RECLEN { + ch = Memc[rp+i] + Memc[ti] = ch + ti = ti + 1 + if (ch == '\n') + break + if (ch == '\'') + break + } + break + + } else { + # Numeric value. + do i = ip, IDB_RECLEN { + ch = Memc[rp+i-1] + Memc[ti] = ch + ti = ti + 1 + if (ch == '\n' || ch == ' ' || ch == '/') + break + } +# if (ch == ' ') +# ti = ti - 1 + break + } + } + + n = 0 + do j = i, IDB_RECLEN { + ch = Memc[rp+j] + Memc[cmmt+n] = ch + n = n + 1 + if (ch == '\n') { + n = n - 1 + break + } + } + Memc[cmmt+n] = EOS + + # Update the parameter value. + op = rp + IDB_STARTVALUE + ti-text - 1 + start = op + for (ip=ti; 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/dbc/imgcom.x b/sys/imio/dbc/imgcom.x new file mode 100644 index 00000000..504c0c55 --- /dev/null +++ b/sys/imio/dbc/imgcom.x @@ -0,0 +1,66 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <ctype.h> +include "idbc.h" + +# IMGCOM -- Get the comment field for a keyword. + +procedure imgcom (im, key, comment) + +pointer im #I image descriptor +char key[ARB] #I parameter to be set +char comment[ARB] #O comment string + +bool string_valued +int ch, i, n, j, ic, op +pointer rp, ip, sp, buf +int idb_findrecord(), ctowrd(), stridx(), idb_getstring() +errchk syserrs + +define end_ 91 +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + # Special fields do not have comment. + if (key[1] == 'i' && key[2] == '_') { + comment[1] = EOS + return + } + + # Find the record. + if (idb_findrecord (im, key, rp) == 0) + call syserrs (SYS_IDBKEYNF, key) + + ip = IDB_STARTVALUE + if (ctowrd (Memc[rp], ip, Memc[buf], SZ_LINE) <= 0) { + comment[1] = EOS + goto end_ + } + + # Look for '/' + while (ip < IDB_RECLEN && (Memc[rp+ip] != '/')) + ip = ip + 1 + if (ip == IDB_RECLEN) { + comment[1] = EOS + goto end_ + } + op = rp+ip+1 + while (op < IDB_RECLEN+rp && (IS_WHITE(Memc[op]) || Memc[op] == '\n')) + op = op + 1 + + # Copy comment section + for (i = 1; Memc[op] != '\n' && op < IDB_RECLEN+rp; op=op+1) { + comment[i] = Memc[op] + i = i + 1 + } + # Trim + i = i - 1 + while (i >= 1 && IS_WHITE(comment[i])) + i = i - 1 + + comment[i+1] = EOS +end_ + call sfree (sp) +end diff --git a/sys/imio/dbc/iminfi.x b/sys/imio/dbc/iminfi.x new file mode 100644 index 00000000..0ddfb540 --- /dev/null +++ b/sys/imio/dbc/iminfi.x @@ -0,0 +1,111 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <fset.h> +include <imhdr.h> +include <imio.h> +include "idbc.h" + +# IMADDFI -- Insert a user field in the image header after the specified +# keyword. It is an error if the named field already exists. + +#procedure imaddfi (im, key, pkey, datatype, baf) +procedure iminfi (im, key, pkey, datatype, baf) + +pointer im #I image descriptor +char key[ARB] #I name of the new parameter +char pkey[ARB] #I 'key' will be inserted bef/after pkey +char datatype[ARB] #I string permits generalization to domains +int baf # I Insert BEFORE or AFTER + +pointer rp, sp, keyname, ua, ip +int fd, max_lenuserarea, curlen, buflen, nchars, piv +int idb_kwlookup(), idb_findrecord() +int strlen(), idb_filstr(), nowhite() +char card[IDB_RECLEN+1] +errchk syserrs, sprintf, pargstr, pargi + +begin + call smark (sp) + call salloc (keyname, SZ_FNAME, TY_CHAR) + + 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. + + ua = IM_USERAREA(im) + curlen = strlen (Memc[ua]) + buflen = LEN_IMDES + IM_LENHDRMEM(im) + max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1 + + if (curlen+81 >= max_lenuserarea) { + IM_HDRLEN(im) = LEN_IMHDR + + (curlen + 10*36*81 + SZ_STRUCT-1) / SZ_STRUCT + IM_LENHDRMEM(im) = IM_HDRLEN(im) + (SZ_UAPAD / SZ_STRUCT) + call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT) + 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 + } + + # Find keyw_after + if (idb_findrecord (im, pkey, rp) == 0) { + # Keyw not found. Append the new keyword. + rp = ua+curlen + baf = BEFORE + } else { + # Shift cards after pivot or before pivot + if (baf == AFTER) + piv = rp + else + piv = rp - IDB_RECLEN - 1 + for (ip= ua+curlen-IDB_RECLEN-1; ip>=piv; ip=ip-IDB_RECLEN-1) { + call amovc (Memc[ip], Memc[ip+IDB_RECLEN+1], IDB_RECLEN) + } + } + Memc[ua+curlen+IDB_RECLEN]='\n' + Memc[ua+curlen+IDB_RECLEN+1]=EOS + + # Form a card with keyword name and placeholder for value. + call sprintf (card, IDB_RECLEN+10, "%-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) + } + + # Replace keyword at the position rp+81. + if (baf == AFTER) + call amovc (card, Memc[rp+IDB_RECLEN+1], IDB_RECLEN) + else + call amovc (card, Memc[rp], IDB_RECLEN) + +#for (ip=1; ip<5; ip=ip+1) { +#call eprintf("<%40.40s>\n") +# call pargstr(Memc[rp-(2-ip)*(IDB_RECLEN+1)]) +#} + call sfree (sp) +end diff --git a/sys/imio/dbc/impcom.x b/sys/imio/dbc/impcom.x new file mode 100644 index 00000000..b110536e --- /dev/null +++ b/sys/imio/dbc/impcom.x @@ -0,0 +1,97 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include "idbc.h" + +# IMPCOM -- Change the comment field for a keyword. + +procedure impcom (im, key, comment) + +pointer im #I image descriptor +char key[ARB] #I parameter to be set +char comment[ARB] #I comment string + +bool string_valued +int ch, i, ti, j +pointer rp, ip, op, sp, val, start, text, cmmt +int idb_findrecord() +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) + + # 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. + + string_valued = false + ti = text + for (ip=IDB_STARTVALUE; ip <= IDB_ENDVALUE; ip=ip+1) { + # Skip leading whitespace. + for (; Memc[rp+ip-1] == ' '; ip=ip+1) { + Memc[ti] = Memc[rp+ip-1] + ti = ti + 1 + } + if (Memc[rp+ip-1] == '\'') { + # Get string value. + Memc[ti] = Memc[rp+ip-1] + ti = ti + 1 + do i = ip, IDB_RECLEN { + ch = Memc[rp+i] + Memc[ti] = ch + ti = ti + 1 + if (ch == '\n') + break + if (ch == '\'') + break + } + do j = i, IDB_ENDVALUE-2 { + Memc[ti] = ' ' ; ti=ti+1 + } + break + + } else { + # Skip numeric value. + do i = ip, IDB_RECLEN { + ch = Memc[rp+i-1] + Memc[ti] = ch + ti = ti + 1 + if (ch == '\n' || ch == ' ' || ch == '/') + break + } + if (ch == ' ') + ti = ti - 1 + do j = i, IDB_ENDVALUE { + Memc[ti] = ' ' ; ti=ti+1 + } + break + } + } + Memc[ti]=EOS + if (comment[1] != EOS) { + call strcat (" / ", Memc[ti], SZ_LINE) + for (i=1; comment[i] == ' '; i=i+1) + ; + call strcat (comment[i], Memc[ti], SZ_LINE) + } else { + do j = i, IDB_RECLEN { + Memc[ti] = ' ' ; ti=ti+1 + } + } + # Update the parameter value. + op = rp + IDB_STARTVALUE + ti-text - 1 + start = op + for (ip=ti; 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/dbc/impkbc.x b/sys/imio/dbc/impkbc.x new file mode 100644 index 00000000..fb28eacd --- /dev/null +++ b/sys/imio/dbc/impkbc.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMPKBC -- Put an image header parameter of type boolean. + +procedure impkbc (im, key, bval, comment) + +pointer im # image descriptor +char key[ARB] # parameter to be set +bool bval # parameter value +char comment[ARB] # +char sval[2] + +begin + if (bval) + sval[1] = 'T' + else + sval[1] = 'F' + sval[2] = EOS + + call impstrc (im, key, sval, comment) +end diff --git a/sys/imio/dbc/impkdc.x b/sys/imio/dbc/impkdc.x new file mode 100644 index 00000000..6eb671f3 --- /dev/null +++ b/sys/imio/dbc/impkdc.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# IMPKDDC -- Put an image header parameter of type double. + +procedure impkdc (im, key, dval, comment) + +pointer im # image descriptor +char key[ARB] # parameter to be set +double dval # double precision value +char comment[ARB] # + +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 impstrc (im, key, Memc[sval], comment) + + call sfree (sp) +end diff --git a/sys/imio/dbc/impkic.x b/sys/imio/dbc/impkic.x new file mode 100644 index 00000000..3acb0fbd --- /dev/null +++ b/sys/imio/dbc/impkic.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMPKIC -- Put an image header parameter of type integer. + +procedure impkic (im, key, ival, comment) + +pointer im # image descriptor +char key[ARB] # parameter to be set +int ival # parameter value +char comment[ARB] # +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 impstrc (im, key, Memc[sval], comment) + + call sfree (sp) +end diff --git a/sys/imio/dbc/impklc.x b/sys/imio/dbc/impklc.x new file mode 100644 index 00000000..7ef227ff --- /dev/null +++ b/sys/imio/dbc/impklc.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMPKLC -- Put an image header parameter of type long integer. + +procedure impklc (im, key, lval, comment) + +pointer im # image descriptor +char key[ARB] # parameter to be set +long lval # parameter value +char comment[ARB] # +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 impstrc (im, key, Memc[sval], comment) + + call sfree (sp) +end diff --git a/sys/imio/dbc/impkrc.x b/sys/imio/dbc/impkrc.x new file mode 100644 index 00000000..1f1459dd --- /dev/null +++ b/sys/imio/dbc/impkrc.x @@ -0,0 +1,25 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# IMPKRC -- Put an image header parameter of type real. + +procedure impkrc (im, key, rval, comment) + +pointer im # image descriptor +char key[ARB] # parameter to be set +real rval # parameter value +char comment[ARB] # +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 impstrc (im, key, Memc[sval], comment) + + call sfree (sp) +end diff --git a/sys/imio/dbc/impksc.x b/sys/imio/dbc/impksc.x new file mode 100644 index 00000000..0a74d0f0 --- /dev/null +++ b/sys/imio/dbc/impksc.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IMPKSC -- Put an image header parameter of type short integer. + +procedure impksc (im, key, value, comment) + +pointer im # image descriptor +char key[ARB] # parameter to be set +short value # parameter value +char comment[ARB] # +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 impstrc (im, key, Memc[sval], comment) + + call sfree (sp) +end diff --git a/sys/imio/dbc/impstrc.x b/sys/imio/dbc/impstrc.x new file mode 100644 index 00000000..0a11782e --- /dev/null +++ b/sys/imio/dbc/impstrc.x @@ -0,0 +1,117 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include "idbc.h" + +# IMPSTRC -- 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 impstrc (im, key, value, comment) + +pointer im #I image descriptor +char key[ARB] #I parameter to be set +char value[ARB] #I new parameter value +char comment[ARB] #I comment string + +bool string_valued +int nchars, ch, i +pointer rp, ip, op, sp, val, start, text, cmmt, slen +int idb_putstring(), idb_findrecord(), idb_filstr(), strlen() +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) + ; + + call strcpy (" / ", Memc[cmmt], IDB_RECLEN) + call strcat (comment, Memc[cmmt], IDB_RECLEN) + + # Put enough blanks to erase the old comment. + slen = strlen(Memc[cmmt]) + for (i=slen+1; i<=71-slen; i=i+1) + Memc[cmmt+i-1] = ' ' + Memc[cmmt+i-1] = 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/dbc/imputextf.x b/sys/imio/dbc/imputextf.x new file mode 100644 index 00000000..151f13e4 --- /dev/null +++ b/sys/imio/dbc/imputextf.x @@ -0,0 +1,185 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <ctype.h> +include <imhdr.h> +include <imio.h> +include "idbc.h" + +define LEN_HISTSTR 71 # length of a history string on a FITS card +define CLEN 81 + +# IMPUTXTF -- Insert a text file in the user area with HISTORY card. +# The file cannot have control characters in it; only the FITS standard +# character set is supported. The text is broken in records long enough +# to fit words; i.e. it tries not to split words. The file can have +# imbedded tabs and they will be expanded. + +procedure imputextf (im, file, pkey, baf) + +pointer im #I image descriptor +char file[ARB] #I the text file to be inserted and appended +char pkey[ARB] #I Pivot keyword to insert 'key' +int baf #I Insert BEFORE or AFTER + +pointer ua, rp, piv, ip, op +int max_lenuserarea, curlen, buflen, jump, nlines +int old_curlen, k, nshift +char blk + +int strlen(), idb_findrecord() +errchk syserrs + +begin + # FITS format requires that the keyword name be upper case. + + ua = IM_USERAREA(im) + curlen = strlen (Memc[ua]) + buflen = LEN_IMDES + IM_LENHDRMEM(im) + max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1 + + # Determine the number of lines before inserting into the UA + call imrartxt (ua, file, nlines, NO) + + old_curlen=curlen + curlen = curlen + nlines*CLEN + if (curlen+81 >= max_lenuserarea) { + IM_HDRLEN(im) = LEN_IMHDR + + (curlen + 10*36*CLEN + SZ_STRUCT-1) / SZ_STRUCT + IM_LENHDRMEM(im) = IM_HDRLEN(im) + (SZ_UAPAD / SZ_STRUCT) + call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT) + buflen = LEN_IMDES + IM_LENHDRMEM(im) + max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1 + ua = IM_USERAREA(im) + } + + blk=' ' + # Find pivot keyword + if (idb_findrecord (im, pkey, rp) == 0) { + # Keyw not found. Append the new keywords. + piv = ua + old_curlen + } else { + # Shift cards after or before pivot. + if (baf == AFTER) + piv = rp + CLEN + else + piv = rp + + jump=nlines*CLEN + + # Shift cards down from the pivot point. + nshift = (ua+old_curlen - piv)/CLEN + ip = ua + old_curlen + do k = 1, nshift { + ip = ip - CLEN + op = jump + ip + call amovc (Memc[ip], Memc[op], CLEN) + } + } + + # Append the HISTORY records to the user area. + call imrartxt (piv, file, nlines, YES) + +end + + +# IMRARTXT -- Internal routines to count the number of lines transfered to the +# UA as HISTORY records. + +procedure imrartxt (piv, fname, nlines, insert) + +pointer piv #I UA address to start inserting kw +char fname[ARB] +int nlines +int insert + +char line[IDB_RECLEN+1], blk, lf +pointer sp, ln, buf, urp +int ip, op, fd, in_last_blank, out_last_blank, blen, len, w, k +int save_ip +int open(), getline(), strlen() + +begin + call smark(sp) + call salloc (ln, SZ_LINE, TY_CHAR) + call salloc (buf, SZ_LINE, TY_CHAR) + + fd = open(fname, READ_ONLY, TEXT_FILE) + nlines= 0 + blk=' ' + lf='\12' + call strcpy ("HISTORY ", Memc[buf], 9) + Memc[buf+IDB_LENSTRINGRECORD]='\n' + Memc[buf+IDB_LENSTRINGRECORD+1]=EOS + urp = piv + while(getline(fd, Memc[ln]) != EOF) { + for (ip=1; Memc[ln+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. + + for (op=1; op <= LEN_HISTSTR; op=op+1) { + if (Memc[ln+ip-1] == lf) { + ip=ip+1 + } + if (IS_WHITE (Memc[ln+ip-1])) { + # Detab input text. + if (Memc[ln+ip-1] == '\t') { + if(ip-save_ip == 1) + w=8 + else + w=9-op+(op/9)*8 + for(k=0;k<w;k=k+1) { + line[op+k] = blk + } + save_ip=ip + op = op + w - 1 + ip = ip + 1 + in_last_blank = ip + out_last_blank = op + next + } + in_last_blank = ip + out_last_blank = op + } else if (Memc[ln+ip-1] == EOS) + break + line[op] = Memc[ln+ip-1] + ip = ip + 1 + } + # The output string is full; close it off properly + # and get ready for the next round (if any). + line[op] = EOS + if (Memc[ln+ip-1] != EOS) { + # Break at last word boundary if in a word. + if (!IS_WHITE (Memc[ln+ip-1])) { + line[out_last_blank+1] = EOS + ip = in_last_blank + 1 + } + + # Skip leading whitespace on next line. + while (IS_WHITE(Memc[ln+ip-1])) + ip = ip + 1 + } + nlines = nlines + 1 + + if (insert == YES) { + # Write out the FITS HISTORY card. + len = strlen(line) + blen = IDB_LENSTRINGRECORD - len - 9 + call amovc (line, Memc[buf+9], len) + call amovkc (blk, Memc[buf+9+len], blen) + + call amovc (Memc[buf], Memc[urp], IDB_RECLEN+1) + urp = urp + IDB_RECLEN + 1 + } + } + } + + call close(fd) + call sfree(sp) +end diff --git a/sys/imio/dbc/imputhi.x b/sys/imio/dbc/imputhi.x new file mode 100644 index 00000000..0d1de5a9 --- /dev/null +++ b/sys/imio/dbc/imputhi.x @@ -0,0 +1,113 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <fset.h> +include <imhdr.h> +include <imio.h> +include "idbc.h" + +# IMPHIS -- Insert a user field in the image header after the specified +# keyword. It is an error if the named field already exists. + +procedure imphis (im, key, text, pkey, baf) + +pointer im #I image descriptor +char key[ARB] #I name of the new parameter +char text[ARB] #I the history string to be added +char pkey[ARB] #I 'key' will be inserted bef/after pkey +int baf # I Insert BEFORE or AFTER + +pointer rp, sp, keyname, ua, ip, instr +int max_lenuserarea, curlen, buflen, nchars, piv +int idb_findrecord() +bool streq() +int strlen(), idb_filstr(), nowhite() +char card[IDB_RECLEN+1] +errchk syserrs, sprintf, pargstr, pargi + +begin + call smark (sp) + call salloc (keyname, SZ_FNAME, TY_CHAR) + call salloc (instr, SZ_LINE, TY_CHAR) + + nchars = idb_filstr (key, Memc[keyname], IDB_SZFITSKEY) + nchars = nowhite (Memc[keyname], Memc[keyname], IDB_SZFITSKEY) + call strupr (Memc[keyname]) + + # Only standard FITS HISTORY keywords are allowed. + if (!(streq(Memc[keyname],"HISTORY") || + streq(Memc[keyname],"COMMENT") || + streq(Memc[keyname],"ADD_BLAN"))) { + call sfree (sp) + return + } + + if (streq(Memc[keyname],"ADD_BLAN")) { + call strcpy (" ", Memc[keyname], SZ_FNAME) + } + + # 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. + + ua = IM_USERAREA(im) + curlen = strlen (Memc[ua]) + buflen = LEN_IMDES + IM_LENHDRMEM(im) + max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1 + + if (curlen+81 >= max_lenuserarea) { + IM_HDRLEN(im) = LEN_IMHDR + + (curlen + 10*36*81 + SZ_STRUCT-1) / SZ_STRUCT + IM_LENHDRMEM(im) = IM_HDRLEN(im) + (SZ_UAPAD / SZ_STRUCT) + call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT) + 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 + } + + # Find keyw_after + if (idb_findrecord (im, pkey, rp) == 0) { + # Keyw not found. Append the new keyword. + rp = ua+curlen + baf = BEFORE + } else { + # Shift cards after pivot or before pivot + if (baf == AFTER) + piv = rp + else + piv = rp - IDB_RECLEN - 1 + for (ip= ua+curlen-IDB_RECLEN-1; ip>=piv; ip=ip-IDB_RECLEN-1) { + call amovc (Memc[ip], Memc[ip+IDB_RECLEN+1], IDB_RECLEN) + } + } + Memc[ua+curlen+IDB_RECLEN]='\n' + Memc[ua+curlen+IDB_RECLEN+1]=EOS + + # Filter the input string to remove any undesirable characters. + nchars = idb_filstr (text, Memc[instr], SZ_LINE) + + # Form a card with keyword name and placeholder for value. + call sprintf (card, IDB_RECLEN+10, "%-8s %-71s\n") + call pargstr (Memc[keyname]) + call pargstr (Memc[instr]) + + # Replace keyword at the position rp+81. + if (baf == AFTER) + call amovc (card, Memc[rp+IDB_RECLEN+1], IDB_RECLEN) + else + call amovc (card, Memc[rp], IDB_RECLEN) + + call sfree (sp) +end diff --git a/sys/imio/dbc/mkpkg b/sys/imio/dbc/mkpkg new file mode 100644 index 00000000..1997f6b6 --- /dev/null +++ b/sys/imio/dbc/mkpkg @@ -0,0 +1,36 @@ +# Update the image header database interface. + +$checkout libex.a lib$ +$update libex.a +$checkin libex.a lib$ +$exit + +libex.a: + imakbc.x + imakbci.x + imakdc.x + imakdci.x + imakic.x + imakici.x + imaklc.x + imaklci.x + imakrc.x + imakrci.x + imaksc.x + imaksci.x + imastrc.x + imastrci.x + imgcom.x idbc.h <ctype.h> + iminfi.x idbc.h <fset.h> <imhdr.h> <imio.h> + impcom.x idbc.h + impkbc.x + impkdc.x <mach.h> + impkic.x + impklc.x + impkrc.x <mach.h> + impksc.x + imdrmcom.x idbc.h + impstrc.x idbc.h + imputextf.x idbc.h <ctype.h> <imhdr.h> <imio.h> + imputhi.x idbc.h <fset.h> <imhdr.h> <imio.h> + ; |