aboutsummaryrefslogtreecommitdiff
path: root/sys/imio/iki/fxf/fxfopix.x
diff options
context:
space:
mode:
Diffstat (limited to 'sys/imio/iki/fxf/fxfopix.x')
-rw-r--r--sys/imio/iki/fxf/fxfopix.x746
1 files changed, 746 insertions, 0 deletions
diff --git a/sys/imio/iki/fxf/fxfopix.x b/sys/imio/iki/fxf/fxfopix.x
new file mode 100644
index 00000000..0401601b
--- /dev/null
+++ b/sys/imio/iki/fxf/fxfopix.x
@@ -0,0 +1,746 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include <error.h>
+include <imhdr.h>
+include <imio.h>
+include <mach.h>
+include "fxf.h"
+include <fset.h>
+
+define MIN_BUFSIZE 512
+
+
+# FXF_OPIX -- Open (or create) the pixel storage file.
+
+procedure fxf_opix (im, status)
+
+pointer im #I image descriptor
+int status #O return status
+
+pointer sp, fn, fit
+char pathname[SZ_PATHNAME]
+int compress, blklen, pixoff, filesize
+int i, hdr_size, sz_pixfile, sz_fitfile, junk, npix
+extern fxfzop(), fxfzrd(), fxfzwr(), fxfzwt(), fxfzst(), fxfzcl()
+int strncmp(), fxf_header_size(), fxf_totpix()
+int strlen(), fopnbf(), fstatl(), itoc()
+
+include <szpixtype.inc>
+
+define err_ 91
+define endowr_ 92
+
+begin
+ call smark (sp)
+ call salloc (fn, SZ_PATHNAME, TY_CHAR)
+
+ status = OK
+ fit = IM_KDES(im)
+
+ compress = YES
+ blklen = 1
+ pixoff = 1
+
+ # Tell IMIO where the pixels are. Append the 'fit' mem descriptor
+ # to filename so that low level zfiofit routines can use it.
+
+ call strcpy (IM_HDRFILE(im), Memc[fn], SZ_PATHNAME)
+ call strcat ("_", Memc[fn], SZ_PATHNAME)
+ i = strlen (Memc[fn])
+ junk = itoc (fit, Memc[fn+i], SZ_PATHNAME)
+ iferr (call fpathname (Memc[fn], pathname, SZ_PATHNAME))
+ goto err_
+
+ if (FKS_OVERWRITE(fit) == YES) {
+ call fxf_overwrite_unit (fit, im)
+ goto endowr_
+ }
+
+ switch (IM_ACMODE(im)) {
+ case READ_ONLY, READ_WRITE, WRITE_ONLY:
+ # Turn on IEEE mapping on input only.
+ call ieegnanr (FIT_SVNANR(fit))
+ call ieegmapr (FIT_SVMAPRIN(fit), FIT_SVMAPROUT(fit))
+ call ieegnand (FIT_SVNAND(fit))
+ call ieegmapd (FIT_SVMAPDIN(fit), FIT_SVMAPDOUT(fit))
+ call ieesnanr (0.0)
+ call ieemapr (YES, NO)
+ call ieesnand (0.0D0)
+ call ieemapd (YES, NO)
+
+ # If the FIT datatype is BYTE or SHORT with scaling then
+ # convert to TY_SHORT and TY_REAL respectively before
+ # releasing the data to the upper level calls. This is
+ # because IMIO does not support BYTE datatype and the need
+ # to scale 16 bits to 32 bits.
+
+ # Do not open pixel portion if it is empty or is not
+ # an IMAGE type.
+
+ if ((strncmp (FIT_EXTTYPE(fit), "IMAGE", 5) != 0 &&
+ strncmp (FIT_EXTTYPE(fit), "SIMPLE", 6) != 0) ||
+ IM_NDIM(im) <= 0) {
+
+ goto err_
+ }
+
+ FIT_IM(fit) = im
+ iferr (IM_PFD(im) = fopnbf (pathname, IM_ACMODE(im),
+ fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+ IM_PFD(im) = NULL
+ goto err_
+ }
+
+ FIT_TOTPIX(fit) = fxf_totpix(im)
+ filesize = fstatl (IM_PFD(im), F_FILESIZE)
+ FIT_PFD(fit) = IM_PFD(im)
+
+ case NEW_COPY, NEW_IMAGE, APPEND:
+ # See if the application has set the number of dimensions.
+ call fxf_chk_ndim (im)
+ FIT_PIXTYPE(fit) = IM_PIXTYPE(im)
+ npix = fxf_totpix (im)
+ FIT_NAXIS(fit) = IM_NDIM(im)
+ call amovi (IM_LEN(im,1), FIT_LENAXIS(fit,1), IM_NDIM(im))
+
+ call fxf_discard_keyw (im)
+ FIT_TOTPIX(fit) = npix
+
+ # Do not allow BSCALE and BZERO in the UA when making a new copy or
+ # new image if bitpix is negative. Except for ushort
+
+ if (IM_PIXTYPE(im) != TY_USHORT) {
+ call fxf_filter_keyw (im, "BSCALE")
+ call fxf_filter_keyw (im, "BZERO")
+ }
+
+ # Hdr_size is in char units. (i.e. 1440 chars per FITS block).
+ hdr_size = fxf_header_size (im)
+
+ # Reset the scaling parameter because in NEW_COPY mode there
+ # should not be scaled pixels. The previous call will get these
+ # values from the input image.
+
+ FIT_BSCALE(fit) = 1.0d0
+ FIT_BZERO(fit) = 0.0d0
+
+ sz_pixfile = npix * pix_size[IM_PIXTYPE(im)]
+
+ # The pixel file needs to be a multiple of 1440 chars.
+ sz_pixfile = FITS_LEN_CHAR (sz_pixfile)
+ sz_fitfile = sz_pixfile + hdr_size
+
+ if (FIT_NEWIMAGE(fit) == YES)
+ call falloc (IM_PIXFILE(im), sz_fitfile)
+
+ FIT_IM(fit) = im
+
+ iferr (IM_PFD(im) = fopnbf (pathname, READ_WRITE,
+ fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+ IM_PFD(im) = NULL
+ call erract (EA_FATAL)
+ goto err_
+ }
+
+ FIT_PFD(fit) = IM_PFD(im)
+ filesize = fstatl (IM_PFD(im), F_FILESIZE)
+ FIT_EOFSIZE(fit) = filesize + 1
+
+ if (FIT_NEWIMAGE(fit) == NO) {
+ # Now we are appending a new IMAGE extension.
+ # Write a blank header in order to append the
+ # pixels after it.
+
+ pixoff = filesize + hdr_size + 1
+
+ # Update the offset for the blank write to follow which uses
+ # a local file driver tied to the IM_PFD descriptor and not
+ # the normal FIO.
+ FIT_PIXOFF(fit) = pixoff
+
+ # Update filesize
+ filesize = filesize + sz_fitfile
+ call fxf_write_blanks (IM_PFD(im), hdr_size)
+ } else
+ pixoff = hdr_size + 1
+
+ FIT_PIXOFF(fit) = pixoff
+ call imioff (im, pixoff, compress, blklen)
+
+ IM_HFD(im) = NULL
+
+ default:
+ call imerr (IM_NAME(im), SYS_IMACMODE)
+ }
+
+endowr_
+ FIT_PFD(fit) = IM_PFD(im)
+ FIT_HFD(fit) = IM_HFD(im)
+
+ # The following statement is to pass the datatype at the low
+ # level fits read and write routines. The datatype value can
+ # change after the image is open. Hopefully the value of 'im'
+ # will remain static.
+
+ FIT_IM(fit) = im
+ status = OK
+
+ call sfree (sp)
+ return
+err_
+ status = ERR
+ call sfree (sp)
+end
+
+
+# FXF_HEADER_SIZE -- Function to calculate the header size that would go
+# into the output file extension.
+
+int procedure fxf_header_size (im)
+
+pointer im #I Image descriptor
+
+bool inherit
+int merge, hdr_size
+pointer op, fit, sp, tb, pb
+int nheader_cards, ualen, ulines, clines
+int strlen()
+
+begin
+ fit = IM_KDES(im)
+ inherit = false
+
+ # Fks_inherit is a combined value.
+ if (FKS_INHERIT(fit) == YES)
+ inherit = true
+
+ call fxf_mandatory_cards (im, nheader_cards)
+
+ if (FIT_NEWIMAGE(fit) == NO && inherit) {
+ # See if current UA keywords are in the global header, if not
+ # there put it in a spool file. At the end, the spool file size is
+ # the output extension header size to be use in fitupdhdr.
+
+ # Check if the file is still in cache. We need CACHELEN and
+ # CACHEHDR.
+
+ call fxf_not_incache (im)
+
+ op = IM_USERAREA(im)
+ ualen = strlen (Memc[op])
+ ulines = ualen / LEN_UACARD
+ clines = FIT_CACHEHLEN(fit) / LEN_UACARD
+
+ call smark (sp)
+ call salloc (tb, ualen+1, TY_CHAR)
+
+ merge = NO
+ pb = tb
+
+ # Now select those lines from the UA (pointed by op) that are
+ # not in the cache and accumulate them in 'pb'.
+
+ call fxf_match_str (op, ulines, FIT_CACHEHDR(fit), clines,merge,pb)
+ Memc[pb+1] = EOS
+ ualen = strlen (Memc[tb])
+
+ call sfree (sp)
+
+ } else {
+ op = IM_USERAREA(im)
+ ualen = strlen (Memc[op])
+ }
+
+ ulines = ualen / LEN_UACARD + nheader_cards + FKS_PADLINES(fit)
+
+ ##### Note: PHULINES is not currently used, should be implemented
+ ##### Not clear to me if this code here is used for the PHU since
+ ##### it is in opix!
+
+ # See if the application has set a minumum number of card for the UA.
+
+ ulines = max (ulines, FKS_EHULINES(fit))
+
+ # The user area contains new_lines (81 chars, LEN_UACARD). Scale to
+ # 80 chars (LEN_CARD). Ualen is in bytes.
+
+ ualen = ulines * LEN_CARD
+
+ # Calculate the number of header FITS blocks in chars.
+ hdr_size = FITS_LEN_CHAR (ualen / 2)
+
+ return (hdr_size)
+end
+
+
+# FXF_BYTE_SHORT -- This routine is obsolete and has been deleted, but is
+# being preserved for the V2.11.2 patch so that a new shared library version
+# does not have to be created. It can be deleted in the next major release.
+
+procedure fxf_byte_short (im, fname)
+
+pointer im
+char fname[ARB]
+
+begin
+end
+
+
+# FXF_WRITE_BLANKS --Procedure to append a blank header to an existing
+# file, preparing to write data after it.
+
+procedure fxf_write_blanks (fd, size)
+
+int fd #I File descriptor
+int size #I New size (chars) to allocate.
+
+pointer sp, bf
+int nblocks,i, fits_lenc
+
+begin
+ call smark (sp)
+
+ # Length of a FITS block (2880) in chars.
+ fits_lenc = FITS_BLOCK_BYTES/SZB_CHAR
+ call salloc (bf, fits_lenc, TY_INT)
+ call amovki (0, Memi[bf], fits_lenc)
+
+ size = FITS_LEN_CHAR(size)
+ nblocks = size / fits_lenc
+
+ call seek (fd, EOF)
+ do i = 1, nblocks
+ call write (fd, Memi[bf], fits_lenc)
+
+ call sfree (sp)
+end
+
+
+# FXF_MANDATORY_CARDS -- Count the required FITS header cards.
+# The cards for the Main Unit are: SIMPLE, BITPIX, NAXIS,
+# EXTEND, ORIGIN, DATE, IRAF_TLM, OBJECT and END;
+# 'IM_NDIM(im)', DATAMIN and DATAMAX will be put out
+# only if the LIMTIME > MTIME.
+# would take care of NAXISi. For an Extension unit, the cards are:
+# XTENSION, BITPIX, NAXIS, PCOUNT, GCOUNT, ORIGIN, DATE, INHERIT,
+# EXTNAME, IRAF_TLM, OBJECT and END; IM_NDIM(im) takes care of
+# NAXISi. Same as above for DATAMIN, DATAMAX.
+# If these cards are in the main header, reduce the number of
+# mandatory cards that are going to be created at closing time
+# (in fitupdhdr).
+
+procedure fxf_mandatory_cards (im, nheader_cards)
+
+pointer im #I im structure
+int nheader_cards #O Number of mandatory cards in header.
+
+pointer ua
+int ncards, rp, fit, acmode
+int idb_findrecord()
+
+begin
+ ua = IM_USERAREA(im)
+ fit = IM_KDES(im)
+
+ if (FIT_NEWIMAGE(fit) == YES) # create a PHU
+ ncards = 9 + IM_NDIM(im)
+ else # create an EHU
+ ncards = 12 + IM_NDIM(im)
+
+ if (idb_findrecord (im, "PCOUNT", rp) > 0) {
+ if (FIT_XTENSION(fit) == YES)
+ ncards = ncards - 1
+ else
+ call fxf_filter_keyw (im, "PCOUNT")
+ }
+ if (idb_findrecord (im, "GCOUNT", rp) > 0) {
+ if (FIT_XTENSION(fit) == YES)
+ ncards = ncards - 1
+ else
+ call fxf_filter_keyw (im, "GCOUNT")
+ }
+ if (idb_findrecord (im, "EXTNAME", rp) > 0) {
+ if (FIT_XTENSION(fit) == YES)
+ ncards = ncards - 1
+ else
+ call fxf_filter_keyw (im, "EXTNAME")
+ }
+ if (idb_findrecord (im, "INHERIT", rp) > 0) {
+ if (FIT_XTENSION(fit) == YES)
+ ncards = ncards - 1
+ else
+ call fxf_filter_keyw (im, "INHERIT")
+ }
+ if (idb_findrecord (im, "EXTEND", rp) > 0) {
+ if (FIT_XTENSION(fit) == NO) {
+ ncards = ncards - 1
+ } else {
+ # Delete the keyword from the UA because EXTEND is not
+ # recommended in XTENSION units.
+
+ call fxf_filter_keyw (im, "EXTEND")
+ }
+ }
+
+ if (idb_findrecord (im, "ORIGIN", rp) > 0)
+ ncards = ncards - 1
+ if (idb_findrecord (im, "DATE", rp) > 0 )
+ ncards = ncards - 1
+ if (idb_findrecord (im, "IRAF-TLM", rp) > 0)
+ ncards = ncards - 1
+ if (idb_findrecord (im, "OBJECT", rp) > 0)
+ ncards = ncards - 1
+
+ # See if we need to add one more mandatory card when an EXTVER value
+ # was specified when appending a new extension.
+
+ if (FIT_NEWIMAGE(fit) == NO && idb_findrecord(im,"EXTVER",rp) == 0) {
+ # Keyword does not exist.
+ acmode = IM_ACMODE(im)
+ if ((acmode == NEW_IMAGE || acmode == NEW_COPY) &&
+ FKS_EXTVER(fit) != INDEFL )
+ ncards = ncards + 1
+ }
+
+ # We want to keep BSCALE and BZERO in the UA in case we are
+ # editing the values. Is up to the user or application
+ # responsability to deal with the change in pixel value when reading.
+ # If we are reading pixels the values will change according to the
+ # input BSCALE and BZERO. If we are adding BSCALE and BZERO before
+ # accessing any pixels, these will get scale. If adding or
+ # changing right before closing the image, the pixel value will be
+ # unchanged.
+
+ # See if BSCALE and BZERO are in the UA for ushort, otherwise
+ # increase the number.
+
+ if (IM_PIXTYPE(im) == TY_USHORT) {
+ if (idb_findrecord (im, "BSCALE", rp) == 0)
+ ncards = ncards + 1
+ if (idb_findrecord (im, "BZERO", rp) == 0)
+ ncards = ncards + 1
+ }
+ nheader_cards = ncards
+end
+
+
+# FXF_OVERWRITE_UNIT -- Overwrite an existent extension. A temporary file
+# is created that contains the current file upto the extension before the
+# one to be overwrite.
+
+procedure fxf_overwrite_unit (fit, im)
+
+pointer fit #I Fits descriptor
+pointer im #I Image descriptor
+
+pointer sp, file, mii
+int pixoff, compress, blklen, sz_fitfile, i, group, filesize
+int junk, in_fd, out_fd, nblocks, nk, hdr_size, sz_pixfile
+extern fxfzop(), fxfzrd(), fxfzwr(), fxfzwt(), fxfzst(), fxfzcl()
+int fnroot(), open(), read(), fxf_totpix(), strncmp(), itoc()
+int strlen(), fopnbf(), fstatl(), fxf_header_size()
+
+include <szpixtype.inc>
+
+errchk syserr, syserrs
+define err_ 91
+
+begin
+ group = FIT_GROUP(fit)
+
+ # Do not overwrite extensions that are not IMAGE.
+ if (group != 0 && strncmp (FIT_EXTTYPE(fit), "IMAGE", 5) != 0 &&
+ strncmp (FIT_EXTTYPE(fit), "SIMPLE", 6) != 0) {
+
+ call syserr (SYS_FXFOVRBEXTN)
+ return
+ }
+
+ call smark (sp)
+ call salloc (file, SZ_FNAME, TY_CHAR)
+ call salloc (mii, FITS_BLOCK_CHARS, TY_INT)
+
+ junk = fnroot (IM_HDRFILE(im), Memc[file], SZ_FNAME)
+
+ # Keep the temporary filename in IM_PIXFILE(im).
+ call mktemp (Memc[file], IM_PIXFILE(im), SZ_PATHNAME)
+ call strcat (".fits", IM_PIXFILE(im), SZ_PATHNAME)
+
+ # If we want to overwrite the first group there is nothing
+ # to copy first.
+
+ if (group != 0) {
+ # Copy from the old file up to hdr_off[group] into a temporary file.
+ in_fd = open (IM_HDRFILE(im), READ_ONLY, BINARY_FILE)
+ out_fd = open (IM_PIXFILE(im), NEW_FILE, BINARY_FILE)
+ nblocks = Memi[FIT_HDRPTR(fit)+group]/ FITS_BLOCK_CHARS
+ do nk = 1, nblocks {
+ junk = read (in_fd, Memi[mii], FITS_BLOCK_CHARS)
+ call write (out_fd, Memi[mii], FITS_BLOCK_CHARS)
+ }
+ call close (in_fd)
+ call close (out_fd)
+ }
+
+ FIT_NAXIS(fit) = IM_NDIM(im)
+ call amovi (IM_LEN(im,1), FIT_LENAXIS(fit,1), IM_NDIM(im))
+
+ FIT_TOTPIX(fit) = fxf_totpix(im)
+
+ # Do not allow BSCALE and BZERO in the UA when making a new copy or
+ # new image if bitpix is negative. Except for ushort.
+
+ if (IM_PIXTYPE(im) != TY_USHORT) {
+ call fxf_filter_keyw (im, "BSCALE")
+ call fxf_filter_keyw (im, "BZERO")
+ }
+
+ # The new copy header should not have the following keywords:
+ # GROUPS, PSIZE and that could come from a GEIS file.
+
+ call fxf_discard_keyw (im)
+ hdr_size = fxf_header_size (im)
+
+ # Reset the scaling parameter because in NEW_COPY mode there
+ # should not be scaled pixels. The previous call will get these
+ # values from the input image.
+
+ FIT_BSCALE(fit) = 1.0d0
+ FIT_BZERO(fit) = 0.0d0
+
+ call fpathname (IM_PIXFILE(im), Memc[file], SZ_PATHNAME)
+ call strcat("_", Memc[file], SZ_PATHNAME)
+ i = strlen(Memc[file])
+ junk = itoc (fit, Memc[file+i], SZ_PATHNAME)
+
+ # The pixel file needs to be a multiple of 1440 chars.
+ sz_pixfile = fxf_totpix(im) * pix_size[IM_PIXTYPE(im)]
+ sz_pixfile = FITS_LEN_CHAR(sz_pixfile)
+ sz_fitfile = sz_pixfile + hdr_size
+
+ if (group == 0)
+ call falloc (IM_PIXFILE(im), sz_fitfile)
+
+ FIT_IM(fit) = im
+ iferr (IM_PFD(im) = fopnbf (Memc[file], READ_WRITE,
+ fxfzop, fxfzrd, fxfzwr, fxfzwt, fxfzst, fxfzcl)) {
+
+ IM_PFD(im) = NULL
+ goto err_
+ }
+
+ filesize = fstatl (IM_PFD(im), F_FILESIZE)
+ FIT_EOFSIZE(fit) = filesize + 1
+ # Now write a blank header.
+ if (group != 0) {
+ call amovki (0, Memi[mii], FITS_BLOCK_CHARS)
+ nblocks = hdr_size/FITS_BLOCK_CHARS
+ FIT_HFD(fit) = -1
+
+ call seek (IM_PFD(im), EOF)
+ do nk = 1, nblocks
+ call write (IM_PFD(im), Memi[mii], FITS_BLOCK_CHARS)
+
+ pixoff = filesize + hdr_size + 1
+ filesize = filesize + sz_fitfile
+ } else
+ pixoff = hdr_size + 1
+
+
+ FIT_PIXOFF(fit) = pixoff
+ IM_HFD(im) = NULL
+
+ blklen = 1
+ compress = YES
+ call imioff (im, pixoff, compress, blklen)
+
+ FIT_PFD(fit) = IM_PFD(im)
+ FIT_HFD(fit) = IM_HFD(im)
+
+ call sfree (sp)
+ return
+err_
+ call syserr (SYS_FXFOVRTOPN)
+ call sfree (sp)
+end
+
+
+# TOTPIX -- Calculate the total number of pixels in the image.
+
+int procedure fxf_totpix (im)
+
+pointer im #I image descriptor
+int i, pix, ndim
+
+begin
+ ndim = IM_NDIM(im)
+ if (ndim == 0)
+ return (0)
+
+ pix = IM_LEN(im,1)
+ do i = 2, ndim
+ pix = pix * IM_LEN(im,i)
+
+ return (pix)
+end
+
+
+# FXF_DISCARD_FITS_KEYW -- Exclude certain keywords from a new copy image.
+
+procedure fxf_discard_keyw (im)
+
+pointer im #I image descriptor
+pointer fit
+
+begin
+ fit = IM_KDES(im)
+
+ call fxf_filter_keyw (im, "GROUPS")
+ call fxf_filter_keyw (im, "PSIZE")
+ call fxf_filter_keyw (im, "BLOCKED")
+ call fxf_filter_keyw (im, "IRAFNAME")
+ call fxf_filter_keyw (im, "IRAF-BPX")
+ call fxf_filter_keyw (im, "IRAFTYPE")
+
+ if (FIT_NEWIMAGE(fit) == NO)
+ call fxf_filter_keyw (im, "EXTEND")
+
+ # Create a PHU.
+ if (FIT_NEWIMAGE(fit) == YES) {
+ call fxf_filter_keyw (im, "PCOUNT")
+ call fxf_filter_keyw (im, "GCOUNT")
+ call fxf_filter_keyw (im, "INHERIT")
+ call fxf_filter_keyw (im, "EXTNAME")
+ call fxf_filter_keyw (im, "EXTVER")
+ call fxf_filter_keyw (im, "EXTLEVEL")
+ }
+end
+
+
+# FXF_FILTER_KEYW -- Delete the names keyword from the userarea.
+
+procedure fxf_filter_keyw (im, key)
+
+pointer im #I image descriptor
+char key[ARB] #I keyword name to delete from USERAREA.
+
+pointer rp
+int off
+int idb_findrecord(), stridxs()
+
+begin
+ # Verify that the named user field exists.
+ if (idb_findrecord (im, key, rp) <= 0)
+ return
+
+ # Delete the field.
+ off = stridxs ("\n", Memc[rp])
+ if (off > 0)
+ call strcpy (Memc[rp+off], Memc[rp], ARB)
+ else
+ Memc[rp] = EOS
+end
+
+
+# FXF_FALLOC -- Preallocate space on disk by writing blanks.
+
+procedure fxf_falloc (fname, size)
+
+char fname[ARB] #I filename
+int size #I size to preallocate in chars
+
+pointer sp, cp
+int nb,i, fd
+errchk open, write
+int open()
+
+begin
+ call smark (sp)
+ call salloc (cp, FITS_BLOCK_CHARS, TY_CHAR)
+
+ call amovkc (' ', Memc[cp], FITS_BLOCK_CHARS)
+ nb = size / FITS_BLOCK_CHARS
+ fd = open (fname, NEW_FILE, BINARY_FILE)
+
+ do i = 1, nb
+ call write (fd, Memc[cp], FITS_BLOCK_CHARS)
+
+ call flush (fd)
+ call close (fd)
+ call sfree (sp)
+end
+
+
+# FXF_CKH_NDIM -- Check that the application has indeed set the number
+# of dimension, otherwise count the axes.
+
+procedure fxf_chk_ndim (im)
+
+pointer im #I imio descriptor
+int ndim #I number of dimension for image
+
+begin
+ ndim = IM_NDIM(im)
+
+ # If ndim was not explicitly set, compute it by counting the number
+ # of nonzero dimensions.
+
+ if (ndim == 0) {
+ for (ndim=1; IM_LEN(im,ndim) > 0 && ndim <= IM_MAXDIM; ndim=ndim+1)
+ ;
+ ndim = ndim - 1
+ IM_NDIM(im) = ndim
+ }
+end
+
+
+# FXF_NOT_INCACHE -- Procedure to find whether the file is in the
+# cache. It could happen that the slot with the entry might have been
+# freed to make room for another file. We want to have valid pointers
+# for FIT_CACHEHDR and FIT_CACHELEN since the calling routine will use them.
+
+procedure fxf_not_incache (im)
+
+pointer im #I image descriptor
+
+int cindx, group, sfit[4]
+pointer sp, hdrfile, fit
+bool streq()
+
+include "fxfcache.com"
+
+begin
+ call smark (sp)
+ call salloc (hdrfile, SZ_PATHNAME, TY_CHAR)
+
+ call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME)
+ fit = IM_KDES(im)
+
+ do cindx=1, rf_cachesize {
+ if (rf_fit[cindx] == NULL)
+ next
+
+ if (streq (Memc[hdrfile], rf_fname[1,cindx])) {
+ call sfree (sp)
+ return
+ }
+ }
+ sfit[1]= FIT_NAXIS(fit)
+ sfit[2] = FIT_INHERIT(fit)
+ sfit[3] = FIT_PLMAXLEN(fit)
+ sfit[4] = IM_CTIME(im)
+
+ group = max (0, FIT_GROUP(fit))
+
+ call fxf_prhdr(im,group)
+
+ FIT_NAXIS(fit) = sfit[1]
+ FIT_INHERIT(fit) = sfit[2]
+ FIT_PLMAXLEN(fit) = sfit[3]
+ IM_CTIME(im) = sfit[4]
+
+ call sfree (sp)
+ return
+end
+
generated by cgit (git 2.34.1) at 2025-09-20 12:47:55 -0400