diff options
Diffstat (limited to 'sys/imio/iki/stf/stfrgpb.x')
| -rw-r--r-- | sys/imio/iki/stf/stfrgpb.x | 179 |
1 files changed, 179 insertions, 0 deletions
diff --git a/sys/imio/iki/stf/stfrgpb.x b/sys/imio/iki/stf/stfrgpb.x new file mode 100644 index 00000000..15c4da0a --- /dev/null +++ b/sys/imio/iki/stf/stfrgpb.x @@ -0,0 +1,179 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imio.h> +include <mach.h> +include "stf.h" + +# STF_RGPB -- Read the group data block into the first few cards of the user +# area of the IMIO image header. The GPB is stored as a binary data structure +# in the STF pixfile. The values of the standard GPB parameters DATAMIN and +# DATAMAX are returned as output arguments. +# +# DLB--11/03/87: Made changes to allow i*2 and i*4 integer parameters in GPB. +# DLB--11/11/87: Changed calculation of character string length in GPB to +# avoid integer truncation error by using P_PSIZE directly. + +procedure stf_rgpb (im, group, acmode, datamin, datamax) + +pointer im # IMIO image descriptor +int group # group to be accessed +int acmode # image access mode +real datamin, datamax # min,max pixel values from GPB + +real rval +double dval +short sval +long lval, offset +bool bval, newgroup +pointer sp, stf, gpb, lbuf, pp +int pfd, pn, sz_param, sz_gpb +errchk imaddb, imadds, imaddl, imaddr, imaddd, imastr +errchk imputd, impstr, open, read +int open(), read(), imaccf() +real imgetr() + +string readerr "cannot read group data block - no such group?" +string badtype "illegal group data parameter datatype" +string nogroup "group index out of range" +define minmax_ 91 + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + stf = IM_KDES(im) + pfd = STF_PFD(stf) + + # Verify that the given group exists. + if (group < 1 || group > STF_GCOUNT(stf)) + call error (1, nogroup) + + # Skip ahead if there is no group parameter block. + if (STF_PSIZE(stf) == 0) + goto minmax_ + + # Open the pixel file if not already open. + if (pfd == NULL) { + iferr { + if (IM_ACMODE(im) == READ_ONLY) + pfd = open (IM_PIXFILE(im), READ_ONLY, BINARY_FILE) + else + pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE) + STF_PFD(stf) = pfd + } then { + call eprintf ("Warning: Cannot open pixfile to read GPB (%s)\n") + call pargstr (IM_NAME(im)) + pfd = NULL + } + } + + # Allocate a buffer for the GPB. + sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR + call salloc (gpb, sz_gpb, TY_CHAR) + + # Read the GPB into a buffer. The GPB is located at the very end of + # the data storage area for the group. If we are opening a new, + # uninitialized group (acmode = new_image or new_copy), do not + # physically read the GPB as it is will be uninitialized data. + + newgroup = (acmode == NEW_IMAGE || acmode == NEW_COPY || pfd == NULL) + if (newgroup) + call aclrc (Memc[gpb], sz_gpb) + else { + offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb + call seek (pfd, offset) + if (read (pfd, Memc[gpb], sz_gpb) != sz_gpb) + call error (1, readerr) + } + + # Extract the binary value of each parameter in the GPB and encode it + # in FITS format in the IMIO user area. + + offset = 0 + for (pn=1; pn <= STF_PCOUNT(stf); pn=pn+1) { + pp = STF_PDES(stf,pn) + + # Fill in the unitialized fields of the GPB parameter descriptor. + P_OFFSET(pp) = offset + sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR + + switch (P_PDTYPE(pp)) { + # changed case for int to short and long--dlb 11/3/87 + case 'I': + if (sz_param == SZ_SHORT) + P_SPPTYPE(pp) = TY_SHORT + else + P_SPPTYPE(pp) = TY_LONG + P_LEN(pp) = 1 + case 'R': + if (sz_param == SZ_REAL) + P_SPPTYPE(pp) = TY_REAL + else + P_SPPTYPE(pp) = TY_DOUBLE + P_LEN(pp) = 1 + case 'C': + P_SPPTYPE(pp) = TY_CHAR + # calculate length directly from PSIZE to avoid truncation error + P_LEN(pp) = min (SZ_LINE, P_PSIZE(pp) / NBITS_BYTE) + case 'L': + P_SPPTYPE(pp) = TY_BOOL + P_LEN(pp) = 1 + default: + call error (1, badtype) + } + + # Extract the binary parameter value and add a FITS encoded card + # to the IMIO user area. In the case of a new copy image, the + # GPB values will already be in the image header, do not modify + # the parameter value, but add the parameter if it was not + # inherited from the old image. + + if (acmode != NEW_COPY || imaccf (im, P_PTYPE(pp)) == NO) { + switch (P_SPPTYPE(pp)) { + case TY_BOOL: + if (SZ_INT != SZ_INT32) + call amovc (Memc[gpb+offset], bval, SZ_INT32) + else + call amovc (Memc[gpb+offset], bval, SZ_BOOL) + call imaddb (im, P_PTYPE(pp), bval) + case TY_SHORT: + call amovc (Memc[gpb+offset], sval, SZ_SHORT) + call imadds (im, P_PTYPE(pp), sval) + case TY_LONG: + if (SZ_INT != SZ_INT32) + call amovc (Memc[gpb+offset], lval, SZ_INT32) + else + call amovc (Memc[gpb+offset], lval, SZ_LONG) + call imaddl (im, P_PTYPE(pp), lval) + case TY_REAL: + call amovc (Memc[gpb+offset], rval, SZ_REAL) + call imaddr (im, P_PTYPE(pp), rval) + case TY_DOUBLE: + call amovc (Memc[gpb+offset], dval, SZ_DOUBLE) + call imaddd (im, P_PTYPE(pp), dval) + case TY_CHAR: + call chrupk (Memc[gpb+offset], 1, Memc[lbuf], 1, P_LEN(pp)) + Memc[lbuf+P_LEN(pp)] = EOS + call imastr (im, P_PTYPE(pp), Memc[lbuf]) + default: + call error (1, badtype) + } + } + + offset = offset + sz_param + } + +minmax_ + # Return DATAMIN, DATAMAX. This is done by searching the user area so + # that ordinary keywords may be used to set datamin and datamax if the + # GPB is not used. + + datamin = 0.0; datamax = 0.0 + if (imaccf (im, "DATAMIN") == YES) + datamin = imgetr (im, "DATAMIN") + if (imaccf (im, "DATAMAX") == YES) + datamax = imgetr (im, "DATAMAX") + + call sfree (sp) +end |