aboutsummaryrefslogtreecommitdiff
path: root/sys/imio/imt
diff options
context:
space:
mode:
Diffstat (limited to 'sys/imio/imt')
-rw-r--r--sys/imio/imt/README280
-rw-r--r--sys/imio/imt/fxf.h172
-rw-r--r--sys/imio/imt/imt.x342
-rw-r--r--sys/imio/imt/imx.h28
-rw-r--r--sys/imio/imt/imx.x242
-rw-r--r--sys/imio/imt/imxbreakout.x233
-rw-r--r--sys/imio/imt/imxescape.x74
-rw-r--r--sys/imio/imt/imxexpand.x1287
-rw-r--r--sys/imio/imt/imxexpr.x222
-rw-r--r--sys/imio/imt/imxftype.x119
-rw-r--r--sys/imio/imt/imxparse.x203
-rw-r--r--sys/imio/imt/imxpreproc.x539
-rw-r--r--sys/imio/imt/mkpkg24
-rw-r--r--sys/imio/imt/t_urlget.x94
-rw-r--r--sys/imio/imt/zzdebug.x227
15 files changed, 4086 insertions, 0 deletions
diff --git a/sys/imio/imt/README b/sys/imio/imt/README
new file mode 100644
index 00000000..be232470
--- /dev/null
+++ b/sys/imio/imt/README
@@ -0,0 +1,280 @@
+
+ Enhanced Image List Template Package
+
+ April 15, 2011
+
+
+ The enhanced image list package provides new capabilities for handling
+image lists, but remains backwards compatible with tasks currently using
+the IMT interface. The enhancements allow for expansion of MEF files into
+lists of extensions using the @-file operator, as well as selection of
+images within more general lists by means of modifiers (e.g. a simple
+expression such as the extname/extver or explicit extension number, or more
+complex boolean expressions to allow selection by header keyword). In
+addition, tables may now take the @-file operator to use a column
+containing image references as an input list.
+
+
+========================================================================
+TODO:
+ - Describe syntax for use with tables and selection by row values
+ - Describe remote image specification caching mechanism
+========================================================================
+
+
+
+Template Strings
+----------------
+
+The FNT template package supports the following forms of pattern strings:
+
+ alpha, *.x, data* // .pix, [a-m]*, @list_file, nite%1%2%.1024.imh
+
+i.e. simple filenames, wildcard expansion in filenames, concatenation of
+filenames, @files, substitution in filenames, or a comma-delimited list of
+the above. The image template package (IMT) extends these patterns to
+allow image names followed by a cluster index or image section in []
+brackets. These patterns remain unchanged in the new version of the
+package to allow backward compatability with existing applications. Lists
+of these types represent *explicit* collections of images, i.e. a
+collection based on the image name (wildcards) or as a result of processing
+by some task (e.g. expansion of an MEF file to create an input @-file of
+expanded extension specifications).
+
+ The enhanced version of the IMT package further abstracts the concept
+of image collections to include data objects such as MEF files or tables
+containing a list of image references that *implicitly* defines the list
+(e.g. the expanded MEF extension specification or the complete column of
+image references). Further, we allow this list (which might be quite
+broad) to be refined using modifiers or selectors on the list and thus
+dynamically create the list without requiring the use (and management) of
+intermediate files. For example,
+
+
+ @file* expand all files beginning w/ 'file'
+ @file//".fits" append ".fits" to contents of 'file'
+
+ @mef.fits expand all (image) extensions of an MEF file
+ @mef.fits[SCI] select SCI extensions from MEF file
+ @mef.fits[SCI,2][noinherit] select v2 SCI extns, add kernel param
+ @mef.fits[1-16x2] select range of extensions from MEF file
+ @mef.fits[+1-8] create a list of extensions for an MEF
+
+ *.fits[1:100,1:100] append section to all FITS images
+ @@file[1:100,1:100] append section to expanded MEFs in 'file'
+
+ *.fits[filter?='V'] select images w/ FILTER keyword containing 'V'
+ @*.fits[gain<3.0] select image extns where GAIN keyword < 3.0
+ *.fits[filter?='V';gain<2.0] select using multiple OR's expressions
+
+
+Template Syntax
+---------------
+
+ The previous syntax and behavior of image templates is unchanged in
+this version, new functionality is provided by (optional) new syntax now
+supported in the template pattern string. Briefly,
+
+ - wildcard filename expansion may now be applied to @-files
+
+ - the use of an '@' operator is now permitted on MEF files. By
+ default, all image extensions in the file will be included in the
+ list, modifiers may be used to select specific extensions or to
+ indicate a range of extensions to be used.
+
+ - the use of an '@@' operator to indicate expansion of the contents
+ of an @-file. For example, an @-file of MEF image names can be
+ expanded to list of all the file extensions using "@@file", whereas
+ just using "@file" would list the names of the MEF files as before.
+
+ - modifier expressions enclosed in square brackets may be appended
+ to an image template string (or @-file) to either constrain the
+ list (e.g. only a range of MEF extensions, only images with a certain
+ keyword value, etc) or to append extra information to the image
+ specification (e.g. to add an image section to all images in the
+ list). Multiple modifier expressions may be used
+
+
+ The allowed syntax for a template string can be described roughly in
+the following way:
+
+
+ [@@ | @] <file> [extname] [<expr>;...] [<ikparams>] [<section>]
+ [@@ | @] <file> [extname,extver][<expr>;...] [<ikparams>] [<section>]
+ [@@ | @] <file> [index_range] [<expr>;...] [<ikparams>] [<section>]
+
+ <-------- selectors -------> <------ modifiers ----->
+
+ The <file> specification may be the name of a file, and image, or a
+table. The behavior of the @-file and @@-file operators will depend on
+the type of <file> but the @-file usage remains backward compatible when
+used with text files.
+
+ The use of a modifier/selection on an MEF file will automatically
+trigger expansion of the extensions in the image and so an '@' operator is
+not strictly required, however only those extensions matching the selection
+expression will be present in the final image list. Note that the use of
+index ranges and extname/extver selectors are mutually exclusive, selector
+expressions may be added to either.
+
+
+@-file Operations
+-----------------
+
+ The @-file operator is unchanged from previous versions when used with
+text files of image names. Modifier/selector expressions however can now
+be applied to the contents of the @-file to select from the list only those
+images that match the selector expression, or to augment the name in the
+list with an additional image syntax such as a section or kernel parameters.
+
+
+@@-file Operations
+------------------
+
+ The @@-file operator is new syntax meant to allow the contents of an
+@-file to be expanded automaticaly, e.g. as if there were an @-file of
+@-file names. Primarily this can be used to create a list of MEF image
+names in which an @-file would return the names of the MEF, while the
+@@-file syntax could be used to expand each MEF into individual extension
+specifications.
+
+
+Extension Indices
+-----------------
+
+ The [index_range] modifier may be used to specify an explicit set of
+extensions to be used. Index ranges are specified as a comma-delimited
+list of strings specifying individual range segments as described in the
+RANGES help page.
+
+ The use of a '+' operator before an index range indicates the range
+list should be expanded without checking that the extension exists in the
+MEF itself. Otherwise, only those extensions present in the MEF will be
+included in the list.
+
+
+Selection Expressions
+---------------------
+
+ Selection expressions may be used to restrict a template list to only
+those images that match some boolean expression, e.g. to provide for
+selection based on a header keyword value. Expressions follow the same
+guidelines as in the HSELECT task 'expr' parameter (see the help page
+for details). Multiple expressions may be specified if they are separated
+by a semicolon however they are evaluated as a single expression of
+OR'd values rather than as individual expressions. This is significant
+when considering that expressions may contain keywords not present in
+all images being checked, for instance
+
+ *.fits[filter?='V';gain<3.0]
+
+would evaluate as if the expression had been written
+
+ (filter?='V' || gain < 3.0)
+
+If a particular image lacks either the 'filter' or 'gain' keyword the
+entire expression will evaluate to false because of an error even if one
+of the two clauses would otherwise have been true.
+
+[NOTE: This behavior will be changed in a future version.]
+
+
+
+Image Sections
+--------------
+ Image sections may be added to an image specification by adding a
+separate modifier string. The section will be added once selection of
+the list by the selector expressions is complete. An example of where
+this might be used is in automatically specifying the bias section for
+all images in a list, e.g.
+
+ @mef.fits[1:128,*] all extensions in the image
+ @mef.fits[1-16x2][1:128,*] only 'left' amplifiers of a mosaic
+ @mef.fits[2-16x2][1024:1128,*] only 'right' amplifiers of a mosaic
+ m31*.fits[345:528,200:300] same section in all registered images
+
+No check is made that the image section is valid for the given image.
+
+
+Kernel Parameters
+-----------------
+
+ A comma-delimited list of image kernel parameters may be added to any
+image specification by adding the keywords to a separate modifier. For
+example,
+ @mef.fits[1-8][noinherit,padline=30]
+
+would expand the file 'mef.fits' to include extensions 1 thru 8 and add the
+kernel parameters, generating a list such as
+
+ mef.fits[1][noinherit,padline=30]
+ mef.fits[2][noinherit,padline=30]
+ : : : :
+ mef.fits[8][noinherit,padline=30]
+
+No check is made to verify that the image kernel keywords are appropriate
+for the image type. Supplying an incorrect kernel parameter will likely
+result in the task throwing an error when opening the image.
+
+
+
+--------------------------------------------------------------------------------
+
+Appendix 1: Examples
+
+ file
+ file*
+ @file
+ @file*
+
+ @file[2] extension
+ @file[SCI] extname
+ @file[SCI,2] extname+extver
+
+ @file[2][noinherit] extension + ikiparams
+ @file[SCI][noinherit] extname + ikiparams
+ @file[SCI,2][noinherit] extname+extver + ikiparams
+
+ @file[2][1:20,2:30] extension + section
+ @file[SCI][1:20,2:30] extname + section
+ @file[SCI,2][1:20,2:30] extname+extver + section
+
+ @file[2][noinherit][1:20,2:30] extension + ikiparams + section
+ @file[SCI][noinherit][1:20,2:30] extname + ikiparams + section
+ @file[SCI,2][noinherit][1:20,2:30] extname+extver + ikiparams + section
+
+ @file[noinherit] ikiparams
+ @file[noinherit][1:123,2:234] ikiparams + sections
+
+ @file[1:123,2:234] sections
+
+ @file[1:123,2:234] sections
+
+ mef*.fits[filter?='V'] selection expression
+ mef*.fits[filter?='V';filter?='B'] selection expressions (OR)
+ mef*.fits[filter?='V'||filter?='B'] selection expressions (OR)
+ mef*.fits[gain>0.5&&gain<2.0] selection expressions (AND)
+
+ Expressions will evaluate to 'false' if there is an error such as
+ "keyword not found", meaning that no images will match when one or
+ more keywords may not be present. Best to use a comma-delimited list
+ in this case.
+
+ Concatenation
+
+ @file // foo append
+ @file* // foo append wildcards
+ @file // [2] append modifiers
+
+ foo // @file prepend
+ foo // @file* prepend wildcards
+ foo // @file[2] prepend modifiers
+
+ Prior Behavior:
+
+ foo // bar.fits ==> foobar.fits
+ foo.fits // bar ==> foobar.fits
+
+ foo // @file1 ==> foosif1.fits,foomef1.fits
+ @file1 // bar ==> sif1foo.fits,mef1foo.fits
+
diff --git a/sys/imio/imt/fxf.h b/sys/imio/imt/fxf.h
new file mode 100644
index 00000000..c4e6188b
--- /dev/null
+++ b/sys/imio/imt/fxf.h
@@ -0,0 +1,172 @@
+# FITS.H -- IKI/FITS internal definitions.
+
+define FITS_ORIGIN "NOAO-IRAF FITS Image Kernel July 2003"
+
+define FITS_LENEXTN 4 # max length imagefile extension
+define SZ_DATATYPE 16 # size of datatype string (eg "REAL*4")
+define SZ_EXTTYPE 20 # size of exttype string (eg BINTABLE)
+define SZ_KEYWORD 8 # size of a FITS keyword
+define SZ_EXTRASPACE (81*32) # extra space for new cards in header
+define DEF_PHULINES 0 # initial allocation for PHU
+define DEF_EHULINES 0 # initial allocation for EHU
+define DEF_PADLINES 0 # initial value for extra lines in HU
+define DEF_PLMAXLEN 32768 # default max PLIO encoded line length
+define DEF_PLDEPTH 0 # default PLIO mask depth
+
+define FITS_BLOCK_BYTES 2880 # FITS logical block length (bytes)
+define FITS_BLOCK_CHARS 1440 # FITS logical block length (spp chars)
+define FITS_STARTVALUE 10 # first column of value field
+define FITS_ENDVALUE 30 # last column of value field
+define FITS_SZVALSTR 21 # nchars in value string
+define LEN_CARD 80 # length of FITS card.
+define LEN_UACARD 81 # size of a Userarea line.
+define LEN_OBJECT 63 # maximum length of a FITS string value
+define LEN_FORMAT 40 # maximum length of a TFORM value
+define NO_KEYW -1 # indicates no keyword is present.
+
+define MAX_OFFSETS 100 # max number of offsets per cache entry.
+define MAX_CACHE 60 # max number of cache entries.
+define DEF_CACHE 10 # default number of cache entries.
+
+define DEF_HDREXTN "fits" # default header file extension
+define ENV_FKINIT "fkinit" # FITS kernel initialization
+
+define DEF_ISOCUTOVER 0 # date when ISO format dates kick in
+define ENV_ISOCUTOVER "isodates" # environment override for default
+
+define FITS_BYTE 8 # Bits in a FITS byte
+define FITS_SHORT 16 # Bits in a FITS short
+define FITS_LONG 32 # Bits in a FITS long
+define FITS_REAL -32 # 32 Bits FITS IEEE float representation
+define FITS_DOUBLE -64 # 64 Bits FITS IEEE double representation
+
+define COL_VALUE 11 # Starting column for parameter values
+define NDEC_REAL 7 # Precision of real
+define NDEC_DOUBLE 14 # Precision of double
+
+define FITS_LEN_CHAR (((($1) + 1439)/1440)* 1440)
+
+# Extension subtypes.
+define FK_PLIO 1
+
+# Mapping of FITS Keywords to IRAF image header. All unrecognized keywords
+# are stored here.
+
+#define UNKNOWN Memc[($1+IMU-1)*SZ_MII_INT+1]
+define UNKNOWN Memc[($1+IMU-1)*SZ_STRUCT+1]
+
+
+# FITS image descriptor, used internally by the FITS kernel. The required
+# header parameters are maintained in this descriptor, everything else is
+# simply copied into the user area of the IMIO descriptor.
+
+define LEN_FITDES 500
+define LEN_FITBASE 400
+
+define FIT_ACMODE Memi[$1] # image access mode
+define FIT_PFD Memi[$1+1] # pixel file descriptor
+define FIT_PIXOFF Memi[$1+2] # pixel offset
+define FIT_TOTPIX Memi[$1+3] # size of image in pixfile, chars
+define FIT_IO Memi[$1+4] # FITS I/O channel
+define FIT_ZCNV Memi[$1+5] # set if on-the-fly conversion needed
+define FIT_IOSTAT Memi[$1+6] # i/o status for zfio routines
+define FIT_TFORMP Memi[$1+7] # TFORM keyword value pointer
+define FIT_TTYPEP Memi[$1+8] # TTYPE keyword value pointer
+define FIT_TFIELDS Memi[$1+9] # number of fields in binary table
+define FIT_PCOUNT Memi[$1+10] # PCOUNT keyword value
+ # extra space
+define FIT_BSCALE Memd[P2D($1+16)]
+define FIT_BZERO Memd[P2D($1+18)]
+define FIT_BITPIX Memi[$1+20] # bits per pixel
+define FIT_NAXIS Memi[$1+21] # number of axes in image
+define FIT_LENAXIS Memi[$1+22+$2-1]# 35:41 = [7] max
+define FIT_ZBYTES Memi[$1+30] # Status value for FIT_ZCNV mode
+define FIT_HFD Memi[$1+31] # Header file descriptor
+define FIT_PIXTYPE Memi[$1+32]
+define FIT_CACHEHDR Memi[$1+33] # Cached main header unit's address.
+define FIT_CACHEHLEN Memi[$1+34] # Lenght of the above.
+define FIT_IM Memi[$1+35] # Has the 'im' descriptor value
+define FIT_GROUP Memi[$1+36]
+define FIT_NEWIMAGE Memi[$1+37] # Newimage flag
+define FIT_HDRPTR Memi[$1+38] # Header data Xtension pointer
+define FIT_PIXPTR Memi[$1+39] # Pixel data Xtension pointer
+define FIT_NUMOFFS Memi[$1+40] # Number of offsets in cache header.
+define FIT_EOFSIZE Memi[$1+41] # Size in char of file before append.
+define FIT_XTENSION Memi[$1+42] # Yes, if an Xtension has been read.
+define FIT_INHERIT Memi[$1+43] # INHERIT header keyword value.
+define FIT_EXTVER Memi[$1+44] # EXTVER value (integer only)
+define FIT_EXPAND Memi[$1+45] # Expand the header?
+define FIT_MIN Memr[P2R($1+46)]# Minimum pixel value
+define FIT_MAX Memr[P2R($1+47)]# Maximum pixel value
+define FIT_MTIME Meml[$1+48] # Time of last mod. for FITS unit
+define FIT_SVNANR Memr[P2R($1+49)]
+define FIT_SVNAND Memd[P2D($1+50)]
+define FIT_SVMAPRIN Memi[$1+52]
+define FIT_SVMAPROUT Memi[$1+53]
+define FIT_SVMAPDIN Memi[$1+54]
+define FIT_SVMAPDOUT Memi[$1+55]
+define FIT_EXTEND Memi[$1+56] # FITS extend keyword
+define FIT_PLMAXLEN Memi[$1+57] # PLIO maximum linelen
+ # extra space
+define FIT_EXTTYPE Memc[P2C($1+70)] # extension type
+define FIT_FILENAME Memc[P2C($1+110)] # FILENAME value
+define FIT_EXTNAME Memc[P2C($1+150)] # EXTNAME value
+define FIT_DATATYPE Memc[P2C($1+190)] # datatype string
+define FIT_TITLE Memc[P2C($1+230)] # title string
+define FIT_OBJECT Memc[P2C($1+270)] # object string
+define FIT_EXTSTYPE Memc[P2C($1+310)] # FITS extension subtype
+ # extra space
+
+# The FKS terms carry the fkinit or kernel section arguments.
+define FKS_APPEND Memi[$1+400] # YES, NO append an extension
+define FKS_INHERIT Memi[$1+401] # YES, NO inherit the main header
+define FKS_OVERWRITE Memi[$1+402] # YES, NO overwrite an extension
+define FKS_DUPNAME Memi[$1+403] # YES, NO allow duplicated EXTNAME
+define FKS_EXTVER Memi[$1+404] # YES, NO allow duplicated EXTNAME
+define FKS_EXPAND Memi[$1+405] # YES, NO expand the header
+define FKS_PHULINES Memi[$1+406] # Allocated lines in PHU
+define FKS_EHULINES Memi[$1+407] # Allocated lines in EHU
+define FKS_PADLINES Memi[$1+408] # Additional lines for HU
+define FKS_NEWFILE Memi[$1+409] # YES, NO force newfile
+define FKS_CACHESIZE Memi[$1+410] # size of header cache
+define FKS_SUBTYPE Memi[$1+411] # BINTABLE subtype
+define FKS_EXTNAME Memc[P2C($1+412)] # EXTNAME value
+ # extra space
+
+
+# Reserved FITS keywords known to this code.
+
+define FK_KEYWORDS "|bitpix|datatype|end|naxis|naxisn|simple|bscale|bzero\
+|origin|iraf-tlm|filename|extend|irafname|irafmax|irafmin|datamax\
+|datamin|xtension|object|pcount|extname|extver|nextend|inherit\
+|zcmptype|tform|ttype|tfields|date|"
+
+define KW_BITPIX 1
+define KW_DATATYPE 2
+define KW_END 3
+define KW_NAXIS 4
+define KW_NAXISN 5
+define KW_SIMPLE 6
+define KW_BSCALE 7
+define KW_BZERO 8
+define KW_ORIGIN 9
+define KW_IRAFTLM 10
+define KW_FILENAME 11
+define KW_EXTEND 12
+define KW_IRAFNAME 13
+define KW_IRAFMAX 14
+define KW_IRAFMIN 15
+define KW_DATAMAX 16
+define KW_DATAMIN 17
+define KW_XTENSION 18
+define KW_OBJECT 19
+define KW_PCOUNT 20
+define KW_EXTNAME 21
+define KW_EXTVER 22
+define KW_NEXTEND 23
+define KW_INHERIT 24
+define KW_ZCMPTYPE 25
+define KW_TFORM 26
+define KW_TTYPE 27
+define KW_TFIELDS 28
+define KW_DATE 29
diff --git a/sys/imio/imt/imt.x b/sys/imio/imt/imt.x
new file mode 100644
index 00000000..64e1441c
--- /dev/null
+++ b/sys/imio/imt/imt.x
@@ -0,0 +1,342 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+.help imt
+.nf ___________________________________________________________________________
+IMT -- Image template package.
+
+The image template package is based upon the filename template package, the
+main difference being that the IMT package knows about the use of [] in image
+names, e.g., for image sections or cluster indices.
+
+ list = imtopenp (clparam)
+
+ list = imtopen (template)
+ imtclose (list)
+ nchars|eof = imtgetim (list, image, maxch)
+ nchars|eof = imtrgetim (list, index, image, maxch)
+ len = imtlen (list)
+ imtrew (list)
+
+An image template consists of a comma delimited list of one or more patterns.
+Each pattern consists of a filename template optionally followed by a cluster
+index or image section.
+
+ filename_template [image stuff] , ...
+
+In the simplest case a simple alphanumeric image or file name may be given.
+Template expansion is carried out by parsing off the [] image stuff, calling
+FNTOPNB to expand the filename template, and then appending the [] string to
+each output filename returned by FNTGFNB. Multiple adjacent [] sequences are
+permitted and are treated as one long string.
+
+The [ must be escaped to be included in the filename template. The escape
+will be passed on, causing the [ to be passed through into the file output
+filename. This prevents use of the [chars] character class notation in image
+templates; the [] are either interpreted as part of the image specification,
+or as part of the filename.
+.endhelp _____________________________________________________________________
+
+define SZ_FNT 16384
+define CH_DELIM 20B # used to flag image section
+
+
+# IMTOPENP -- Open an image template obtained as the string value of a CL
+# parameter.
+
+pointer procedure imtopenp (param)
+
+char param[ARB] # CL parameter with string value template
+pointer sp, template, imt
+pointer imtopen()
+errchk clgstr
+
+begin
+ call smark (sp)
+ call salloc (template, SZ_FNT, TY_CHAR)
+
+ call clgstr (param, Memc[template], SZ_FNT)
+ imt = imtopen (Memc[template])
+
+ call sfree (sp)
+ return (imt)
+end
+
+
+# IMTOPEN -- Open an image template. The filename template package is
+# sophisticated enough to do all the necessary filename editing, etc., so all
+# we need do is recast the image notation into a FNT edit operation, e.g.,
+# `*.imh[*,-*]' becomes `*.hhh%%?\[\*\,-\*]%', with the ? (CH_DELIM, actually
+# an unprintable ascii code) being included to make it easy to locate the
+# section string in the filenames returned by FNT. We then open the resultant
+# template and perform the inverse mapping upon the filenames returned by FNT.
+
+pointer procedure imtopen (template)
+
+char template[ARB] # image template
+
+int sort, level, ip, ch
+pointer sp, listp, fnt, op
+define output {Memc[op]=$1;op=op+1}
+
+int fntopnb(), strlen()
+pointer imxopen()
+bool envgetb()
+
+begin
+ # The interface is unchanged as far as the applications are
+ # concerned, but we'll branch here to the enhanced list processing
+ # if it is available.
+
+ if (envgetb ("use_vo") && envgetb ("use_new_imt"))
+ return (imxopen (template))
+
+
+ call smark (sp)
+ call salloc (fnt, max(strlen(template)*2, SZ_FNT), TY_CHAR)
+
+ # Sorting is disabled as input and output templates, derived from the
+ # same database but with string editing used to modify the output list,
+ # may be sorted differently as sorting is performed upon the edited
+ # output list.
+
+ sort = NO
+
+ op = fnt
+ for (ip=1; template[ip] != EOS; ip=ip+1) {
+ ch = template[ip]
+
+ if (ch == '[') {
+ if (ip > 1 && template[ip-1] == '!') {
+ # ![ -- Pass a [ to FNT (character class notation).
+ Memc[op-1] = '['
+
+ } else if (ip > 1 && template[ip-1] == '\\') {
+ # \[ -- The [ is part of the filename. Pass it on as an
+ # escape sequence to get by the FNT.
+
+ output ('[')
+
+ } else {
+ # [ -- Unescaped [. This marks the beginning of an image
+ # section sequence. Output `%%[...]%' and escape all
+ # pattern matching metacharacters until a comma template
+ # delimiter is encountered. Note that a comma within []
+ # is not a template delimiter.
+
+ output ('%')
+ output ('%')
+ output (CH_DELIM)
+
+ level = 0
+ for (; template[ip] != EOS; ip=ip+1) {
+ ch = template[ip]
+ if (ch == ',') { # ,
+ if (level <= 0)
+ break # exit loop
+ else {
+ output ('\\')
+ output (ch)
+ }
+ } else if (ch == '[') { # [
+ output ('\\')
+ output (ch)
+ level = level + 1
+ } else if (ch == ']') { # ]
+ output (ch)
+ level = level - 1
+ } else if (ch == '*') { # *
+ output ('\\')
+ output (ch)
+ } else # normal chars
+ output (ch)
+ }
+ output ('%')
+ ip = ip - 1
+ }
+
+ } else if (ch == '@') {
+ # List file reference. Output the CH_DELIM code before the @
+ # to prevent further translations on the image section names
+ # returned from the list file, e.g., "CH_DELIM // @listfile".
+
+ output (CH_DELIM)
+ output ('/')
+ output ('/')
+ output (ch)
+
+ } else
+ output (ch)
+ }
+
+ Memc[op] = EOS
+
+ listp = fntopnb (Memc[fnt], sort)
+
+ call sfree (sp)
+ return (listp)
+end
+
+
+# IMTGETIM -- Get the next image name from the image template. FNT returns a
+# filename with optional appended image section (preceded by the CH_DELIM
+# character). Our job is to escape any [ in the filename part of the image
+# name to avoid interpretation of these chars as image section characters by
+# IMIO. The CH_DELIM is deleted and everything following is simply copied
+# to the output.
+
+int procedure imtgetim (imt, outstr, maxch)
+
+pointer imt # image template descriptor
+char outstr[ARB] # output string
+int maxch # max chars out
+
+int nchars
+pointer sp, buf
+int fntgfnb(), imt_mapname()
+errchk fntgfnb
+
+begin
+ call smark (sp)
+ call salloc (buf, SZ_PATHNAME, TY_CHAR)
+
+ if (fntgfnb (imt, Memc[buf], SZ_PATHNAME) == EOF) {
+ outstr[1] = EOS
+ call sfree (sp)
+ return (EOF)
+ }
+
+ nchars = imt_mapname (Memc[buf], outstr, maxch)
+ call sfree (sp)
+ return (nchars)
+end
+
+
+# IMTRGETIM -- Like imt_getim, but may be used to randomly access the image
+# list.
+
+int procedure imtrgetim (imt, index, outstr, maxch)
+
+pointer imt # image template descriptor
+int index # list element to be returned
+char outstr[ARB] # output string
+int maxch # max chars out
+
+int nchars
+pointer sp, buf
+int fntrfnb(), imt_mapname()
+errchk fntrfnb
+
+begin
+ call smark (sp)
+ call salloc (buf, SZ_PATHNAME, TY_CHAR)
+
+ if (fntrfnb (imt, index, Memc[buf], SZ_PATHNAME) == EOF) {
+ outstr[1] = EOS
+ call sfree (sp)
+ return (EOF)
+ }
+
+ nchars = imt_mapname (Memc[buf], outstr, maxch)
+ call sfree (sp)
+ return (nchars)
+end
+
+
+# IMTLEN -- Return the number of image names in the expanded list.
+
+int procedure imtlen (imt)
+
+pointer imt # image template descriptor
+int fntlenb()
+
+begin
+ return (fntlenb (imt))
+end
+
+
+# IMTREW -- Rewind the expanded image list.
+
+procedure imtrew (imt)
+
+pointer imt # image template descriptor
+
+begin
+ call fntrewb (imt)
+end
+
+
+# IMTCLOSE -- Close an image template.
+
+procedure imtclose (imt)
+
+pointer imt # image template descriptor
+
+begin
+ call fntclsb (imt)
+end
+
+
+# IMT_MAPNAME -- Translate the string returned by FNT into an image
+# specification suitable for input to IMIO.
+
+int procedure imt_mapname (fnt, outstr, maxch)
+
+char fnt[ARB] # FNT string
+char outstr[ARB] # output string
+int maxch
+
+int ip, op
+char url[SZ_PATHNAME], cfname[SZ_PATHNAME]
+
+int strncmp(), strlen()
+bool envgetb()
+
+begin
+ # Check for a URL-encoded string.
+
+ if (strncmp ("http:", fnt, 5) == 0) {
+ call aclrc (url, SZ_PATHNAME)
+ call sprintf (url, SZ_PATHNAME, "http://%s")
+ call pargstr (fnt[6])
+
+ call fcadd ("cache$", url, "", cfname, SZ_PATHNAME)
+ call strcpy (cfname, outstr, SZ_PATHNAME)
+ return (strlen (cfname))
+ }
+
+ op = 1
+ for (ip=1; fnt[ip] != EOS; ip=ip+1) {
+ if (fnt[ip] == '[') {
+ outstr[op] = '\\'
+ op = op + 1
+ outstr[op] = '['
+ op = op + 1
+
+ } else if (fnt[ip] == CH_DELIM) {
+ for (ip=ip+1; fnt[ip] != EOS; ip=ip+1) {
+ outstr[op] = fnt[ip]
+ op = op + 1
+ if (op > maxch)
+ break
+ }
+ break
+
+ } else {
+ outstr[op] = fnt[ip]
+ op = op + 1
+ if (op > maxch)
+ break
+ }
+ }
+ outstr[op] = EOS
+
+ # FIXME
+ if (envgetb ("vo_prefetch") && strncmp (outstr, "cache", 5) == 0) {
+# call sprintf (cfname, SZ_LINE, "%s.fits")
+ call sprintf (cfname, SZ_LINE, "%s")
+ call pargstr (outstr)
+ call fcwait ("cache$", cfname)
+ }
+
+ return (op - 1)
+end
diff --git a/sys/imio/imt/imx.h b/sys/imio/imt/imx.h
new file mode 100644
index 00000000..362e146f
--- /dev/null
+++ b/sys/imio/imt/imx.h
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+
+define SZ_FNT 32768
+define CH_DELIM 20B # used to flag image section
+
+define IMT_FILE 0 # file list
+define IMT_IMAGE 1 # image list
+define IMT_TABLE 2 # table list (ascii file)
+define IMT_VOTABLE 3 # table list (XML file)
+define IMT_URL 4 # file URL
+define IMT_DIR 5 # directory
+
+define IMT_OUTPUTS "|none|list|file|" # expansion options
+define IMTY_NONE 1 # No output
+define IMTY_LIST 2 # List output
+define IMTY_FILE 3 # File output
+
+define SZ_RANGE 100 # Size of extension range list
+define SZ_LISTOUT 16384 # Size of extension output list
+
+define FIRST 1 # Default starting range
+define LAST MAX_INT # Default ending range
+define STEP 1 # Default step
+define EOLIST -1 # End of list
+
diff --git a/sys/imio/imt/imx.x b/sys/imio/imt/imx.x
new file mode 100644
index 00000000..ba3f7bc8
--- /dev/null
+++ b/sys/imio/imt/imx.x
@@ -0,0 +1,242 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <syserr.h>
+include <ctype.h>
+include "imx.h"
+
+define DEBUG FALSE
+
+
+# IMXOPEN -- Open an image template using the enhanced expansion
+# capabilities. This procedure is simply the entry point to the imtopen()
+# method in the standard IMT interface.
+
+pointer procedure imxopen (template)
+
+char template[ARB] # image template
+
+int i, sort, level, ip, ch, expand, nchars, nimages, index, type
+int max_fnt, fnt_len, len, flen
+pointer listp, intmp, fnt, op, exp
+char lfile[SZ_LINE], lexpr[SZ_LINE], likparams[SZ_LINE], lsec[SZ_LINE]
+char lindex[SZ_LINE], lextname[SZ_LINE], lextver[SZ_LINE], elem[SZ_LINE]
+
+pointer imx_preproc (), imx_imexpand (), imx_fexpand ()
+pointer imx_texpand (), imx_dexpand ()
+int imx_filetype (), imx_parse (), imx_get_element ()
+int fntopnb (), strlen (), strsearch()
+int sum, fntlenb()
+bool envgetb()
+
+define output {Memc[op]=$1;op=op+1}
+define escape {output('\\');output($1)}
+
+begin
+ # Pre-process the input template.
+ intmp = imx_preproc (template)
+
+ if (DEBUG) {
+ call eprintf ("template: '%s'\npreproc: '%s'\n\n")
+ call pargstr (template)
+ call pargstr (Memc[intmp])
+ }
+
+
+ fnt_len = 0 # initialize
+ max_fnt = SZ_FNT
+ call calloc (fnt, max_fnt, TY_CHAR)
+
+ # Sorting is disabled as input and output templates, derived from the
+ # same database but with string editing used to modify the output list,
+ # may be sorted differently as sorting is performed upon the edited
+ # output list.
+
+ sort = NO
+
+ op = fnt
+ ip = intmp
+
+ for (ip=intmp; Memc[ip] != EOS; ip=ip+1) {
+ ch = Memc[ip]
+
+ if (ch == '[') {
+ if (ip > 1 && Memc[ip-1] == '!') {
+ # ![ -- Pass a [ to FNT (character class notation).
+ Memc[op-1] = '['
+
+ } else if (ip > 1 && Memc[ip-1] == '\\') {
+ # \[ -- The [ is part of the filename. Pass it on as an
+ # escape sequence to get by the FNT.
+
+ output ('[')
+
+ } else {
+ # [ -- Unescaped [. This marks the beginning of an image
+ # section sequence. Output `%%[...]%' and escape all
+ # pattern matching metacharacters until a comma template
+ # delimiter is encountered. Note that a comma within []
+ # is not a template delimiter.
+
+ output ('%')
+ output ('%')
+ output (CH_DELIM)
+
+ level = 0
+ for (; Memc[ip] != EOS; ip=ip+1) {
+ ch = Memc[ip]
+ if (ch == ',') { # ,
+ if (level <= 0)
+ break # exit loop
+ else {
+ escape (ch)
+ }
+ } else if (ch == '[') { # [
+ escape (ch)
+ level = level + 1
+ } else if (ch == ']') { # ]
+ output (ch)
+ level = level - 1
+ } else if (ch == '*') { # *
+ escape (ch)
+ } else # normal chars
+ output (ch)
+ }
+ output ('%')
+ ip = ip - 1
+ }
+
+ } else if (ch == '@') {
+ # List file reference. Output the CH_DELIM code before the @
+ # to prevent further translations on the image section names
+ # returned from the list file, e.g., "CH_DELIM // @listfile".
+
+ # See if we're asking to expand the contents of the file,
+ # e.g. as in "@@listfile" where 'listfile' contains MEFs
+ # or tables we later expand.
+ expand = NO
+ if (Memc[ip+1] == '@')
+ expand = YES
+
+ # Break out the listfile from the filtering expression.
+
+ index = 1
+ nchars = imx_get_element (Memc[ip], index, elem, SZ_LINE)
+ ip = ip + strlen(elem) - 1
+
+ nchars = imx_parse (elem, lfile, lindex, lextname,
+ lextver, lexpr, lsec, likparams, SZ_LINE)
+
+ if (DEBUG) {
+ call eprintf ("imtopen: lfile='%s' lexpr='%s' ip='%s'\n")
+ call pargstr (lfile)
+ call pargstr (lexpr)
+ call pargstr (Memc[ip])
+ }
+
+
+ exp = NULL
+ type = imx_filetype (lfile)
+ switch (type) {
+ case IMT_IMAGE:
+ exp = imx_imexpand (lfile, lexpr, lindex, lextname, lextver,
+ likparams, lsec, nimages)
+
+ case IMT_TABLE:
+ case IMT_VOTABLE:
+ exp = imx_texpand (lfile, type, lexpr, lindex, "", nimages)
+
+ case IMT_FILE:
+ if (strsearch (lfile, "//") > 0) {
+ call calloc (exp, SZ_FNAME, TY_CHAR)
+ call strcpy (lfile, Memc[exp], SZ_FNAME)
+ nimages = 1
+
+ } else if (lfile[1] == '@' && strsearch(lfile, "//") == 0) {
+ exp = imx_fexpand (lfile[2], lexpr, lindex, lextname,
+ lextver, likparams, lsec, nimages)
+# if (nimages > 0) {
+# output (CH_DELIM); output ('/'); output ('/')
+# }
+
+ } else {
+ call calloc (exp, SZ_FNAME, TY_CHAR)
+ call strcpy (lfile, Memc[exp], SZ_FNAME)
+ nimages = 1
+ }
+
+ case IMT_DIR:
+ exp = imx_dexpand (lfile, lexpr, lindex, lextname, lextver,
+ likparams, lsec, nimages)
+ }
+
+ if (DEBUG) {
+ call eprintf ("expand: exp='%s' len=%d nim=%d\n")
+ call pargstr (Memc[exp])
+ call pargi (strlen(Memc[exp]))
+ call pargi (nimages)
+ }
+
+
+ # Copy to the output template string.
+ len = strlen (Memc[exp])
+ if (nimages > 0) {
+ if ((fnt_len + len) >= max_fnt) {
+ max_fnt = max_fnt + len + 1
+ if (fnt != NULL)
+ call realloc (fnt, max_fnt, TY_CHAR)
+ else
+ call calloc (fnt, max_fnt, TY_CHAR)
+ op = fnt
+ if (fnt_len > 0)
+ op = fnt + strlen (Memc[fnt])
+ }
+ for (i=0; i < len; i=i+1)
+ output (Memc[exp+i])
+ Memc[op+1] = EOS
+ fnt_len = fnt_len + strlen (Memc[exp])
+ }
+
+ if (exp != NULL)
+ call mfree (exp, TY_CHAR)
+ nimages = 0
+
+ } else
+ output (ch)
+ }
+ output ('\0')
+ Memc[op] = EOS
+
+
+ # Clean up the expanded template string in case there were selection
+ # filters that rejected images and we have extra commas in the string.
+ len = strlen (Memc[fnt])
+ if (Memc[fnt+len-1] == ',') { # kill trailing commas
+ for (ip=fnt+len-1; Memc[ip] == ',' && ip >= fnt; ip=ip-1)
+ Memc[ip] = '\0'
+ }
+ if (Memc[fnt] == ',') {
+ for (ip=fnt; Memc[ip] == ','; ) # skip leading commas
+ ip = ip + 1
+ for (op=fnt; Memc[ip] != EOS; ip=ip+1) {
+ Memc[op] = Memc[ip]
+ op = op + 1
+ }
+ Memc[op] = '\0'
+ }
+
+ if (DEBUG) {
+ call eprintf ("imxopen: fnt='%s'\n")
+ call pargstr (Memc[fnt])
+ }
+
+
+ # Open the template string using the filename list.
+ listp = fntopnb (Memc[fnt], sort)
+
+ # Clean up.
+ call mfree (fnt, TY_CHAR)
+ call mfree (intmp, TY_CHAR)
+
+ return (listp)
+end
diff --git a/sys/imio/imt/imxbreakout.x b/sys/imio/imt/imxbreakout.x
new file mode 100644
index 00000000..57a92b8a
--- /dev/null
+++ b/sys/imio/imt/imxbreakout.x
@@ -0,0 +1,233 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+
+
+# IMX_BREAKOUT -- Break out the filename template from the filtering
+# expression in the list item. Our input value is a single item in the
+# template list, we'll logically separate image parameters, section strings
+# and extension values from expressions that might be used in filtering.
+
+int procedure imx_breakout (item, expand, fname, expr, sec, ikparams, maxch)
+
+char item[ARB] #i template string ptr
+int expand #i expanding contents?
+char fname[ARB] #o list filename
+char expr[ARB] #o filtering expression
+char sec[ARB] #o section string
+char ikparams[ARB] #o image kernel params
+int maxch #i max chars in fname and expr
+
+char ch, str[SZ_LINE], sifname[SZ_LINE]
+int nchars, ip, op
+bool is_sif
+
+bool imx_issection(), imx_sifmatch()
+int stridx()
+
+define next_str_ 99
+
+begin
+ call aclrc (fname, maxch)
+ call aclrc (expr, maxch)
+ call aclrc (sec, maxch)
+
+ # At the start the ip points to the '@' in the template string.
+ # Skip ahead to the start of the filename template string.
+ ip = 1
+ if (expand == YES)
+ ip = ip + 1
+
+ # Copy out the filename template up to the EOS, a '[' to indicate
+ # the start of a filter expression, or a comma indicating the next
+ # item in the list.
+ ch = item[ip]
+ for (op=1; ch != EOS; op=op+1) {
+ fname[op] = ch
+
+ ch = item[ip+1]
+ if (ch == ',' || ch == EOS)
+ return (ip-1) # next list item, no filter expr
+ else if (ch == '[')
+ break # break to get the filter expr
+
+ ip = ip + 1
+ }
+
+
+ # Get the string up to the closing ']' char.
+next_str_
+ ip = ip + 2
+ ch = item[ip]
+ call aclrc (str, SZ_LINE)
+ for (op=1; ch != EOS; op=op+1) {
+ str[op] = ch
+
+ ip = ip + 1
+ ch = item[ip]
+ if (ch == ']')
+ break # break to get the filter expr
+ }
+
+ if (imx_issection (str)) {
+ call strcpy (str, sec, SZ_LINE)
+ } else {
+ if (expr[1] != EOS) {
+ call strcat (",", expr, SZ_LINE)
+ call strcat (str, expr, SZ_LINE)
+ } else
+ call strcpy (str, expr, SZ_LINE)
+ }
+
+ if (item[ip+1] != EOS)
+ goto next_str_
+
+ call imx_ikparams (expr, ikparams, SZ_LINE)
+
+ # If we've found both a section and an expression, check that the
+ # section isn't being confused with an index list.
+ #if (sec[1] != EOS && expr[1] != EOS) {
+ # if (!is_sif && stridx (':', sec) == 0) {
+ # call strcat (",", expr, SZ_LINE)
+ # call strcat (sec, expr, SZ_LINE)
+ # }
+ #}
+
+ if (sec[1] != EOS) {
+ call aclrc (sifname, SZ_LINE)
+ call sprintf (sifname, SZ_LINE, "%s[1][%s]")
+ if (fname[1] == '@')
+ call pargstr (fname[2])
+ else
+ call pargstr (fname)
+ call pargstr (sec)
+ } else {
+ call strcpy (fname, sifname, SZ_LINE)
+ }
+ is_sif = imx_sifmatch (sifname, "yes")
+
+ nchars = ip - 1
+ return (nchars)
+end
+
+
+# IMX_ISSECTION -- Determine if the string is an image section.
+#
+# Note: There is a possible ambiguity here where using an image section
+# that represents a single pixel (e.g. foo.fits[100,100]) which might also
+# be a list of image extensions.
+
+bool procedure imx_issection (str)
+
+char str[ARB] # string to be checked
+
+int ip, stridxs()
+
+begin
+ for (ip=1; str[ip] != EOS; ip=ip+1) {
+ if (IS_ALPHA(str[ip]) || stridxs ("x()<>?", str) > 0)
+ return (FALSE)
+ }
+
+ # Test for a range list, e.g. "[1-5]"
+ if (stridxs ("-,", str) > 0 && stridxs (":*", str) == 0)
+ return (FALSE);
+
+ # Test for a section that flips axes, e.g. "[-*,*]"
+ if (stridxs ("-*:,", str) > 0)
+ return (TRUE);
+
+ return (FALSE)
+end
+
+
+# IMX_IKPARMS -- Break out the image kernel params from the template list
+# expression string.
+
+procedure imx_ikparams (expr, ikparams, maxch)
+
+char expr[ARB] # expression string to modify
+char ikparams[ARB] # extracted image kernel params
+int maxch # max size of output strings
+
+int ip, op, nexpr, niki
+char ch, in[SZ_LINE], sub[SZ_LINE]
+
+bool imx_isikparam()
+
+begin
+ call aclrc (in, SZ_LINE) # initialize
+ call strcpy (expr, in, SZ_LINE)
+ nexpr = 0
+ niki = 0
+
+ call aclrc (expr, maxch)
+ call aclrc (ikparams, maxch)
+ for (ip=1; in[ip] != EOS; ip=ip+1) {
+ # Copy out the sub expression, i.e. up to the comma or EOS.
+ call aclrc (sub, SZ_LINE)
+ op = 1
+ while (in[ip] != EOS && in[ip] != ',' && in[ip] != ';') {
+ sub[op] = in[ip]
+ ip = ip + 1
+ op = op + 1
+ }
+ ch = in[ip]
+
+ if (imx_isikparam (sub)) {
+ if (niki > 0)
+ call strcat (",", ikparams, maxch)
+ call strcat (sub, ikparams, maxch)
+ niki = niki + 1
+
+ } else {
+ if (nexpr > 0)
+ call strcat (",", expr, maxch)
+ call strcat (sub, expr, maxch)
+ nexpr = nexpr + 1
+ }
+
+ if (ch == EOS)
+ break
+ }
+end
+
+
+# IMX_ISIKPARAM -- See whether the substring refers to an image kernel param.
+
+bool procedure imx_isikparam (str)
+
+char str[ARB] # string to check
+
+int strncmp()
+
+begin
+ if (strncmp (str, "extname", 7) == 0 || strncmp (str, "extver", 6) == 0)
+ return (TRUE)
+
+ # Check for the "no" versions of selected keywords.
+ else if (strncmp (str, "no", 2) == 0) {
+ if ((strncmp (str[3], "append", 4) == 0) ||
+ (strncmp (str[3], "inherit", 4) == 0) ||
+ (strncmp (str[3], "overwrite", 4) == 0) ||
+ (strncmp (str[3], "dupname", 4) == 0) ||
+ (strncmp (str[3], "expand", 4) == 0))
+ return (TRUE)
+ }
+
+ # Other kernel keywords.
+ if (strncmp (str, "inherit", 4) == 0 ||
+ strncmp (str, "overwrite", 4) == 0 ||
+ strncmp (str, "dupname", 4) == 0 ||
+ strncmp (str, "append", 4) == 0 ||
+ strncmp (str, "noappend", 4) == 0 ||
+ strncmp (str, "type", 4) == 0 ||
+ strncmp (str, "expand", 4) == 0 ||
+ strncmp (str, "phulines", 4) == 0 ||
+ strncmp (str, "ehulines", 4) == 0 ||
+ strncmp (str, "padlines", 4) == 0 ||
+ strncmp (str, "cachesize", 4) == 0)
+ return (TRUE)
+
+ return (FALSE)
+end
diff --git a/sys/imio/imt/imxescape.x b/sys/imio/imt/imxescape.x
new file mode 100644
index 00000000..92750ab7
--- /dev/null
+++ b/sys/imio/imt/imxescape.x
@@ -0,0 +1,74 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "imx.h"
+
+
+# IMX_ESCAPE -- Return a pointer to the composed file name, escaping parts
+# as needed.
+
+pointer procedure imx_escape (in, index, extname, extver, ikparams,
+ section, expr, maxch)
+
+char in[ARB] #I File image name (without kernel or image sec)
+char index[ARB] #I Range list of extension indexes
+char extname[ARB] #I Pattern for extension names
+char extver[ARB] #I Range list of extension versions
+char ikparams[ARB] #I Image kernel parameters
+char section[ARB] #I Image section
+char expr[ARB] #I Selection expression
+int maxch #I Print errors?
+
+pointer out, op
+int i, len, level
+char ch, peek, prev
+bool init_esc
+
+int strlen()
+
+define output {Memc[op]=$1;op=op+1}
+define escape {output('\\');output($1)}
+
+begin
+ len = max (SZ_LINE, strlen (in))
+ call calloc (out, max (SZ_LINE, (4*len)), TY_CHAR)
+
+ op = out
+ level = 0
+
+ init_esc = false
+ for (i=1; i <= len; i=i+1) {
+ prev = in[max(1,i)]
+ ch = in[i]
+ peek = in[i+1]
+
+ if (ch == EOS)
+ break;
+ if (ch == '[') {
+ if (prev != ']' && !init_esc) {
+ output ('%')
+ output ('%')
+ output (CH_DELIM)
+ init_esc = true
+ }
+ escape (ch)
+ level = level + 1
+ } else if (ch == ']') {
+ output (ch)
+ if (peek != '[') # closing delim
+ output ('%')
+ level = level - 1
+ } else if (ch == ',') {
+ if (level > 0)
+ output('\\')
+ if (level == 0)
+ init_esc = false
+ output (ch)
+ } else if (ch == '*')
+ escape (ch)
+ else
+ output (ch)
+ }
+ output (EOS)
+
+ return (out)
+end
diff --git a/sys/imio/imt/imxexpand.x b/sys/imio/imt/imxexpand.x
new file mode 100644
index 00000000..72efb17c
--- /dev/null
+++ b/sys/imio/imt/imxexpand.x
@@ -0,0 +1,1287 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <syserr.h>
+include <imhdr.h>
+include <imset.h>
+include <mach.h>
+include <fio.h>
+include <finfo.h>
+include <ctype.h>
+include <diropen.h>
+
+include "imx.h"
+include <votParse_spp.h>
+
+
+define SZ_BUF 8192 # name buffer string
+
+
+# IMX_IMEXPAND -- Expand a template of FITS files into a list of image
+# extensions.
+
+pointer procedure imx_imexpand (input, expr, index, extname, extver, ikparams,
+ section, nimages)
+
+char input[ARB] # List of ME file names
+char expr[ARB] # Filtering expression
+char index[ARB] # Range list of extension indexes
+char extname[ARB] # Patterns for extension names
+char extver[ARB] # Range list of extension versions
+char ikparams[ARB] # Image kernel parameters
+char section[ARB] # Image section parameters
+int nimages # Number of output images
+
+int lindex # List index number?
+int lname # List extension name?
+int lver # List extension version?
+
+pointer in, out # Pointer to output string
+pointer sp, sif, image, listout
+int list, len, maxch
+
+int imx_extns(), strlen(), fntgfnb(), fntlenb()
+pointer imx_escape()
+bool imx_sifmatch()
+
+begin
+ call smark (sp)
+ call salloc (in, SZ_FNAME, TY_CHAR)
+ call salloc (image, SZ_FNAME, TY_CHAR)
+
+
+ lindex = YES # expansion parameters
+ lname = NO
+ lver = NO
+ out = NULL
+ len = 0
+ nimages = 0
+ maxch = SZ_LISTOUT
+
+ call aclrc (Memc[in], SZ_FNAME)
+ if (input[1] == '@')
+ call strcpy (input[2], Memc[in], SZ_FNAME)
+ else
+ call strcpy (input, Memc[in], SZ_FNAME)
+
+ # Get the list.
+ list = imx_extns (Memc[in], "IMAGE", index, extname, extver,
+ lindex, lname, lver, ikparams, section, expr, YES)
+
+ if (list == NULL || fntlenb (list) == 0) {
+ call calloc (out, SZ_LINE, TY_CHAR)
+ call strcpy (Memc[in], Memc[out], SZ_LINE)
+ if (section[1] != EOS) {
+ call strcat ("\\[", Memc[out], maxch)
+ call strcat (section, Memc[out], maxch)
+ call strcat ("]", Memc[out], maxch)
+ }
+ if (ikparams[1] != EOS) {
+ call strcat ("\\[", Memc[out], maxch)
+ call strcat (ikparams, Memc[out], maxch)
+ call strcat ("]", Memc[out], maxch)
+ }
+
+ if (index[1] == EOS && imx_sifmatch (Memc[out], expr)) {
+ nimages = 1
+ sif = imx_escape (Memc[out], index, extname, extver, ikparams,
+ section, expr, maxch)
+ } else
+ call calloc (sif, SZ_LINE, TY_CHAR)
+ call mfree (out, TY_CHAR)
+ return (sif)
+ }
+
+ # Format the output and set the number of images.
+ call calloc (listout, maxch, TY_CHAR)
+ iferr {
+ while (fntgfnb (list, Memc[image], SZ_FNAME) != EOF) {
+ nimages = nimages + 1
+ if (nimages > 1) {
+ call strcat (",", Memc[listout], maxch)
+ len = len + 1
+ }
+ if ((len + strlen (Memc[image])) >= maxch) {
+ maxch = maxch + SZ_LISTOUT
+ call realloc (listout, maxch, TY_CHAR)
+ }
+
+ call strcat (Memc[image], Memc[listout], maxch)
+ len = len + strlen (Memc[image])
+
+# if (section[1] != EOS) {
+# call strcat ("[", Memc[listout], maxch)
+# call strcat (section, Memc[listout], maxch)
+# call strcat ("]", Memc[listout], maxch)
+# len = len + strlen (section) + 2
+# }
+ }
+
+ # Escape the output image specification in a form that is correct
+ # for the filename template interface.
+
+ out = imx_escape (Memc[listout], index, extname, extver, ikparams,
+ section, expr, maxch)
+
+ } then {
+ call fntclsb (list)
+ call sfree (sp)
+ call error (1, "Output list format is too long")
+ }
+ call fntclsb (list)
+ call sfree (sp)
+
+ return (out)
+end
+
+
+# IMX_FEXPAND -- Expand a template of files into a list of images names.
+
+pointer procedure imx_fexpand (input, expr, index, extname, extver, ikparams,
+ section, nimages)
+
+char input[ARB] # List of ME file names
+char expr[ARB] # Filtering expression
+char index[ARB] # Range list of extension indexes
+char extname[ARB] # Patterns for extension names
+char extver[ARB] # Range list of extension versions
+char ikparams[ARB] # Image kernel parameters
+char section[ARB] # Image section parameters
+int nimages # Number of output images
+
+pointer sp, name, exp, lexp, nexp
+int fd, ip, op, len, elen, nlines, nims, maxch, nchars, level
+bool do_proc
+char line[SZ_LINE], buf[SZ_LINE], ch
+
+define output {buf[op]=$1;op=op+1}
+
+
+int open(), getline(), strlen(), stridx()
+pointer imx_imexpand()
+
+begin
+ iferr (fd = open (input, READ_ONLY, TEXT_FILE)) {
+ call error (1, "Cannot open @file")
+ return (NULL)
+ }
+
+ call smark (sp)
+ call salloc (name, SZ_PATHNAME, TY_CHAR)
+
+ maxch = SZ_FNT
+ call calloc (exp, maxch, TY_CHAR)
+ call aclrc (Memc[exp], maxch)
+
+#call eprintf (
+# "fexpand: index='%s' name='%s' ver='%s' sec='%s' ik='%s' expr='%s'\n")
+# call pargstr (index) ; call pargstr (extname) ; call pargstr (extver) ;
+# call pargstr (section) ; call pargstr (ikparams) ; call pargstr (expr)
+
+ nlines = 0
+ nchars = 0
+ nimages = 0
+
+ while (getline (fd, line) > 0) {
+ len = strlen (line)
+ line[len] = EOS # kill newline
+ nlines = nlines + 1
+
+ call aclrc (Memc[name], SZ_PATHNAME)
+ call sprintf (Memc[name], SZ_PATHNAME, "@%s")
+ call pargstr (line)
+
+ lexp = 0
+ do_proc = (index[1]!=EOS || section[1]!=EOS ||
+ expr[1]!=EOS || extname[1]!=EOS)
+
+ if (input[1] == '@' || do_proc) {
+
+ # We're either being asked to expand what is presumably a
+ # image name in the form of an @@file input, or else we've
+ # added image sections, expressions, etc where the correct
+ # output specification is the expanded image name.
+
+ lexp = imx_imexpand (Memc[name], expr, index, extname, extver,
+ ikparams, section, nims)
+
+ elen = 0
+ if (lexp != NULL && Memc[lexp] != EOS)
+ elen = strlen (Memc[lexp])
+
+ # Reallocate space is the output name if needed.
+ #if ((nchars + elen) >= (maxch - SZ_FNAME)) {
+ if ((nchars + elen) >= maxch) {
+ call calloc (nexp, maxch + SZ_FNT, TY_CHAR)
+ call amovc (Memc[exp], Memc[nexp], maxch)
+ call mfree (exp, TY_CHAR)
+ maxch = maxch + SZ_FNT
+ exp = nexp
+ }
+
+ # Create a comma-delimited list.
+ if (nlines > 1)
+ call strcat (",", Memc[exp], maxch)
+ if (lexp != NULL && Memc[lexp] != EOS) {
+ call strcat (Memc[lexp], Memc[exp], maxch)
+ nchars = nchars + elen + 1
+ }
+ nimages = nimages + nims
+ } else {
+ if (nlines > 1) {
+ call strcat (",", Memc[exp], maxch)
+ nchars = nchars + 1
+ }
+ if (stridx ('[', line) != 0) {
+ call aclrc (buf, SZ_LINE)
+ op = 1
+ for (ip=1; line[ip] != EOS; ip=ip+1) {
+ if (line[ip] == '[') {
+ output ('%')
+ output ('%')
+ output (CH_DELIM)
+
+ level = 0
+ for (; line[ip] != EOS; ip=ip+1) {
+ ch = line[ip]
+ if (ch == ',') { # ,
+ if (level <= 0)
+ break # exit loop
+ else {
+ output ('\\')
+ output (ch)
+ }
+ } else if (ch == '[') { # [
+ output ('\\')
+ output (ch)
+ level = level + 1
+ } else if (ch == ']') { # ]
+ output (ch)
+ level = level - 1
+ } else if (ch == '*') { # *
+ output ('\\')
+ output (ch)
+ } else # normal chars
+ output (ch)
+ }
+ output ('%')
+ ip = ip - 1
+
+ break
+ }
+ buf[op] = line[ip]
+ op = op + 1
+ }
+ call strcat (buf, Memc[exp], maxch)
+ nchars = nchars + strlen (buf)
+
+ } else {
+ call strcat (line, Memc[exp], maxch)
+ nchars = nchars + strlen (line)
+ }
+
+ nchars = nchars + len + 1
+ nimages = nimages + 1
+
+ # Reallocate space is the output name if needed.
+
+ if ((nchars + SZ_LINE) >= maxch) {
+ call calloc (nexp, maxch + SZ_FNT, TY_CHAR)
+ call amovc (Memc[exp], Memc[nexp], maxch)
+ call mfree (exp, TY_CHAR)
+ maxch = maxch + SZ_FNT
+ exp = nexp
+ }
+ }
+ call mfree (lexp, TY_CHAR)
+ }
+
+ call close (fd) # clean up
+ call sfree (sp)
+
+ return (exp)
+end
+
+
+# IMX_TEXPAND -- Expand a template of tables into a list of images.
+
+pointer procedure imx_texpand (input, type, expr, index, fmt, nimages)
+
+char input[ARB] # Input table name
+int type # Table type
+char expr[ARB] # Filtering expression
+char index[ARB] # Range list of table rows
+char fmt[ARB] # Requested file format
+int nimages # Number of output images
+
+char fname[SZ_PATHNAME] # File name to open
+char ofname[SZ_PATHNAME]
+pointer sp, exp, nodename
+int ip, vfd, status, delim
+
+pointer imx_votable(), imx_table()
+int vfnopen(), vfnmapu(), strncmp(), ki_gnode()
+
+begin
+ call smark (sp)
+ call salloc (nodename, SZ_PATHNAME, TY_CHAR)
+
+ exp = NULL # initialize values
+ nimages = 0
+
+ # Get the base filename without the '@' prefix.
+ if (input[1] == '@')
+ call strcpy (input[2], fname, SZ_PATHNAME)
+ else
+ call strcpy (input, fname, SZ_PATHNAME)
+
+ # Map input VFN to OSFN.
+ ip = 1
+ if (strncmp (fname, "http://", 7) == 0) {
+ call strcpy (fname, ofname, SZ_PATHNAME)
+ } else {
+ vfd = vfnopen (fname, READ_ONLY)
+ status = vfnmapu (vfd, ofname, SZ_PATHNAME)
+ call vfnclose (vfd, VFN_NOUPDATE)
+
+ # If the file resides on the local node strip the node name,
+ # returning a legal host system filename as the result.
+ if (ki_gnode (ofname, Memc[nodename], delim) == 0)
+ ip = delim + 1
+ }
+
+
+ # Now process the file. For a VOTable we parse the file and
+ # extract the acref columns as cached image names, for ascii
+ # tables we read the URLs directly but likewise returned the
+ # cache name.
+
+ if (type == IMT_TABLE)
+ exp = imx_table (ofname[ip], index, nimages)
+ else if (type == IMT_VOTABLE)
+ exp = imx_votable (ofname[ip], expr, index, fmt, nimages)
+
+ call sfree (sp)
+ return (exp)
+end
+
+
+# IMX_DEXPAND -- Expand a directory into a list of images.
+
+pointer procedure imx_dexpand (input, expr, index, extname, extver, ikparams,
+ sec, nimages)
+
+char input[ARB] # List of MEF file names
+char expr[ARB] # Filtering expression
+char index[ARB] # Index range
+char extname[ARB] # Extension name
+char extver[ARB] # Extension version
+char ikparams[ARB] # IKI parameters
+char sec[ARB] # Image section
+int nimages # Number of output images
+
+pointer sp, exp, nodename, imname, listout
+int dir, len, llen, nim, ip, delim, vfd, status, maxlen
+char dirname[SZ_PATHNAME], ofname[SZ_PATHNAME], pdir[SZ_PATHNAME]
+char fpath[SZ_PATHNAME], fname[SZ_PATHNAME]
+
+pointer imx_imexpand ()
+int vfnopen(), vfnmapu(), ki_gnode(), imx_filetype()
+int strlen(), diropen(), isdirectory(), getline()
+
+begin
+ call smark (sp)
+ call salloc (nodename, SZ_PATHNAME, TY_CHAR)
+
+ # Get the base filename without the '@' prefix.
+ if (input[1] == '@') {
+ if (input[2] == '@')
+ call strcpy (input[3], dirname, SZ_PATHNAME)
+ else
+ call strcpy (input[2], dirname, SZ_PATHNAME)
+ } else
+ call strcpy (input, dirname, SZ_PATHNAME)
+
+ # Remove trailing '/' or '$' from dir
+ len = strlen (dirname)
+ if (dirname[len] == '/')
+ dirname[len] = EOS
+
+ # Map input VFN to OSFN.
+ ip = 1
+ vfd = vfnopen (dirname, READ_ONLY)
+ status = vfnmapu (vfd, ofname, SZ_PATHNAME)
+ call vfnclose (vfd, VFN_NOUPDATE)
+
+ # If the file resides on the local node strip the node name,
+ # returning a legal host system filename as the result.
+ if (ki_gnode (ofname, Memc[nodename], delim) == 0)
+ ip = delim + 1
+
+ call sfree (sp)
+
+ # Otherwise, read through the directory and remove the contents.
+ dir = diropen (ofname, SKIP_HIDDEN_FILES)
+
+ maxlen = SZ_LISTOUT
+ call calloc (listout, SZ_LISTOUT, TY_CHAR)
+ llen = 0
+ while (getline (dir, fname) != EOF) {
+ len = strlen (fname)
+ fname[len] = '\0'
+
+ len = strlen (ofname)
+ if (ofname[len] == '/' || ofname[len] == '$')
+ call sprintf (fpath, SZ_PATHNAME, "%s%s")
+ else
+ call sprintf (fpath, SZ_PATHNAME, "%s/%s")
+ call pargstr (dirname)
+ call pargstr (fname)
+
+ llen = llen + strlen (fpath)
+
+ # We only test plain files, skip directories.
+ if (isdirectory (fpath, pdir, SZ_PATHNAME) > 0)
+ next
+
+ if (imx_filetype (fpath) == IMT_IMAGE) {
+
+ if (input[2] == '@')
+ imname = imx_imexpand (fpath, expr, index, extname, extver,
+ ikparams, sec, nim)
+ else {
+ call calloc (imname, SZ_PATHNAME, TY_CHAR)
+ call strcpy (fpath, Memc[imname], SZ_PATHNAME)
+ }
+
+ if (imname != NULL && Memc[imname] != EOS) {
+ nimages = nimages + 1
+
+ if (nimages > 1) {
+ call strcat (",", Memc[listout], maxlen)
+ llen = llen + 1
+ }
+ if ((llen + strlen (Memc[imname])) >= maxlen) {
+ maxlen = maxlen + SZ_LISTOUT
+ call realloc (listout, maxlen, TY_CHAR)
+ }
+
+ call strcat (Memc[imname], Memc[listout], maxlen)
+ llen = llen + strlen (Memc[imname])
+
+ if (sec[1] != EOS) {
+ call strcat ("[", Memc[listout], maxlen)
+ call strcat (sec, Memc[listout], maxlen)
+ call strcat ("]", Memc[listout], maxlen)
+ llen = llen + strlen (sec) + 2
+ }
+
+ if (imname != NULL)
+ call mfree (imname, TY_CHAR)
+ }
+ }
+ }
+
+ return (listout)
+end
+
+
+# IMX_FETCH -- Fetch the urls from the list.
+
+procedure imx_fetch (urls, istemp)
+
+char urls[ARB] #I file of URLS to download
+bool istemp #i is input file temporary?
+
+char osfn[SZ_PATHNAME]
+char url_osfn[SZ_PATHNAME]
+
+int n, envgets()
+char nthreads[SZ_FNAME]
+
+begin
+ # Get the host pathname of the cache directory.
+ call fmapfn ("cache$", osfn, SZ_PATHNAME)
+ call strupk (osfn, osfn, SZ_PATHNAME)
+
+ call fmapfn (urls, url_osfn, SZ_PATHNAME)
+ call strupk (url_osfn, url_osfn, SZ_PATHNAME)
+
+ n = envgets ("vo_nthreads", nthreads, SZ_FNAME)
+
+ # voget -B -C -D cache$ -b url -N <N> [-t] <infile>
+ if (istemp) {
+ call vx_voget (10, "-B", "-C", "-D", osfn, "-b", "url",
+ "-N", nthreads, "-t", url_osfn)
+ } else {
+ call vx_voget (10, "-B", "-C", "-D", osfn, "-b", "url",
+ "-N", nthreads, "-B", url_osfn)
+ }
+end
+
+
+# IMX_VOTABLE -- Read a VOTable, extracting the column of access references
+# as the image list.
+
+pointer procedure imx_votable (input, expr, index, fmt, nimages)
+
+char input[ARB] # List of ME file names
+char expr[ARB] # Filtering expression
+char index[ARB] # Range list of table rows
+char fmt[ARB] # Requested file format
+int nimages # Number of output images
+
+pointer vot, exp, ranges
+int nranges, tfd
+char tfile[SZ_PATHNAME]
+
+int open()
+int imx_decode_ranges()
+pointer imx_votselect(), votinit()
+bool envgetb()
+
+begin
+ # Create a temp file for the parsed access references.
+ call mktemp ("tmp$vot", tfile, SZ_PATHNAME)
+ iferr (tfd = open (tfile, NEW_FILE, TEXT_FILE)) {
+ nimages = 0
+ return (NULL)
+ }
+
+ # Expand the index string into a range structure.
+ if (index[1] != EOS) {
+ call calloc (ranges, 3 * SZ_RANGE, TY_INT)
+ if (imx_decode_ranges (index, Memi[ranges], SZ_RANGE,
+ nranges, YES) == ERR) {
+ call eprintf ("error parsing range '%s'\n")
+ call pargstr (index)
+ }
+ } else
+ ranges = NULL
+
+ # Initialize the VOT struct and parse the table.
+ vot = votinit (input)
+
+ # Select the column from the VOTable with the access reference.
+ exp = imx_votselect (vot, tfd, fmt, ranges, nimages)
+
+ call mfree (ranges, TY_INT)
+ call votclose (vot) # close the files
+ call close (tfd)
+
+ # Close the temp file and pre-fetch the data if needed.
+ if (envgetb ("vo_prefetch"))
+ call imx_fetch (tfile, true)
+
+ return (exp)
+end
+
+
+# IMX_VOTSELECT -- Select the access reference column.
+
+pointer procedure imx_votselect (vot, fd, fmt, ranges, nimages)
+
+pointer vot #i VOTable struct pointer
+int fd #i filename of selected rows
+char fmt[ARB] #i file format
+pointer ranges #i ranges struct pointer
+int nimages #o no. selected images
+
+pointer exp
+int col, len, clen, maxlen
+char acref_ucd[SZ_FNAME], imfmt[SZ_FNAME], ucd_col[SZ_FNAME]
+char acref[SZ_LINE], ucd[SZ_FNAME], buf[SZ_LINE], cfname[SZ_PATHNAME]
+int i, rownum, field, acref_col, acfmt_col
+
+int strcmp(), strsearch(), strlen(), vx_getNext()
+bool imx_in_range()
+
+begin
+ # Figure out which table column we want. Note that we assume there
+ # is only one <RESOURCE> element. The caller may pass in a specific
+ # column to be used, otherwise look for for the named UCD.
+
+ col = 0 # FIXME
+ call aclrc (ucd_col, SZ_FNAME) # FIXME
+ call strcpy ("fits", imfmt, SZ_FNAME) # FIXME
+
+ call aclrc (acref_ucd, SZ_FNAME)
+ if (col > 0) {
+ acref_col = col
+ } else {
+ if (ucd_col[1] != EOS)
+ call strcpy (ucd_col, acref_ucd, SZ_FNAME)
+ else
+ call strcpy (DEF_ACREF_UCD, acref_ucd, SZ_FNAME)
+
+ # Find the access reference column number.
+ i = 0
+ for (field=VOT_FIELD(vot); field > 0; field=vx_getNext (field)) {
+ call aclrc (ucd, SZ_FNAME)
+ call vx_getAttr (field, "ucd", ucd, SZ_FNAME)
+ if (strcmp (ucd, acref_ucd) == 0) {
+ acref_col = i
+ } else if (strcmp (ucd, DEF_FORMAT_UCD) == 0)
+ acfmt_col = i
+ i = i + 1
+ }
+ }
+
+ maxlen = SZ_BUF
+ call calloc (exp, maxlen, TY_CHAR)
+
+ # Download the files.
+ for (i=0; i < VOT_NROWS(vot); i=i+1) {
+ call vx_getTableCell (VOT_TDATA(vot), i, acfmt_col, imfmt, SZ_FNAME)
+
+ if (fmt[1] == EOS || (fmt[1] != EOS && strsearch(imfmt, fmt) > 0)) {
+ call vx_getTableCell (VOT_TDATA(vot), i, acref_col,
+ acref, SZ_LINE)
+
+ # Do the row selection based on the index string.
+ rownum = i + 1
+ if (ranges != NULL && ! imx_in_range (Memi[ranges], rownum))
+ next
+
+ # Generate a unique cache filename based on the URL.
+ call fcname ("cache$", acref, "url", cfname, SZ_PATHNAME)
+
+ # Append the cache name to the output string. Reallocate the
+ # string pointer if needed.
+ clen = strlen (cfname)
+ if ((len + clen) >= maxlen) {
+ maxlen = maxlen + SZ_BUF
+ call realloc (exp, maxlen, TY_CHAR)
+ }
+ len = len + clen
+
+ if (nimages == 0) {
+ call strcpy (cfname, Memc[exp], maxlen)
+ } else {
+ call strcat (",", Memc[exp], maxlen)
+ call strcat (cfname, Memc[exp], maxlen)
+ }
+ call aclrc (buf, SZ_LINE)
+
+ # Write the URL to the download file.
+ call fprintf (fd, "%s\n")
+ call pargstr (acref)
+
+ nimages = nimages + 1
+ }
+ }
+
+ return (exp)
+end
+
+
+# IMX_TABLE -- Read an ASCII text table of URLs and create the list
+# of files to process. We apply the list index to do row selection
+# and return a list of cached filenames.
+
+pointer procedure imx_table (input, index, nimages)
+
+char input[ARB] # List of ME file names
+char index[ARB] # Range list of table rows
+int nimages # Number of output images
+
+pointer exp, ranges
+int rownum, nranges, fd, len, clen, maxlen
+char buf[SZ_LINE], cfname[SZ_PATHNAME]
+
+int open(), getline(), strlen()
+int imx_decode_ranges()
+bool imx_in_range(), envgetb()
+
+begin
+ call aclrc (buf, SZ_LINE)
+ iferr (fd = open (input, READ_ONLY, TEXT_FILE))
+ call syserr (SYS_FOPEN)
+
+ maxlen = SZ_BUF
+ call calloc (exp, maxlen, TY_CHAR)
+
+ call calloc (ranges, 3 * SZ_RANGE, TY_INT)
+ if (index[1] != EOS) {
+ if (imx_decode_ranges (index, Memi[ranges], SZ_RANGE,
+ nranges, YES) == ERR) {
+ call eprintf ("error parsing range '%s'\n")
+ call pargstr (index)
+ }
+ }
+
+ len = 0
+ nimages = 0
+ rownum = 0
+ while (getline (fd, buf) != EOF) {
+
+ # Skip comments and blank lines.
+ if (buf[1] == '\n' || buf[1] == '#')
+ next
+ else
+ rownum = rownum + 1
+
+ # Do the row selection based on the index string.
+ if (index[1] != EOS && ! imx_in_range (Memi[ranges], rownum))
+ next
+
+ # Generate a unique cache filename based on the URL.
+ call fcname ("cache$", buf, "url", cfname, SZ_PATHNAME)
+
+ # Append the cache name to the output string. Reallocate the
+ # string pointer if needed.
+ clen = strlen (cfname)
+ if ((len + clen) >= maxlen) {
+ maxlen = maxlen + SZ_BUF
+ call realloc (exp, maxlen, TY_CHAR)
+ }
+ len = len + clen
+
+ if (nimages == 0) {
+ call strcpy (cfname, Memc[exp], maxlen)
+ } else {
+ call strcat (",", Memc[exp], maxlen)
+ call strcat (cfname, Memc[exp], maxlen)
+ }
+ call aclrc (buf, SZ_LINE)
+
+ nimages = nimages + 1
+ }
+
+ call mfree (ranges, TY_INT)
+ call close (fd)
+
+ if (envgetb ("vo_prefetch"))
+ call imx_fetch (input, false)
+
+ return (exp)
+end
+
+
+# IMX_EXTNS -- Expand a template of ME files into a list of image extensions.
+
+int procedure imx_extns (files, exttype, index, extname, extver,
+ lindex, lname, lver, ikparams, section, expr, err)
+
+char files[ARB] #I List of ME files
+char exttype[ARB] #I Extension type string
+char index[ARB] #I Range list of extension indexes
+char extname[ARB] #I Patterns for extension names
+char extver[ARB] #I Range list of extension versions
+int lindex #I List index number?
+int lname #I List extension name?
+int lver #I List extension version?
+char expr[ARB] #I Selection expression
+char ikparams[ARB] #I Image kernel parameters
+char section[ARB] #I Image section parameters
+int err #I Print errors?
+int list #O Image list
+
+int i, fd, create
+pointer sp, temp, fname, imname, sec, rindex, rextver, ikp, str
+int fntopnb(), fntgfnb()
+int imx_decode_ranges(), nowhite(), open()
+errchk open, imx_extn, delete
+
+begin
+ call smark (sp)
+ call salloc (temp, SZ_FNAME, TY_CHAR)
+ call salloc (fname, SZ_FNAME, TY_CHAR)
+ call salloc (imname, SZ_FNAME, TY_CHAR)
+ call salloc (sec, SZ_FNAME, TY_CHAR)
+ call salloc (ikp, SZ_LINE, TY_CHAR)
+ call salloc (str, SZ_LINE, TY_CHAR)
+
+ # Expand parameters.
+ list = fntopnb (files, NO)
+ call salloc (rindex, 3*SZ_RANGE, TY_INT)
+ if (imx_decode_ranges (index, Memi[rindex], SZ_RANGE, i, create) == ERR)
+ call error (1, "Bad index range list")
+
+ rextver = NULL
+ if (nowhite (extver, Memc[str], SZ_LINE) > 0) {
+ call salloc (rextver, 3*SZ_RANGE, TY_INT)
+ if (imx_decode_ranges (Memc[str], Memi[rextver], SZ_RANGE,
+ i, create) == ERR)
+ call error (1, "Bad extension version range list")
+ }
+
+ call aclrc (Memc[ikp], SZ_LINE)
+ i = nowhite (ikparams, Memc[ikp], SZ_LINE)
+
+ # Expand ME files into list of image extensions in a temp file.
+ call mktemp ("@tmp$iraf", Memc[temp], SZ_FNAME)
+ fd = open (Memc[temp+1], NEW_FILE, TEXT_FILE)
+ while (fntgfnb (list, Memc[fname], SZ_FNAME) != EOF) {
+ call imgimage (Memc[fname], Memc[imname], SZ_FNAME)
+ call imgsection (Memc[fname], Memc[sec], SZ_FNAME)
+
+ call imx_extn (fd, Memc[imname], exttype, expr, rindex, extname,
+ rextver, lindex, lname, lver, Memc[ikp], section,
+ create, err)
+ }
+ call fntclsb (list)
+ call close (fd)
+
+ # Return list.
+ list = fntopnb (Memc[temp], NO)
+ call delete (Memc[temp+1])
+ call sfree (sp)
+
+ return (list)
+end
+
+
+# IMX_EXTN -- Expand a single ME file into a list of image extensions.
+# The image extensions are written to the input file descriptor.
+
+procedure imx_extn (fd, fname, exttype, expr, index, extname, extver, lindex,
+ lname, lver, ikparams, section, create, err)
+
+int fd #I File descriptor for list
+char fname[SZ_FNAME] #I File image name (without kernel or image sec)
+char exttype[SZ_FNAME] #I File extension type
+char expr[ARB] #I Selection expression
+pointer index #I Range list of extension indexes
+char extname[ARB] #I Pattern for extension names
+pointer extver #I Range list of extension versions
+int lindex #I List index number?
+int lname #I List extension name?
+int lver #I List extension version?
+char ikparams[ARB] #I Image kernel parameters
+char section[ARB] #I Image section
+int create #I Create names from index range?
+int err #I Print errors?
+
+pointer sp, image, name, type, str, im
+int i, j, ver
+
+pointer immap()
+int imx_get_next_number(), errcode(), imgeti(), stridxs(), strcmp()
+bool imx_in_range(), imx_extmatch(), imx_matchexpr(), imx_sifmatch()
+
+begin
+ call smark (sp)
+ call salloc (image, SZ_FNAME, TY_CHAR)
+ call salloc (type, SZ_FNAME, TY_CHAR)
+ call salloc (name, SZ_LINE, TY_CHAR)
+ call salloc (str, SZ_LINE, TY_CHAR)
+
+ i = -1
+ while (imx_get_next_number (Memi[index], i) != EOF) {
+ j = stridxs ("[", fname)
+ if (j > 0) {
+ if (i > 0)
+ break
+ call strcpy (fname, Memc[image], SZ_FNAME)
+ } else {
+ call sprintf (Memc[image], SZ_FNAME, "%s[%d]")
+ call pargstr (fname)
+ call pargi (i)
+ }
+
+ if (section[1] != EOS) {
+ call strcat ("[", Memc[image], SZ_FNAME)
+ call strcat (section, Memc[image], SZ_FNAME)
+ call strcat ("]", Memc[image], SZ_FNAME)
+ }
+
+ # We know the extension doesn't exist, generate the name.
+ if (create == YES) {
+ call fprintf (fd, "%s")
+ call pargstr (Memc[image])
+ if (section[1] != EOS) {
+ call fprintf (fd, "[%s]")
+ call pargstr (section)
+ }
+ call fprintf (fd, "\n")
+ next
+ }
+
+
+ iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+ switch (errcode()) {
+ case SYS_FXFRFEOF:
+ if (i == 1) {
+ if (extname[1] == EOS && imx_sifmatch (fname, expr)) {
+ call fprintf (fd, "%s\n")
+ call pargstr (fname)
+ next
+ } else
+ break
+ }
+ break
+ case SYS_IKIEXTN:
+ next
+ case SYS_IKIOPEN:
+ switch (i) {
+ case 0:
+ next
+ case 1:
+ if (err == YES)
+ call erract (EA_WARN)
+ break
+ default:
+ break
+ }
+ default:
+ call erract (EA_ERROR)
+ }
+ }
+
+
+ # Check the extension type. [NOT USED]
+ if (exttype[1] != EOS) {
+ iferr (call imgstr (im, "xtension", Memc[type], SZ_FNAME))
+ Memc[type] = EOS
+ if (Memc[type] != EOS && strcmp (Memc[type], exttype) != 0) {
+ call imunmap (im)
+ next
+ }
+ }
+
+#call eprintf("imx_extn: name='%s' ver='%s' expr='%s' sec='%s' iki='%s'\n")
+# call pargstr (extname) ; call pargstr (Memc[extver]) ;
+# call pargstr (expr) ; call pargstr (section) ;
+# call pargstr (ikparams) ;
+
+ # Check the extension name.
+ if (extname[1] != EOS) {
+ iferr (call imgstr (im, "extname", Memc[name], SZ_FNAME))
+ Memc[name] = EOS
+ if (!imx_extmatch (Memc[name], extname)) {
+ call imunmap (im)
+ next
+ }
+ }
+
+ # Check the extension version.
+ if (extver != NULL) {
+ iferr (ver = imgeti (im, "extver")) {
+ call imunmap (im)
+ next
+ }
+ if (!imx_in_range (Memi[extver], ver)) {
+ call imunmap (im)
+ next
+ }
+ }
+
+ # Check the selection expression.
+ if (expr[1] != EOS) {
+ if (!imx_matchexpr (im, expr)) {
+ call imunmap (im)
+ next
+ }
+ }
+
+
+ # Set the extension name and version.
+ if (lname == YES) {
+ iferr (call imgstr (im, "extname", Memc[name], SZ_LINE))
+ Memc[name] = EOS
+ } else
+ Memc[name] = EOS
+ if (lver == YES) {
+ iferr (ver = imgeti (im, "extver"))
+ ver = INDEFI
+ } else
+ ver = INDEFI
+
+ # Write the image name.
+ call fprintf (fd, fname)
+ if (j == 0) {
+ if (lindex == YES || (Memc[name] == EOS && IS_INDEFI(ver))) {
+ call fprintf (fd, "[%d]")
+ call pargi (i)
+ }
+ if (Memc[name] != EOS) {
+ call fprintf (fd, "[%s")
+ call pargstr (Memc[name])
+ if (!IS_INDEFI(ver)) {
+ call fprintf (fd, ",%d")
+ call pargi (ver)
+ }
+ if (ikparams[1] != EOS) {
+ call fprintf (fd, ",%s")
+ call pargstr (ikparams)
+ }
+ call fprintf (fd, "]")
+ } else if (!IS_INDEFI(ver)) {
+ call fprintf (fd, "[extver=%d")
+ call pargi (ver)
+ if (ikparams[1] != EOS) {
+ call fprintf (fd, ",%s")
+ call pargstr (ikparams)
+ }
+ call fprintf (fd, "]")
+ } else if (ikparams[1] != EOS) {
+ call fprintf (fd, "[%s]%%")
+ call pargstr (ikparams)
+ }
+ }
+ if (section[1] != EOS) {
+ call fprintf (fd, "[%s]")
+ call pargstr (section)
+ }
+ call fprintf (fd, "\n")
+
+ call imunmap (im)
+ }
+
+ call sfree (sp)
+end
+
+
+# IMX_DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas. Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers. ERR is returned as
+# the function value if a conversion error occurs. The list of ranges is
+# delimited by EOLIST.
+
+int procedure imx_decode_ranges (range_string, ranges, max_ranges,
+ nvalues, create)
+
+char range_string[ARB] # Range string to be decoded
+int ranges[3, max_ranges] # Range array
+int max_ranges # Maximum number of ranges
+int nvalues # The number of values in the ranges
+int create # generate range string?
+
+int ip, nrange, first, last, step, ctoi()
+
+begin
+ create = NO
+ if (range_string[1] == '+') {
+ ip = 2
+ create = YES
+ } else
+ ip = 1
+ nvalues = 0
+
+ do nrange = 1, max_ranges - 1 {
+ # Defaults to all nonnegative integers
+ first = FIRST
+ last = LAST
+ step = STEP
+
+ # Skip delimiters
+ while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+ ip = ip + 1
+
+ # Get first limit.
+ # Must be a number, '-', 'x', or EOS. If not return ERR.
+ if (range_string[ip] == EOS) { # end of list
+ if (nrange == 1) {
+ # Null string defaults
+ ranges[1, 1] = first
+ ranges[2, 1] = last
+ ranges[3, 1] = step
+ ranges[1, 2] = EOLIST
+ nvalues = MAX_INT
+ return (OK)
+ } else {
+ ranges[1, nrange] = EOLIST
+ return (OK)
+ }
+ } else if (range_string[ip] == '-')
+ ;
+ else if (range_string[ip] == 'x')
+ ;
+ else if (IS_DIGIT(range_string[ip])) { # ,n..
+ if (ctoi (range_string, ip, first) == 0)
+ return (ERR)
+ } else
+ return (ERR)
+
+ # Skip delimiters
+ while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+ ip = ip + 1
+
+ # Get last limit
+ # Must be '-', or 'x' otherwise last = first.
+ if (range_string[ip] == 'x')
+ ;
+ else if (range_string[ip] == '-') {
+ ip = ip + 1
+ while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+ ip = ip + 1
+ if (range_string[ip] == EOS)
+ ;
+ else if (IS_DIGIT(range_string[ip])) {
+ if (ctoi (range_string, ip, last) == 0)
+ return (ERR)
+ } else if (range_string[ip] == 'x')
+ ;
+ else
+ return (ERR)
+ } else
+ last = first
+
+ # Skip delimiters
+ while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+ ip = ip + 1
+
+ # Get step.
+ # Must be 'x' or assume default step.
+ if (range_string[ip] == 'x') {
+ ip = ip + 1
+ while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+ ip = ip + 1
+ if (range_string[ip] == EOS)
+ ;
+ else if (IS_DIGIT(range_string[ip])) {
+ if (ctoi (range_string, ip, step) == 0)
+ ;
+ if (step == 0)
+ return (ERR)
+ } else if (range_string[ip] == '-')
+ ;
+ else
+ return (ERR)
+ }
+
+ # Output the range triple.
+ ranges[1, nrange] = first
+ ranges[2, nrange] = last
+ ranges[3, nrange] = step
+ nvalues = nvalues + abs (last-first) / step + 1
+ }
+
+ return (ERR) # ran out of space
+end
+
+
+# IMX_GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number. Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given. Duplicate entries
+# are ignored. EOF is returned at the end of the list.
+
+int procedure imx_get_next_number (ranges, number)
+
+int ranges[ARB] # Range array
+int number # Both input and output parameter
+
+int ip, first, last, step, next_number, remainder
+
+begin
+ # If number+1 is anywhere in the list, that is the next number,
+ # otherwise the next number is the smallest number in the list which
+ # is greater than number+1.
+
+ number = number + 1
+ next_number = MAX_INT
+
+ for (ip=1; ranges[ip] != EOLIST; ip=ip+3) {
+ first = min (ranges[ip], ranges[ip+1])
+ last = max (ranges[ip], ranges[ip+1])
+ step = ranges[ip+2]
+ if (step == 0)
+ call error (1, "Step size of zero in range list")
+ if (number >= first && number <= last) {
+ remainder = mod (number - first, step)
+ if (remainder == 0)
+ return (number)
+ if (number - remainder + step <= last)
+ next_number = number - remainder + step
+ } else if (first > number)
+ next_number = min (next_number, first)
+ }
+
+ if (next_number == MAX_INT)
+ return (EOF)
+ else {
+ number = next_number
+ return (number)
+ }
+end
+
+
+# IMX_EXTMATCH -- Match extname against a comma-delimited list of patterns.
+
+bool procedure imx_extmatch (extname, patterns)
+
+char extname[ARB] #I Extension name to match
+char patterns[ARB] #I Comma-delimited list of patterns
+bool stat #O Match?
+
+int i, j, k, sz_pat, strlen(), patmake(), patmatch(), nowhite()
+pointer sp, patstr, patbuf
+
+begin
+ stat = false
+
+ sz_pat = strlen (patterns)
+ if (sz_pat == 0)
+ return (stat)
+ sz_pat = sz_pat + SZ_LINE
+
+ call smark (sp)
+ call salloc (patstr, sz_pat, TY_CHAR)
+ call salloc (patbuf, sz_pat, TY_CHAR)
+
+ i = nowhite (patterns, Memc[patstr], sz_pat)
+ if (i == 0)
+ stat = true
+ else if (i == 1 && Memc[patstr] == '*')
+ stat = true
+ else {
+ i = 1
+ for (j=i;; j=j+1) {
+ if (patterns[j] != ',' && patterns[j] != EOS)
+ next
+ if (j - i > 0) {
+ if (j-i == 1 && patterns[i] == '*') {
+ stat = true
+ break
+ }
+ call strcpy (patterns[i], Memc[patstr+1], j-i)
+ Memc[patstr] = '^'
+ Memc[patstr+j-i+1] = '$'
+ Memc[patstr+j-i+2] = EOS
+ k = patmake (Memc[patstr], Memc[patbuf], sz_pat)
+ if (patmatch (extname, Memc[patbuf]) > 0) {
+ stat = true
+ break
+ }
+ }
+ if (patterns[j] == EOS)
+ break
+ i = j + 1
+ }
+ }
+
+ call sfree (sp)
+ return (stat)
+end
+
+
+# IMX_IN_RANGE -- Test number to see if it is in range.
+# If the number is INDEFI then it is mapped to the maximum integer.
+
+bool procedure imx_in_range (ranges, number)
+
+int ranges[ARB] # Range array
+int number # Number to be tested against ranges
+
+int ip, first, last, step, num
+
+begin
+ if (IS_INDEFI (number))
+ num = MAX_INT
+ else
+ num = number
+
+ for (ip=1; ranges[ip] != NULL; ip=ip+3) {
+ first = min (ranges[ip], ranges[ip+1])
+ last = max (ranges[ip], ranges[ip+1])
+ step = ranges[ip+2]
+ if (num >= first && num <= last)
+ if (mod (num - first, step) == 0)
+ return (true)
+ }
+
+ return (false)
+end
diff --git a/sys/imio/imt/imxexpr.x b/sys/imio/imt/imxexpr.x
new file mode 100644
index 00000000..55c185ef
--- /dev/null
+++ b/sys/imio/imt/imxexpr.x
@@ -0,0 +1,222 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <evexpr.h>
+include <imset.h>
+include <imhdr.h>
+include <ctype.h>
+include <lexnum.h>
+
+define LEN_USERAREA 28800 # allow for the largest possible header
+define SZ_IMAGENAME 63 # max size of an image name
+define SZ_FIELDNAME 31 # max size of a field name
+
+define DEBUG FALSE
+
+
+
+# IMX_MATCHEXPR -- Match the open image descriptor against the expression.
+
+bool procedure imx_matchexpr (im, expr)
+
+pointer im #I image descriptor
+char expr[ARB] #I expression string
+
+bool stat
+char val[SZ_LINE]
+pointer o
+
+pointer imt_im # getop common
+char imt_image[SZ_IMAGENAME]
+char imt_field[SZ_FIELDNAME]
+common /imtgop/ imt_im, imt_image, imt_field
+
+pointer evexpr()
+extern imx_getop()
+int locpr()
+errchk locpr, evexpr
+
+begin
+ call aclrc (val, SZ_LINE)
+ call aclrc (imt_image, SZ_IMAGENAME)
+ call aclrc (imt_field, SZ_FIELDNAME)
+
+ imt_im = im
+ if (expr[1] != EOS) {
+ iferr {
+ o = evexpr (expr, locpr (imx_getop), 0)
+ call imx_encodeop (o, val, SZ_LINE)
+ stat = O_VALB(o)
+ call xev_freeop (o)
+ call mfree (o, TY_STRUCT)
+ } then
+ stat = FALSE
+
+ if (DEBUG) {
+ call eprintf ("expr = '%s' %b\n")
+ call pargstr (expr) ; call pargb (stat)
+ }
+
+ return (stat)
+ }
+
+ return (FALSE)
+end
+
+
+# IMX_SIFMATCH -- Check whether the file is a simple image matching the
+# expression.
+
+bool procedure imx_sifmatch (fname, expr)
+
+char fname[ARB] #I image name
+char expr[ARB] #I expression string
+
+pointer im
+bool stat
+
+pointer immap()
+bool imx_matchexpr (), streq()
+errchk immap
+
+begin
+ if (expr[1] == EOS)
+ return (TRUE)
+
+ iferr (im = immap (fname, READ_ONLY, 0)) {
+ return (FALSE)
+ }
+
+ if (streq (expr, "yes"))
+ stat = TRUE
+ else
+ stat = imx_matchexpr (im, expr)
+ call imunmap (im)
+
+ return (stat)
+end
+
+
+# IMX_GETOP -- Satisfy an operand request from EVEXPR. In this context,
+# operand names refer to the fields of the image header. The following
+# special operand names are recognized:
+#
+# . a string literal, returned as the string "."
+# $ the value of the current field
+# $F the name of the current field
+# $I the name of the current image
+# $T the current time, expressed as an integer
+#
+# The companion procedure HE_GETOPSETIMAGE is used to pass the image pointer
+# and image and field names.
+
+procedure imx_getop (operand, o)
+
+char operand[ARB] # operand name
+pointer o # operand (output)
+
+pointer imt_im # getop common
+char imt_image[SZ_IMAGENAME]
+char imt_field[SZ_FIELDNAME]
+common /imtgop/ imt_im, imt_image, imt_field
+bool streq()
+long clktime()
+errchk imx_getfield
+
+begin
+ if (streq (operand, ".")) {
+ call xev_initop (o, 1, TY_CHAR)
+ call strcpy (".", O_VALC(o), 1)
+
+ } else if (streq (operand, "$")) {
+ call imx_getfield (imt_im, imt_field, o)
+
+ } else if (streq (operand, "$F")) {
+ call xev_initop (o, SZ_FIELDNAME, TY_CHAR)
+ call strcpy (imt_field, O_VALC(o), SZ_FIELDNAME)
+
+ } else if (streq (operand, "$I")) {
+ call xev_initop (o, SZ_IMAGENAME, TY_CHAR)
+ call strcpy (imt_image, O_VALC(o), SZ_IMAGENAME)
+
+ } else if (streq (operand, "$T")) {
+ # Assignment of long into int may fail on some systems. Maybe
+ # should use type string and let database convert to long...
+
+ call xev_initop (o, 0, TY_INT)
+ O_VALI(o) = clktime (long(0))
+
+ } else
+ call imx_getfield (imt_im, operand, o)
+end
+
+
+# IMX_GETFIELD -- Return the value of the named field of the image header as
+# an EVEXPR type operand structure.
+
+procedure imx_getfield (im, field, o)
+
+pointer im # image descriptor
+char field[ARB] # name of field to be returned
+pointer o # pointer to output operand
+
+bool imgetb()
+int ftype, imgeti(), imgftype()
+real imgetr()
+
+begin
+ iferr {
+ ftype = imgftype (im, field)
+ } then {
+ call xev_initop (o, SZ_LINE, TY_CHAR) # keyword not found
+ call aclrc (O_VALC(o), SZ_LINE)
+ return
+ }
+
+ switch (ftype) {
+ case TY_BOOL:
+ call xev_initop (o, 0, TY_BOOL)
+ O_VALB(o) = imgetb (im, field)
+
+ case TY_SHORT, TY_INT, TY_LONG:
+ call xev_initop (o, 0, TY_INT)
+ O_VALI(o) = imgeti (im, field)
+
+ case TY_REAL, TY_DOUBLE, TY_COMPLEX:
+ call xev_initop (o, 0, TY_REAL)
+ O_VALR(o) = imgetr (im, field)
+
+ default:
+ call xev_initop (o, SZ_LINE, TY_CHAR)
+ call imgstr (im, field, O_VALC(o), SZ_LINE)
+ }
+end
+
+
+# IMX_ENCODEOP -- Encode an operand as returned by EVEXPR as a string. EVEXPR
+# operands are restricted to the datatypes bool, int, real, and string.
+
+procedure imx_encodeop (o, outstr, maxch)
+
+pointer o # operand to be encoded
+char outstr[ARB] # output string
+int maxch # max chars in outstr
+
+begin
+ switch (O_TYPE(o)) {
+ case TY_BOOL:
+ call sprintf (outstr, maxch, "%b")
+ call pargb (O_VALB(o))
+ case TY_CHAR:
+ call sprintf (outstr, maxch, "%s")
+ call pargstr (O_VALC(o))
+ case TY_INT:
+ call sprintf (outstr, maxch, "%d")
+ call pargi (O_VALI(o))
+ case TY_REAL:
+ call sprintf (outstr, maxch, "%g")
+ call pargr (O_VALR(o))
+ default:
+ call error (1, "unknown expression datatype")
+ }
+end
diff --git a/sys/imio/imt/imxftype.x b/sys/imio/imt/imxftype.x
new file mode 100644
index 00000000..e083f032
--- /dev/null
+++ b/sys/imio/imt/imxftype.x
@@ -0,0 +1,119 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <syserr.h>
+include <imhdr.h>
+include "imx.h"
+
+
+# IMX_FILETYPE -- Determine the file type.
+
+int procedure imx_filetype (fname)
+
+char fname[ARB] #i file name
+
+char img[SZ_FNAME], name[SZ_FNAME], buf[SZ_LINE]
+
+int i, nchars, fd
+bool is_http_list
+
+int errcode(), open(), read(), access(), imaccess()
+int strncmp(), strsearch(), isdirectory()
+pointer im, immap()
+
+begin
+ # Check for a URL.
+ if (strncmp ("http://", fname, 7) == 0)
+ return (IMT_URL)
+
+ call aclrc (name, SZ_FNAME)
+ if (fname[1] == '@')
+ call strcpy (fname[2], name, SZ_FNAME)
+ else
+ call strcpy (fname, name, SZ_FNAME)
+
+ # See if it is a directory.
+ if (isdirectory (name, buf, SZ_LINE) > 0)
+ return (IMT_DIR)
+
+ # Check for concatenated strings.
+ if (strsearch (fname, "//") > 0) {
+ if (isdirectory (fname, buf, SZ_LINE) > 0)
+ return (IMT_DIR)
+ else
+ return (IMT_FILE)
+ }
+
+ call aclrc (img, SZ_FNAME) # PHU
+ call sprintf (img, SZ_FNAME, "%s[0]")
+ call pargstr (name)
+
+ # Get a peek at the file.
+ call aclrc (buf, SZ_LINE)
+ if (imaccess (name, READ_ONLY) == YES ||
+ imaccess (img, READ_ONLY) == YES) {
+ return (IMT_IMAGE);
+ } else if (access (name, 0, 0) == YES) {
+ fd = open (name, READ_ONLY, TEXT_FILE)
+ nchars = read (fd, buf, SZ_LINE)
+ call strupr (buf)
+ call close (fd)
+ }
+
+ # See if it might be an image of some kind.
+ if (strncmp (buf, "SIMPLE", 6) == 0) {
+
+ ifnoerr (im = immap (name, READ_ONLY, 0)) { # SIF, OIF, etc
+ call imunmap (im)
+ return (IMT_IMAGE)
+ }
+
+ do i = 0, 1 { # MEF
+ call aclrc (img, SZ_FNAME)
+ call sprintf (img, SZ_FNAME, "%s[%d]")
+ call pargstr (name)
+ call pargi (i)
+
+ iferr (im = immap (img, READ_ONLY, 0)) {
+ switch (errcode()) {
+ case SYS_FXFRFEOF:
+ break
+ case SYS_IKIEXTN:
+ next
+ case SYS_IKIOPEN:
+ if (i == 0)
+ next
+ break
+ default:
+ call erract (EA_ERROR)
+ }
+ } else {
+ call imunmap (im)
+ return (IMT_IMAGE)
+ }
+ }
+
+ } else {
+
+ # If we get this far, we have a file of some kind. See if it is a
+ # list of URLs, a VOTable, or a plain file.
+ is_http_list = FALSE
+ fd = open (name, READ_ONLY, TEXT_FILE)
+ do i = 1, 10 {
+ call aclrc (buf, SZ_LINE)
+ nchars = read (fd, buf, SZ_LINE)
+ call strupr (buf)
+ if (strsearch (buf, "VOTABLE") > 0) {
+ call close (fd)
+ return (IMT_VOTABLE)
+ } else if (strncmp (buf, "http://", 7) == 0)
+ is_http_list = TRUE
+ }
+ call close (fd)
+ }
+
+ if (is_http_list)
+ return (IMT_TABLE)
+ else
+ return (IMT_FILE)
+end
diff --git a/sys/imio/imt/imxparse.x b/sys/imio/imt/imxparse.x
new file mode 100644
index 00000000..f26f0918
--- /dev/null
+++ b/sys/imio/imt/imxparse.x
@@ -0,0 +1,203 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <imhdr.h>
+include "imx.h"
+
+
+define IMT_INDEX 1
+define IMT_NAME 2
+define IMT_VER 3
+define IMT_EXPR 4
+
+define DEBUG FALSE
+
+
+
+# IMX_PARSE -- Parse a filename to extract index ranges, extension names,
+# versions and filtering expressions.
+
+int procedure imx_parse (input, fname, index, extname, extver,
+ expr, sec, ikparams, maxch)
+
+char input[ARB] #i template string ptr
+char fname[ARB] #o file name
+char index[ARB] #o index range string
+char extname[ARB] #o extension name
+char extver[ARB] #o extension version
+char expr[ARB] #o filtering expression string
+char sec[ARB] #o image section string
+char ikparams[ARB] #o image kernel section params
+int maxch #i max chars in string params
+
+pointer im
+int nchars, ip, idx
+char comma, lexpr[SZ_LINE], subex[SZ_LINE], name[SZ_PATHNAME]
+
+int imx_breakout(), imx_next_expr(), imx_expr_type(), stridx()
+pointer immap()
+
+begin
+ call aclrc (expr, maxch) # initialize
+ call aclrc (index, maxch)
+ call aclrc (fname, maxch)
+ call aclrc (extver, maxch)
+ call aclrc (extname, maxch)
+ call aclrc (ikparams, maxch)
+ call aclrc (lexpr, SZ_LINE)
+
+
+ # Separate the filename from the expression string.
+ nchars = imx_breakout (input, NO, fname, lexpr, sec, ikparams, maxch)
+
+ # Parse into sub-expression strings, breaking it up into the
+ # appropriate form depending on the contents.
+ if (lexpr[1] != EOS) {
+ ip = 1
+ while (imx_next_expr (lexpr, ip, subex, maxch) != EOS) {
+
+ if (DEBUG) {
+ call eprintf ("parse subex = '%s'\t\t'%s'\n")
+ call pargstr (subex) ; call pargstr (lexpr)
+ }
+
+ switch (imx_expr_type (subex)) {
+ case IMT_INDEX:
+ call strcpy (subex, index, maxch)
+ case IMT_NAME:
+ call strcpy (subex, extname, maxch)
+ case IMT_VER:
+ comma = ','
+ idx = stridx (comma, subex)
+ call strcpy (subex[idx+1], extver, maxch)
+ subex[idx] = '\0'
+ call strcpy (subex, extname, maxch)
+ case IMT_EXPR:
+ if (expr[1] != EOS) {
+ call strcat ("||", expr, maxch)
+ call strcat (subex, expr, maxch)
+ } else
+ call strcpy (subex, expr, maxch)
+ default:
+ call error (1, "unknown expression type")
+ }
+
+ ip = ip + 1
+ }
+ }
+
+ if (DEBUG) {
+ call eprintf ("final expr = '%s' index = '%s' sec = '%s'\n")
+ call pargstr (expr)
+ call pargstr (index)
+ call pargstr (sec)
+ }
+
+ call aclrc (name, SZ_PATHNAME)
+ if (fname[1] == '@')
+ call strcpy (fname[2], name, SZ_PATHNAME)
+ else
+ call strcpy (fname, name, SZ_PATHNAME)
+ if (index[1] != EOS) {
+ call strcat ("[", name, SZ_PATHNAME)
+ call strcat (index, name, SZ_PATHNAME)
+ call strcat ("]", name, SZ_PATHNAME)
+ }
+ if (sec[1] != EOS) {
+ call strcat ("[", name, SZ_PATHNAME)
+ call strcat (sec, name, SZ_PATHNAME)
+ call strcat ("]", name, SZ_PATHNAME)
+ }
+
+# iferr {
+# im = immap (name, READ_ONLY, 0)
+# call imunmap (im)
+# } then
+# ;
+
+ return (nchars)
+end
+
+
+# IMX_NEXT_EXPR -- Get the next sub expression from the string. Expressions
+# are delimited by semicolons, the location in the expression string is
+# updated.
+
+int procedure imx_next_expr (expr, ip, subex, maxch)
+
+char expr[ARB] #i input expression string
+int ip #u location in expr
+char subex[ARB] #o sub expression string
+int maxch #i max size of subexpr string
+
+char op
+
+begin
+ if (expr[ip] == EOS)
+ return (EOS)
+
+ # Skip leading whitespace/delimiters.
+ while (IS_WHITE(expr[ip]) || expr[ip] == ';')
+ ip = ip + 1
+
+ op = 1 # copy until EOS or next delimiter
+ while (expr[ip] != EOS && expr[ip] != ';' && expr[ip] != ']') {
+ subex[op] = expr[ip]
+ ip = ip + 1
+ op = op + 1
+ }
+ subex[op] = EOS
+
+ if (expr[ip] == ']')
+ ip = ip + 1
+
+ return (ip)
+end
+
+
+# IMX_EXPR_TYPE -- Determine the type of expression we have. A range list
+# is assumed to be an extension index list; a single alphabetic word is
+# assumed to be an extension name, if followed by a numeric value it also
+# contains an extension version; anything else is a selection expression.
+
+int procedure imx_expr_type (expr)
+
+char expr[ARB] #i expression
+
+int ip, len
+char ch
+int strlen (), stridxs(), stridx()
+
+begin
+ len = strlen (expr)
+
+ # [<expr>]
+ ch = expr[1]
+ if ((IS_ALNUM(expr[1]) || stridx (ch, "('\"") > 0) &&
+ stridxs ("?=:()<>&|@", expr) != 0)
+ return (IMT_EXPR)
+
+ # [extname,extver]
+ ch = ','
+ if (IS_ALPHA(expr[1]) && IS_DIGIT(expr[len]) && stridx (ch, expr) > 0)
+ return (IMT_VER)
+
+ # [extname]
+ if (IS_ALPHA(expr[1]) && stridx (ch, expr) == 0)
+ return (IMT_NAME)
+
+ # [index] or [index_range]
+ if ((IS_DIGIT(expr[1])) ||
+ ((expr[1] == '+' || expr[1] == '-') && IS_DIGIT(expr[2]))) {
+ for (ip=1; expr[ip] != EOS; ip = ip + 1) {
+ ch = expr[ip]
+ if (! IS_DIGIT(ch)) {
+ if (stridx (ch, "-x,+") == 0)
+ return (IMT_EXPR)
+ }
+ }
+ return (IMT_INDEX)
+ }
+
+ return (0)
+end
diff --git a/sys/imio/imt/imxpreproc.x b/sys/imio/imt/imxpreproc.x
new file mode 100644
index 00000000..b0faccfc
--- /dev/null
+++ b/sys/imio/imt/imxpreproc.x
@@ -0,0 +1,539 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "imx.h"
+
+define DEBUG FALSE
+define SZ_PREFIX 2
+
+
+pointer procedure imx_preproc (template)
+
+char template[ARB] #i input template string
+
+pointer exp, pre, out, op, list
+char file[SZ_PATHNAME]
+char mods[SZ_LINE], fname[SZ_LINE]
+int i, j, osize, len, llen, nmods
+
+define output {Memc[out+op]=$1;op=op+1}
+define outstr {len=strlen($1);for(j=1;j<=len;j=j+1)output($1[j])}
+define outcomma {if(($1))output(',')}
+
+pointer imx_fnexpand (), imx_preproc_list()
+pointer fntopnb()
+int fntlenb(), fntgfnb(), strlen(), strsearch(), strncmp(), imx_split()
+
+begin
+ # First Pass: Do any filename expansion in the template, maintaining
+ # the '@' prefix and any modifiers. The result is a comma-delimited
+ # list we process later to expand further.
+
+ exp = imx_fnexpand (template)
+
+ # Second Pass: Process the matched list to expand the '@' files and
+ # modifiers into a simple comma-delimited list the FNT interface
+ # will process.
+
+ pre = imx_preproc_list (Memc[exp])
+
+ # Third Pass: Handle concatenation in the filenames.
+ if ((strncmp (Memc[pre],"http://",7) == 0) ||
+ (strncmp (Memc[pre],"file://",7) == 0)) {
+ osize = strlen (Memc[pre])
+ call calloc (out, osize, TY_CHAR)
+ call strcpy (Memc[pre], Memc[out], osize)
+
+ } else if (strsearch(Memc[pre],"//") > 0 &&
+ strsearch(Memc[pre],".fits") > 0) {
+
+ # FIXME -- Need to handle the case of concatenation with
+ # a MEF file. Problem is, expanding the MEF requires we
+ # recursively call ourselves to expand the image so we
+ # need to do some restructuring. For example,
+ #
+ # foo // @mef.fits -> foomef.fits[1],foomef.fits[2], ....
+ # @mef.fits // foo -> meffoo.fits[1],meffoo.fits[2], ....
+
+ call error (0, "Image expansion/concatenation not yet supported.")
+
+
+ } else if (strsearch (Memc[pre], "//") > 0) {
+
+ nmods = imx_split (Memc[pre], fname, mods, SZ_LINE)
+ list = fntopnb (fname, YES)
+ llen = fntlenb (list)
+
+ osize = strlen (Memc[pre])
+ call calloc (out, osize * 2, TY_CHAR)
+
+ op = 0
+ for (i=0; i < llen; i=i+1) {
+ call aclrc (file, SZ_PATHNAME)
+ if (fntgfnb (list, file, SZ_PATHNAME) == EOF)
+ break
+
+ if ((op + strlen (file) + strlen (mods) + 3) >= osize) {
+ osize = osize + SZ_LINE
+ call realloc (out, osize, TY_CHAR)
+ }
+
+ # FIXME ???
+ #outcomma (i > 0); output ('@'); outstr(file) ; outstr(mods)
+ outcomma (i > 0); outstr(file) ; outstr(mods)
+ }
+ output ('\0')
+ call fntclsb (list)
+
+ } else {
+ osize = strlen (Memc[pre])
+ call calloc (out, osize, TY_CHAR)
+ call strcpy (Memc[pre], Memc[out], osize)
+ }
+
+ if (DEBUG) {
+ call eprintf ("pre exp = '%s'\n") ; call pargstr (Memc[exp])
+ call eprintf ("pre pre = '%s'\n") ; call pargstr (Memc[pre])
+ call eprintf ("pre out = '%s'\n") ; call pargstr (Memc[out])
+ }
+
+ call mfree (exp, TY_CHAR) # clean up
+ call mfree (pre, TY_CHAR)
+
+ return (out)
+end
+
+
+# IMX_FNEXPAND -- Do any filename expansion in the template, maintaining the
+# '@' prefix and any modifiers. The result is a comma-delimited list we
+# process later to expand further.
+
+pointer procedure imx_fnexpand (template)
+
+char template[ARB] #i input template string
+
+pointer elem, ep, op, out, listp, sz_out, op_start, op_end
+int i, j, ip, in, len, llen, nelem, fi, fo
+char prefix[SZ_PREFIX], fname[SZ_PATHNAME], mods[SZ_LINE]
+char left[SZ_PATHNAME], right[SZ_PATHNAME]
+char file[SZ_PATHNAME], cfname[SZ_PATHNAME], osfn[SZ_PATHNAME]
+
+define output {Memc[op]=$1;op=op+1}
+define outstr {len=strlen($1);for(j=1;j<=len;j=j+1)output($1[j])}
+
+int fntopnb(), fntgfnb(), fntlenb(), strlen(), stridxs(), strsearch()
+int imx_get_element(), strncmp(), stridx()
+
+begin
+ # Allocate an intial string buffer.
+ call calloc (out, SZ_FNT, TY_CHAR)
+ call calloc (elem, SZ_FNT, TY_CHAR)
+
+ in = 1
+ nelem = 0
+ op = out
+ op_start = out
+ op_end = out + SZ_FNT - 1
+ sz_out = SZ_FNT
+
+ while (imx_get_element (template, in, Memc[elem], SZ_FNT) != EOS) {
+
+ ep = elem
+ nelem = nelem + 1
+ outcomma(nelem > 1)
+
+ call aclrc (prefix, SZ_PREFIX)
+ call aclrc (fname, SZ_PATHNAME)
+ call aclrc (mods, SZ_LINE)
+
+ # Gather any prefix '@' symbols.
+ if (Memc[elem] == '@') {
+ for (i=1; Memc[ep] == '@'; i=i+1) {
+ prefix[i] = Memc[ep]
+ ep = ep + 1
+ }
+ } else {
+ ip = stridx ('@', Memc[elem])
+ if (ip > 1) {
+ call strcpy (Memc[elem], prefix, ip-1)
+ ep = elem + ip - 1
+ prefix[ip] = EOS
+ call strcat ("//", prefix[ip], SZ_PREFIX)
+ }
+ }
+
+ # Get the filename component up to the EOS or the modifiers.
+ for (i=1; Memc[ep] != '[' && Memc[ep] != EOS; i=i+1) {
+ fname[i] = Memc[ep]
+ ep = ep + 1
+ }
+
+ if (strncmp ("http://", fname, 7) == 0) {
+ call fmapfn ("cache$", osfn, SZ_PATHNAME)
+ call strupk (osfn, osfn, SZ_PATHNAME)
+
+ #call fcadd (osfn, fname, "fits", cfname, SZ_PATHNAME)
+ call fcadd (osfn, fname, "", cfname, SZ_PATHNAME)
+
+ call strcpy (cfname, fname, SZ_PATHNAME)
+
+ } else if (strncmp ("file://", fname, 7) == 0) {
+ fi = 8
+ if (strncmp ("file:///localhost", fname, 17) == 0)
+ fi = 18
+ else if (strncmp ("file://localhost", fname, 16) == 0)
+ fi = 17
+
+ for (fo=1; fname[fi] != EOS; fi=fi+1) {
+ if (fname[fi] == '/' && fname[fi+1] == '/')
+ fi = fi + 1
+ cfname[fo] = fname[fi]
+ fo = fo + 1
+ }
+ call strcpy (cfname, fname, SZ_PATHNAME)
+ }
+
+ # Get the modifier strings.
+ for (i=1; Memc[ep] != EOS ; i=i+1) {
+ mods[i] = Memc[ep]
+ ep = ep + 1
+ }
+
+
+ if (DEBUG) {
+ call eprintf ("fnexp: '%s' --> '%s' '%s' '%s'\n")
+ call pargstr (Memc[elem]); call pargstr (prefix);
+ call pargstr (fname); call pargstr (mods)
+ }
+
+ # Expand wildcards if needed.
+ if (stridxs("*?", fname) > 0) {
+
+ # FIXME - Need to do concatenation here ...??
+ if (strsearch (fname, "//") > 0) {
+ call aclrc (left, SZ_PATHNAME)
+ call aclrc (right, SZ_PATHNAME)
+
+ # Gather the left and right side of a concatenation with
+ # wildcards. Expand the side with the wildcard but
+ # maintain the concatenation so we keep the previous
+ # behavior in how these processed.
+ for (ip=1; fname[ip] != '/'; ip=ip+1)
+ left[ip] = fname[ip]
+ ip = ip + 2
+ for (i=1; fname[ip] != EOS; ip=ip+1) {
+ right[i] = fname[ip]
+ i = i + 1
+ }
+
+ if (stridxs("*?", left) > 0) {
+ listp = fntopnb (left, YES)
+ llen = fntlenb (listp)
+ for (i=0; i < llen; i=i+1) {
+ call aclrc (file, SZ_PATHNAME)
+ if (fntgfnb (listp, file, SZ_PATHNAME) == EOF)
+ break
+ outcomma (i > 0)
+ outstr(prefix)
+ outstr(file) ; outstr("//") ; outstr(right)
+ }
+ call fntclsb (listp)
+ } else {
+ listp = fntopnb (right, YES)
+ llen = fntlenb (listp)
+ for (i=0; i < llen; i=i+1) {
+ call aclrc (file, SZ_PATHNAME)
+ if (fntgfnb (listp, file, SZ_PATHNAME) == EOF)
+ break
+ outcomma (i > 0)
+ outstr(prefix)
+ outstr(left) ; outstr("//") ; outstr(file)
+ }
+ call fntclsb (listp)
+ }
+ next
+
+ } else {
+ listp = fntopnb (fname, YES)
+ llen = fntlenb (listp)
+ for (i=0; i < llen; i=i+1) {
+ call aclrc (file, SZ_PATHNAME)
+ if (fntgfnb (listp, file, SZ_PATHNAME) == EOF)
+ break
+ outcomma ( i > 0)
+ outstr(prefix) ; outstr(file) ; outstr(mods)
+
+
+ # Reallocate the output string if needed.
+ if ((op_end - op) < SZ_FNAME || op >= op_end) {
+ sz_out = sz_out + SZ_FNT
+ len = (op - out - 1)
+
+ call calloc (op_start, sz_out, TY_CHAR)
+ call amovc (Memc[out], Memc[op_start], len)
+ for (op=op_start; Memc[op] != EOS; )
+ op = op + 1
+
+ op_end = op_start + sz_out
+ call mfree (out, TY_CHAR)
+ out = op_start
+ }
+ }
+ call fntclsb (listp)
+ }
+
+
+ } else {
+ outstr(prefix) ; outstr(fname) ; outstr(mods)
+ }
+
+ call aclrc (Memc[elem], SZ_FNT)
+ }
+ output ('\0')
+
+ call mfree (elem, TY_CHAR)
+ return (out)
+end
+
+
+# IMX_PREPROC_LIST -- Process the expanded filename string to open any
+# @files and produce final expression strings.
+
+pointer procedure imx_preproc_list (template)
+
+char template[ARB] #i template string
+
+pointer tp, ip, op, itp, listp, elem
+int i, lp, in, len, tend, tlen, plen, llen
+int nchars, atat, nelem, in_filter
+char ch, file[SZ_LINE], expr[SZ_LINE], fname[SZ_PATHNAME]
+char ikparams[SZ_LINE], sec[SZ_LINE], dirname[SZ_PATHNAME]
+
+define output {Memc[op]=$1;op=op+1}
+
+int fntopnb(), fntgfnb(), fntlenb(), strlen(), stridxs(), strsearch()
+int access(), imx_get_element(), imx_breakout(), isdirectory()
+
+begin
+ # Allocate an intial string buffer.
+ tlen = strlen (template)
+ plen = max(strlen(template)*2, SZ_FNT)
+ call calloc (tp, plen, TY_CHAR)
+ call calloc (itp, tlen + 1, TY_CHAR)
+ call calloc (elem, SZ_FNT, TY_CHAR)
+
+ in = 1
+ op = tp
+ nelem = 0
+ while (imx_get_element (template, in, Memc[elem], SZ_FNT) != EOS) {
+
+ # Break out the filename and expression.
+ nchars = imx_breakout (Memc[elem], NO, file, expr,
+ sec, ikparams, SZ_LINE)
+
+ nelem = nelem + 1
+ outcomma (nelem > 1)
+
+ atat = NO
+ call aclrc (Memc[itp], tlen+1)
+
+ if (stridxs("[]", Memc[elem]) > 0 && expr[1] != EOS) {
+ if (Memc[elem] == '@' || strsearch (Memc[elem], "//") > 0)
+ call sprintf (Memc[itp], tlen+1, "%s")
+ else
+ call sprintf (Memc[itp], tlen+1, "@%s")
+ call pargstr (Memc[elem])
+
+ } else if (strsearch (Memc[elem], "][") > 0) {
+ call sprintf (Memc[itp], tlen+1, "@%s")
+ call pargstr (Memc[elem])
+
+ } else {
+ # Simple filename or @file, just copy it out if it exists.
+ if (Memc[elem] == '@') {
+ if (Memc[elem+1] != '@' && access (Memc[elem+1],0,0) == NO)
+ if (strsearch (Memc[elem], "//") == 0)
+ next
+ if (Memc[elem+1] == '@') {
+ lp = 1
+ atat = YES
+ call sprintf (Memc[itp], tlen+1, "%s")
+ call pargstr (Memc[elem])
+ } else {
+ lp = 0
+ for (; Memc[elem+lp] != EOS; lp=lp+1)
+ output (Memc[elem+lp])
+ next
+ }
+ } else {
+ lp = 0
+ for (; Memc[elem+lp] != EOS; lp=lp+1)
+ output (Memc[elem+lp])
+ }
+ }
+
+ ip = itp
+ tend = itp + strlen (Memc[itp]) - 1
+ ch = Memc[ip]
+
+ if (ch == '@') { # @file
+
+ if (Memc[ip+1] == '@') { # @@file
+ atat = YES
+ ip = ip + 1
+ }
+
+ if (atat == NO) {
+ # No metachars, copy item entirely to output string.
+ in_filter = NO
+ while (Memc[ip] != EOS && ip <= tend) {
+ if (Memc[ip] == '[') in_filter = YES
+ if (Memc[ip] == ']') in_filter = NO
+ if (Memc[ip] == ',' && in_filter == NO) {
+ output (Memc[ip])
+ ip = ip + 1
+ break
+ }
+ output (Memc[ip])
+ ip = ip + 1
+ }
+ next
+ }
+
+ if (atat == YES) {
+ if (isdirectory (file[3], dirname, SZ_PATHNAME) > 0) {
+ len = strlen (file)
+ if (file[len] != '$')
+ call strcat ("/", file, SZ_FNAME)
+ call strcat ("*.fits", file, SZ_FNAME)
+ listp = fntopnb (file[3], YES)
+ } else
+ listp = fntopnb (file[2], YES)
+ } else
+ listp = fntopnb (file, YES)
+
+ llen = fntlenb (listp)
+ for (i=0; i < llen; i=i+1) {
+ call aclrc (fname, SZ_PATHNAME)
+ if (fntgfnb (listp, fname, SZ_PATHNAME) == EOF)
+ break
+
+ if (atat == YES)
+ output ('@')
+ for (lp=1; fname[lp] != EOS; lp=lp+1)
+ output (fname[lp])
+ if (expr[1] != EOS) { # append extension info
+ output ('[')
+ for (lp=1; expr[lp] != EOS; lp=lp+1)
+ output (expr[lp])
+ if (ikparams[1] != EOS) {
+ output (',')
+ for (lp=1; ikparams[lp] != EOS; lp=lp+1)
+ output (ikparams[lp])
+ }
+ output (']')
+ }
+ if (sec[1] != EOS) { # append any section notation
+ output ('[')
+ for (lp=1; sec[lp] != EOS; lp=lp+1)
+ output (sec[lp])
+ output (']')
+ }
+
+ outcomma (i < (llen-1))
+ }
+ call fntclsb (listp)
+ ip = ip + nchars + 1
+
+ if (Memc[ip+1] == ',')
+ break
+ } # else
+ # call strcpy (Memc[elem], Memc[op], SZ_FNT)
+ }
+
+ call mfree (itp, TY_CHAR)
+ call mfree (elem, TY_CHAR)
+
+ return (tp)
+end
+
+
+# IMX_GET_ELEMENT -- Get the next element of a list template.
+
+int procedure imx_get_element (template, ip, elem, maxch)
+
+char template[ARB] #i input template string
+int ip #u template index
+char elem[ARB] #o output string buffer
+int maxch #i max size of output element
+
+int op, level, done
+char ch
+
+begin
+ op = 1
+ done = 0
+ level = 0
+
+ if (template[ip] == EOS)
+ return (EOS)
+ if (template[ip] == ',')
+ ip = ip + 1
+
+ call aclrc (elem, maxch)
+ while (template[ip] != EOS) {
+ ch = template[ip]
+
+ if (ch == EOS || (ch == ',' && level == 0)) {
+ done = 1
+ } else if (ch == '[')
+ level = level + 1
+ else if (ch == ']')
+ level = level - 1
+
+ if (done == 1) {
+ return (ip + 1)
+ } else
+ elem[op] = ch
+
+ ip = ip + 1
+ op = op + 1
+ }
+
+ return (ip)
+end
+
+
+# IMX_SPLIT -- Split a list element into the coarse filename and modifiers
+
+int procedure imx_split (in, fname, mods, maxch)
+
+char in[ARB] #i input template string
+char fname[ARB] #o filename
+char mods[ARB] #o modifier strings
+int maxch #i max size of output string
+
+int i, j, nmods
+
+begin
+ # Allocate an intial string buffer.
+ nmods = 0
+ call aclrc (mods, maxch)
+ call aclrc (fname, maxch)
+
+
+ # Gather any prefix '@' symbols.
+ for (i=1; in[i] != '[' && in[i] != EOS && i < maxch; i=i+1)
+ fname[i] = in[i]
+
+ # Get the filename component up to the EOS or the modifiers.
+ if (in[i] == '[') {
+ for (j=1; in[i] != EOS && i < maxch && j < maxch; i=i+1) {
+ mods[j] = in[i]
+ j = j + 1
+ if (in[i] == '[')
+ nmods = nmods + 1
+ }
+ }
+
+ return (nmods)
+end
diff --git a/sys/imio/imt/mkpkg b/sys/imio/imt/mkpkg
new file mode 100644
index 00000000..eca1a520
--- /dev/null
+++ b/sys/imio/imt/mkpkg
@@ -0,0 +1,24 @@
+# Update the IMIO portion of the LIBEX library.
+
+$checkout libex.a ../
+$update libex.a
+$checkin libex.a ../
+$exit
+
+libex.a:
+ imt.x
+ imx.x imx.h <error.h>
+ imxbreakout.x
+ imxparse.x imx.h <ctype.h>
+ imxescape.x imx.h
+ imxexpand.x imx.h <ctype.h> <error.h> <imhdr.h> <imset.h> <mach.h>
+ imxexpr.x imx.h <ctype.h> <error.h> <evexpr.h> <lexnum.h>
+ imxftype.x imx.h <error.h>
+ imxpreproc.x imx.h
+ ;
+
+test:
+ $call libpkg.a
+ $omake zzdebug.x
+ $link zzdebug.o libpkg.a
+ ;
diff --git a/sys/imio/imt/t_urlget.x b/sys/imio/imt/t_urlget.x
new file mode 100644
index 00000000..e0e7bf26
--- /dev/null
+++ b/sys/imio/imt/t_urlget.x
@@ -0,0 +1,94 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <syserr.h>
+include <imhdr.h>
+include <imset.h>
+include <mach.h>
+
+task urlget = t_urlget
+
+
+
+# URLGET -- Do an HTTP GET of a URL to the named file.
+
+procedure t_urlget ()
+
+pointer reply
+char url[SZ_PATHNAME], fname[SZ_PATHNAME], extn[SZ_PATHNAME]
+char cache[SZ_PATHNAME], lfname[SZ_PATHNAME]
+int nread
+bool use_cache, verbose
+
+int url_get()
+bool fcaccess()
+
+begin
+ # Get the parameters
+ call clgstr ("url", url, SZ_PATHNAME)
+
+ call url_to_name (url, fname, SZ_PATHNAME)
+ call strcpy ("", extn, SZ_PATHNAME)
+ call strcpy ("/tmp/cache/", cache, SZ_PATHNAME)
+ verbose = true
+ use_cache = false
+
+
+ # Tell them what we're doing.
+ if (verbose) {
+ call printf ("%s -> %s\n")
+ call pargstr (url)
+ call pargstr (fname)
+ call flush (STDOUT)
+ }
+
+ # Retrieve the URL.
+ if (use_cache) {
+ call aclrc (lfname, SZ_FNAME);
+
+ if (fcaccess (cache, url, "fits")) {
+ call fcname (cache, url, "f", lfname, SZ_PATHNAME)
+ if (extn[1] != EOS) {
+ # Add an extension to the cached file.
+ call strcat (".", lfname, SZ_PATHNAME)
+ call strcat (extn, lfname, SZ_PATHNAME)
+ }
+ } else {
+ # Add it to the cache, also handles the download.
+ call fcadd (cache, url, extn, lfname, SZ_PATHNAME)
+ }
+ call fcopy (lfname, fname)
+
+ } else {
+ # Not in cache, or not using the cache, so force the download.
+ call calloc (reply, SZ_LINE, TY_CHAR)
+ nread = url_get (url, fname, reply)
+ call mfree (reply, TY_CHAR)
+ }
+end
+
+
+# URL_TO_NAME -- Generate a filename from a URL.
+
+procedure url_to_name (url, name, maxch)
+
+char url[ARB] #i URL being accessed
+char name[ARB] #o output name
+int maxch #i max size of output name
+
+int ip, strlen()
+char ch
+
+begin
+ ip = strlen (url)
+ while (ip > 1) {
+ ch = url[ip]
+ if (ch == '/' || ch == '?' || ch == '&' || ch == ';' || ch == '=') {
+ call strcpy (url[ip+1], name, maxch)
+ return
+ }
+ ip = ip - 1
+ }
+
+ call strcpy (url[ip], name, maxch)
+end
diff --git a/sys/imio/imt/zzdebug.x b/sys/imio/imt/zzdebug.x
new file mode 100644
index 00000000..746fc6f1
--- /dev/null
+++ b/sys/imio/imt/zzdebug.x
@@ -0,0 +1,227 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <syserr.h>
+include <imhdr.h>
+include <imset.h>
+include <mach.h>
+include "imx.h"
+
+
+task imt = t_imt,
+ parse = t_parse,
+ fnexpand = t_fnexpand,
+ prelist = t_prelist,
+ preproc = t_preproc,
+ breakout = t_breakout,
+ imexpand = t_imexpand,
+ fexpand = t_fexpand
+
+
+
+# IMT -- Test the image template package.
+
+procedure t_imt ()
+
+char template[SZ_LINE]
+char image[SZ_FNAME]
+
+pointer imt, im, imtopen(), immap()
+int i, imtgetim()
+bool num, clgetb()
+
+begin
+ call clgstr ("in", template, SZ_LINE)
+ num = clgetb ("number")
+
+ imt = imtopen (template)
+
+ for (i=0; imtgetim (imt, image, SZ_FNAME) != EOF; i=i+1) {
+
+ if (num) {
+ im = immap (image, READ_ONLY, 0)
+ call printf ("%3d %s %d x %d\n")
+ call pargi (i+1)
+ call pargstr (image)
+ call pargi (IM_LEN(im,1))
+ call pargi (IM_LEN(im,2))
+ call imunmap (im)
+ } else {
+ if (i > 0)
+ call printf (",")
+ call printf ("%s")
+ call pargstr (image)
+ }
+ }
+ call printf ("\n")
+ call printf ("Nimages = %d\n")
+ call pargi (i)
+
+ call imtclose (imt)
+end
+
+
+# PARSE -- Test the image template package expression parse.
+
+procedure t_parse ()
+
+char template[SZ_LINE], name[SZ_LINE], index[SZ_LINE], ikparams[SZ_LINE]
+char extname[SZ_LINE], extver[SZ_LINE], expr[SZ_LINE], sec[SZ_LINE]
+
+int nch, imx_parse()
+
+begin
+ call clgstr ("in", template, SZ_LINE)
+
+ nch = imx_parse (template, name, index, extname, extver,
+ expr, sec, ikparams, SZ_LINE)
+
+ call eprintf ("%s\n") ; call pargstr (template)
+ call eprintf ("\tname\t= %s\n") ; call pargstr (name)
+ call eprintf ("\tindex\t= %s\n") ; call pargstr (index)
+ call eprintf ("\textname\t= %s\n") ; call pargstr (extname)
+ call eprintf ("\textver\t= %s\n") ; call pargstr (extver)
+ call eprintf ("\texpr\t= %s\n") ; call pargstr (expr)
+ call eprintf ("\tikparams\t= %s\n") ; call pargstr (ikparams)
+ call eprintf ("\tsec\t= %s\n") ; call pargstr (sec)
+end
+
+
+# FNEXPAND -- Test the image template package pre-processor.
+
+procedure t_fnexpand ()
+
+char template[SZ_LINE]
+
+pointer pp, imx_fnexpand()
+
+begin
+ call clgstr ("in", template, SZ_LINE)
+
+ pp = imx_fnexpand (template)
+
+ call eprintf ("%s\n")
+ call pargstr (Memc[pp])
+ call mfree (pp, TY_CHAR)
+end
+
+
+# PRELIST -- Test the image template package pre-processor.
+
+procedure t_prelist ()
+
+char template[SZ_LINE]
+
+pointer pp, imx_preproc_list()
+
+begin
+ call clgstr ("in", template, SZ_LINE)
+
+ pp = imx_preproc_list (template)
+
+ call eprintf ("%s\n")
+ call pargstr (Memc[pp])
+ call mfree (pp, TY_CHAR)
+end
+
+
+# PREPROC -- Test the image template package pre-processor.
+
+procedure t_preproc ()
+
+char template[SZ_LINE]
+
+pointer pp, imx_preproc()
+
+begin
+ call clgstr ("in", template, SZ_LINE)
+
+ pp = imx_preproc (template)
+
+ call eprintf ("%s\n")
+ call pargstr (Memc[pp])
+ call mfree (pp, TY_CHAR)
+end
+
+
+# BREAKOUT -- Test the image template package expression breakout code.
+
+procedure t_breakout ()
+
+char template[SZ_LINE]
+
+int nchars
+char image[SZ_LINE], expr[SZ_LINE], sec[SZ_LINE], ikparams[SZ_LINE]
+
+int imx_breakout()
+
+begin
+ call clgstr ("in", template, SZ_LINE)
+
+ nchars = imx_breakout(template, NO, image, expr, sec, ikparams, SZ_LINE)
+
+ call eprintf ("nchars=%d image='%s' expr='%s' sec='%s' ik='%s'\n")
+ call pargi (nchars)
+ call pargstr (image)
+ call pargstr (expr)
+ call pargstr (sec)
+ call pargstr (ikparams)
+end
+
+
+# IMEXPAND -- Test the MEF image expansion.
+
+procedure t_imexpand ()
+
+char template[SZ_LINE]
+int nimages
+
+pointer imt, imx_imexpand()
+
+begin
+ call clgstr ("in", template, SZ_LINE)
+
+ imt = imx_imexpand (template,
+ "", # expr
+ "", # index
+ "", # extname
+ "", # extver
+ "", # ikparams
+ "", # sections
+ nimages)
+
+ call printf ("nimages = %d\n%s\n");
+ call pargi (nimages)
+ call pargstr (Memc[imt])
+
+ call mfree (imt, TY_CHAR)
+end
+
+
+# FEXPAND -- Test the filename expansion.
+
+procedure t_fexpand ()
+
+char template[SZ_LINE]
+int nimages
+
+pointer imt, imx_fexpand()
+
+begin
+ call clgstr ("in", template, SZ_LINE)
+
+ imt = imx_fexpand (template,
+ "", # expr
+ "", # index
+ "", # extname
+ "", # extver
+ "", # ikparams
+ "", # sections
+ nimages)
+
+ call printf ("nimages = %d\n%s\n");
+ call pargi (nimages)
+ call pargstr (Memc[imt])
+
+ call mfree (imt, TY_CHAR)
+end
generated by cgit (git 2.34.1) at 2025-09-20 09:55:30 -0400