diff options
Diffstat (limited to 'sys/imio/iki/qpf')
| -rw-r--r-- | sys/imio/iki/qpf/README | 2 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/mkpkg | 22 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpf.h | 20 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfaccess.x | 44 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfclose.x | 29 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfcopy.x | 39 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfcopypar.x | 117 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfdelete.x | 29 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfopen.x | 165 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfopix.x | 55 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfrename.x | 37 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfupdhdr.x | 13 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfwattr.x | 191 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/qpfwfilter.x | 53 | ||||
| -rw-r--r-- | sys/imio/iki/qpf/zfioqp.x | 189 |
15 files changed, 1005 insertions, 0 deletions
diff --git a/sys/imio/iki/qpf/README b/sys/imio/iki/qpf/README new file mode 100644 index 00000000..cea44538 --- /dev/null +++ b/sys/imio/iki/qpf/README @@ -0,0 +1,2 @@ +IKI/QPF -- IKI kernel for the QPOE (position ordered event file) image format. +See the QPOE source directories for additional information on QPOE. diff --git a/sys/imio/iki/qpf/mkpkg b/sys/imio/iki/qpf/mkpkg new file mode 100644 index 00000000..eb3e8efd --- /dev/null +++ b/sys/imio/iki/qpf/mkpkg @@ -0,0 +1,22 @@ +# Make the IKI/QPF interface (photon image kernel). + +$checkout libex.a lib$ +$update libex.a +$checkin libex.a lib$ +$exit + +libex.a: + qpfaccess.x qpf.h + qpfclose.x qpf.h <imhdr.h> <imio.h> + qpfcopy.x qpf.h <error.h> + qpfcopypar.x qpf.h <error.h> <imhdr.h> <imio.h> <qpset.h> + qpfdelete.x <error.h> + qpfopen.x qpf.h <error.h> <imhdr.h> <imio.h> <mach.h>\ + <qpioset.h> <qpset.h> + qpfopix.x qpf.h <imhdr.h> <imio.h> + qpfrename.x qpf.h <error.h> + qpfupdhdr.x + qpfwattr.x qpf.h <ctype.h> <qpioset.h> + qpfwfilter.x qpf.h + zfioqp.x qpf.h <fio.h> <imhdr.h> <imio.h> <mach.h> <qpioset.h> + ; diff --git a/sys/imio/iki/qpf/qpf.h b/sys/imio/iki/qpf/qpf.h new file mode 100644 index 00000000..37e29cee --- /dev/null +++ b/sys/imio/iki/qpf/qpf.h @@ -0,0 +1,20 @@ +# QPF.H -- IKI/QPF internal definitions. + +define QPF_EXTN "qp" # image header filename extension +define MAX_LENEXTN 3 # max length imagefile extension +define SZ_KWNAME 8 # size of a FITS keyword name +define SZ_BIGSTR 64 # max length string per FITS card +define SZ_MAXFILTER 4096 # max size QPIO filter (for log only) + +define LEN_QPFDES 10 +define QPF_IM Memi[$1] # backpointer to image descriptor +define QPF_QP Memi[$1+1] # QPOE datafile descriptor +define QPF_IO Memi[$1+2] # QPIO descriptor +define QPF_XBLOCK Memr[P2R($1+3)] # X block factor for sampling +define QPF_YBLOCK Memr[P2R($1+4)] # Y block factor for sampling +define QPF_VS Memi[$1+5+$2-1] # start vector of active rect +define QPF_VE Memi[$1+7+$2-1] # end vector of active rect +define QPF_IOSTAT Memi[$1+9] # i/o status (byte count) + +# QPOE parameters to be omitted from the IMIO header user parameter list. +define OMIT "|naxes|axlen|datamin|datamax|cretime|modtime|limtime|" diff --git a/sys/imio/iki/qpf/qpfaccess.x b/sys/imio/iki/qpf/qpfaccess.x new file mode 100644 index 00000000..52d0b06f --- /dev/null +++ b/sys/imio/iki/qpf/qpfaccess.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "qpf.h" + +# QPF_ACCESS -- Test the accessibility or existence of an existing image, +# or the legality of the name of a new image. + +procedure qpf_access (kernel, root, extn, acmode, status) + +int kernel #I IKI kernel +char root[ARB] #I root filename +char extn[ARB] #U extension (SET on output if none specified) +int acmode #I access mode (0 to test only existence) +int status #O ok or err + +pointer sp, fname +int btoi(), qp_access(), iki_validextn() +string qpf_extn QPF_EXTN + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + + # If new image, test only the legality of the given extension. + # This is used to select a kernel given the imagefile extension. + + status = NO + if (extn[1] != EOS) + status = btoi (iki_validextn (kernel, extn) > 0) + + if (acmode != NEW_IMAGE && acmode != NEW_COPY) { + if (extn[1] == EOS) { + call iki_mkfname (root, qpf_extn, Memc[fname], SZ_PATHNAME) + status = qp_access (Memc[fname], acmode) + if (status != NO) + call strcpy (qpf_extn, extn, MAX_LENEXTN) + } else if (status != NO) { + call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME) + status = qp_access (Memc[fname], acmode) + } + } + + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/qpfclose.x b/sys/imio/iki/qpf/qpfclose.x new file mode 100644 index 00000000..b4bad7b4 --- /dev/null +++ b/sys/imio/iki/qpf/qpfclose.x @@ -0,0 +1,29 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imio.h> +include "qpf.h" + +# QPF_CLOSE -- Close a QPOE image. + +procedure qpf_close (im, status) + +pointer im #I image descriptor +int status #O output status + +pointer qpf + +begin + # Close the QPF virtual file driver. + if (IM_PFD(im) != NULL) + call close (IM_PFD(im)) + + # Close the various descriptors. + qpf = IM_KDES(im) + if (QPF_IO(qpf) != NULL) + call qpio_close (QPF_IO(qpf)) + if (QPF_QP(qpf) != NULL) + call qp_close (QPF_QP(qpf)) + + call mfree (qpf, TY_STRUCT) +end diff --git a/sys/imio/iki/qpf/qpfcopy.x b/sys/imio/iki/qpf/qpfcopy.x new file mode 100644 index 00000000..ebc2fa5b --- /dev/null +++ b/sys/imio/iki/qpf/qpfcopy.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include "qpf.h" + +# QPF_COPY -- Copy an image. A special operator is provided for fast, blind +# copies of entire images. + +procedure qpf_copy (kernel, old_root, old_extn, new_root, new_extn, status) + +int kernel #I IKI kernel +char old_root[ARB] #I old image root name +char old_extn[ARB] #I old image extn +char new_root[ARB] #I new image root name +char new_extn[ARB] #I new extn +int status #O output status + +pointer sp +pointer oldname, newname +errchk qp_copy + +begin + call smark (sp) + call salloc (oldname, SZ_PATHNAME, TY_CHAR) + call salloc (newname, SZ_PATHNAME, TY_CHAR) + + # Get filename of old and new images. + call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME) + call iki_mkfname (new_root, QPF_EXTN, Memc[newname], SZ_PATHNAME) + + # Copy the datafile. + iferr (call qp_copy (Memc[oldname], Memc[newname])) { + call erract (EA_WARN) + status = ERR + } else + status = OK + + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/qpfcopypar.x b/sys/imio/iki/qpf/qpfcopypar.x new file mode 100644 index 00000000..cfa94c62 --- /dev/null +++ b/sys/imio/iki/qpf/qpfcopypar.x @@ -0,0 +1,117 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <imio.h> +include <qpset.h> +include "qpf.h" + +# QPF_COPYPARAMS -- Copy parameters from the QPOE datafile header into the +# image header. Only scalar parameters are copied. + +procedure qpf_copyparams (im, qp) + +pointer im #I image descriptor +pointer qp #I QPOE descriptor + +int nelem, dtype, maxelem, flags +pointer sp, param, text, comment, datatype, fl, qpf, mw, io + +pointer qp_ofnlu(), qpio_loadwcs() +int qp_gnfn(), qp_queryf(), stridx(), strdic() +errchk qp_ofnlu, qp_gnfn, qp_queryf, imaddi, qp_geti, mw_saveim + +bool qp_getb() +short qp_gets() +int qp_geti(), qp_gstr() +real qp_getr() +double qp_getd() + +begin + call smark (sp) + call salloc (text, SZ_LINE, TY_CHAR) + call salloc (param, SZ_FNAME, TY_CHAR) + call salloc (comment, SZ_COMMENT, TY_CHAR) + call salloc (datatype, SZ_DATATYPE, TY_CHAR) + + qpf = IM_KDES(im) + + # Copy QPOE special keywords. + call imaddi (im, "NAXES", qp_geti(qp,"naxes")) + call imaddi (im, "AXLEN1", qp_geti(qp,"axlen[1]")) + call imaddi (im, "AXLEN2", qp_geti(qp,"axlen[2]")) + call imaddr (im, "XBLOCK", QPF_XBLOCK(qpf)) + call imaddr (im, "YBLOCK", QPF_YBLOCK(qpf)) + + # Output the QPOE filter. + iferr (call qpf_wfilter (qpf, im)) + call erract (EA_WARN) + + # Compute and output any filter attributes. + iferr (call qpf_wattr (qpf, im)) + call erract (EA_WARN) + + # Copy the WCS, if any. + io = QPF_IO(qpf) + if (io != NULL) + ifnoerr (mw = qpio_loadwcs (io)) { + call mw_saveim (mw, im) + call mw_close (mw) + } + + # Copy general keywords. + fl = qp_ofnlu (qp, "*") + + while (qp_gnfn (fl, Memc[param], SZ_FNAME) != EOF) { + # Get the next scalar parameter which has a nonnull value. + nelem = qp_queryf (qp, Memc[param], Memc[datatype], maxelem, + Memc[comment], flags) + if (strdic (Memc[param], Memc[text], SZ_LINE, OMIT) > 0) + next + + dtype = stridx (Memc[datatype], "bcsilrdx") + + # Make entry for a parameter which has no value, or an unprintable + # value. + + if (nelem == 0 || (nelem > 1 && dtype != TY_CHAR) || + dtype < TY_BOOL || dtype > TY_COMPLEX) { + + call sprintf (Memc[text], SZ_LINE, "%14s[%03d] %s") + call pargstr (Memc[datatype]) + call pargi (nelem) + call pargstr (Memc[comment]) + + iferr (call imastr (im, Memc[param], Memc[text])) + call erract (EA_WARN) + next + } + + # Copy parameter to image header. + iferr { + switch (dtype) { + case TY_BOOL: + call imaddb (im, Memc[param], qp_getb(qp,Memc[param])) + case TY_CHAR: + if (qp_gstr (qp, Memc[param], Memc[text], SZ_LINE) > 0) + call imastr (im, Memc[param], Memc[text]) + case TY_SHORT: + call imadds (im, Memc[param], qp_gets(qp,Memc[param])) + case TY_INT, TY_LONG: + call imaddi (im, Memc[param], qp_geti(qp,Memc[param])) + case TY_REAL: + call imaddr (im, Memc[param], qp_getr(qp,Memc[param])) + case TY_DOUBLE: + call imaddd (im, Memc[param], qp_getd(qp,Memc[param])) + case TY_COMPLEX: + ; # not supported. + } + } then { + call erract (EA_WARN) + break + } + } + + call qp_cfnl (fl) + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/qpfdelete.x b/sys/imio/iki/qpf/qpfdelete.x new file mode 100644 index 00000000..c503c174 --- /dev/null +++ b/sys/imio/iki/qpf/qpfdelete.x @@ -0,0 +1,29 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> + +# QPF_DELETE -- Delete a datafile. + +procedure qpf_delete (kernel, root, extn, status) + +int kernel #I IKI kernel +char root[ARB] #I root filename +char extn[ARB] #I extension +int status #O output status + +pointer sp, fname +errchk qp_delete + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + + call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME) + iferr (call qp_delete (Memc[fname])) { + call erract (EA_WARN) + status = ERR + } else + status = OK + + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/qpfopen.x b/sys/imio/iki/qpf/qpfopen.x new file mode 100644 index 00000000..99a57df1 --- /dev/null +++ b/sys/imio/iki/qpf/qpfopen.x @@ -0,0 +1,165 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <mach.h> +include <imhdr.h> +include <imio.h> +include <qpset.h> +include <qpioset.h> +include "qpf.h" + +# QPF_OPEN -- Open a QPOE image. New QPOE images can only be written by +# calling QPOE directly; under IMIO, only READ_ONLY access is supported. + +procedure qpf_open (kernel, im, o_im, + root, extn, ksection, cl_index, cl_size, acmode, status) + +int kernel #I IKI kernel +pointer im #I image descriptor +pointer o_im #I [not used] +char root[ARB] #I root image name +char extn[ARB] #I filename extension +char ksection[ARB] #I QPIO filter expression +int cl_index #I [not used] +int cl_size #I [not used] +int acmode #I [not used] +int status #O ok|err + +int n +real xblock, yblock, tol +pointer sp, qp, io, v, fname, qpf + +pointer qp_open, qpio_open() +real qpio_statr(), qp_statr() +int qpio_getrange(), qp_geti(), qp_gstr(), qp_lenf() +define err_ 91 + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (v, SZ_FNAME, TY_CHAR) + + io = NULL + qp = NULL + qpf = NULL + tol = EPSILONR * 100 + + # The only valid cl_index for a QPOE image is -1 (none specified) or 1. + if (!(cl_index < 0 || cl_index == 1)) + goto err_ + + call malloc (qpf, LEN_QPFDES, TY_STRUCT) + + # Open the QPOE file. + call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME) + iferr (qp = qp_open (Memc[fname], READ_ONLY, 0)) { + qp = NULL + goto err_ + } + + # Open the event list under QPIO for sampled (pixel) i/o. + iferr (io = qpio_open (qp, ksection, READ_ONLY)) + io = NULL + + # Determine the data range and pixel type. + iferr (IM_CTIME(im) = qp_geti (qp, "cretime")) + IM_CTIME(im) = 0 + iferr (IM_MTIME(im) = qp_geti (qp, "modtime")) + IM_MTIME(im) = 0 + iferr (IM_LIMTIME(im) = qp_geti (qp, "limtime")) + IM_LIMTIME(im) = 0 + + # The min and max pixel values for a sampled event file depend + # strongly on the blocking factor, which is a runtime variable. + # Ideally when the poefile is written the vectors 'datamin' and + # 'datamax' should be computed for the main event list. These + # give the min and max pixel values (counts/pixel) for each blocking + # factor from 1 to len(data[min|max]), i.e., the blocking factor + # serves as the index into these vectors. + + if (io != NULL) { + xblock = max (1.0, qpio_statr (io, QPIO_XBLOCKFACTOR)) + yblock = max (1.0, qpio_statr (io, QPIO_YBLOCKFACTOR)) + } else { + xblock = max (1.0, qp_statr (qp, QPOE_XBLOCKFACTOR)) + yblock = max (1.0, qp_statr (qp, QPOE_YBLOCKFACTOR)) + } + call strcpy ("datamax", Memc[v], SZ_FNAME) + n = qp_lenf (qp, Memc[v]) + + if (n >= max(xblock,yblock)) { + call sprintf (Memc[v+7], SZ_FNAME-7, "[%d]") + call pargi (nint((xblock+yblock)/2)) + IM_MAX(im) = qp_geti (qp, Memc[v]) + Memc[v+5] = 'i'; Memc[v+6] = 'n' + IM_MIN(im) = qp_geti (qp, Memc[v]) + } else + IM_LIMTIME(im) = 0 + + # Set the image pixel type. This is arbitrary, provided we have + # enough dynamic range to represent the maximum pixel value. + + IM_PIXTYPE(im) = TY_INT + if (IM_LIMTIME(im) != 0 && IM_LIMTIME(im) >= IM_MTIME(im)) + if (int(IM_MAX(im)) <= MAX_SHORT) + IM_PIXTYPE(im) = TY_SHORT + + # Set the image size parameters. If the user has specified a rect + # within which i/o is to occur, set the logical image size to the + # size of the rect rather than the full matrix. + + if (io != NULL) { + IM_NDIM(im) = qpio_getrange (io, QPF_VS(qpf,1), QPF_VE(qpf,1), 2) + IM_LEN(im,1) = (QPF_VE(qpf,1) - QPF_VS(qpf,1) + 1) / xblock + tol + IM_LEN(im,2) = (QPF_VE(qpf,2) - QPF_VS(qpf,2) + 1) / yblock + tol + } else { + IM_NDIM(im) = 2 + IM_LEN(im,1) = qp_geti (qp, "axlen[1]") / xblock + tol + IM_LEN(im,2) = qp_geti (qp, "axlen[2]") / yblock + tol + QPF_VS(qpf,1) = 1; QPF_VE(qpf,1) = IM_LEN(im,1) + QPF_VS(qpf,2) = 1; QPF_VE(qpf,2) = IM_LEN(im,2) + } + call imioff (im, 1, YES, 1) + + iferr (n = qp_gstr (qp, "title", IM_TITLE(im), SZ_IMTITLE)) + IM_TITLE(im) = EOS + iferr (n = qp_gstr (qp, "history", IM_HISTORY(im), SZ_IMHIST)) + IM_HISTORY(im) = EOS + + call strcpy (root, IM_HDRFILE(im), SZ_IMHDRFILE) + IM_PIXFILE(im) = EOS + IM_HFD(im) = NULL + IM_PFD(im) = NULL + + # Set up the QPF descriptor. + QPF_IM(qpf) = im + QPF_QP(qpf) = qp + QPF_IO(qpf) = io + QPF_XBLOCK(qpf) = xblock + QPF_YBLOCK(qpf) = yblock + QPF_IOSTAT(qpf) = 0 + + IM_KDES(im) = qpf + + # Copy any scalar QPOE file header parameters into the IMIO header. + iferr (call qpf_copyparams (im, qp)) + call erract (EA_WARN) + + status = OK + call sfree (sp) + return + +err_ + # Error abort. + if (io != NULL) + call qpio_close (io) + if (qp != NULL) + call qp_close (qp) + + call mfree (qpf, TY_STRUCT) + IM_KDES(im) = NULL + + status = ERR + call erract (EA_WARN) + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/qpfopix.x b/sys/imio/iki/qpf/qpfopix.x new file mode 100644 index 00000000..9b5750ff --- /dev/null +++ b/sys/imio/iki/qpf/qpfopix.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imio.h> +include "qpf.h" + +# QPF_OPIX -- Open the "pixel storage file", i.e., open the special QPF/QPOE +# virtual file driver, which samples the QPOE event list in real time to +# produce image "pixels", where each pixel contains a count of the number of +# photons mapping to that point in the output image matrix. + +procedure qpf_opix (im, status) + +pointer im #I image descriptor +int status #O return status + +pointer sp, fname, qpf +extern qpfzop(), qpfzrd(), qpfzwr(), qpfzwt(), qpfzst(), qpfzcl() +int fopnbf() + +begin + status = OK + if (IM_PFD(im) != NULL) + return + + # Verify that the QPIO open succeeded at open time; if not, the file + # may not have an event list (which is legal, but not for pixel i/o). + + qpf = IM_KDES(im) + if (QPF_IO(qpf) == NULL) { + status = ERR + return + } + + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + # Encode the QPF descriptor as a pseudo-filename to pass the descriptor + # through fopnbf to the QPF virtual binary file driver. + + call sprintf (Memc[fname], SZ_FNAME, "QPF%d") + call pargi (IM_KDES(im)) + + # Open a file descriptor for the dummy QPOE file driver, used to access + # the event list as a virtual pixel array (sampled at runtime). + + iferr (IM_PFD(im) = fopnbf (Memc[fname], READ_ONLY, + qpfzop, qpfzrd, qpfzwr, qpfzwt, qpfzst, qpfzcl)) { + + IM_PFD(im) = NULL + status = ERR + } + + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/qpfrename.x b/sys/imio/iki/qpf/qpfrename.x new file mode 100644 index 00000000..70f90626 --- /dev/null +++ b/sys/imio/iki/qpf/qpfrename.x @@ -0,0 +1,37 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include "qpf.h" + +# QPF_RENAME -- Rename a datafile. + +procedure qpf_rename (kernel, old_root, old_extn, new_root, new_extn, status) + +int kernel #I IKI kernel +char old_root[ARB] #I old image root name +char old_extn[ARB] #I old image extn +char new_root[ARB] #I new image root name +char new_extn[ARB] #I old image extn +int status #O output status + +pointer sp, oldname, newname +errchk qp_rename + +begin + call smark (sp) + call salloc (oldname, SZ_PATHNAME, TY_CHAR) + call salloc (newname, SZ_PATHNAME, TY_CHAR) + + # Get filenames of old and new datafiles. + call iki_mkfname (old_root, old_extn, Memc[oldname], SZ_PATHNAME) + call iki_mkfname (new_root, QPF_EXTN, Memc[newname], SZ_PATHNAME) + + # Rename the datafile. + iferr (call qp_rename (Memc[oldname], Memc[newname])) { + call erract (EA_WARN) + status = ERR + } else + status = OK + + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/qpfupdhdr.x b/sys/imio/iki/qpf/qpfupdhdr.x new file mode 100644 index 00000000..9dd67ea6 --- /dev/null +++ b/sys/imio/iki/qpf/qpfupdhdr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# QPF_UPDHDR -- Update the image header. This is a no-op for QPF since the +# datafiles can only be accessed READ_ONLY via IMIO. + +procedure qpf_updhdr (im, status) + +pointer im #I image descriptor +int status #O output status + +begin + status = OK +end diff --git a/sys/imio/iki/qpf/qpfwattr.x b/sys/imio/iki/qpf/qpfwattr.x new file mode 100644 index 00000000..b48a6793 --- /dev/null +++ b/sys/imio/iki/qpf/qpfwattr.x @@ -0,0 +1,191 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <qpioset.h> +include "qpf.h" + +# QPF_WATTR -- Record information about the attributes of the filter +# expression used to generate an image. Currently the only value which can be +# computed and recorded is total range (integral of the in-range intervals) of +# the range list defining an attribute, for example, the total exposure time +# defined by the time range list used to filter the data. +# +# This routine is driven by a set of optional QPOE header keywords of the +# form +# +# Keyword String Value +# +# defattrN <param-name> = "integral" <attribute-name>[:type] +# e.g. +# defattr1 "exptime = integral time:d" +# +# where param-name is the parameter name to be written to the output image +# header, "integral" is the value to be computed, and attribute-name is the +# QPEX attribute (e.g., "time") to be used for the computation. A finite +# value is returned for the integral if a range list is given for the named +# attribute and the range is closed. If the range is open on either or both +# ends, or no range expression is defined for the attribute, then INDEF is +# returned for the value of the integral. + +procedure qpf_wattr (qpf, im) + +pointer qpf #I QPF descriptor +pointer im #I image descriptor + +real r1, r2, rsum +double d1, d2, dsum +int dtype, i, j, xlen, nranges, i1, i2, isum +pointer sp, io, qp, ex, kwname, kwval, pname, funame, atname, ip, xs, xe + +bool strne() +pointer qpio_stati() +int qp_gstr(), ctowrd(), qp_accessf() +int qpex_attrli(), qpex_attrlr(), qpex_attrld() +errchk qpex_attrli, qpex_attrlr, qpex_attrld, imaddi, imaddr, imaddd + +begin + io = QPF_IO(qpf) + if (io == NULL) + return + + qp = QPF_QP(qpf) + ex = qpio_stati (io, QPIO_EX) + + call smark (sp) + call salloc (kwname, SZ_FNAME, TY_CHAR) + call salloc (kwval, SZ_LINE, TY_CHAR) + call salloc (pname, SZ_FNAME, TY_CHAR) + call salloc (funame, SZ_FNAME, TY_CHAR) + call salloc (atname, SZ_FNAME, TY_CHAR) + + # Process a sequence of "defattrN" header parameter definitions. + # Each defines a parameter to be computed and added to the output + # image header. + + do i = 1, ARB { + # Check for a parameter named "defattrN", get string value. + call sprintf (Memc[kwname], SZ_FNAME, "defattr%d") + call pargi (i) + + if (qp_accessf (qp, Memc[kwname]) == NO) + break + if (qp_gstr (qp, Memc[kwname], Memc[kwval], SZ_LINE) <= 0) + break + + # Parse string value into parameter name, function name, + # expression attribute name, and datatype. + + ip = kwval + if (ctowrd (Memc, ip, Memc[pname], SZ_FNAME) <= 0) + break + while (IS_WHITE(Memc[ip]) || Memc[ip] == '=') + ip = ip + 1 + if (ctowrd (Memc, ip, Memc[funame], SZ_FNAME) <= 0) + break + if (ctowrd (Memc, ip, Memc[atname], SZ_FNAME) <= 0) + break + + dtype = TY_INT + for (ip=atname; Memc[ip] != EOS; ip=ip+1) + if (Memc[ip] == ':') { + Memc[ip] = EOS + if (Memc[ip+1] == 'd') + dtype = TY_DOUBLE + else if (Memc[ip+1] == 'r') + dtype = TY_REAL + else + call eprintf ("QPF.defattr: datatype not recognized\n") + } + + # Verify known function type. + if (strne (Memc[funame], "integral")) { + call eprintf ("QPF.defattr: function `%s' not recognized\n") + call pargstr (Memc[funame]) + break + } + + # Compute the integral of the range list for the named attribute. + xlen = 0 + xs = NULL + xe = NULL + + switch (dtype) { + case TY_REAL: + if (ex == NULL) + nranges = 0 + else + nranges = qpex_attrlr (ex, Memc[atname], xs, xe, xlen) + + if (nranges <= 0) + rsum = INDEFR + else { + rsum = 0 + do j = 1, nranges { + r1 = Memr[xs+j-1] + r2 = Memr[xe+j-1] + if (IS_INDEFR(r1) || IS_INDEFR(r2)) { + rsum = INDEFR + break + } else + rsum = rsum + (r2 - r1) + } + } + + call mfree (xs, TY_REAL) + call mfree (xe, TY_REAL) + call imaddr (im, Memc[pname], rsum) + + case TY_DOUBLE: + if (ex == NULL) + nranges = 0 + else + nranges = qpex_attrld (ex, Memc[atname], xs, xe, xlen) + + if (nranges <= 0) + dsum = INDEFD + else { + dsum = 0 + do j = 1, nranges { + d1 = Memd[xs+j-1] + d2 = Memd[xe+j-1] + if (IS_INDEFD(d1) || IS_INDEFD(d2)) { + dsum = INDEFD + break + } else + dsum = dsum + (d2 - d1) + } + } + + call mfree (xs, TY_DOUBLE) + call mfree (xe, TY_DOUBLE) + call imaddd (im, Memc[pname], dsum) + + default: + if (ex == NULL) + nranges = 0 + else + nranges = qpex_attrli (ex, Memc[atname], xs, xe, xlen) + + if (nranges <= 0) + isum = INDEFI + else { + isum = 0 + do j = 1, nranges { + i1 = Memi[xs+j-1] + i2 = Memi[xe+j-1] + if (IS_INDEFI(i1) || IS_INDEFI(i2)) { + isum = INDEFI + break + } else + isum = isum + (i2 - i1) + } + } + + call mfree (xs, TY_INT) + call mfree (xe, TY_INT) + call imaddi (im, Memc[pname], isum) + } + } + + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/qpfwfilter.x b/sys/imio/iki/qpf/qpfwfilter.x new file mode 100644 index 00000000..e521cbc6 --- /dev/null +++ b/sys/imio/iki/qpf/qpfwfilter.x @@ -0,0 +1,53 @@ +include "qpf.h" + +# QPF_WFILTER -- Record the QPIO filter used to generate an image as a series +# of FITS cards in the image header. Note: excessively long filters are +# truncated to avoid overfilling the image header. + +procedure qpf_wfilter (qpf, im) + +pointer qpf #I QPF descriptor +pointer im #I image descriptor + +int nchars, nleft, index +pointer io, sp, bp, ip, kw, strval +errchk qpio_getfilter, impstr +int qpio_getfilter() + +begin + io = QPF_IO(qpf) + if (io == NULL) + return + + call smark (sp) + call salloc (kw, SZ_KWNAME, TY_CHAR) + call salloc (bp, SZ_MAXFILTER, TY_CHAR) + call salloc (strval, SZ_BIGSTR, TY_CHAR) + + # Get the filter as as string from QPIO. + nchars = qpio_getfilter (io, Memc[bp], SZ_MAXFILTER) + + # If the filter is longer than our string buffer, write a "..." at + # the end of the filter to indicate that it is being truncated. + + if (nchars == SZ_MAXFILTER) + call strcpy ("...", Memc[bp+nchars-3], 3) + + index = 1 + ip = bp + + # Output a series of QPFILTnn cards to record the full filter. + for (nleft = nchars; nleft > 0; nleft = nleft - SZ_BIGSTR) { + call strcpy (Memc[ip], Memc[strval], SZ_BIGSTR) + call sprintf (Memc[kw], SZ_KWNAME, "QPFILT%02d") + call pargi (index) + iferr (call imaddf (im, Memc[kw], "c")) + ; + call impstr (im, Memc[kw], Memc[strval]) + + ip = ip + SZ_BIGSTR + index = index + 1 + } + + call sfree (sp) +end diff --git a/sys/imio/iki/qpf/zfioqp.x b/sys/imio/iki/qpf/zfioqp.x new file mode 100644 index 00000000..0e1c38ff --- /dev/null +++ b/sys/imio/iki/qpf/zfioqp.x @@ -0,0 +1,189 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imhdr.h> +include <imio.h> +include <fio.h> +include <qpioset.h> +include "qpf.h" + +# ZFIOQP -- QPF virtual file driver. This driver presents to the caller a +# virtual file space containing a two dimensional array of type short or int +# pixels, wherein each "pixel" is a count of the number of events from a +# QPOE event list which map into that pixel. An i/o request results in +# runtime filtering and sampling of the event list, mapping each event which +# passes the filter into the corresponding output pixel, and incrementing the +# value of that pixel to count the event. + +# QPFZOP -- Open the file driver for i/o on the QPIO descriptor opened at +# qpf_open time. + +procedure qpfzop (pkfn, mode, status) + +char pkfn[ARB] #I packed virtual filename from FIO +int mode #I file access mode (ignored) +int status #O output status - i/o channel if successful + +int ip +pointer sp, fn, qpf +int ctoi() + +begin + call smark (sp) + call salloc (fn, SZ_FNAME, TY_CHAR) + + # The QPF descriptor is passed encoded in the pseudo filename as + # "QPFxxxx" (decimal). Extract this and return it as the i/o + # channel for the driver. + + ip = 4 + call strupk (pkfn, Memc[fn], SZ_FNAME) + if (ctoi (Memc[fn], ip, qpf) <= 0) + status = ERR + else + status = qpf + + QPF_IOSTAT(qpf) = 0 + call sfree (sp) +end + + +# QPFZCL -- Close the QPF binary file driver. + +procedure qpfzcl (chan, status) + +int chan #I QPF i/o channel +int status #O output status + +begin + status = OK +end + + +# QPFZRD -- Read a segment of the virtual pixel array into the output buffer, +# i.e., zero the output buffer and sample the event list, accumulating counts +# in the output array. + +procedure qpfzrd (chan, obuf, nbytes, boffset) + +int chan #I QPF i/o channel +char obuf[ARB] #O output buffer +int nbytes #I nbytes to be read +int boffset #I file offset at which read commences + +pointer qpf, im, io +int vs[2], ve[2] +real xblock, yblock +int szb_pixel, ncols, pixel, nev, xoff, yoff +int qpio_readpixs(), qpio_readpixi() + +include <szpixtype.inc> + +begin + qpf = chan + im = QPF_IM(qpf) + io = QPF_IO(qpf) + + xblock = QPF_XBLOCK(qpf) + yblock = QPF_YBLOCK(qpf) + ncols = IM_PHYSLEN(im,1) + xoff = QPF_VS(qpf,1) + yoff = QPF_VS(qpf,2) + szb_pixel = pix_size[IM_PIXTYPE(im)] * SZB_CHAR + + # Convert boffset, nbytes to vs, ve. + pixel = (boffset - 1) / szb_pixel + vs[1] = (mod (pixel, ncols)) * xblock + xoff + vs[2] = (pixel / ncols) * yblock + yoff + + pixel = (boffset-1 + nbytes - szb_pixel) / szb_pixel + ve[1] = (mod (pixel, ncols)) * xblock + (xblock-1) + xoff + ve[2] = (pixel / ncols) * yblock + (yblock-1) + yoff + + # Call readpix to sample image into the output buffer. Zero the buffer + # first since the read is additive. + + call aclrc (obuf, nbytes / SZB_CHAR) + iferr { + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + nev = qpio_readpixs (io, obuf, vs, ve, 2, xblock, yblock) + case TY_INT: + nev = qpio_readpixi (io, obuf, vs, ve, 2, xblock, yblock) + } + } then { + QPF_IOSTAT(qpf) = ERR + } else + QPF_IOSTAT(qpf) = nbytes +end + + +# QPFZWR -- Write to the virtual pixel array. QPF permits only read-only +# access, but we ignore write requests, so return OK and do nothing if this +# routine is called. + +procedure qpfzwr (chan, ibuf, nbytes, boffset) + +int chan #I QPF i/o channel +char ibuf[ARB] #O datg buffer +int nbytes #I nbytes to be written +int boffset #I file offset to write at + +pointer qpf + +begin + qpf = chan + QPF_IOSTAT(qpf) = nbytes +end + + +# QPFZWT -- Return the number of virtual bytes transferred in the last i/o +# request. + +procedure qpfzwt (chan, status) + +int chan #I QPF i/o channel +int status #O i/o channel status + +pointer qpf + +begin + qpf = chan + status = QPF_IOSTAT(qpf) +end + + +# QPFZST -- Query device/file parameters. + +procedure qpfzst (chan, param, value) + +int chan #I QPF i/o channel +int param #I parameter to be returned +int value #O parameter value + +pointer qpf, im, io +int szb_pixel, npix +int qpio_stati() + +include <szpixtype.inc> + +begin + qpf = chan + im = QPF_IM(qpf) + io = QPF_IO(qpf) + npix = IM_PHYSLEN(im,1) * IM_PHYSLEN(im,2) + szb_pixel = pix_size[IM_PIXTYPE(im)] * SZB_CHAR + + switch (param) { + case FSTT_BLKSIZE: + value = 1 + case FSTT_FILSIZE: + value = npix * szb_pixel + case FSTT_OPTBUFSIZE: + value = min (npix*szb_pixel, qpio_stati(io,QPIO_OPTBUFSIZE)) + case FSTT_MAXBUFSIZE: + value = npix * szb_pixel + default: + value = ERR + } +end |