diff options
| author | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
|---|---|---|
| committer | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
| commit | 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch) | |
| tree | 4464880c571602d54f6ae114729bf62a89518057 /pkg/images/imutil | |
| download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz | |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'pkg/images/imutil')
114 files changed, 27304 insertions, 0 deletions
diff --git a/pkg/images/imutil/Revisions b/pkg/images/imutil/Revisions new file mode 100644 index 00000000..706b483e --- /dev/null +++ b/pkg/images/imutil/Revisions @@ -0,0 +1,2045 @@ +.help revisions Jan97 images.imutil +.nf +pkg/images/imutil/imreplace.par +pkg/images/imutil/src/imrep.gx + Fixed a floating-point precision problem with short/int images in which + the lower cutoff could be rounded up. Also fixed a typo in the parameter + file. (9/22/99, MJF) + +pkg/images/imutil/src/t_imarith.x + Added a check for division by zero in the header keywords. + (8/10/99, Valdes) + +pkg/images/imutil/src/t_imreplace.x +pkg/images/imutil/src/imrep.gx +pkg/images/imutil/imreplace.par +pkg/images/imutil/doc/imreplace.hlp + Added a radius parameter to also replace any pixels within a specified + distance of pixels within the replacement window. (12/11/97, Valdes) + +===== +V2.11 +===== +=============================== +Package Reorganization +=============================== + +pkg/images/imarith/t_imsum.x +pkg/images/imarith/t_imcombine.x +pkg/images/doc/imsum.hlp +pkg/images/doc/imcombine.hlp + Provided options for USHORT data. (12/10/96, Valdes) + +pkg/images/imarith/icsetout.x +pkg/images/doc/imcombine.hlp + A new option for computing offsets from the image WCS has been added. + (11/30/96, Valdes) + +pkg/images/imarith/t_imcombine.x +pkg/images/imarith/icombine.gx + Changed the error checking to catch additional errors relating to too + many files. (11/12/96, Valdes) + +pkg/images/imarith/icsort.gx + There was an error in the ic_2sort routine when there are exactly + three images that one of the explicit cases did not properly keep + the image identifications. See buglog 344. (8/1/96, Valdes) + +pkg/images/filters/median.x + The routine mde_yefilter was being called with the wrong number of + arguments. + (7/18/96, Davis) + +pkg/images/imarith/t_imcombine.x +pkg/images/imarith/icombine.gx +pkg/images/imarith/icimstack.x + +pkg/images/imarith/iclog.x +pkg/images/imarith/mkpkg +pkg/images/doc/imcombine.hlp + The limit on the maximum number of images that can be combined, set by + the maximum number of logical file descriptors, has been removed. If + the condition of too many files is detected the task now automatically + stacks all the images in a temporary image and then combines them with + the project option. + (5/14/96, Valdes) + +pkg/images/geometry/xregister/rgxfit.x + Changed several Memr[] references to Memi[] in the rg_fit routine. + This bug was causing a floating point error in the xregister task + on the Dec Alpha if the coords file was defined, and could potentially + cause problems on other machines. + (Davis, April 3, 1996) + +pkg/images/geometry/t_geotran.x +pkg/images/geometry/geograph.x +pkg/images/doc/geomap.hlp + Corrected the definition of skew in the routines which compute a geometric + interpretation of the 6-coefficient fit, which compute the coefficients + from the geometric parameters, and in the relevant help pages. + (2/19/96, Davis) + +pkg/images/median.par +pkg/images/rmedian.par +pkg/images/mode.par +pkg/images/rmode.par +pkg/images/fmedian.par +pkg/images/frmedian.par +pkg/images/fmode.par +pkg/images/frmode.par +pkg/images/doc/median.hlp +pkg/images/doc/rmedian.hlp +pkg/images/doc/mode.hlp +pkg/images/doc/rmode.hlp +pkg/images/doc/fmedian.hlp +pkg/images/doc/frmedian.hlp +pkg/images/doc/fmode.hlp +pkg/images/doc/frmode.hlp +pkg/images/filters/t_median.x +pkg/images/filters/t_rmedian.x +pkg/images/filters/t_mode.x +pkg/images/filters/t_rmode.x +pkg/images/filters/t_fmedian.x +pkg/images/filters/t_frmedian.x +pkg/images/filters/t_fmode.x +pkg/images/filters/t_frmode.x + Added a verbose parameter to the median, rmedian, mode, rmode, fmedian, + frmedian, fmode, and frmode tasks. (11/27/95, Davis) + +pkg/images/geometry/doc/geotran.hlp + Fixed an error in the help page for geotran. The default values for + the xscale and yscale parameters were incorrectly listed as INDEF, + INDEF instead of 1.0, 1.0. (11/14/95, Davis) + +pkg/images/imarith/icpclip.gx + Fixed a bug where a variable was improperly used for two different + purposes causing the algorithm to fail (bug 316). (10/19/95, Valdes) + +pkg/images/doc/imcombine.hlp + Clarified a point about how the sigma is calculated with the SIGCLIP + option. (10/11/95, Valdes) + +pkg/images/imarith/icombine.gx + To deal with the case of readnoise=0. and image data which has points with + negative mean or median and very small minimum readnoise is set + internally to avoid computing a zero sigma and dividing by it. This + applies to the noise model rejection options. (8/11/95, Valdes) + +pkg/images/frmedian.hlp +pkg/images/frmode.hlp +pkg/images/rmedian.hlp +pkg/images/rmode.hlp +pkg/images/frmedian.par +pkg/images/frmode.par +pkg/images/rmedian.par +pkg/images/rmode.par +pkg/images/filters/frmedian.h +pkg/images/filters/frmode.h +pkg/images/filters/rmedian.h +pkg/images/filters/rmode.h +pkg/images/filters/t_frmedian.x +pkg/images/filters/t_frmode.x +pkg/images/filters/t_rmedian.x +pkg/images/filters/t_rmode.x +pkg/images/filters/frmedian.x +pkg/images/filters/frmode.x +pkg/images/filters/rmedian.x +pkg/images/filters/rmode.x +pkg/images/filters/med_utils.x + Added new ring median and modal filtering tasks frmedian, rmedian, + frmode, and rmode to the images package. + (6/20/95, Davis) + +pkg/images/fmedian.hlp +pkg/images/fmode.hlp +pkg/images/median.hlp +pkg/images/mode.hlp +pkg/images/fmedian.par +pkg/images/fmode.par +pkg/images/median.par +pkg/images/mode.par +pkg/images/filters/fmedian.h +pkg/images/filters/fmode.h +pkg/images/filters/median.h +pkg/images/filters/mode.h +pkg/images/filters/t_fmedian.x +pkg/images/filters/t_fmode.x +pkg/images/filters/t_median.x +pkg/images/filters/t_mode.x +pkg/images/filters/fmedian.x +pkg/images/filters/fmode.x +pkg/images/filters/median.x +pkg/images/filters/mode.x +pkg/images/filters/fmd_buf.x +pkg/images/filters/fmd_hist.x +pkg/images/filters/fmd_maxmin.x +pkg/images/filters/med_buf.x +pkg/images/filters/med_sort.x + Added minimum and maximum good data parameters to the fmedian, fmode, + median, and mode filtering tasks. Removed the 64X64 kernel size limit + in the median and mode tasks. Replaced the common blocks with structures + and .h files. + (6/20/95, Davis) + +pkg/images/geometry/t_geotran.x +pkg/images/geometry/geotran.x +pkg/images/geometry/geotimtran.x + Fixed a bug in the buffering of the x and y coordinate surface interpolants + which can cause a memory corruption error if, nthe nxsample or nysample + parameters are > 1, and the nxblock or nyblock parameters are less + than the x and y dimensions of the input image. Took the opportunity + to clean up the code. + (6/13/95, Davis) + +======= +V2.10.4 +======= + +pkg/images/geometry/t_geomap.x + Corrected a harmless typo in the code which determines the minimum + and maximum x values and improved the precision of the test when the + input is double precision. + (4/18/95, Davis) + +pkg/images/doc/fit1d.hlp + Added a description of the interactive parameter to the fit1d help page. + (4/17/95, Davis) + +pkg/images/imarith/t_imcombine.x + If an error occurs while opening an input image header the error + recovery will close all open images and then propagate the error. + For the case of running out of file descriptors with STF format + images this will allow the error message to be printed rather + than the error code. (4/3/95, Valdes) + +pkg/images/geometry/xregister/t_xregister.x + Added a test on the status code returned from the fitting routine so + the xregister tasks does not go ahead and write an output image when + the user quits the task in in interactive mode. + (3/31/95, Davis) + +pkg/images/imarith/icscale.x +pkg/images/doc/imcombine.hlp + The behavior of the weights when using both multiplicative and zero + point scaling was incorrect; the zero levels have to account for + the scaling. (3/27/95, Valdes) + +pkg/images/geometry/xregister/rgxtools.x + Changed some amovr and amovi calls to amovkr and amovki calls. + (3/15/95, Davis) + +pkg/images/geometry/t_imshift.x +pkg/images/geometry/t_magnify.x +pkg/images/geometry/geotran.x +pkg/images/geometry/xregister/rgximshift.x + The buffering margins set for the bicubic spline interpolants were + increased to improve the flux conservation properties of the interpolant + in cases where the data is undersampled. (12/6/94, Davis) + +pkg/images/xregister/rgxbckgrd.x + In several places the construct array[1++nx-wborder] was being used + instead of array[1+nx-wborder]. Apparently caused by a typo which + propagated through the code, the Sun compilers did not catch this, but + the IBM/RISC6000 compilers did. (11/16/94, Davis) + + +pkg/images/xregister.par +pkg/images/doc/xregister.hlp +pkg/images/geometry/xregister/t_xregister.x +pkg/images/geometry/xregister/rgxcorr.x +pkg/images/geometry/xregister/rgxicorr.x +pkg/images/geometry/xregister/rgxcolon.x +pkg/images/geometry/xregister/rgxdbio.x + The xregister task was modified to to write the output shifts file + in either text database format (the current default) or in simple text + format. The change was made so that the output of xregister could + both be edited more easily by the user and be used directly with the + imshift task. (11/11/94, Davis) + +pkg/images/imfit/fit1d.x + A Memc in the ratio output option was incorrectly used instead of Memr + when the bug fix of 11/16/93 was made. (10/14/94, Valdes) + +pkg/images/geometry/xregister/rgxcorr.x + The procedure rg_xlaplace was being incorrectly declared as an integer + procedure. + (8/1/94, Davis) + +pkg/images/geometry/xregister/rgxregions.x + The routine strncmp was being called (with a missing number of characters + argument) instead of strcmp. This was causing a bus error under solaris + but not sun os whenever the user set regions to "grid ...". (7/27/94 LED) + +pkg/images/tv/imexaine/ierimexam.x + The Gaussian fitting can return a negative sigma**2 which would cause + an FPE when the square root is taken. This will only occur when + there is no reasonable signal. The results of the gaussian fitting + are now set to INDEF if this unphysical result occurs. (7/7/94, Valdes) + +pkg/images/geometry/geofit.x + A routine expecting two char arrays was being passed two real arrays + instead resulting in a segmentation violation if calctype=real + and reject > 0. + (6/21/94, Davis) + +pkg/images/imarith/t_imarith.x + IMARITH now deletes the CCDMEAN keyword if present. (6/21/94, Valdes) + +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/icsclip.gx + 1. The restoration of deleted pixels to satisfy the nkeep parameter + was being done inside the iteration loop causing the possiblity + of a non-terminating loop; i.e. pixels are rejected, they are + restored, and the number left then does not statisfy the termination + condition. The restoration step was moved following the iterative + rejection. + 2. The restoration was also incorrectly when mclip=no and could + lead to a segmentation violation. + (6/13/94, Valdes) + +pkg/images/geometry/xregister/rgxicorr.x + The path names to the xregister task interactive help files was incorrect. + (6/13/94, Davis) + +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icsclip.gx + Found and fixed another typo bug. (6/7/94, Valdes/Zhang) + +pkg/images/imarith/icscale.x + The sigma scaling flag, doscale1, would not be set in the case of + a mean offset of zero though the scale factors could be different. + (5/25/94, Valdes/Zhang) + +pkg/images/imarith/icsclip.gx + There was a missing line: l = Memi[mp1]. (5/25/94, Valdes/Zhang) + +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/icsclip.gx + The reordering step when a central median is used during rejection + but the final combining is average was incorrect if the number + of rejected low pixels was greater than the number of pixel + number of pixels not rejected. (5/25/94, Valdes) + +pkg/images/geometry/t_geotran.x + In cases where there was no input geomap database, geotran was + unnecessarily overiding the size of the input image requested by the + user if the size of the image was bigger than the default output size + (the size of the output image which would include all the input image + pixels is no user shifts were applied). + (5/10/94, Davis) + +pkg/images/imarith/icscale.x +pkg/images/imarith/t_imcombine.x + 1. There is now a warning error if the scale, zero, or weight type + is unknown. + 2. An sfree was being called before the allocated memory was finished + being used. + (5/2/94, Valdes) + +pkg/images/tv/imexaine/ierimexam.x + For some objects the moment analysis could fail producing a floating + overflow error in imexamine, because the code was trying to use + INDEF as the initial value of the object fwhm. Changed the gaussian + fitting code to use a fraction of the fitting radius as the initial value + for the fitted full-width half-maximum in cases where the moment analysis + cannot compute an initial value. + (4/15/94 LED) + +pkg/images/imarith/iclog.x + Changed the mean, median, mode, and zero formats from 6g to 7.5g to + insure 5 significant digits regardless of signs and decimal points. + (4/13/94, Valdes) + +pkg/images/doc/imcombine.hlp + Tried again to clarify the scaling as multiplicative and the offseting + as additive for file input and for log output. (3/22/94, Valdes) + +pkg/images/imarith/iacclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/iscclip.gx + The image sigma was incorrectly computed when an offset scaling is used. + (3/8/94, Valdes) + +pkg/images/doc/imcombine.hlp + The MINMAX example confused low and high. (3/7/94, Valdes) + +pkg/images/geometry/t_geomap.x +pkg/images/geometry/geofit.x +pkg/images/geometry/geograph.x + Fixed a bug in the geomap code which caused the linear portion of the transformation + to be computed incorrectly if the x and y fits had a different functional form. + (12/29/93, Davis) + +pkg/images/imarith/t_imcombine.x +pkg/images/imcombine.par +pkg/images/do/imcombine.hlp + The output pixel datatypes now include unsigned short integer. + (12/4/93, Valdes) + +pkg/images/doc/imcombine.hlp + Fixed an error in the example of offseting. (11/23/93, Valdes) + +pkg/images/imfit/fit1d.x + When doing operations in place the input and output buffers are the + same and the difference and ratio operations assumed they were not + causing the final results to be wrong. (11/16/93, Valdes) + +pkg/images/imarith/t_imarith.x +pkg/images/doc/imarith.hlp + If no calculation type is specified then it will be at least real + for a division. Since the output pixel type defaults to the + calculation type if not specified this will also result in a + real output if dividing two integer images. (11/12/93, Valdes) + +pkg/images/imarith/icgrow.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/icsclip.gx +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/t_imcombine.x +pkg/images/doc/imcombine.hlp + If there were fewer initial pixels than specified by nkeep then the + task would attempt to add garbage data to achieve nkeep pixels. This + could occur when using offsets, bad pixel masks, or thresholds. The + code was changed to check against the initial number of pixels rather + than the number of images. Also a negative nkeep is no longer + converted to a positive value based on the number of images. Instead + it specifies the maximum number of pixels to reject from the initial + set of pixels. (11/8/93, Valdes) + +======= +V2.10.2 +======= + +pkg/images/imarith/icsetout.x + Added MWCS calls to update the axis mapping when using the project + option in IMCOMBINE. (10/8/93, Valdes) + +pkg$images/imarith/icscale.x +pkg$images/doc/imcombine.hlp + The help indicated that user input scale or zero level factors + by an @file or keyword are multiplicative and additive while the + task was using then as divisive and subtractive. This was + corrected to agree with the intend of the documentation. + Also the factors are no longer normalized. (9/24/93, Valdes) + +pkg$images/imarith/icsetout.x + The case in which absolute offsets are specified but the offsets are + all the same did not work correctly. (9/24/93, Valdes) + +pkg$images/imfit/imsurfit.h +pkg$images/imfit/t_imsurfit.x +pkg$images/imfit/imsurfit.x +pkg$images/lib/ranges.x + Fixed two bugs in the imsurfit task bad pixel rejection code. For low + k-sigma rejections factors the bad pixel list could overflow resulting + in a segmentation violation or a hung task. Overlapping ranges were + not being decoded into a bad pixel list properly resulting in + oscillating bad pixel rejection behavior where certain groups of + bad pixels were alternately being included and excluded from the fit. + Both bugs are fixed in iraf 2.10.3 + (9/21/93, Davis) + +pkg$images/doc/imcombine.hlp + Clarified how bad pixel masks work with the "project" option. + (9/13/93, Valdes) + +pkg$images/imfit/fit1d.x + When the input and output images are the same there was an typo error + such that the output was opened separately but then never unmapped + resulting in the end of the image not being updated. (8/6/93, Valdes) + +pkg$images/imarith/t_imcombine.x + The algorithm for making sure there are enough file descriptors failed + to account for the need to reopen the output image header for an + update. Thus when the number of input images + output images + logfile + was exactly 60 the task would fail. The update occurs when the output + image is unmapped so the solution was to close the input images first + except for the first image whose pointer is used in the new copy of the + output image. (8/4/93, Valdes) + +pkg$images/filters/t_mode.x +pkg$images/filters/t_median.x + Fixed a bug in the error trapping code in the median and mode tasks. + The call to eprintf contained an extra invalid error code agument. + (7/28/93, Davis) + +pkg$images/geometry/geomap.par +pkg$images/geometry/t_geomap.x +pkg$images/geometry/geogmap.x +pkg$images/geometry/geofit.x + Fixed a bug in the error handling code in geomap which was producing + a segmentation violation on exit if the user's coordinate list + had fewer than 3 data points. Also improved the error messages + presented to the user in both interactive and non-interactive mode. + (7/7/93, Davis) + +pkg$images/imarith/icgdata.gx + There was an indexing error in setting up the ID array when using + the grow option. This caused the CRREJECT/CCDCLIP algorithm to + fail with a floating divide by zero error when there were non-zero + shifts. (5/26/93, Valdes) + +pkg$images/imarith/icmedian.gx + The median calculation is now done so that the original input data + is not lost. This slightly greater inefficiency is required so + that an output sigma image may be computed if desired. (5/10/93, Valdes) + +pkg$images/geometry/t_imshift.x + Added support for type ushort to the imshift task in cases where the + pixel shifts are integral. + (5/8/93, Davis) + +pkg$images/doc/rotate.hlp + Fixed a bug in the rotate task help page which implied that automatic + image size computation would occur if ncols or nlines were set no 0 + instead of ncols and nlines. + (4/17/93, Davis) + +pkg$images/imarith/imcombine.gx + There was no error checking when writing to the output image. If + an error occurred (the example being when an imaccessible imdir was + set) obscure messages would result. Errchks were added. + (4/16/93, Valdes) + +pkg$images/doc/gauss.hlp + Fixed 2 sign errors in the equations in the documentation describing + the elliptical gaussian fucntion. + (4/13/92, Davis) + +pkg/images/imutil/t_imslice.x + Removed an error check in the imslice task, which was preventing it from + being used to reduce the dimensionality of images where the length of + the slice dimension is 1.0. + (2/16/83, Davis) + +pkg/images/filters/fmedian.x + The fmedian task was printing debugging information under iraf 2.10.2. + (1/25/93, Davis) + +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/icsclip.gx + When using mclip=yes and when more pixels are rejected than allowed by + the nkeep parameter there was a subtle bug in how the pixels are added + back which can result in a segmentation violation. + if (nh == n2) ==> if (nh == n[i]) + (1/20/93, Valdes) + + +======= +V2.10.1 +======= + +pkg/images/imarith/t_imcombine.x +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icgrow.gx +pkg/images/imarith/iclog.x +pkg/images/imarith/icombine.com +pkg/images/imarith/icombine.gx +pkg/images/imarith/icombine.h +pkg/images/imarith/icpclip.gx +pkg/images/imarith/icscale.x +pkg/images/imarith/icsclip.gx +pkg/images/imarith/icsetout.x +pkg/images/imcombine.par +pkg/images/doc/combine.hlp + The weighting was changed from using the square root of the exposure time + or image statistics to using the values directly. This corresponds + to variance weighting. Other options for specifying the scaling and + weighting factors were added; namely from a file or from a different + image header keyword. The \fInkeep\fR parameter was added to allow + controlling the maximum number of pixels to be rejected by the clipping + algorithms. The \fIsnoise\fR parameter was added to include a sensitivity + or scale noise component to the noise model. Errors will now delete + the output image. + (9/30/92, Valdes) + +pkg/images/imutil/imcopy.x + Added a call to flush after the status line printout so that the output + will appear immediately. (8/19/92, Davis) + +pkg/images/filters/mkpkg +pkg/images/filters/t_fmedian.x +pkg/images/filters/fmedian.x +pkg/images/filters/fmd_buf.x +pkg/images/filters/fmd_maxmin.x + The fmedian task could crash with a segmentation violation if mapping + was turned off (hmin = zmin and hmax = zmax) and the input image + contained data outside the range defined by zmin and zmax. (8/18/92, Davis) + +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/icsclip.gx + There was a very unlikely possibility that if all the input pixels had + exactly the same number of rejected pixels the weighted average would + be done incorrectly because the dflag would not be set. (8/11/92, Valdes) + +pkg/images/imarith/icmm.gx + This procedure failed to set the dflag resulting in the weighted average + being computed in correctly. (8/11/92, Valdes) + +pkg/images/imfit/fit1d.x + At some point changes were made but not documented dealing with image + sections on the input/output. The changes seem to have left off the + final step of opening the output image using the appropriate image + sections. Because of this it is an error to use an image section + on an input image when the output image is different; i.e. + + cl> fit1d dev$pix[200:400,*] junk + + This has now been fixed. (8/10/92, Valdes) + +pkg/images/imarith/icscales.x + The zero levels were incorrectly scaled twice. (8/10/92, Valdes) + +pkg/images/imarith/icstat.gx + Contained the statement + nv = max (1., (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + which is max(real,int). Changed the 1. to a 1. (8/10/92, Valdes) + +pkg$images/imarith/icaclip.gx +pkg$images/imarith/iccclip.gx +pkg$images/imarith/icsclip.gx + These files contained multiple cases (ten or so) of constructs such as + "max (1., ...)" or "max (0., ...)" where the ... could be either real + or double. In the double cases the DEC compiler complained about a + type mismatch since 1. is real. (8/10/92, Valdes) + +pkg$images/imfit/t_imsurfit.x + Fixed a bug in the section reading code. Imsurfit is supposed to switch + the order of the section delimiters in x and y if x2 < x1 or y2 < 1. + Unfortunately the y test was actually "if (y2 < x1)" instead of + "if (y2 < y1)". Whether or not the code actually works correctly + depends on the value of x1 relative to y2. This bug was not present + in 2.9.1 but is present in subsequent releases. (7/30/92 LED) + +======= +V2.10.1 +======= + +pkg$images/filters/t_gauss.x + The case theta=90 and ratio > 0.0 but < 1.0 was producing an incorrect + convolution if bilinear=yes, because the major axis sigmas being + input along the x and y axes were sigma and ratio * sigma respectively + instead of ratio * sigma and sigma in this case. + +pkg$images/imutil/imcopy.x + Modified imcopy to write its verbose output to STDOUT instead of + STDERR. (6/24/92, Davis) + +pkg$images/imarith/imcombine.gx + The step where impl1$t is called to check if there is enough memory + did not set the return buffer because the values are irrelevant for + this check. However, depending on history, this buffer could have + arbitrary values and later when IMIO attempts to flush this buffer, + at least in the case of image type coersion, cause arithmetic errors. + The fix was to clear the returned buffers. (4/27/92, Valdes) + +pkg$images/imutil/t_imstack.x + Modified the imslice task to read the old and write a new axis map. + (4/23/92, Davis) + +pkg$images/geometry/t_imslice.x + Modified the imslice task to read the old and write a new axis map. + (4/23/92, Davis) + +pkg$images/geometry/t_blkavg.x +pkg$images/geometry/t_blkrep.x + Modified the calls to mw_shift and mw_scale to explicitly set the + number of logical axes instead of using the default of 0. + (4/23/92, Davis) + +pkg$images/geometry/t_imtrans.x + Modified imtranspose so that it correctly picks up the axis map + and writes it to the output image wcs. (4/23/92, Davis) + +pkg$images/register.par +pkg$images/geotran.par +pkg$images/doc/register.hlp +pkg$images/doc/geotran.hlp + Changed the default values of the parameters xscale and yscale in + the register and geotran tasks from INDEF to 1.0 (4/23/92, Davis) + +pkg$images/geometry/t_imtrans.x +pkg$images/doc/imtranspose.hlp + Modified the imtranspose task so it does a true transpose of the + axes instead of simply modifying the lterm. (4/8/92, Davis) + +pkg$images/iminfo/listpixels.x + Added the formats parameter for formatting the output pixel coordinates + to the listpixels task. These formats take precedence over the formats + stored in the WCS in the image header and the previous default format. + (4/7/92, Davis) + +pkg$images/imutil/t_imstack.x + Added wcs support to the imstack task. (4/2/92, Davis) + +pkg$images/iminfo/listpixels.x + Modified listpixels so that it will work correctly if the dimension + of the wcs is less than the dimension of the image. (3/16/92, Davis) + +pkg$images/geometry/t_geotran.x + Modified the rotate, imlintran, register and geotran tasks wcs updating + code to deal correclty with dimensionally reduced data. (3/16/92, Davis) + +pkg$images/imarith/icalip.gx +pkg$images/imarith/icclip.gx +pkg$images/imarith/ipslip.gx +pkg$images/imarith/icslip.gx +pkg$images/imarith/icmedian.gx + The median calculation with an even number of points for short data + could overflow (addition of two short values) and be incorrect. + (3/16/92, Valdes) + +pkg$images/geometry/t_blkavg.x +pkg$images/geometry/t_blkrep.x + 1. Improved the precision of the blkavg task wcs updating code. + 2. Changed the blkrep task wcs updating code so that it is consistent + with blkavg. This means that a blkrep command followed by a blkavg + command or vice versa will return the original coordinate system + to within machine precision. (3/16/92, Davis) + +pkg$images/iminfo/listpixels.x + Modified listpixels to print out an error if it could not open the + wcs in the image. (3/15/92, Davis) + +pkg$images/geometry/t_magnify.x + Fixed a bug in the magnify task wcs updating code which was not + working correctly for dimensionally reduced images. (3/15/92, Davis) + +pkg$images/geometry/t_imtrans.x + Fixed a bug in the imtranspose task wcs updating code which was not + working correctly for dimensionally reduced images. (3/14/92, Davis) + +pkg$images/imarith/icalip.gx +pkg$images/imarith/icclip.gx +pkg$images/imarith/icslip.gx + There was a bug allowing the number of valid pixels counter to become + negative. Also there was a step which should not be done if the + number of valid pixels is less than 1; i.e. all pixels rejected. + A test was put in to skip this step. (3/13/92, Valdes) + +pkg$images/iminfo/t_imslice.x +pkg$images/doc/imslice.hlp + Added wcs support to the imslice task. + (3/12/92, Davis) + +pkg$images/iminfo/t_imstat.x + Fixed a bug in the code for computing the standard deviation, kurtosis, + and skew, wherein precision was being lost because two of the intermediate + variables in the computation were real instead of double precision. + (3/10/92, Davis) + +pkg$images/iminfo/listpixels.x + 1. Modified listpixels task to use the MWCS axis "format" attributes + if they are present in the image header. + 2. Added support for dimensionally reduced images, i.e. + images which are sections of larger images and whose coordinate + transformations depend on the reduced axes, to the listpixels task. + (3/6/92, Davis) + +pkg$images/imarith/t_imcombine.x +pkg$images/imarith/icsetout.x + Changed error messages to say IMCOMBINE instead of ICOMBINE. + (3/2/92, Valdes) + +pkg$images/imarith/iclog.x + Added listing of read noise and gain. (2/10/92, Valdes) + +pkg$images/imarith/icscale.x +pkg$images/imarith/icpclip.gx + 1. Datatype declaration for asumi was incorrect. + 2. Reduced the minimum number of images allowed for PCLIP to 3. + (1/7/92, Valdes) + +pkg$images/imarith/icgrow.gx + The first pixel to be checked was incorrectly set to 0 instead of 1 + resulting in a segvio when using the grow option. (12/6/91, Valdes) + +pkg$images/imarith/icgdata.gx +pkg$images/imarith/icscale.x + Fixed datatype declaration errors found by SPPLINT. (11/22/91, Valdes) + +pkg$images/iminfo/t_imstat.x + Fixed a bug in the kurtosis computation found by ST. + (Davis 10/11/91) + +pkg$images/iminfo/t_imstat.x +pkg$images/doc/imstat.hlp + Corrected a bug in the mode computation in imstatistics. The parabolic + interpolation correction for computing the histogram peak was being + applied in the wrong direction. Note that for dev$pix the wrong answer + is actually closer to the expected answer than the correct answer + due to binning effects. + (Davis 9/24/91) + +pkg$images/filters/t_gauss.x + The code which computes the gaussian kernel was producing a divide by + zero error if ratio=0.0 and bilinear=yes (2.10 version only). + (Davis 9/18/91) + +pkg$images/doc/magnify.hlp + Corrected a bug in the magnify help page. + (Davis 9/18/91) + +pkg$images/imarith/icsclip.gx +pkg$images/imarith/icaclip.gx +pkg$images/imarith/iccclip.gx + There was a typo, Memr[d[k]+k] --> Memr[d[j]+k]. (9/17/91, Valdes) + +pkg$images/imarith/icstat.gx +pkg$images/imarith/icmask.x + The offsets were used improperly in computing image statistics. + (Valdes, 9/17/91) + +pkg$images/geometry/t_imshift.x + The shifts file pointer was not being correctly initialized to NULL + in the case where no shifts file was declared. When the task + was invoked repeatedly from a script, this could result in an array being + referenced, for which space had not been previously allocated. + (Davis 7/29/91) + +pkg$images/imarith/imc* - +pkg$images/imarith/ic* + +pkg$images/imarith/t_imcombine.x +pkg$images/imarith/mkpkg +pkg$images/imarith/generic/mkpkg +pkg$images/imcombine.par +pkg$images/doc/imcombine.hlp + Replaced old version of IMCOMBINE with new version supporting masks, + offsets, and new algorithms. (Valdes 7/19/91) + +pkg$images/iminfo/imhistogram.x + Imhistogram has been modified to print the value of the middle of + histogram bin instead of the left edge if the output type is list + instead of plot. (Davis 6/11/91) + +pkg$images/t_imsurfit.x + Modified the sections file reading code to check the order of the + x1 x2 y1 y2 parameters and switch (x1,x2) or (y1,y2) if x2 < x1 or + y2 < y1 respectively. (Davis 5/28/91) + +pkg$images/listpixels.par +pkg$images/iminfo/listpixels.x +pkg$images/doc/listpixels.hlp + Modified the listpixels task to be able to print the pixel coordinates + in logical, physical or world coordinates. The default coordinate + system is still logical as before. (Davis 5/17/91) + +pkg$images/images.par +pkg$images/doc/minmax.hlp +pkg$images/imutil/t_minmax.x +pkg$images/imutil/minmax.x + Minmax was modified to do the minimum and maximum values computations + in double precision or complex instead of real if the input image + pixel type is double precision or complex. Note that the minimum and + maximum header values are still stored as real however. + (Davis 5/16/91) + +imarith/t_imarith.x + There was a missing statement to set the error flag if the image + dimensions did not match. (5/14/91, Valdes) + +doc/imarith.hlp + Fixed some formatting problems in the imarith help page. (5/2/91 Davis) + +imarith$imcombine.x + Changed the order in which images are unmapped to have the output images + closed last. This is to allow file descriptors for the temporary image + used when updating STF headers. (4/22/91, Valdes) + +pkg$images/geometry/t_blkavg.x +pkg$images/geometry/blkavg.gx +pkg$images/geometry/blkavg.x + The blkavg task was partially modified to support complex image data. + The full modifications cannot be made because of an error in abavx.x + and the missing routine absux.x. + (4/18/91 Davis) + +pkg$images/geometry/geofit.x + The x and y fits cross-terms switch was not being set correctly to "yes" + in the case where xxorder=2 and xyorder=2 or in the case where yxorder=2 + and yyorder=2. + (4/9/91 Davis) + +pkg$images/geometry/geogmap.x + Modified the line which prints the geometric parameters to use the + variable name xshift and yshift instead of delx and dely. + (4/9/91 Davis) + +pkg$images/imfit/imsurfit.x + Fixed a bug in the pixel rejection code which occurred when upper was > + 0.0 and lower = 0.0 or lower > 0 and upper = 0.0. The problem was that + the code was simply setting the rejection limits to the computed sigma + times the upper and lower parameters without checking for the 0.0 + condition first. In the first case this results in all points with + negative residuals being rejected and in the latter all points with + positive residuals are rejected. + (2/25/91 Davis) + +pkg$images/doc/hedit.hlp +pkg$images/doc/hselect.hlp +pkg$images/doc/imheader.hlp +pkg$images/doc/imgets.hlp + Added a reference to imgets in the SEE ALSO sections of the hedit and + hselect tasks. + Added a reference to hselect and hedit in the SEE ALSO sections of the + imheader and imgets tasks. + (2/22/91 Davis) + +pkg$images/gradient.hlp +pkg$images/laplace.hlp +pkg$images/gauss.hlp +pkg$images/convolve.hlp +pkg$images/gradient.par +pkg$images/laplace.par +pkg$images/gauss.par +pkg$images/convolve.par +pkg$images/t_gradient.x +pkg$images/t_laplace.x +pkg$images/t_gauss.x +pkg$images/t_convolve.x +pkg$images/convolve.x +pkg$images/xyconvolve.x +pkg$images/radcnv.x + The convolution operators were modified to run more efficiently in + certain cases. The LAPLACE task was modified to make use of the + radial symmetry of the convolution kernel in the y direction as well + as the x direction resulting in a modest speedup in execution time. + A new parameter bilinear was added to the GAUSS and CONVOLVE tasks. + By default and if appropriate mathematically, GAUSS now makes use of + the bilinearity or separability of the Gaussian function, + to separate the 2D convolution in x and y into two equivalent + 1D convolutions in x and y, resulting in a considerable speedup + in execution time. Similarly the user can know program CONVOLVE to + compute a bilinear convolution instead of a full 2D 1 if appropriate. + (1/29/91 Davis) + +pkg$images/filters/t_convolve.x + CONVOLVE was not decoding the legal 1D kernel "1.0 2.0 1.0" correctly + although the alternate form "1.0 2.0 1.0;" worked. Leading + blanks in string kernels as in for example " 1.0 2.0 1.0" also generated + and error. Fixed these bugs and added some additional error checking code. + (11/28/90 Davis) + +pkg$images/doc/gauss.hlp + Added a detailed mathematical description of the gaussian kernel used + by the GAUSS task to the help page. + +pkg$images/images.hd +pkg$images/rotate.cl +pkg$images/imlintran.cl +pkg$images/register.cl +pkg$images/register.par + Added src="script file name" entries to the IMAGES help database + for the tasks ROTATE, IMLINTRAN, and REGISTER. Changed the CL + script for REGISTER to a procedure script to remove the ugly + local variable declarations. Added a few comments to the scripts. + (12/11/90, Davis) + +pkg$images/iminfo/imhistogram.x + Added a new parameter binwidth to imhistogram. If binwidth is defined + it determines the histogram resolution in intensity units, otherwise + nbins determines the resolution as before. (10/26/90, Davis) + +pkg$images/doc/sections.hlp + Clarified what is meant by an image template and that the task itself + does not check whether the specified names are actually images. + The examples were improved. (10/3/90, Valdes) + +pkg$images/doc/fit1d.hlp + Changed lines to columns in example 2. (10/3/90, Valdes) + +pkg$images/imarith/imcscales.x + When an error occured while parsing the mode section the untrapped error + caused further problems downstream. Because it would require adding + lots of errchks to cause the program to gracefully abort I instead made + it a warning. (10/2/90, Valdes) + +pkg$images/imutil/hedit.x + Hedit was computing but not using min_lenarea. If the user specified + a min_lenuserarea greater than the default of 28800 then the default + was being used instead of the larger number. + +pkg$imarith/imasub.gx + The case of subtracting an image from the constant zero had a bug + which is now fixed. (8/14/90, Valdes) + +pkg$images/t_imtrans.x + Modified the imtranspose task so it will work on type ushort images. + (6/6/90 Davis) + +pkg$images + Added world coordinate system support to the following tasks: imshift, + shiftlines, magnify, imtranspose, blkrep, blkavg, rotate, imlintran, + register and geotran. The only limitation is that register and geotran + will only support simple linear transformations. + (2/24/90 Davis) + +pkg$images/geometry/geotimtran.x + Fixed a problem in the boundary extension "reflect" option code for small + images which was causing odd values to be inserted at the edges of the + image. + (2/14/90 Davis) + +pkg$images/iminfo/imhistogram.x + A new parameter "hist_type" was added to the imhistogram task giving + the user the option of plotting the integral, first derivative and + second derivative of the histogram as well as the normal histogram. + Code was contributed by Rob Seaman. + (2/2/90 Davis) + +pkg$images/geometry/geogmap.x + The path name of the help file was being erroneously renamed with + the result that when users ran the double precision version of the + code they could not find the help file. + (26/1/90 Davis) + +pkg$images/filters/t_boxcar.x,t_convolve.x + Added some checks for 1-D images. + (1/20/90 Davis) + +pkg$images/iminfo/t_imstat.x,imstat.h + Made several minor bug fixes and alterations in the imstatistics task + in response to user complaints and suggestions. + + 1. Changed the verbose parameter to the format parameter. If format is + "yes" (the default) then the selected fields are printed in fixed format + with column labels. Other wise the fields are printed in free format + separated by 2 blanks. This fixes the problem of fields running together. + + 2. Fixed a bug in the code which estimates the median from the image + histogram by linearly interpolating around the midpt of the integrated + histogram. The bug occurred when more than half the pixels were in the + first bin. + + 3. Added a check to ensure that the number of fields did not overflow + the fields array. + + 4. Removed the extraneous blank line printed after the title. + + 5. The pound sign is now printed at the beginning of the column header + string regardless of which field is printed first. In the previous + versions it was only being printed if the image name field was + printed first. + + 6. Changed the name of the median field to midpt in response to user + confusions about how the median is computed. + + (1/20/90, Davis) + +pkg$images/imutil/t_imslice.hlp + The imslice was not correctly computing the number of lines in the + output image in the case where the slice dimension was 1. + (12/4/89, Davis) + +pkg$images/doc/imcombine.hlp + Clarified and documented definitions of the scale, offset, and weights. + (11/30/89, Valdes) + +pkg$images/geometry/geotran.x + High order surfaces of a certain functional form could occasionally + produce out of bounds pixel errors. The bug was caused by not properly + computing the distortion of the image boundary for higher order + surfaces. + (11/21/89, Davis) + +pkg$images/geometry/imshift.x + The circulating buffer space was not being freed after each execution + of IMSHIFT. This did not cause an error in execution but for a long + list of frames could result in alot of memory being tied up. + (10/25/89, Davis) + +pkg$images/imarith/t_imarith.x + IMARITH is not prepared to deal with images sections in the output. + It used to look for '[' to decide if the output specification included + and image section. This has been changed to call the IMIO procedure + imgsection and check if a non-null section string is returned. + Thus it is up to IMIO to decide what part of the image name is + an image section. (9/5/89, Valdes) + +pkg$images/imarith/imcmode.gx + Fixed bug causing infinite loop when computing mode of constant value + section. (8/14/89, Valdes) + +==== +V2.8 +==== + +pkg$images/iminfo/t_imstat.x + Davis, Jun 15, 1989 + Added a couple of switches to that skew and kurtosis are not computed + if they are not to be printed. + +pkg$images/iminfo/t_imstat.x + Davis, Jun 14, 1989 + A simple mod was made to the skew and kurtosis computation to avoid + divide by zero errors in case of underflow. + +pkg$images/imutil/chpixtype.par + Davis, Jun 13, 1989 + The parameter file has been modified to accept an output pixel + type of ushort. + +pkg$images/imarith/imcombine.gx + Valdes, Jun 2, 1989 + A new scheme to detect file errors is now used. + +pkg$images/imfit/t_imsurfit.x + Davis, Jun 1, 1989 + 1. If the user set regions = "sections" but the sections file + did not exist the task would go into an infinite loop. The problem + was a missing error check on the open statement. + +pkg$images/iminfo/imhistogram.x,imhistogram.par + Davis, May 31, 1989 + A new version of imhistogram has been installed. These mods have + been made over a period of a month by Doug Tody and Rob Seaman. + The mods include + 1. An option to turn off log scaling of the y axis of the histogram plot. + 2. A new autoscale parameter which avoids aliasing problems for integer + data. + 3. A new parameter top_close which resolves the ambiguity in the top + bin of the histogram. + +pkg$images/imarith/imcombine.gx + Valdes, May 9, 1989 + Because a file descriptor was not reserved for string buffer operations + and a call to stropen in cnvdate was not error checked the task would + hang when more than 115 images were combined. Better error checking + was added and now an error message is printed when the maximum number + of images that can be combined is exceeded. + +pkg$images/imarith/t_imarith.x + Valdes, May 6, 1989 + Operations in which the output image has an image section are now + skipped with a warning message. + +pkg$images/imarith/sigma.gx +pkg$images/imarith/imcmode.gx + Valdes, May 6, 1989 + 1. The weighted sigma was being computed incorrectly. + 2. The argument declarations were wrong for integer input images. + Namely the mean vector is always real. + 3. Minor change to imcmode.gx to return correct datatype. + +pkg$images/imstack,imslice + Davis, April 1, 1989 + The proto images tasks imstack and imslice have been moved from the + proto package to the images package. Imstack is unchanged except that + it now supports the image data types USHORT and COMPLEX. Imslice has + been modified to allow slicing along any dimension of the image instead + of just the highest dimension. + +pkg$images/imstatistics. + Davis, Mar 31, 1989 + 1. A totally new version of the imstatistics task has been written + and replaces the old version. The new task allows the user to select + which statistical parameters to compute and print. These include + the mean, median, mode, standard deviation, skew, kurtosis and the + minimum and maximum pixel values. + +pkg$images/imhistogram.par +pkg$images/iminfo/imhistogram.x +pkg$images/doc/imhistogram.hlp + Davis, Mar 31, 1989 + 1. The imhistogram task has been modified to plot "box" style histograms + as well as "line" type histograms. Type "line" remains the default. + +pkg$images/geometry/geotran.par,register.par,geomap.par +pkg$images/doc/geomap.hlp,register.hlp,geotran.hlp + Davis, Mar 6, 1989 + 1. Improved the parameter prompting in GEOMAP, REGISTER and GEOTRAN + and improved the help pages. + 2. Changed GEOMAP database quantities "xscale" and "yscale" to "xmag" + and "ymag" for consistency . Geotran was changed appropriately. + +pkg$images/imarith/imcmode.gx + For short data a short variable was wraping around when there were + a significant number of saturated pixels leading to an infinite loop. + The variables were made real regardless of the image datatype. + (3/1/89, Valdes) + +pkg$images/imutil/imcopy.x + Davis, Feb 28, 1989 + 1. Added support for type USHORT to the imcopy task. This is a merged + ST modification. + +pkg$images/imarith/imcthreshold.gx +pkg$images/imcombine.par +pkg$images/doc/imcombine.hlp +pkg$images/imarith/imcscales.x + Valdes, Feb 16, 1989 + 1. Added provision for blank value when all pixels are rejected by the + threshold. + 2. Fixed a bug that was improperly scaling images in the threshold option. + 3. The offset printed in the log now has the opposite sign so that it + is the value "added" to bring images to a common level. + +pkg$images/imfit/imsurfit.x + Davis, Feb 23, 1989 + Fixed a bug in the median fitting code which could cause the porgram + to go into an infinite loop if the region to be fitted was less than + the size of the whole image. + +pkg$images/geometry/t_magnify.x + Davis, Feb 16, 1989 + Modified magnify to work on 1D images as well as 2D images. The + documentation has been updated. + +pkg$images/geometry/t_geotran.x + Davis, Feb 15, 1989 + Modified the GEOTRAN and REGISTER tasks so that they can handle a list + of transform records one for each input image. + +pkg$images/imarith/imcmode.gx + Valdes, Feb 8, 1989 + Added test for nx=1. + +pkg$images/imarith/t_imcombine.x + Valdes, Feb 3, 1989 + The test for the datatype of the output sigma image was wrong. + +pkg$images/iminfo/listpixels.x,listpixels.par + Davis, Feb 6, 1989 + The listpixels task has been modified to print out the pixels for a + list of images instead of a single image only. A title line for each + image listed can optionally be printed on the standard output if + the new parameter verbose is set to yes. + +pkg$images/geometry/t_imshift.x + Davis, Feb 2, 1989 + Added a new parameter shifts_file to the imshift task. Shifts_file + is the name of a text file containing the the x and yshifts for + each input image to be shifted. The number of input shifts must + equal the number of input images. + +pkg$images/geometry/t_geomap.x + Davis, Jan 17, 1989 + Added an error message for the case where the coordinates is empty + of there are no points in the specified data range. Previously the + task would proceed to the next coordinate file without any message. + +pkg$images/geometry/t_magnify.x + Davis, Jan 14, 1989 + Added the parameter flux conserve to the magnify task to bring it into + line with all the other geometric transformation tasks. + +pgk$images/geometry/geotran.x,geotimtran.x + Davis, Jan 2, 1989 + A bug was fixed in the flux conserve code. If the x and y reference + coordinates are not in pixel units and are not 1 then + the computed flux per pixel was too small by xscale * yscale. + +pkg$images/filters/acnvrr.x,convolve.x,boxcar.x,aboxcar.x + Davis, Dec 27, 1988 + I changed the name of the acnvrr procedure to cnv_radcnvr to avoid + a name conflict with a vops library procedure. This only showed + up when shared libraries were implemented. I also changed the name + of the aboxcarr procedure to cnv_aboxr to avoid conflict with the + vops naming conventions. + +pkg$images/imarith/imcaverage.gx + Davis, Dec 22, 1988 + Added an errchk statement for imc_scales and imgnl$t to stop the + program bombing with segmentation violations when mode <= 0. + +pkg$images/imarith/imcscales.x + Valdes, Dec 8, 1988 + 1. IMCOMBINE now prints the scale as a multiplicative quantity. + 2. The combined exposure time was not being scaled by the scaling + factors resulting in a final exposure time inconsistent with the + data. + +pkg$images/iminfo/imhistogram.x + Davis, Nov 30, 1988 + Changed the list+ mode so that bin value and count are printed out instead + of bin count and value. This makes the plot and list modes compatable. + +pkg$images/iminfo/t_imstat.x + Davis, Nov 17, 1988 + Added the n=n+1 back into the inner loop of imstat. + +pkg$images/geotran.par,register.par + Davis, Nov 11 , 1988 + Fixed to glaring errors in the parameter files for register and geotran. + Xscale and yscale were described as pixels per reference unit when + they should be reference units per pixel. The appropriate bug fix has been + made. + +pkg$images/geometry/t_geotran.x + Davis, November 7, 1988 + The routine gsrestore was not being error checked. If either of the + input x or y coordinate surface was linear and the other was not, + the message came back GSRESTORE: Illegal x coordinate. This bug has + been fixed. + +pkg$images/imarith/imcombine.gx + Valdes, October 19, 1988 + A vops clear routine was not called generically causing a crash with + double images. + +pkg$images/filters/t_fmedian.x,t_median.x,t_fmode.x,t_mode.x,t_gradient.x + t_gauss.x,t_boxcar.x,t_convolve.x,t_laplace.x + Davis, October 4, 1988 + I fixed a bug in the error handling code for the filters tasks. If + and error occurred during task execution and the input image name was + the same as the output image name then the input image was trashed. + +pkg$images/imarith/imcscales.gx + Valdes, September 28, 1988 + It is now an error for the mode to be nonpositive when scaling or weighting. + +pkg$images/imarith/imcmedian.gx + Valdes, August 16, 1988 + The median option was selecting the n/2 value instead of (n+1)/2. Thus, + for an odd number of images the wrong value was being determined for the + median. + +pkg$images/geometry/t_imshift.x + Davis, August 11, 1988 + 1. Imshift has been modified to uses the optimized code if nearest + neighbour interpolation is requested. A nint is done on the shifts + before calling the quick shift routine. + 2. If the requested pixel shift is too large imshift will now + clean up any pixelless header files before continuing execution. + +pkg$images/geometry/blkavg.gx + Davis, July 13, 1988 + Blkavg has been fixed so that it will work on 1D images. + +pkg$images/geometry/t_imtrans.x,imtrans.x + Davis, July 12, 1988 + Imtranspose has been modified to work on complex images. + +pkg$images/imutil/t_chpix.x + Davis, June 29, 1988 + A new task chpixtype has been added to the images package. Chpixtype + changes the pixel types of a list of images to a specified output pixel + type. Seven data types are supported "short", "ushort", "int", "long" + "real" and "double". + +pkg$images/geometry/rotate.cl,imlintran.cl,t_geotran.x + Davis, June 10, 1988 + The rotate and imlintran scripts have been rewritten to use procedure + scripts. This removes all the annoying temporary cl variables which + appear when the user does an lpar. In previous versions of these + two tasks the output was restricted to being the same size as the input + image. This is still the default case, but the user can now set the + ncols and nrows parameters to the desired output size. I ncols or nlines + < 0 then then the task compute the output image size required to contain + the whole input image. + +pkg$images/filters/t_convolve.x,t_laplace.x,t_gradient.x,t_gauss.x,convolve.x + Davis, June 1, 1988 + The convolution operators laplace, gauss and convolve have been modified + to make use of radial symmetry in the convolution kernel. In gauss and + laplace the change is transparent to the user. For the convolve operator + the user must indicate that the kernel is radially symmetric by setting + the parameter radsym. For kernels of 7 by 7 or greater the speedup + in timings is on the order of 30% on the Vax 750 with the fpa. + +pkg$images/imarith/imcmode.gx + Valdes, Apr 11, 1988 + 1. The use of a mode sections was handled incorrectly. + +pkg$images/imfit/fit1d.x + Valdes, Jan 4, 1988 + 1. Added an error check for a failure in IMMAP. The missing error check + caused FIT1D to hang when a bad input image was specified. + +pkg$images/magnify.par +pkg$images/imcombine.par +pkg$images/imarith/imcmode.gx +pkg$images/doc/imarith.hlp + Valdes, Dec 7, 1987 + 1. Added option list to parameter prompts. + 2. Fixed minor typo in help page + 3. The mode calculation in IMCOMBINE would go into an infinite loop + if all the pixel values were the same. If all the pixels are the + same them it skips searching for the mode and returns the constant + number. + +pkg$images/geometry/geotimtran.x + Davis, Nov 25, 1987 + 1. A bug in the boundary extension = wrap option was found in the + IMLINTRAN task. The problem occured in computing values for out of + bounds pixels in the range 0.0 < x < 1.0, ncols < x < ncols + 1.0, + 0.0 < y < 1.0 and nlines < y < nlines + 1. The computed coordinates + were falling outside the boundaries of the interpolation array. + +pkg$images/geometry/t_geomap.x,geograph.x + Davis, Nov 19, 1987 + 1. The geomap task now writes the name of the output file into the database. + 2. Rotation angles of 360. degrees have been altered to 0 degrees. + +pkg$images/imfit/t_imsurfit.x,imsurfit.x +pkg$images/lib/ranges.x + Davis, Nov 2, 1987 + A bug in the regions fitting option of the IMSURFIT task has been found + and fixed. This bug would occur when the user set the regions parameter + to sections and then listed section which overlapped each other. The + modified ranges package was not handling the overlap correctly and + computing a number of points which was incorrect. + +pkg$images/imarith/* + + Valdes, Sep 30, 1987 + The directory was reorganized to put generic code in the subdirectory + generic. + + A new task called IMCOMBINE has been added. It provides for combining + images by a number of algorithms, statistically weighting the images + when averaging, scaling or offsetting the images by the exposure time + or image mode before combining, and rejecting deviant pixels. It is + almost fully generic including complex images and works on images of + any dimension. + +pkg$images/geometry/geotran.x + Davis, Sept 3, 1987 + A bug in the flux conserving algorithm was found in the geotran code. + The symptom was that the flux of the output image occasionally was + negative. This would happen when two conditions were met, the transformation + was of higher order than a simple rotation, magnification, translation + and an axis flip was involved. The mathematical interpretation of this + bug is that the coordinate surface had turned upside down. The solution + for people running systems with this bug is to multiply there images + by -1. + +pkg$images/imfit/imsurfit.h,t_imsurfit.x + Davis, Aug 6, 1987 + A new option was added to the parameter regions in the imsurfit task. + Imsurfit will now fit a surface to a single circular region defined + by an x and y center and a radius. + +pkg$images/geometry/geotimtran.x + Davis, Jun 15, 1987 + Geotran and register were failing when the output image number of rows + and columns was different from the input number of rows and columns. + Geotran was mistakenly using the input images sizes to determine the + number of output lines that should be produced. The same problem occurred + when the values of the boundary pixels were being computed. The program + was using the output image dimensions to compute the boundary pixels + instead of the input image dimensions. + +pkg$images/geometry/geofit.x,geogmap.x + Davis, Jun 11, 1987 + A bug in the error checking code in the geomap task was fixed. The + condition of too few points for a reasonable was not being trapped + correctly. The appropriate errchk statements were added. + +pkg$images/geomap.par + Davis, Jun 10, 1987 + The default fitting function was changed to polynomial. This will satisfy + most users who wish to do shifts, rotations, and magnifications and + avoid the neccessity of correctly setting the xmin, xmax, ymin, and ymax + parameters. For the chebyshev and legendre polynomial functions these + parameters must be explicitly set. For reference coordinates in pixel + units the normal settings are 1, ncols, 1 and nlines respectively. + +pkg$images/iminfo/hselect.x,imheader.x,images$/imutil/hselect.x + Davis, Jun 8, 1987 + Imheader has been modified to open an image with the default min_lenuserarea + Hselect and hedit will now open the image setting the user area to the + maximum of 28800 chars or the min_lenuser environment variable. + +pkg$images/iminfo/t_imstat.x + Davis, May 22, 1987 + An error in the image minimum computation was corrected. This error + would show up most noiticeably if imstat was run on a 1 pixel image. + The min value would be left set to MAX_REAL. + +pkg$images/filters/mkpkg + Davis, May 22, 1987 + I added mach.h to the dependency file list of t_fmedian.x and + recompiled. The segmentation violations I had been getting in the + program disappeared. + +pkg$images/t_shiftlines.x,shiftlines.x + Davis, April 15, 1987 + 1. I changed the names of the procedures shiftlines and shiftlinesi + to sh_lines and sh_linesi. When the original names were contracted + to 6 letter fortran names they became shifti and shifts which just + so happens to collide with shifti and shifts in the subdirectory + osb. On VMS this was causing problems with the shareable libraries. + If images was linked with -z there was no problem. + +pkg$images/imarith/t_imsum.x + Valdes, March 24, 1987 + 1. IMSUM was failing to unmap images opened to check image dimensions + in a quick first pass through the image list. This is probably + the source of the out of files problem with STF images. It may + be the source of the out of memory problem reported from AOS/IRAF. + +pkg$images/imfit/fit1d.x +pkg$images/imfit/mkpkg + Valdes, March 17, 1987 + 1. Added error checking for the illegal operation in which both input + and output image had an image section. This was causing the task + to crash. The task now behaves properly in this circumstance and + even allows the fitted output to be placed in an image section of + an existing output image (even different than the input image + section) provided the input and output images have the same sizes. + +pkg$images/t_convolve.x + Davis, March 3, 1987 + 1. Fixed the kernel decoding routine in the convolve task so that + it now recognizes the row delimter character in string entry mode. + +pkg$images/geometry,filters + Davis, February 27, 1987 + 1. Changed all the imseti (im, TY_BNDRYPIXVAL, value) calls to imsetr. + +pkg$images/t_minmax.x,minmax.x + Davis, February 24, 1987 + 1. Minmax has been changed to compute the minimum and maximum pixel + as well as the minimum and maximum pixel values. The pixels are output + in section notation and stored in the minmax parameter file. + +pkg$images/t_magnify.x + Davis, February 19, 1987 + 1. Magnify was aborting with the error MSIFIT: Too few datapoints + when trying to reduce an image using the higher order interpolants + poly3, poly5 and spline3. I increased the NEDGE defined constant + from 2 to three and modified the code to use the out of bounds + imio. + +pkg$images/geograph.x,geogmap.x + Davis, February 17, 1987 + 1. Geomap now uses the gpagefile routine to page the .keys file. + The :show command deactivates the workstation before printing a + block of text and reactivates it when it is finished. + +pkg$images/geometry/geomap,geotran + Davis, January 26, 1987 + 1. There have been substantial changes to the geomap, and geotrans + tasks and those tasks rotate, imlintran and register which depend + on them. + 2. Geomap has been changed to be able to compute a transformation + in both single and double precision. + 3. The geotran code has been speeded up considerably. A simple rotate + now takes 70 seconds instead of 155 seconds using bilinear interpolation. + 4. Two new cl parameters nxblock and nyblock have been added to the + rotate, imlintran, register and geotran tasks. If the output image + is smaller than these parameters then the entire output image + is computed at once. Otherwise the output image is computed in blocks + nxblock by nyblock in size. + 5. The 3 geotran parameters rotation, scangle and flip have been replaced + with two parameters xrotation and yrotation which serve the same purpose. + +pkg$images/geometry/t_shiftlines.x,shiftlines.x + Davis, January 19, 1987 + 1. The shiftlines task has been completely rewritten. The following + are the major changes. + 2. Shiftlines now makes use of the imio boundary extension operations. + Therefore the four options: nearest pixel, reflect, wrap and constant + boundary extension are available. + 3. The interpolation code has been vectorised. The previous version + was using the function call asieval for every output pixel evaluated. + The asieval call were replaced with asivector calls. + 4. An extra CL parameter constant to support constant boundary + exension was added. + 5. The shiftlines help page was modified and the date changed to + January 1987. + +pkg$images/imfit/imsurfit.x + Davis, January 12, 1987 + 1. I changed the amedr call to asokr calls. For my application it did + not matter whether the input array is left partially sorted and the asokr + routine is more efficient. + +pkg$images/lib/pixlist.x + Davis, December 12, 1986 + 1. A bug in the pl_get_ranges routine caused the routine to fail when the + number of ranges got too large. The program could not detect the end of + the ranges and would go into an infinite loop. + +pkg$images/iminfo/t_imstat.x + Davis, December 3, 1986 + 1. Imstat was failing on constant images because finite machine precision + could result in a negative sigma squared. Added a check for this condition. + +pkg$images/filters/fmode.x + Davis, October 27, 1986 + 1. Added a check for 0 data range before calling amapr. + +pkg$images/imarith/imsum.gx + Valdes, October 20, 1986 + 1. Found and fixed bug in this routine which caused pixel rejection + to fail some fraction of the time. + +pkg$images/geometry/blkrp.gx + Valdes, October 13, 1986 + 1. There was a bug when the replication factor for axis 1 was 1. + +pkg$images/iminfo/imhistogram.x + Hammond, October 8, 1986 + 1. Running imhistogram on a constant valued image would result in + a "floating divide by zero fault" in ahgm. This condition is + now trapped and a warning printed if there is no range in the data. + +pkg$images/tv/doc/cvl.hlp + Valdes, October 7, 1986 + 1. Typo in V2.3 documentation fixed: "zcale" -> "zscale". + +pkg$images/fit1d.par + Valdes, October 7, 1986 + 1. When querying for the output type the query was: + +Type of output (fit, difference, ratio) (fit|difference|ratio) (): + + The enumerated values were removed since they are given in the + prompt string. + +pkg$images/imarith/t_imsum.x +pkg$images/imarith/imsum.gx +pkg$images/do/imsum.hlp + Valdes, October 7, 1986 + 1. Medians or pixel rejection with more than 15 images is now + correct. There was an error in buffering. + 2. Averages of integer datatype images are now correct. The error + was caused by summing the pixel values divided by the number + of images instead of summing the pixel values and then dividing + by the number of images. + 3. Option keywords may now be abbreviated. + 4. The output pixel datatype now defaults to the calculation datatype + as is done in IMARITH. The help page was modified to indicate this. + 5. Dynamic memory is now used throughout to reduce the size of the + executable. + 6. The bugs 1-2 are present in V2.3 and not in V2.2. + +pkg$images/imarith/t_imarith.x +pkg$images/imarith.par +pkg$images/doc/imarith.hlp + Valdes, October 6, 1986 + 1. The parameter "debug" was changed to "noact". "debug" is reserved + for debugging information. + 2. The output pixel type now defaults to the calculation datatype. + 3. The datatype of constant operands is determined with LEXNUM. This + fixes a bug in which a constant such as "1." was classified as an + integer. + 4. Trailing whitespace in the string for a constant operand is allowed. + This fixes a bug with using "@" files created with the task FIELDS + from a table of numbers. Trailing whitespace in image names is + not checked for since this should be taken care of by lower level + system services. + 5. The reported bug with the "max" operation not creating a pixel file + was the result of the previous round of changes. This has been + corrected. This problem does not exist in the released version. + 6. All strings are now dynamically allocated. Also IMTOPENP is used + to open a CL list directly. + 7. The help page was revised for points (1) and (2). + +pkg$images/fmode.par +pkg$images/fmd_buf.x +pkg$images/med_sort.x + Davis, September 29, 1986 + 1. Changed the default value of the unmap parameter in fmode to yes. The + documentation was changed and the date modified. + 2. Added a test to make sure that the input image was not a constant + image in fmode and fmedian. + 3. Fixed the recently added swap macro in the sort routines which + was giving erroneous results for small boxes in tasks median and mode. + +pkg$images/imfit/fit1d.x + Valdes, September 24, 1986 + 1. Changed subroutine name with a VOPS prefix to one with a FIT1D + prefix. + +pkg$images/imarith/t_imdivide.x +pkg$images/doc/imdivide.hlp +pkg$images/imdivide.par + Valdes, September 24, 1986 + 1. Modified this ancient and obsolete task to remove redundant + subroutines now available in the VOPS library. + 2. The option to select action on zero divide was removed since + there was only one option. Parameter file changed. + 3. Help page revised. + +pkg$images/geometry/t_blkrep.x + +pkg$images/geometry/blkrp.gx + +pkg$images/geometry/blkrep.x + +pkg$images/doc/blkrep.hlp + +pkg$images/doc/mkpkg +pkg$images/images.cl +pkg$images/images.men +pkg$images/images.hd +pkg$images/x_images.x + Valdes, September 24, 1986 + 1. A new task called BLKREP for block replicating images has been added. + This task is a complement to BLKAVG and performs a function not + available in any other way. + 2. Help for BLKREP has been added. + +pkg$images/imarith/t_imarith.x +pkg$images/imarith/imadiv.gx +pkg$images/doc/imarith.hlp +pkg$images/imarith.par + Valdes, September 24, 1986 + 1. IMARITH has been modified to provide replacement of divisions + by zero with a constant parameter value. + 2. The documentation has been revised to include this change and to + clarify and emphasize areas of possible confusion. + +pkg$images/doc/magnify.hlp +pkg$images/doc/blkavg.hlp + Valdes, September 18, 1986 + 1. The MAGNIFY help document was expanded to clarify that images with axis + lengths of 1 cannot be magnified. Also a discussion of the output + size of a magnified image. This has been misunderstood often. + 2. Minor typo fix for BLKAVG. + +images$geometry/blkav.gx: Davis, September 7, 1986 + 1. The routine blkav$t was declared a function but called everywhere as + a procedure. Removed the function declaration. + +images$filters/med_sort.x: Davis, August 14, 1986 + 1. A bug in the sorting routine for MEDIAN and MODE in which the doop + loop increment was being set to zero has been fixed. This bug was + causing MEDIAN and MODE to fail on class 6 for certain sized windows. + +images$imfit/fit1d.x: Davis, July 24, 1986 + 1. A bug in the type=ratio option of fit1d was fixed. The iferr call + on the vector operator adivr was not trapping a divide by zero + condition. Changed adivr to adivzr. + +images$iminfo/listpixels.x: Davis, July 21, 1986 + 1. I changed a pargl to pargi for writing out the column number of the + pixels. + +images$iminfo/t_imstat.x: Davis, July 21, 1986 + 1. I changed a pargr to a pargd for the double precision quantitiies + sum(MIN) and sum(MAX). + +images$imfit/t_lineclean.x: Davis, July 14, 1986 + 1. Bug in the calling sequence for ic_clean fixed. The ic pointer + was not being passed to ic_clean causing access violation and/or + segmentation violation errors. + +images$imfit/fit1d.x, lineclean.x: Valdes, July 3, 1986 + 1. FIT1D and LINECLEAN modified to use new ICFIT package. + +From Valdes June 19, 1986 + +1. The help page for IMSUM was modified to explicitly state what the +median of an even number of images does. + +----------------------------------------------------------------------------- + +From Davis June 13, 1986 + +1. A bug in CONVOLVE in which insufficient space was being allocated for +long (> 161 elements) 1D kernels has been fixed. CONVOLVE was not +allocating sufficent extra space. + +----------------------------------------------------------------------------- + +From Davis June 12, 1986 + +1. I have changed the default value of parameter unmap in task FMEDIAN to +yes to preserve the original data range. + +2. I have changed the value of parameter row_delimiter from \n to ;. + +----------------------------------------------------------------------------- + +From Davis May 12, 1986 + +1. Changed the angle convention in GAUSS so that theta is the angle of the +major axis with respect to the x axis measured counter-clockwise as specified +in the help page instead of the negative of that angle. + +----------------------------------------------------------------------------- + +From Davis Apr 28, 1986 + +1. Moved geomap.key to lib$scr and made redefined HELPFILE in geogmap.x +appropriately. + +------------------------------------------------------------------------------ + +images$imarith/imsum.gx: Valdes Apr 25, 1986 + 1. Fixed bug in generic code which called the real VOPS operator + regardless of the datatype. This caused IMSUM to fail on short + images. + +From Davis Apr 17, 1986 + +1. Changed constructs of the form boolean == false in the file imdelete.x +to ! boolean. + +------------------------------------------------------------------------------ + +images$imarith: Valdes, April 8, 1986 + 1. IMARITH has been modified to also operate on a list of specified + header parameters. This is primarily used when adding images to + also added the exposure times. A new parameter was added and the + help page modified. + 2. IMSUM has been modified to also operate on a list of specified + header parameters. This is primarily used when summing images to + also sum the exposure times. A new parameter was added and the + help page modified. + +------------------------------------------------------------------------------ + +From Valdes Mar 24, 1986: + +1. When modifying IMARITH to handle mixed dimensions the output image header +was made a copy of the image with the higher dimension. However, the default +when the images were of the same dimension changed to be a copy of the second +operand. This has been changed back to being a copy of the first operand +image. + +------------------------------------------------------------------------------ + +From Davis Mar 21, 1986: + +1. A NULL pointer bug in the subroutine plfree inside IMSURFIT was causing +segmentation violation errors. A null pointer test was added to plfree. + +------------------------------------------------------------------------------ + +From Davis Mar 20, 1986: + +1. A bug involving in place operations in several image tasks has been fixed. + +------------------------------------------------------------------------------ + +From Davis Mar 19, 1986: + +1. IMSURFIT no longer permits the input image to be replaced by the output +image. + +2. The tasks IMSHIFT, IMTRANSPOSE, SHIFTLINES, and GEOTRAN have been modified +to use the images tools xt_mkimtemp and xt_delimtemp for in place +calculations. + +------------------------------------------------------------------------------- + +From Valdes Mar 13, 1986: + +1. Bug dealing with type coercion in short datatype images in IMARITH and IMSUM +which occurs on the SUN has been fixed. +------ +From Valdes Mar 10, 1986: + +1. IMSUM has been modified to work on any number of images. + +2. Modified the help page +------ +From Valdes Feb 25, 1986: + +There have been two changes to IMARITH: + +1. A bug preventing use of image sections has been removed. + +2. An improvement allowing use of images of different dimension. +The algorithm is as follow: + + a. Check if both operands are images. If not the output + image is a copy of the operand image. + + b. Check that the axes lengths are the same for the dimensions + in common. For example a 3D and 2D image must have the same + number of columns and lines. + + c. Set the output image to be a copy of the image with the + higher dimension. + + d. Repeat the operation over the lower dimensions for each of + the higher dimensions. + +For example, consider subtracting a 2D image from a 3D image. The output +image will be 3D and the 2D image is subtracted from each band of the +3D image. This will work for any combination of dimensions. Another +example is dividing a 3D image by a 1D image. Then each line of each +plane and each band will be divided by the 1D image. Likely applications +will be subtracting biases and darks and dividing by response calibrations +in stacked observations. + +3. Modified the help page +=========== +Release 2.2 +=========== +From Davis Mar 6, 1986: + +1. A serious bug had crept into GAUSS after I made some changes. For 2D +images the sense of the sigma was reversed, i.e sigma = 2.0 was actually +sigma = 0.5. This bug has now been fixed. + +--------------------------------------------------------------------------- + +From Davis Jan 13, 1986: + +1. Listpixels will now print out complex pixel values correctly. + +--------------------------------------------------------------------------- + +From Davis Dec 12, 1985: + +1. The directional gradient operator has been added to the images package. + +--------------------------------------------------------------------------- + +From Valdes Dec 11, 1985: + +1. IMARITH has been modified to first check if an operand is an existing +file. This allows purely numeric image names to be used. + +--------------------------------------------------------------------------- + +From Davis Dec 11, 1985: + +1. A Laplacian (second derivatives) operator has been added to the images +package. + +--------------------------------------------------------------------------- + +From Davis Dec 10, 1985: + +1. The new convolution tasks boxcar, gauss and convolve have been added +to the images package. Convolve convolves an image with an arbitrary +user supplied rectangular kernel. Gauss convolves an image with a 2D +Gaussian of arbitrary size. Boxcar will smooth an image using a smoothing +window of arbitrary size. + +2. The images package source code has been reorganized into the following +subdirectories: 1) filters 2) geometry 3) imfit 4) imarith 4) iminfo and +5) imutil 6) lib. Lib contains routines which may be of use to several IRAF +tasks such as ranges. The imutil subdirectory contains tasks which modify +images in some way such as hedit. The iminfo subdirectory contains code +for displaying header and pixel values and other image characteristics +such as the histogram. Image arithmetic and fitting routines are found +in imarith and imfit respectively. Filters contains the convolution and +median filtering routines and geometry contains the geometric distortion +corrections routines. + +3. The documentation of the main images package has been brought into +conformity with the new IRAF standards. + +4. Documentation for imdelete, imheader, imhistogram, listpixels and +sections has been added to the help database. + +5. The parameter structure for imhistogram has been simplified. The +redundant parameters sections and setranges have been removed. + +--------------------------------------------------------------------------- + + +From Valdes Nov 4, 1985: + +1. IMCOPY modified so that the output image may be a directory. Previously +logical directories were not correctly identified. +------ + +From Davis Oct 21, 1985: + +1. A bug in the pixel rejection cycle of IMSURFIT was corrected. The routine +make_ranges in ranges.x was not successfully converting a sorted list of +rejected pixels into a list of ranges in all cases. + +2. Automatic zero divide error checking has been added to IMSURFIT. +------ +From Valdes Oct 17, 1985: + +1. Fit1d now allows averaging of image lines or columns when interactively +setting the fitting parameters. The syntax is "Fit line = 10 30"; i.e. +blank separated line or column numbers. A single number selects just one +line or column. Be aware however, that the actual fitting of the image +is still done on each column or line individually. + +2. The zero line in the interactive curve fitting graphs has been removed. +This zero line interfered with fitting data near zero. +------ +From Rooke Oct 10, 1985: + +1. Blkaverage was changed to "blkavg" and modified to support any allowed +number of dimensions. It was also made faster in most cases, depending on +the blocking factors in each dimension. +------ +From Valdes Oct 4, 1985: + +1. Fit1d and lineclean modified to allow separate low and high rejection +limits and rejection iterations. +------ +From Davis Oct 3, 1985: + +1. Minmax was not calculating the minimum correctly for integer images. +because the initial values were not being set correctly. +------ +From Valdes Oct 1, 1985: + +1. Imheader was modified to print the image history. Though the history +mechanism is little used at the moment it should become an important part +of any image. + +2. Task revisions renamed to revs. +------ +From Davis Sept 30, 1985: + +1. Two new tasks median and fmedian have been added to the images package. +Fmedian is a fast median filtering algorithm for integer data which uses +the histogram of the image to calculate the median at each window. Median +is a slower but more general algorithm which performs the same task. +------ +From Valdes August 26, 1985: + +1. Blkaverage has been modified to include an new parameter called option. +The current options are to average the blocks or sum the blocks. +------ +From Valdes August 7, 1985 + +1. Fit1d and lineclean wer recompiled with the modified icfit package. +The new package contains better labeling and graph documentation. + +2. The two tasks now have parameters for setting the graphics device +and reading cursor input from a file. +______ +From: /u2/davis/ Tue 08:27:09 06-Aug-85 +Package: images +Title: imshift bug + +Imshift was shifting incorrectly when an integral pixel shift in x and +a fractional pixel shift in y was requested. The actual x shift was +xshift + 1. The bug has been fixed and imshift will now work correctly for +any combination of fractional and integral pixel shifts +------ +From: /u2/davis/ Fri 18:14:12 02-Aug-85 +Package: images +Title: new images task + +A new task GEOMAP has been added to the images package. GEOMAP calculates +the spatial transformation required to map one image onto another. +------ +From: /u2/davis/ Thu 16:47:49 01-Aug-85 +Package: images +Title: new images tasks + +The tasks ROTATE, IMLINTRAN and GEODISTRAN have been added to the images +package. ROTATE rotates and shifts an image. IMLINTRAN will rotate, rescale +and shift an an image. GEODISTRAN corrects an image for geometric distortion. +------ +From Valdes July 26, 1985: + +1. The task revisions has been added to page revisions to the images +package. The intent is that each package will have a revisions task. +Note that this means there may be multiple tasks named revisions loaded +at one time. Typing revisions alone will give the revisions for the +current package. To get the system revisions type system.revisions. + +2. A new task called fit1d replaces linefit. It is essentially the same +as linefit except for an extra parameter "axis" which selects the axis along +which the functions are to be fit. Axis 1 is lines and axis 2 is columns. +The advantages of this change are: + + a. Column fitting can now be done without transposing the image. + This allows linefit to be used with image sections along + both axes. + b. For 1D images there is no prompt for the line number. +.endhelp diff --git a/pkg/images/imutil/_imaxes.par b/pkg/images/imutil/_imaxes.par new file mode 100644 index 00000000..833ca170 --- /dev/null +++ b/pkg/images/imutil/_imaxes.par @@ -0,0 +1,9 @@ +image,s,a,,,,image name +ndim,i,h +len1,i,h +len2,i,h +len3,i,h +len4,i,h +len5,i,h +len6,i,h +len7,i,h diff --git a/pkg/images/imutil/chpixtype.par b/pkg/images/imutil/chpixtype.par new file mode 100644 index 00000000..4302c427 --- /dev/null +++ b/pkg/images/imutil/chpixtype.par @@ -0,0 +1,8 @@ +# CHPIXTYPE + +input,f,a,,,,Input images +output,f,a,,,,Output images +newpixtype,s,a,,"|ushort|short|int|long|real|double|complex|",,Output pixel type +oldpixtype,s,h,"all","|all|ushort|short|int|long|real|double|complex|",,Input pixel type +verbose,b,h,y,,,Verbose mode +mode,s,h,'ql' diff --git a/pkg/images/imutil/doc/chpix.hlp b/pkg/images/imutil/doc/chpix.hlp new file mode 100644 index 00000000..9104b254 --- /dev/null +++ b/pkg/images/imutil/doc/chpix.hlp @@ -0,0 +1,64 @@ +.help chpixtype Jun88 images.imutil +.ih +NAME +chpixtype -- change the pixel type of an image +.ih +USAGE +chpixtype input output newpixtype +.ih +PARAMETERS +.ls input +The list of input images. +.le +.ls output +The list of output images. If the output image list is the same as the input +image list then the original images are overwritten. +.le +.ls newpixtype +The pixel type of the output image. The options are: "ushort", "short", +"int", "long", "real", "double" and "complex". +.le +.ls oldpixtype = "all" +The pixel type of the input images to be converted. By default all the +images in the input list are converted to the pixel type specified by +newpixtype. The remaining options are "ushort", "short", "int", "long", +"real", "double" and "complex" in which case only those images of the +specified type are converted. +.le +.ls verbose = yes +Print messages about actions performed. +.le + +.ih +DESCRIPTION + +The list of images specified by \fIinput\fR and pixel type \fIoldpixtype\fR +are converted to the pixel type specified by \fInewpixtype\fR and written +to the list of output images specified by \fIoutput\fR. + +Conversion from one pixel type to another is direct and may involve both +loss of precision and dynamic range. Mapping of floating point numbers +to integer numbers is done by truncation. Mapping of complex numbers +to floating point or integer numbers will preserve the real part of the +complex number only. + +.ih +EXAMPLES + +1. Convert a list of images to type real, overwriting the existing images. + + im> chpixtype nite1*.imh nite1*.imh real + +2. Convert only those images in imlist1 which are of type short to type real. + Imlist1 and imlist2 are text files containing the list of input and + output images respectively. The image names are listed 1 per line. + + im> chpixtype @imlist1 @imlist2 real old=short +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +imarith +.endhelp diff --git a/pkg/images/imutil/doc/hedit.hlp b/pkg/images/imutil/doc/hedit.hlp new file mode 100644 index 00000000..3871d8e7 --- /dev/null +++ b/pkg/images/imutil/doc/hedit.hlp @@ -0,0 +1,375 @@ +.help hedit Apr01 images.imutil +.ih +NAME +hedit - edit or view an image header or headers +.ih +USAGE +hedit images fields value +.ih +PARAMETERS +.ls images +Template specifying the images to be edited. +.le +.ls fields +Template specifying the fields to be edited in each image. The template is +expanded independently for each image against the set of all fields in the +image header. +.le +.ls value +Either a string constant or a general expression (if the first character is +a left parenthesis) to be evaluated to compute the new value of each field. +A single expression is used for all fields. The special value "." causes the +value of each field to be printed rather than edited. +.le +.ls add = no +Change the operation of the editor from update to add new field. If the +field already exists it is edited. If this option is selected the field +list may name only a single field. The add switch takes precedence +over the addonly and delete switches. +.le +.ls addonly = no +Change the operation of the editor from update to add a new field. If the +field already exists it is not changed. If this option is selected the field +list may name only a single field. The addonly switch takes precedence over +the delete switch. +.le +.ls delete = no +Change the operation of the editor from update to delete field. +The listed fields are deleted from each image. +.le +.ls verify = yes +Interactively verify all operations which modify the image database. +The editor will describe the operation to be performed, prompting with the +new value of the parameter in the case of a field edit. Type carriage +return or "yes" to complete the operation, or enter a new value explicitly +as a string. Respond with "no" if you do not wish to change the value of +the parameter. +.le +.ls show = yes +Print a record of each operation which modifies the database upon the standard +output. Old values are given as well as new values, making it possible to +undo an edit operation. +.le +.ls update = yes +Enable updating of the image database. If updating is disabled the edit +operations are performed in memory but image headers will not be updated +on disk. +.le +.ih +DESCRIPTION + +1. Basic Usage + + The most basic functions of the image header editor are modification and +inspection of the fields of an image header. Both the "standard" and +"user" fields may be edited in the same fashion, although not all standard +fields are writable. For example, to change the value of the standard field +"title" of the image "m74" to "sky flat" we would enter the following command. + + cl> hedit m74 title "sky flat" + +If \fIverify\fR mode is selected the editor will print the old value of the +field and query with the new value, allowing some other value to be entered +instead, e.g.: + +.nf + cl> hedit m74 title "sky flat" + m74,i_title ("old title" -> "sky flat"): +.fi + +To accept the new value shown to the right of the arrow, type carriage +return or "yes" or "y" followed by carriage return. To continue without +changing the value of the field in question enter "no" or "n" followed by +carriage return. To enter some other value merely type in the new value. +If the new value is one of the reserved strings, e.g., "yes" or "no", +enter it preceded by a backslash. If verification is enabled you will +also be asked if you want to update the header, once all header fields +have been edited. This is your last chance to change your mind before +the header is modified on disk. If you respond negatively the image header +will not be updated, and editing will continue with the next image. +If the response is "q" the editor will exit entirely. + +To conveniently print the value of the field "title" without modifying the +image header, we repeat the command with the special value ".". + + cl> hedit m74 title . + +To print (or edit) the values of all header fields a field template may be +given. + + cl> hedit m74 * . + +To print (or edit) the values of only a few fields the field template may +be given as a list. + + cl> hedit m74 w0,wpc . + +To print the value of one or more fields in a set of images, an image template +may be given. Both image templates and field templates may be given if +desired. + + cl> hedit n1.* exp . + +Abbreviations are not permitted for field names, i.e., the given template +must match the full field name. Currently, field name matches are case +insensitive since image headers are often converted to and from FITS headers, +which are case insensitive. + + +2. Advanced Usage + + The header editor is capable of performing global edits on entire image +databases wherein the new value of each field is computed automatically at +edit time and may depend on the values of other fields in the image header. +Editing may be performed in either batch or interactive mode. An audit trail +may be maintained (via the \fIshow\fR switch and i/o redirection), permitting +restoration of the database in the event of an error. Trial runs may be made +with updating disabled, before committing to an actual edit which modifies the +database. + +The major editing functions of the \fIhedit\fR task are the following: + +.nf + update modify the value of a field or fields + addonly add a new field + add add a new field or modify an old one + delete delete a set of fields +.fi + +In addition, \fIhedit\fR may be used merely to inspect the values of the header +fields, without modification of the image database. + + +2.1 Standard header fields + + The header editor may be used to access both the standard image header +fields and any user or application defined fields. The standard header fields +currently defined are shown below. There is no guarantee that the names and/or +usage of these fields will not change in the future. + + +.ks +.nf + i_ctime int create time + i_history string history comments + i_limtime int time when min,max last updated + i_maxpixval real maximum pixel value + i_minpixval real minimum pixel value + i_mtime int time of last modify + i_naxis int number of axes (dimensionality) + i_naxis[1-7] int length of each axis + i_pixfile string pathname of pixel storage file + i_pixtype int pixel datatype code + i_title string title string +.fi +.ke + + +The standard header field names have an "i_" prefix to reduce the possibility +of a name collision with a user field name, and to distinguish the two classes +of parameters in templates. The prefix may be omitted provided the simple +name is unique. + + +2.2 Field name template + + The form of the field name list or template parameter \fIfields\fR is +equivalent to that of a filename template except that "@listfile" is not +supported, and of course the template is expanded upon the field name list +of an image, rather than upon a directory. Abbreviations are not permitted +in field names and case is not significant. Case is ignored in this context +due to the present internal storage format for the user parameters (FITS), +which also limits the length of a user field name to 8 characters. + + +2.3 Value expression + + The \fIvalue\fR parameter is a string type parameter. If the first +character in the string is a left parenthesis the string is interpreted as +an algebraic expression wherein the operands may be constants, image header +variables (field names), special variables (defined below), or calls to +intrinsic functions. The expression syntax is equivalent to that used in +the CL and SPP languages. If the value string is not parenthesized it is +assumed to be a string constant. The \fIvalue\fR string will often contain +blanks, quotes, parenthesis, etc., and hence must usually be quoted to avoid +interpretation by the CL rather than by the header editor. + +For example, the command + + cl> hedit m74 title "title // ';ss'" + +would change the title to the literal string constant "title // ';ss'", +whereas the command + + cl> hedit m74 title "(title // ';ss')" + +would concatenate the string ";ss" to the old title string. We require +parenthesis for expression evaluation to avoid the need to doubly quote +simple string constant values, which would be even more confusing for the +user than using parenthesis. For example, if expressions did not have to +be parenthesized, the first example in the basic usage section would have +to be entered as shown below. + + cl> hedit m74 title '"sky flat"' # invalid command + +Expression evaluation for \fIhedit\fR, \fIhselect\fR, and similar tasks +is carried out internally by the FMTIO library routine \fBevexpr\fR. +For completeness minimal documentation is given here, but the documentation +for \fIevexpr\fR itself should be consulted if additional detail is required +or if problems occur. + + +2.3.1 operators + + The following operators are recognized in value expressions. With the +exception of the operators "?", "?=", and "@", the operator set is equivalent +to that available in the CL and SPP languages. + + +.nf + + - * / arithmetic operators + ** exponentiation + // string concatenation + ! - boolean not, unary negation + < <= > >= order comparison (works for strings) + == != && || equals, not equals, and, or + ?= string equals pattern + ? : conditional expression + @ reference a variable +.fi + + +The operators "==", "&&", and "||" may be abbreviated as "=", "&", and "|" +if desired. The ?= operator performs pattern matching upon strings. +For example, the boolean expression shown below will be true whenever the +field "title" contains the substring "sky". + + (title ?= '*sky*') + +The conditional expression operator '?', which is patterned after a similar +operator in C, is used to make IF ELSE like decisions within an expression. +The syntax is as follows: + + <bool_expr> '?' <true_expr> ':' <false_expr> + +e.g., the expression + + ((a > b) ? 1 : 0) + +has the value 1 if A is greater than B, and 0 otherwise. The datatypes +of the true and false expressions need not be the same, unlike a compiled +language. Note that if the parenthesis are omitted ambiguous forms of +the expression are possible, e.g.: + + (a > b) ? 1 : a + 1 + +could be interpreted either as + + ((a > b) ? 1 : a) + 1 +or as + (a > b) ? 1 : (a + 1) + +If the parenthesis are omitted the latter interpretation is assumed. + +The operator @ must be used to dereference variables that have names with +funny (non-alphanumeric) characters in them, forcing the variable name to +be given as a string constant. For example, the value of the expression + + @"co-flag" + +is the value of the variable "co-flag". If the variable were referenced +directly by name the "-" would be interpreted as the subtraction operator, +causing an unknown variable reference (e.g., to "co"). +The operand following the @ may be any string valued expression. +The @ operator is right associative, hence the construct "@@param" is the +value of the parameter named by the value of the parameter "param". + +An expression may contain operands of datatypes bool, int, real, and string. +Mixed mode expressions are permitted with automatic type coercion. Most type +coercions from boolean or string to other datatypes are illegal. The boolean +constants "yes" and "no" are predefined and may be used within expressions. + + +2.3.2 intrinsic functions + + A number of standard intrinsic functions are recognized within expressions. +The set of functions currently supported is shown below. + + +.nf + abs acos asin atan atan2 bool cos + exp int log log10 max min mod + nint real sin sqrt str tan +.fi + + +The trigonometric functions operate in units of degrees rather than radians. +The \fImin\fR and \fImax\fR functions may have any number of arguments up +to a maximum of sixteen or so (configurable). The arguments need not all +be of the same datatype. + +A function call may take either of the following forms: + +.nf + <identifier> '(' arglist ')' +or + <string_expr> '(' arglist ')' +.fi + +The first form is the conventional form found in all programming languages. +The second permits the generation of function names by string valued +expressions and might be useful on rare occasions. + + +2.3.3 special operands + + As noted earlier, expression operands may be constants, variables (header +fields), function calls, or references to any of the special variables. +The following special variables are recognized within expressions: + + +.nf + . A string constant, used to flag printing + $ The value of the "current field" + $F The name of the "current field" + $I The name of the "current image" + $T The current clock time (an integer value) +.fi + + +These builtin variables are especially useful for constructing context +dependent expressions. For example, the value of a field may be incremented +by 100 by assigning it the value "$ + 100". + +.ih +EXAMPLES +1. Globally edit the database "n1", setting the value of the string parameter +"obs" to "sky" if "s-flag" is 1, to "obj" otherwise. + + cl> hedit n1.* obs '(@"s-flag" == 1 ? "sky" : "obj")' + +2. Globally edit the same database, replacing the value of the parameter +"variance" by the square root of the original value. + + cl> hedit n1.* var '(sqrt(var))' + +3. Replace the values of the fields A and B by the absolute value of the +original value: + + cl> hedit n1.* a,b '(abs($))' + +.ih +BUGS +The internal storage format is currently FITS card image, hence field names +are limited to 8 characters with no case sensitivity. String values are +limited to 63 characters. There is an upper limit on the number of fields +in a header but it is quite large - assume it is 1024 or so. Global operations +on databases are currently quite slow because the individual records (image +headers) are stored in separate files. + +A task is needed which would take the audit trail produced by the \fIshow\fR +option and use it to undo an edit. +.ih +SEE ALSO +hselect, imgets, imheader +.endhelp diff --git a/pkg/images/imutil/doc/hselect.hlp b/pkg/images/imutil/doc/hselect.hlp new file mode 100644 index 00000000..d94f240b --- /dev/null +++ b/pkg/images/imutil/doc/hselect.hlp @@ -0,0 +1,103 @@ +.help hselect May85 images.imutil +.ih +NAME +hselect - extract keyword values from images satisfying a selection expression +.ih +USAGE +hselect images fields expr +.ih +PARAMETERS +.ls images +Images forming the set from which selected images are to be drawn. +.le +.ls fields +Comma separated list of keywords or keyword patterns to be extracted +from each selected image. The list elements are matched against the +set of keywords in the header except for those beginning with "$" which +are special values or explicit checks for keywords that might be missing. +.le +.ls expr +The boolean expression to be used as the selection criteria. The expression +is evaluated independently for each image. +.le +.ls missing = "INDEF" +Output value for missing keywords. Note that this will only occur when the +fields are specified with leading "$". +.le +.ih +DESCRIPTION +The function of \fIhselect\fR is to extract keyword values from a subset +of images satisfying a boolean selection expression. The resultant table +of keyword values is output in list form, suitable for further analysis +or for use to generate a list of images to be processed by another task. + +The form of the boolean expression \fIexpr\fR is fully documented in the +manual page for the \fIhedit\fR task. In the case of \fIhselect\fR task, +however, the expression need not be parenthesized to be evaluated as an +expression. + +The keywords whose values are to be output are specified by the \fIfields\fR +parameter. This is a comma delimited list of keywords and patterns. The +keywords and patterns are matched against the set of keywords in the image. +Of particular importance is that explicit keywords, that is without any +wildcard, are matched against the header and so if the keyword is not in the +header then the keyword value is not output. If one wants to explicitly +output a place holder for a missing keyword use a leading $; e.g. $mykey. +If the keyword is absent then the value given by the \fImissing\fR +parameter will be output. This is useful when scanning the output. + +In addition to escaping the keyword matching, the leading $ character is +also used to select special values such as "$I" for the name of the current +image. See \fBhedit\fR for more on the special values and pattern syntax. +.ih +EXAMPLES +1. Compute the mean exposure time for all the images in a database. Note that +the argument "yes" is a trivial case of a general boolean expression and +hence need not be quoted. + + cl> hselect n1.* exp yes | average + +2. Print the name, length of axes 1 and 2, and title of all two dimensional +images in a database. + + +.nf + cl> hselect n1.* $I,naxis[12],title 'naxis == 2' + n1.0001 512 512 quartz + n1.0002 512 512 "dome flat" + n1.0005 384 800 "ngc 3127 at 45 degrees" + cl> +.fi + + +3. Produce an image name list for use to drive another task. The selection +criterion is all images for which the value of the parameter "q-flag" +has the value 1. Note carefully the use of quotes. If the @ operator +is unfamiliar read the manual page for \fIhedit\fR. + + cl> hselect n1.* $I '@"q-flag" == 1' > imlist + +If the parameter "q-flag" were instead named "qflag", the following +simpler expression would suffice. + + cl> hselect n1.* $I 'qflag == 1' > imlist + +4. Scan a set of keyword and allow for missing keywords. + +.nf + cl> hselect pix $I,$exptime,$airmass yes missing=INDEF | + >>> scan (s1, x, y) +.fi + +Note that when checking for missing values the missing value must be +of the appropriate type or else you need to use string variables or +nscan to check. The default missing value is "INDEF" which can be +scanned into both string and numerical variables. +.ih +BUGS +Since individual image headers are currently stored as separate files, +selection from a large database is quite slow. +.ih +SEE ALSO +hedit, imgets, imheader +.endhelp diff --git a/pkg/images/imutil/doc/imarith.hlp b/pkg/images/imutil/doc/imarith.hlp new file mode 100644 index 00000000..00c913e8 --- /dev/null +++ b/pkg/images/imutil/doc/imarith.hlp @@ -0,0 +1,218 @@ +.help imarith Sep86 images.imutil +.ih +NAME +imarith -- binary image arithmetic +.ih +USAGE +imarith operand1 op operand2 result +.ih +PARAMETERS +.ls operand1, operand2 +Lists of images and constants to be used as operands. +Image templates and image sections are allowed. +.le +.ls op +Operator to be applied to the operands. The allowed operators +are "+", "-", "*", "/", "min", and "max". +.le +.ls result +List of resultant images. +.le +.ls title = "" +Title for the resultant images. If null ("") then the title is taken +from operand1 if operand1 is an image or from operand2 otherwise. +.le +.ls divzero = 0. +Replacement value for division by zero. When the denominator is zero +or nearly zero the result is replaced by this value. +.le +.ls hparams = "" +List of header parameters to be operated upon. This is primarily +used for adding exposure times when adding images. +.le +.ls pixtype = "", calctype = "" +Pixel datatype for the resultant image and the internal calculation datatype. +The choices are given below. They may be abbreviated to one character. +.ls "" +\fICalctype\fR defaults to the highest precedence operand datatype. If the +highest precedence datatype is an integer type and the operation is +division then the calculation type will be "real". If the highest +precedence operand is type "ushort", \fIcalctype\fR will default to +"long". \fIPixtype\fR defaults to \fIcalctype\fR. Users who want type +"ushort" images on output will need to set \fIpixtype\fR to "ushort" +explicitly. +.le +.ls "1", "2" +The pixel datatype of the first or second operand. +.le +.ls "short", "ushort", "integer", "long", "real", "double" +Allowed IRAF pixel datatypes. +.le +.le +.ls verbose = no +Print the operator, operands, calculation datatype, and the resultant image +name, title, and pixel datatype. +.le +.ls noact = no +Like the verbose option but the operations are not actually performed. +.le +.ih +DESCRIPTION +Binary image arithmetic is performed of the form: + + operand1 op operand2 = result + +where the operators are addition, subtraction, multiplication, +division, and minimum and maximum. The division operator checks for +nearly zero denominators and replaces the ratio by the value specified +by the parameter \fIdivzero\fR. The operands are lists of images and +numerical constants and the result is a list of images. The number of +elements in an operand list must either be one or equal the number of +elements in the resultant list. If the number of elements is one then +it is used for each resultant image. If the number is equal to the +number of resultant images then the elements in the operand list are +matched with the elements in the resultant list. The only limitation +on the combination of images and constants in the operand lists is that +both operands for a given resultant image may not be constants. The +resultant images may have the same name as one of the operand images in +which case a temporary image is created and after the operation is +successfully completed the image to be replaced is overwritten by the +temporary image. + +If both operands are images the lengths of each axis for the common +dimensions must be the same though the dimensions need not be the +same. The resultant image header will be a copy of the operand image +with the greater dimension. If the dimensions are the same then image +header for the resultant image is copied from operand1. The title of +the resultant image may be changed using the parameter \fItitle\fR. +The pixel datatype for the resultant image may be set using the +parameter \fIpixtype\fR. If no pixel datatype is specified then the +pixel datatype defaults to the calculation datatype given by the +parameter \fIcalctype\fR. The calculation datatype defaults to the +highest precedence datatype of the operand images or constants except +that a division operation will default to real for integer images. +The precedence of the datatypes, highest first, is double, +real, long, integer, and short. The datatype of a constant operand is +either short integer or real. A real constant has a decimal point. + +Arithmetic on images of unequal dimensions implies that the operation +is repeated for each element of the higher dimensions. For example +subtracting a two dimensional image from a three dimensional image +consists of subtracting the two dimensional image from each band of the +three dimensional image. This works for any combination of image +dimensions. As an extreme example dividing a seven dimensional image +by a one dimension image consists of dividing each line of each plane +of each band ... by the one dimensional image. + +There are two points to emphasize when using images of unequal +dimensions. First, a one dimensional image operates on a line +of a two or higher dimension image. To apply a one dimensional image +to the columns of a higher dimensional image increase the image +dimensionality with \fBimstack\fR, transpose the resultant image, +and then replicate the columns with \fBblkrep\fR (see the EXAMPLE +section). The second point of confusion is that an image with a +size given by \fBimheader\fR of [20,1] is a two dimensional image +while an image with size of [20] is a one dimensional image. To +reduce the dimensionality of an image use \fBimcopy\fR. + +In addition to operating on the image pixels the image header parameters +specified by the list \fIhparams\fR are also operated upon. The operation +is the same as performed on the pixels and the values are either the +values associated with named header parameters or the operand constant +values. The primary purpose of this feature is to add exposure times +when adding images. + +The verbose option is used to record the image arithmetic. The output +consists of the operator, the operand image names, the resultant image +name and pixel datatype, and the calculation datatype. +.ih +EXAMPLES +1. To add two images and the exposure times: + +.nf + cl> imarith ccd1 + ccd2 sum + >>> hparams="itime,otime,ttime,exposure" +.fi + +2. To subtract a constant from an image and replace input image by the +subtracted image: + + cl> imarith m31 - 223.2 m31 + +Note that the final pixel datatype and the calculation datatype will be at +least of type real because the constant operand is real. + +3. To scale two exposures, divide one by the other, and extract the central +portion: + +.nf + cl> imarith exp1[10:90,10:90] * 1.2 temp1 + cl> imarith exp2[10:90,10:90] * 0.9 temp2 + cl> imarith temp1 / temp2 final title='Ratio of exp1 and exp 2' + cl> imdelete temp1,temp2 +.fi + +Note that in this example the images temp1, temp2, and final will be +of real pixel datatype (or double if either exp1 or exp2 are of pixel +datatype double) because the numerical constants are real numbers. + +4. To divide two images of arbitrary pixel datatype using real arithmetic +and create a short pixel datatype resultant image: + +.nf + cl> imarith image1 / image2 image3 pixtype=real \ + >>> calctype=short title="Ratio of image1 and image2" +.fi + +5. To divide several images by calibration image using the image pixel type of +the numerator images to determine the pixel type of the calibration images +and the calculation arithmetic type: + +.nf + cl> imarith image1,image2,image3 / calibration \ + >>> image1a,image2a,image3a pixtype=1 calctype=1 +.fi + +The same operation can be done in place with image template expansion by: + +.nf + cl> imarith image* / calibration image* pixtype=1 calctype=1 +.fi + +6. To subtract a two dimensional bias from stacked observations (multiple +two dimensional observations stacked to form a three dimensional image): + + cl> imarith obs* - bias obs*//b + +Note that the output observations obs101b, ..., will be three dimensional. + +7. To divide a 50 x 50 image by the average column: + +.nf + cl> blkavg img avcol 50 1 + cl> blkrep avcol avcol 50 1 + cl> imarith img / avcol flat +.fi + +8. To subtract a one dimensional image from the lines of a two dimensional +image: + + cl> imarith im2d - im1d diff + +9. To subtract a one dimensional image from the columns of a two dimensional +image: + +.nf + cl> imstack im1d imcol + cl> imtranspose imcol imcol + cl> blkrep imcol imcol 100 1 + cl> imarith im2d - imcol diff +.fi + +Note the need to make a two dimensional image with each column +replicated since a one dimensional image will operate on the lines +of a two dimensional image. +.ih +SEE ALSO +blkrep, imdivide, imfunction, imstack, imtranspose +.endhelp diff --git a/pkg/images/imutil/doc/imcopy.hlp b/pkg/images/imutil/doc/imcopy.hlp new file mode 100644 index 00000000..1128c587 --- /dev/null +++ b/pkg/images/imutil/doc/imcopy.hlp @@ -0,0 +1,91 @@ +.help imcopy Oct84 images.imutil +.ih +NAME +imcopy -- copy images +.ih +USAGE +imcopy input output +.ih +PARAMETERS +.ls input +Images to be copied. +.le +.ls output +Output images or directory. +.le +.ls verbose = yes +Print each operation as it takes place? +.le +.ih +DESCRIPTION +Each of the input images, which may be given as a general image template +including sections, is copied to the corresponding output image list, +which may also be given as an image template, or the output directory. +If the output is a list of images then the number of input images must be +equal to the number of output images and the input and output images are paired +in order. If the output image name exists and contains a section then the +input image (provided it is the same size as the section) will be copied +into that section of the input image. If the output image name does not +have a section specification and if it is the same as the input image name +then the input image is copied to a temporary file which replaces the input +image when the copy is successfully concluded. Note that these are the only +cases where clobber checking is bypassed; that is, if an output image name +is not equal to the input image name or a subsection of an existing image +and the file already exists then a clobber error will occur if +clobber checking is in effect. + +The verbose options prints for each copy lines of the form: +.nf + +input image -> output image +.fi +.ih +EXAMPLES +1. For a simple copy of an image: + + cl> imcopy image imagecopy + +2. To copy a portion of an image: + + cl> imcopy image[10:20,*] subimage + +3. To copy several images: + + cl> imcopy image1,image2,frame10 a,b,c + +4. To trim an image: + + cl> imcopy image[10:20,*] image + +In the above example the specified section of the input image replaces the +original input image. To trim several images using an image template: + + cl> imcopy frame*[1:512,1:512] frame* + +In this example all images beginning with "frame" are trimmed to 512 x 512. + +5. To copy a set of images to a new directory: + +.nf + cl> imcopy image* directory + or + cl> imcopy image* directory$ + or + cl> imcopy image* osdirectory +.fi + +where "osdirectory" is an operating system directory name (i.e. /user/me +in UNIX). + +6. To copy a section of an image in an already existing image of + sufficient size to contain the input section. + +.nf + cl> imcopy image[1:512,1:512] outimage[257:768,257:768] +.fi + +.ih +BUGS +The distinction between copying to a section of an existing image +and overwriting a input image is rather inobvious. +.endhelp diff --git a/pkg/images/imutil/doc/imdelete.hlp b/pkg/images/imutil/doc/imdelete.hlp new file mode 100644 index 00000000..54d926fe --- /dev/null +++ b/pkg/images/imutil/doc/imdelete.hlp @@ -0,0 +1,55 @@ +.help imdelete Dec85 images.imutil +.ih +NAME +imdelete -- delete a list of images +.ih +USAGE +imdelete images +.ih +PARAMETERS +.ls images +List of images to be deleted. +.le +.ls go_ahead +Delete the image? +.le +.ls verify = no +Verify the delete operation for each image. +.le +.ls default_action = yes +The default action for the verify query. +.le +.ih +DESCRIPTION +IMDELETE takes as input a list of IRAF images specified by \fIimages\fR and +deletes both the header and pixel files. In \fIverify\fR mode IMDELETE +queries the user for the appropriate action to be taken for each IRAF image. + +If the \fIimages\fR parameter is a URL, it will be accessed and put into +the file cache, then immediately deleted. To simply remove a file from +the cache, use the \fIfcache\fR command instead. +.ih +EXAMPLES +1. Delete a list of images + +.nf + cl> imdelete fits* +.fi + +2. Delete a list of images using verify + +.nf + cl> imdel fits* ver+ + cl> Delete file \fI'fits1'\fR ? (yes): yes + cl> Delete file \fI'fits2'\fR ? (yes): yes + cl> Delete file \fI'fits3'\fR ? (yes): yes +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +imcopy, fcache +.endhelp diff --git a/pkg/images/imutil/doc/imdivide.hlp b/pkg/images/imutil/doc/imdivide.hlp new file mode 100644 index 00000000..2f104029 --- /dev/null +++ b/pkg/images/imutil/doc/imdivide.hlp @@ -0,0 +1,65 @@ +.help imdivide Sep86 images.imutil +.ih +NAME +imdivide -- image division with zero checking and rescaling +.ih +USAGE +imdivide numerator denominator resultant +.ih +PARAMETERS +.ls numerator +Numerator image. +.le +.ls denominator +Denominator image. +.le +.ls resultant +Resultant image. This image will be of datatype real. +.le +.ls title = '*' +Title for resultant image. The special character '*' defaults the title +to that of the numerator image. +.le +.ls constant = 0 +The constant value for the zero division constant option. +.le +.ls rescale = norescale +After the image division the resultant image may be rescaled with the following +options: +.ls norescale +Do not rescale the resultant image. +.le +.ls mean +Scale the resultant image to the specified mean value. +.le +.ls numerator +Scale the resultant image to have the same mean value as the numerator image. +.le +.le +.ls mean = 1 +The mean value used rescale the resultant image under 'mean' option of +\fIrescale\fR. +.le +.ls verbose = no +Print the means of each image? +.le +.ih +DESCRIPTION +The \fInumerator\fR image is divided by the \fIdenominator\fR image to +form the \fIresultant\fR image. The division is checked for division by +zero and replaces the result with the value of the parameter \fIconstant\fR. +After the division the resultant image may be rescaled. +The rescaling option is selected with \fIrescale\fR. The options are +not to rescale, rescale to the specified \fImean\fR value, and rescale to +the mean of the numerator. The means of the three images are calculated +and may be printed with the verbose option. +.ih +EXAMPLES +1. To divide a object image by a flat field and then rescale the division +back to the mean of the object image: + + cl> imdivide object image final rescale=numerator +.ih +SEE ALSO +imarith +.endhelp diff --git a/pkg/images/imutil/doc/imexpr.hlp b/pkg/images/imutil/doc/imexpr.hlp new file mode 100644 index 00000000..76886d95 --- /dev/null +++ b/pkg/images/imutil/doc/imexpr.hlp @@ -0,0 +1,447 @@ +.help imexpr Dec01 images.imutil +.ih +NAME +imexpr -- General image expression evaluator +.ih +USAGE +imexpr expr output [a b c ...] +.ih +PARAMETERS +.ls expr +The expression to be evaluated. This may be the actual expression, or the +string "@file" in which case the expression is taken from the named file. +The input operands (i.e., numeric constants, images, or image header +parameters) are referred to in the expression symbolically using the letters +"a" through "z". +.le +.ls output +The output image. A section may be given to write into a section of an +existing image. +.le +.ls a - z +The input operands referenced by the expression. The value of an operand +may be an image name or section, a numeric constant, or a reference to an +image header parameter of the form \fIoperand.param\fR, where \fIoperand\fR +is one of the other input operands "a" through "z", corresponding to an input +image (for example, "a.itime" is the parameter "itime" from the image +assigned to operand "a"). An example of an input image operand is +"a=dev$pix". +.le +.ls dims = "auto" +The dimensions of the output image. If the special value \fIauto\fR is +given the output image dimensions are computed based on the input operands +and the expression being evaluated. Otherwise the value is a list of axis +lengths, e.g., "512,512". +.le +.ls intype = "int" +The minimum datatype for an input image operand. If the special value +\fIauto\fR is given the operand type will be the same as the pixel type of +the image. Otherwise one of the values "short", "int", "long", "real", +or "double" should be given. The program will promote the type of the +input operand to the type specified if the actual type is less precise +than the value of \fIintype\fR, otherwise the type of the input operand +is not changed. For example, if \fIintype\fR is "int" (the default), +short integer input operands will be promoted to integer but int, long, +real or double operands will be unaffected. Setting \fIintype\fR to real +will force the expression to be evaluated in floating point. +.le +.ls outtype = "auto" +The pixel type of the output image. If set to the special value \fIauto\fR +the output image will be the same type as the expression being evaluated. +If set to \fIref\fR the output image will have the same type as the +"reference" input image (see below), regardless of the expression type. +If an explicit type is specified such as "short", "ushort", "int", "real", +an image of the indicated type will be created. +.le +.ls refim = "auto" +The reference image to be used to pass the WCS and other image header +attributes to the output image. If set to \fIauto\fR the program will +compute the best reference image, which is the first input image +with the highest number of dimensions. To force a particular input image +to be the reference image the value should be set to the name of an input +operand ("a", "b", etc.). The named operand must refer to an image. +.le +.ls bwidth = 0 +The boundary width in pixels for boundary extension. Boundary extension +is enabled by setting this value to a positive nonzero value. Boundary +extension is needed when an input image section references out of bounds. +.le +.ls btype = "nearest" +The type of boundary extension, chosen from the list "constant", "nearest", +"reflect", "wrap", or "project". +.le +.ls bpixval = 0. +The boundary pixel value if \fIbtype\fR="constant". +.le +.ls rangecheck = yes +If range checking is enabled then the program will check for illegal +operations such as divide by zero or the square root or logarithm of a +negative value, substituting a constant value (zero) if such an operation +is detected. This may be necessary to avoid aborting the entire operation +because of a few bad pixels in an image. A conditional expression may be +used to detect such pixels and perform any special processing. +.le +.ls verbose = yes +Enable or disable informative messages. If enabled, the program will echo +the expression to be evaluated after all expansions have been performed, +and percent-done messages will be printed as the expression is evaluated. +.le +.ls exprdb = "" +The file name of an optional expression database. An expression database +may be used to define symbolic constants or a library of custom function +macros. +.le +.ih +DESCRIPTION +\fIimexpr\fR evaluates an image expression and writes the result to the +output image. Images may be any dimension or size and any datatype except +complex (complex images may be read but only the real part will be used). + +If the input images are not all the same size the computation will be +performed over the largest area which is common to all images. If the +images are not all the same dimension the lesser dimension operands will be +iteratively combined with the higher dimension ones. For example, when +both a one and two dimensional image are used in the same expression, +the vector (one dimensional image) will be applied to all lines of the +two dimensional image. + +Evaluation of the image expression is carried out one line at a time. This +is efficient and permits operations on arbitrarily large images without +using excessive memory, but does not allow 2D or higher operations to be +performed within the expression (e.g., transpose). The entire expression is +evaluated once for each line of the output image. + + +\fBOperands\fR + +Input operands are represented symbolically in the input expression using +the symbols "a" through "z", corresponding to \fIimexpr\fR task parameters. +Use of symbolic operands allows the same expression to be used with different +data sets, simplifies the expression syntax, and allows a single input image +to be used several places in the same expression. + +Three classes of input operands are recognized: images, image parameters, and +numeric constants. + +.nf + dev$pix[*,55] image operand + a.itime image parameter + 1.2345 numeric constant +.fi + +Since the input operands are CL parameters they may be set on the command +line, or entered in response to parameter prompts when the task executes and +evaluates the input expression. For example, + +.nf + cl> imexpr "a - a/b" pix + operand a: dev$pix[*,55] + operand b: a.itime +.fi + +would evaluate the expression shown, storing the result in the output image +"pix". + +Operands may also be specified directly in the expression, with the +exception of image operands. For example, + + cl> imexpr "a - a / a.itime" + +is equivalent to the earlier example. + +If the input operand is not a simple identifier (a simple name like "itime" +containing only alphanumeric characters, underscore, ".", or "$") then it +is necessary to quote the operand name and precede it with an "@", e.g., + + cl> imexpr 'a - a / @"a.i-time"' + +Finally, there is a special builtin type of operand used to represent the +image pixel coordinates in an image expression. These operands have the +special reserved names "I", "J", "K", etc., up to the dimensions of the +output image. The names must be upper case to avoid confusion to with the +input operands "i", "j", "k" and so on. + +.nf + I X coordinate of pixel (column) + J Y coordinate of pixel (line) + K Z coordinate of pixel (band) +.fi + +An example of the use of the pixel coordinate operands is the generation of +multidimensional analytic functions. + + +\fBOperators\fR + +The expression syntax implemented by \fIimexpr\fR provides the following +set of operators: + +.nf + ( expr ) grouping + + - * / arithmetic + ** exponentiation + // concatenate + expr ? expr1 : expr2 conditional expression + @ "name" get operand + + && logical and + || logical or + ! logical not + < less than + <= less than or equal + > greater than + >= greater than or equal + == equals + != not equals + ?= substring equals + + & bitwise and + | bitwise or + ^ bitwise exclusive or + ~ bitwise not (complement) +.fi + +The conditional expression has the value \fIexpr1\fR if \fIexpr\fR is true, +and \fIexpr2\fR otherwise. Since the expression is evaluated at every pixel +this permits pixel-dependent operations such as checking for special pixel +values, or selection of elements from either of two vectors. For example, +the command + + (a < 0) ? 555 : b / a + +has the constant value 555 if "a" is less than zero, and "b / a" otherwise. +Conditional expressions are general expressions and may be nested or used +anywhere an expression is permitted. + +The concatenation operator applies to all types of data, not just strings. +Concatenating two vectors results in a vector the combined length of the +two input vectors. + +The substring equals operator "?=", used for string comparisons, is like +"==" but checks for the presence of a substring, rather than exact equality +of the two strings. + + +\fBFunctions\fR + +Where it makes sense all intrinsic functions support all datatypes, with +some restrictions on \fIbool\fR and \fIchar\fR. Arguments may be scalars or +vectors and scalar and vector arguments may be mixed in the same function +call. Arguments are automatically type converted upon input as necessary. +Some functions support a variable number of arguments and the details of +the the operation to be performed may depend upon how many arguments are +given. + +Functions which operate upon vectors are applied to the \fIlines\fR of an +image. When applied to an image of dimension two or greater, these +functions are evaluated separately for every line of the multidimensional +image. + +Standard Intrinsic Functions + +.nf + abs (a) absolute value + max (a, b, ...) maximum value + min (a, b, ...) minimum value + mod (a, b) modulus + sqrt (a) square root +.fi + +Mathematical or trigonometric functions + +.nf + acos (a) arc cosine + asin (a) arc sine + atan (a [,b]) arc tangent + atan2 (a [,b]) arc tangent + cos (a) cosine + cosh (a) hyperbolic cosine + exp (a) exponential + log (a) natural logarithm + log10 (a) logarithm base 10 + sin (a) sine + sinh (a) hyperbolic sine + tan (a) tangent + tanh (a) hyperbolic tangent +.fi + +The trigonometric functions operate in units of radians. The \fIdeg\fR and +\fIrad\fR intrinsic functions (see below) can be used to convert to and from +degrees if desired. + +Type conversion functions + +.nf + bool (a) coerce to boolean + short (a) coerce to short + int (a) truncate to integer + nint (a) nearest integer + long (a) coerce to long (same as int) + real (a) coerce to real + double (a) coerce to double + str (a) coerce to string +.fi + +The numeric type conversion functions will convert a string to a number if +called with a character argument. The \fIstr\fR function will convert any +number to a string. + +Projection functions + +.nf + len (a) length of a vector + hiv (a) high value of a vector + lov (a) low value of a vector + mean (a [, ksigma]) mean of a vector + median (a) median of a vector + stddev (a [, ksigma]) standard deviation + sum (a) sum of a vector +.fi + +The projection functions take a vector as input and return a scalar value as +output. The functions \fImean\fR and \fIstddev\fR, used to compute the mean +and standard deviation of a vector, allow an optional second argument which +if given causes a K-sigma rejection to be performed. + +Miscellaneous functions + +.nf + deg (a) radians to degrees + rad (a) degrees to radians + median (a, b, c [, d [, e]]) vector median of 3-5 vectors + repl (a, n) replicate + sort (a) sort a vector + shift (a, npix) shift a vector +.fi + +The \fImedian\fR function shown here computes the vector median of several +input vectors, unlike the projection median which computes the median value +of a vector sample. \fIsort\fR sorts a vector, returning the sorted vector +as output (this can be useful for studying the statistics of a sample). +\fIshift\fR applies an integral pixel shift to a vector, wrapping around at +the endpoints. A positive shift shifts data features to the right (higher +indices). + +The \fIrepl\fR (replicate) function replicates a data element, returning a +vector of length (n * len(a)) as output. For example, this can be used to +create a dummy data array or image by replicating a constant value. + + +\fBThe Expression Database\fR + +The \fIimexpr\fR expression database provides a macro facility which can be +used to create custom libraries of functions for specific applications. A +simple example follows. + +.nf + # Sample IMEXPR expression database file. + + # Constants. + SQRTOF2= 1.4142135623730950488 + BASE_E= 2.7182818284590452353 + PI= 3.1415926535897932385 + GAMMA= .57721566490153286061 # Euler's constant + + # Functions. + div10(a) ((a) / 10) + divz(a,b) ((abs(b) < .000001) ? 0 : a / b) + + div(a,b) (div10(b) / a) + sinx (cos(I / 30.0)) + sinxy(a,b) (cos (I / a) + cos (J / b)) +.fi + +The complete syntax of a macro entry is as follows: + + <symbol>['(' arg-list ')'][':'|'='] replacement-text + +The replacement text may appear on the same line as the macro name or may +start on the next line, and may extend over multiple input lines if +necessary. If so, continuation lines must be indented. The first line +with no whitespace at the beginning of the line terminates the macro. +Macro functions may be nested. Macro functions are indistinguishable from +intrinsic functions in expressions. + + +\fBIMEXPR and Pixel Masks\fR + +Although \fIimexpr\fR has no special support for pixel masks, it was +designed to work with masks and it is important to realize how these can be +used. IRAF image i/o includes support for a special type of image, the +pixel mask or ".pl" type image. Pixel masks are used for things such as +region identification in images - any arbitrary region of an image can be +assigned a constant value in a mask to mark the region. Masks can then be +used during image analysis to identify the subset of image pixels to be +used. An image mask stored as a ".pl" file is stored in compressed form and +is typically only a few kilobytes in size. + +There are many ways to create masks, but in some cases \fIimexpr\fR itself +can be used for this purpose. For example, to create a boolean mask with +\fIimexpr\fR merely evaluate a boolean expression and specify a ".pl" file +as the output image. For example, + + cl> imexpr "a > 800" mask.pl + +will create a boolean mask "mask.pl" which identifies all the pixels in an +image with a value greater than 800. + +An example of the use of masks is the problem of combining portions of two +images to form a new image. + + cl> imexpr "c ? a : b" c=mask.pl + +This example will select pixels from either image A or B to form the output +image, using the mask assigned to operand C to control the selection. +.ih +EXAMPLES +1. Copy an image, changing the datatype to real (there are better ways to +do this of course). + + cl> imexpr a pix2 a=pix outtype=real + +2. Create a new, empty image with all the pixels set to 0. + + cl> imexpr "repl(0,512)" pix dim=512,512 + +3. Create a 1D image containing the sinc function. + + cl> imexpr "I == 10 ? 1.0 : sin(I-10.0)/(I-10)" sinc dim=20 + +4. Create a new image containing a simple test pattern consisting of a 5 +element vector repeated 100 times across each image line. + + cl> imexpr "repl((9 // 3 // 3 // 11 // 11), 100)" patt dim=500,500 + +5. Subtract the median value from each line of an image. + + cl> imexpr "a - median(a)" medimage + +6. Compute the HIV (low value) projection of an image. The result is a +transposed 1D image. + + cl> imexpr "hiv(a)" hvector + +7. Swap the left and right halves of an image. + +.nf + cl> imexpr "a // b" pix swapimage + operand a: dev$pix[256:512,*] + operand b: dev$pix[1:255,*] +.fi + +8. Create a circular mask of a given radius about a user-defined center. + +.nf + cl> type expr + (sqrt((I-b)**2 + (J-c)**2) <= d) + cl> imexpr @expr mask.pl b=256 c=256 d=100 dims=512,512 +.fi + +.ih +BUGS +The input and output images cannot be the same. +No support for type complex yet, or operations like the fourier transform. +.ih +SEE ALSO +imarith, imfunction, imcombine +.endhelp diff --git a/pkg/images/imutil/doc/imfunction.hlp b/pkg/images/imutil/doc/imfunction.hlp new file mode 100644 index 00000000..6cdef58e --- /dev/null +++ b/pkg/images/imutil/doc/imfunction.hlp @@ -0,0 +1,130 @@ +.help imfunction Aug91 images.imutil +.ih +NAME +imfunction -- Apply a function to the image pixel values +.ih +USAGE +imfunction input output function +.ih +PARAMETERS +.ls input +The input image list. +.le +.ls output +Output image list. The number of output images must match the number of +input images. If the output image list equals the input image list +the input images are overwritten. +.le +.ls function +Function to be applied to the input pixels. The options are: +.ls log10 +Take the logarithm to base 10 of an image. Negative and zero-valued +pixels will be assigned the value -MAX_EXPONENT. +.le +.ls alog10 +Taken the antilogarithm to base 10 of the image. Positive out-of-bounds +pixel values will be assigned the value MAX_REAL, negative out-of-bounds +pixel values will be assigned the value 0.0. +.le +.ls ln +Take the natural logarithm of an image. Negative and zero-valued pixels +will be assigned the value - ln (10.) * MAX_EXPONENT. +.le +.ls aln +Take the antilogarithm to base e of an image. Positive out-of-bounds pixel +values will be assigned the value MAX_REAL, negative out-of-bounds +pixel values will be assigned the value 0.0 +.le +.ls sqrt +Take the square root of an image. Negative pixel values will be assigned +the value 0.0. +.le +.ls square +Take the square of an image. +.le +.ls cbrt +Take the cube root of an image. +.le +.ls cube +Take the cube of an image. +.le +.ls abs +Take the absolute value of an image. +.le +.ls neg +Take the negative of an image. +.le +.ls cos +Take the cosine of an image. +.le +.ls sin +Take the sine of an image. +.le +.ls tan +Take the tangent of an image. +.le +.ls acos +Take the arc-cosine of an image. The output pixels will lie between +0.0 and PI. +.le +.ls asin +Take the arc-sine of an image. The output pixels will lie between -PI/2 +and +PI/2. +.le +.ls atan +Take the arc-tangent of an image. The output pixels will lie between +-PI/2 and +PI/2. +.le +.ls hcos +Take the hyperbolic cosine of an image. Positive or negative +out-of-bounds pixels will be assigned the value MAX_REAL. +.le +.ls hsin +Take the hyperbolic sine of an image. Positive and negative out-of-bounds +pixel values will be assigned the values MAX_REAL and -MAX_REAL respectively. +.le +.ls htan +Take the hyperbolic tangent of an image. +.le +.ls reciprocal +Take the reciprocal of an image. Zero-valued pixels will be assigned +the output value 0.0 +.le +.le +.ls verbose = yes +Print messages about actions taken by the task? +.le + +.ih +DESCRIPTION + +The selected function \fIfunction\fR is applied to the pixel values of all +the input images \fIinput\fR to create the pixel values of the output +images \fIoutput\fR. The number of output images must equal the number of +input images. If the output image name is the same as the input image name +the input image will be overwritten. + +If the input image is type real or double the output image will +be of type real or double respectively. If the input image is type +ushort then the output image will be type real. If the input image is one of +the remaining integer data types, then the output image will be type +real, unless function is "abs" or "neg", in which case the output +data type will be the same as the input data type. + +Values of the machine dependent constants MAX_REAL and MAX_EXPONENT can be +found in the file "hlib$mach.h". + +.ih +EXAMPLES + +1. Take the logarithm of the pixel values of images in1 and in2 and write +the results to out1 and out2. + +.nf + cl> imfunction in1,in2 out1,out2 log10 +.fi + +.ih +SEE ALSO +imarith,imreplace +.endhelp diff --git a/pkg/images/imutil/doc/imgets.hlp b/pkg/images/imutil/doc/imgets.hlp new file mode 100644 index 00000000..12fa2a74 --- /dev/null +++ b/pkg/images/imutil/doc/imgets.hlp @@ -0,0 +1,70 @@ +.help imgets Jan85 images.imutil +.ih +NAME +imgets -- get the value of an image header parameter as a string +.ih +USAGE +imgets image param +.ih +PARAMETERS +.ls image +Name of the image to be accessed. +.le +.ls param +Name of the parameter whose value is to be returned. +.le +.ls value = "" +The value of the parameter, returned as a string. +.le +.ih +DESCRIPTION +The value of the parameter \fIparam\fR of the image \fIimage\fR is returned +as a string in the output parameter \fIvalue\fR. The CL type coercion +functions \fIint\fR and \fIreal\fR may be used to decode the returned +value as an integer or floating point value. Both standard image header +parameters and special application or instrument dependent parameters may be +accessed. If the parameter cannot be found a warning message is printed and +the value "0" is returned. Parameter names are case sensitive. + +The following standard image header parameters may be accessed with +\fBimgets\fR: + +.nf + i_pixtype pixel type (short, real, etc.) + i_naxis number of dimensions + i_naxis[1-7] length of the axes (x=1,y=2) + i_minpixval minimum pixel value or INDEF + i_maxpixval maximum pixel value or INDEF + i_title image title string + i_pixfile pixel storage file name +.fi + +This task is most useful for image parameter access from within CL scripts. +The task \fBimheader\fR is more useful for just looking at the image header +parameters. +.ih +EXAMPLES +1. Fetch the instrument parameter "HA" (hour angle) from the image header of +the image "nite1.1001", and compute and print the hour angle in degrees: + +.ks +.nf + cl> imgets nite1.1001 HA + cl> = real(imgets.value) * 15.0 + 42.79335 +.fi +.ke + +2. Print the number of pixels per line in the same image. + +.ks +.nf + cl> imgets nite1.1001 i_naxis1 + cl> = int(imgets.value) + 1024 +.fi +.ke +.ih +SEE ALSO +imheader, hedit, hselect +.endhelp diff --git a/pkg/images/imutil/doc/imheader.hlp b/pkg/images/imutil/doc/imheader.hlp new file mode 100644 index 00000000..c32feb0a --- /dev/null +++ b/pkg/images/imutil/doc/imheader.hlp @@ -0,0 +1,62 @@ +.help imheader Jun97 images.imutil +.ih +NAME +imheader -- list header parameters for a list of images +.ih +USAGE +imheader [images] +.ih +PARAMETERS +.ls images +List of IRAF images. +.le +.ls imlist = "*.imh,*.fits,*.pl,*.qp,*.hhh" +The default IRAF image name template. +.le +.ls longheader = no +Print verbose image header. +.le +.ls userfields = yes +If longheader is set print the information in the user area. +.le +.ih +DESCRIPTION +IMHEADER prints header information in various formats for the list of IRAF +images specified by \fIimages\fR, or by the default image name template +\fIimlist\fR. If \fIlongheader\fR = no, the image name, +dimensions, pixel type and title are printed. If \fIlongheader\fR = yes, +information on the create and modify dates, image statistics and so forth +are printed. Non-standard IRAF header information can be printed by +setting \fIuserfields\fR = yes. + +.ih +EXAMPLES + +1. Print the header contents of a list of IRAF fits images. + +.nf + cl> imheader *.fits +.fi + +2. Print the header contents of a list of old IRAF format images in verbose +mode. + +.nf + cl> imheader *.imh lo+ +.fi + +3. Print short headers for all IRAF images of all types, e.g. imh, fits etc +in the current directory. + +.nf + cl> imheader +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +imgets, hedit, hselect +.endhelp diff --git a/pkg/images/imutil/doc/imhistogram.hlp b/pkg/images/imutil/doc/imhistogram.hlp new file mode 100644 index 00000000..970f07fc --- /dev/null +++ b/pkg/images/imutil/doc/imhistogram.hlp @@ -0,0 +1,111 @@ +.help imhistogram Nov89 images.imutil +.ih +NAME +imhistogram -- print or plot the histogram of an image +.ih +USAGE +imhistogram image +.ih +PARAMETERS +.ls image +The name of the image or image subsection whose histogram is to be calculated. +.le +.ls z1 = INDEF, z2 = INDEF +The minimum and maximum histogram intensity. The image minimum and maximum +pixel values are used by default. +.le +.ls binwidth = INDEF +The resolution of the histogram in counts. If \fIbinwidth\fR is not defined, +the parameter \fInbins\fR determines the histogram resolution. +.le +.ls nbins = 512 +The number of bins in, or resolution of, the histogram. +The \fInbins\fR parameter is overridden if \fIbinwidth\fR is defined. +.le +.ls autoscale = yes +In the case of integer data, automatically adjust \fInbins\fR and +\fIz2\fR to avoid aliasing effects. +.le +.ls top_closed = no +Include z2 in the top bin? Each bin of the histogram is a subinterval +that is half open at the top. \fITop_closed\fR decides whether those +pixels with values equal to z2 are to be counted in the histogram. If +\fBtop_closed\fR is yes, the top bin will be larger than the other bins. +.le +.ls hist_type = "normal" +The type of histogram to plot or list. The choices are "normal", +"cumulative", "difference", or "second_difference". The two +"difference" options are calculated as forward differences, i.e., +diff[n] = hist[n+1] - hist[n]. +.le +.ls listout = no +List instead of plot the histogram? The list is never log scaled. +.le +.ls plot_type = "line" +The plot vector type. The options are "line" and "box". +.le +.ls logy = yes +Use log scaling on the y-axis of the plot? +.le +.ls device = "stdgraph" +The output graphics device. +.le +.ih +DESCRIPTION +\fIimhistogram\fR calculates the histogram of the IRAF image +\fIimage\fR using the parameters \fInbins\fR, \fIz1\fR and \fIz2\fR. +If either \fIz1\fR or \fIz2\fR is undefined the image minimum or +maximum is used. If \fIlistout\fR = no, the histogram is plotted on +the graphics device \fIdevice\fR in the vector mode specified by +\fIplot_type\fR. The plot may be log scaled if \fIlogy\fR = yes (the +default). If \fIlistout\fR = yes, the histogram is listed on the +standard output. + +In addition to producing the "normal" histogram, the task will also +calculate cumulative and marginal (forward difference) histograms +depending on the choice of the \fIhist_type\fR parameter (choices +are: "normal", "cumulative", "difference", and "second_difference"). +The plot will be labeled by the type of histogram as well as the image +name and title and the binning parameters. + +Each bin of the histogram is defined to be half open at the top. This +results in an ambiguity deciding whether those pixels with z=z2 are +included in the topmost bin. This decision is left to the user via the +\fItop_closed\fR parameter. This is usually only important with integer +images and histograms with few bins. +.ih +EXAMPLES +1. Output the histogram of an image to a file. + + cl> imhist M51.imh li+ nbins=100 > fits1.hst + +2. Plot the histogram of another image between the values 0 and 2000. + + cl> imhist M31.imh nbins=100 z1=0. z2=2000. + +3. Ditto, but set the histogram resolution explicitly to avoid +smoothing the histogram. + + cl> imhist M31.imh nbins=100 z1=0 z2=2000 nbins=2001 + +4. Plot the cumulative histogram. This is most useful for images with +fairly flat "normal" histograms. + + cl> imhist R50.imh hist=cum +.ih +BUGS +If the resolution of the histogram (number of bins) is a non-integral multiple +of the intensity resolution of the data (number of possible intensity values), +then \fIaliasing\fR can occur. The effect is to cause periodic zero dropouts +(for an oversampled histogram) or excess-valued bins (for a slightly +undersampled histogram). The \fIautoscaling\fR feature, if enabled, will +adjust the histogram parameters to avoid such aliasing effects for integer +data. This is not possible for floating point data, however, in which case +aliasing is certainly possible and can only be avoided by manually adjusting +the histogram parameters. One should also be aware that \fIsmoothing\fR of +the histogram will occur whenever the data range exceeds the histogram +resolution. +.ih +SEE ALSO +listpixels, plot.graph, proto.mkhistogram +.endhelp diff --git a/pkg/images/imutil/doc/imjoin.hlp b/pkg/images/imutil/doc/imjoin.hlp new file mode 100644 index 00000000..0c5d8245 --- /dev/null +++ b/pkg/images/imutil/doc/imjoin.hlp @@ -0,0 +1,70 @@ +.help imjoin Jan97 images.imutil +.ih +NAME +imjoin -- join images along a specified axis +.ih +USAGE +imjoin input output join_dimension +.ih +PARAMETERS +.ls input +The list of input images to be joined. The input images must have the +same dimensionality and the same size along all dimensions but the join +dimension. +.le +.ls output +The output combined image. +.le +.ls join_dimension +The image dimension along which the input images will be joined. +.le +.ls pixtype = "" +The output image pixel type. The options are in order of increasing +precedence "s" (short), "u" (unsigned short), "i" (integer), +"l" (long integer), "r" (real), "d" (double), and "x" (complex). +If the output image pixel type is not specified, it defaults to highest +precedence input image datatype. +.le +.ls verbose = yes +Print messages about actions taken by the task ? +.le + +.ih +DESCRIPTION + +IMJOIN creates a single output image \fIoutput\fR by joining a list of input +images \fIinput\fR along a specified dimension \fIjoin_dimension\fR. IMJOIN +can be used to create a single long 1-dimensional image from a list of shorter +1-dimensional images, or to piece together a set of 3-dimensional images into +larger 3-dimensional images along either the x, y, or z directions. The input +images must all have the same number of dimensions and the same size along +all dimensions by the join dimension. The output image inherits the +world coordinates system if any of the first input image. + +.ih +EXAMPLES + +.nf +1. Join a list of 1-dimensional spectra into a single long output spectrum. + + cl> imjoin @inlist output 1 + +2. Join three datacubes along the z direction. + + cl> imjoin c1,c2,c3 c123 3 + +.fi + +.ih +TIMINGS + +.ih +BUGS + +On some systems there are limitations on the number of input images that +can be joined in a single execution of IMJOIN. + +.ih +SEE ALSO +imstack, imslice, imtile +.endhelp diff --git a/pkg/images/imutil/doc/imrename.hlp b/pkg/images/imutil/doc/imrename.hlp new file mode 100644 index 00000000..dbba949b --- /dev/null +++ b/pkg/images/imutil/doc/imrename.hlp @@ -0,0 +1,50 @@ +.help imrename Apr89 images.imutil +.ih +NAME +imrename -- rename one or more images +.ih +USAGE +imrename oldnames newnames +.ih +PARAMETERS +.ls oldnames +An image template specifying the names of the images to be renamed. +.le +.ls newnames +Either an image template specifying the new names for the images, +or the name of the directory to which the images are to be renamed (moved). +.le +.ls verbose = no +If verbose output is enabled a message will be printed on the standard output +recording each rename operation. +.le +.ih +DESCRIPTION +The \fBimrename\fR task renames one or more images. The ordinary \fIrename\fR +task cannot be used to rename images since an image may consist of more than +one file. +.ih +EXAMPLES +1. Rename the image "pix" to "wfpc.1". + + cl> imrename pix wfpc.1 + +2. Rename all the "nite1*" images as "nite1_c". + + cl> imrename nite1.*.imh nite1%%_c%.*.imh + +3. Move the images in logical directory "dd" to the current directory. + + cl> imrename dd$*.imh . + +4. Move the pixel files associated with the images in the current directory +to a subdirectory "pix" of the current directory. + +.nf + cl> reset imdir = HDR$pix/ + cl> imrename *.imh . +.fi +.ih +SEE ALSO +imcopy, imdelete, imheader +.endhelp diff --git a/pkg/images/imutil/doc/imreplace.hlp b/pkg/images/imutil/doc/imreplace.hlp new file mode 100644 index 00000000..80e9f12c --- /dev/null +++ b/pkg/images/imutil/doc/imreplace.hlp @@ -0,0 +1,72 @@ +.help imreplace Dec97 images.imutil +.ih +NAME +imreplace -- replace pixels in a window by a constant +.ih +USAGE +imreplace images value lower upper +.ih +PARAMETERS +.ls images +Images in which the pixels are to be replaced. +.le +.ls value +Replacement value for pixels in the window. +.le +.ls imaginary = 0. +Replacement value for pixels in the windoe for the imaginary part of +complex data. +.le +.ls lower = INDEF +Lower limit of window for replacing pixels. If INDEF then all pixels +are above \fIlower\fR. For complex images this is the magnitude +of the pixel values. For integer images the value is rounded up +to the next higher integer. +.le +.ls upper = INDEF +Upper limit of window for replacing pixels. If INDEF then all pixels +are below \fIupper\fR. For complex images this is the magnitude +of the pixel values. For integer images the value is rounded down +to the next lower integer. +.le +.ls radius = 0. +Additional replacement radius around pixels which are in the replacement +window. If a pixel is within this distance of a pixel within the replacement +window it is also replaced with the replacement value. Distances are +measured between pixel centers which are have integer coordinates. +.le +.ih +DESCRIPTION +The pixels in the \fIimages\fR between \fIlower\fR and \fIupper\fR, +and all other pixels with a distance given by \fIradius\fR, +are replaced by the constant \fIvalue\fR. The special value INDEF in +\fIlower\fR and \fIupper\fR corresponds to the minimum and maximum +possible pixel values, respectively. + +For complex images the replacement value is specified as separate +real and imaginary and the thresholds are the magnitude. For +integer images the thresholds are used as inclusive limits +so that, for example, the range 5.1-9.9 affets pixels 6-9. +.ih +EXAMPLES +1. In a flat field calibration which has been scaled to unit mean replace +all response values less than or equal to 0.8 by 1. + + cl> imreplace calib 1 upper=.8 + +2. Set all pixels to zero within a section of an image. + + cl> imreplace image[1:10,5:100] 0 +.ih +REVISIONS +.ls IMREPLACE V2.11.1 +A replacement radius to replace additional pixels was added. +.le +.ls IMREPLACE V2.11 +The lower value is now rounded up for integer images so that a range +like 5.1-9.9 affects pixels 6-9 instead of 5-9. +.le +.ih +SEE ALSO +imexpr +.endhelp diff --git a/pkg/images/imutil/doc/imslice.hlp b/pkg/images/imutil/doc/imslice.hlp new file mode 100644 index 00000000..368240d0 --- /dev/null +++ b/pkg/images/imutil/doc/imslice.hlp @@ -0,0 +1,58 @@ +.help imslice Feb90 images.imutil +.ih +NAME +imslice -- slice an image into images of lower dimension +.ih +USAGE +imslice input output slicedim +.ih +PARAMETERS +.ls input +The list of input images to be sliced. The input images must have a +dimensionality greater than one. +.le +.ls output +The root name of the output images. For each n-dimensional input +image m (n-1)-dimensional images will be created, where m is the +length of the axis to be sliced. The sequence number m will +be appended to the output image name. +.le +.ls slice_dimension +The dimension to be sliced. +.le +.ls verbose = yes +Print messages about actions taken. +.le +.ih +DESCRIPTION +The n-dimensional images \fIinput\fR are sliced into m (n-1)-dimensional +images \fIoutput\fR, where m is the length of the axis of the input +image to be sliced. A sequence number from 1 to m is appended to output +to create the output image name. +.ih +EXAMPLES +1. Slice the 3-D image "datacube" into a list of 2D images. A list of +images called plane001, plane002, plane003 ... will be created. + +.nf + im> imslice datacube plane 3 +.fi + +2. Slice the list of 2-D images "nite1,nite2,nite3" into a list of 1-D images. +A new list of images nite1001, nite1002, ..., nite2001, nite2002, ..., +nite3001, nite3002 will be created. + +.nf + im> imslice nite1,nite2,nite3 nite1,nite2,nite3 2 +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +If the image to be sliced is an image section, the images slices will +refer to the section not the original image. +.ih +SEE ALSO +imstack, imcopy +.endhelp diff --git a/pkg/images/imutil/doc/imstack.hlp b/pkg/images/imutil/doc/imstack.hlp new file mode 100644 index 00000000..e3eeccd9 --- /dev/null +++ b/pkg/images/imutil/doc/imstack.hlp @@ -0,0 +1,56 @@ +.help imstack Apr92 images.imutil +.ih +NAME +imstack -- stack images into an image of higher dimension +.ih +USAGE +imstack images output +.ih +PARAMETERS +.ls images +List of images to be stacked. +.le +.ls output +Name of output image created. +.le +.ls title = "*" +Title of output image. If "*" then the title defaults to that of +the first input image. +.le +.ls pixtype = "*" +Pixel datatype of output image. If "*" then the pixel datatype defaults to +that of the first input image. +.le +.ih +DESCRIPTION + +The input \fIimages\fR are stacked to form an \fIoutput\fR image having one +higher dimension than the input images, and a length of that dimension equal +to the number of input images. The input images must all be of the same +dimension and size. + +The output image inherits the world coordinate system (WCS) of the first +input image. If the dimension of the input image WCS is greater than or +equal to the dimension of the output image, the input WCS is copied to the +output image WCS without modification. Otherwise the input image WCS +dimension is incremented by 1 and copied to the output image WCS, the input +WCS coordinate transformations for each input image axis are copied to the +output image WCS without modification, and the new output image axis is +assigned a WCS type of 'linear' and the identity transformation. + +.ih +EXAMPLES + +1. Stack a set of four two dimensional images: + + cl> imstack image* image.3d + +2. To stack a section of images: + + cl> imstack image*[1:10,1:10] newimage +.ih +BUGS +.ih +SEE ALSO +imslice +.endhelp diff --git a/pkg/images/imutil/doc/imstat.hlp b/pkg/images/imutil/doc/imstat.hlp new file mode 100644 index 00000000..ed5183d9 --- /dev/null +++ b/pkg/images/imutil/doc/imstat.hlp @@ -0,0 +1,121 @@ +.help imstatistics Feb01 images.imutil +.ih +NAME +imstatistics -- compute and print image pixel statistics +.ih +USAGE +imstatistics images +.ih +PARAMETERS +.ls images +The input images or image sections for which pixel statistics are to be +computed. +.le +.ls fields = "image,npix,mean,stddev,min,max" +The statistical quantities to be computed and printed. +.le +.ls lower = INDEF +The minimum good data limit. All pixels are above the default value of INDEF. +.le +.ls upper = INDEF +The maximum good data limit. All pixels are above the default value of INDEF. +.le +.ls nclip = 0 +The maximum number of iterative clipping cycles. By default no clipping is +performed. +.le +.ls lsigma = 3.0 +The low side clipping factor in sigma. +.le +.ls usigma = 3.0 +The high side clipping factor in sigma. +.le +.ls binwidth = 0.1 +The width of the histogram bins used for computing the midpoint (estimate +of the median) and the mode. +The units are in sigma. +.le +.ls format = yes +Label the output columns and print the result in fixed format. If format +is "no" no column labels are printed and the output is in free format. +.le +.ls cache = no +Cache the image data in memory ? This can increase the efficiency of the +task if nclip > 0 or either of the midpt and mode statistics are computed. +.le +.ih +DESCRIPTION +The statistical quantities specified by the parameter \fIfields\fR are +computed and printed for each image in the list specified by \fIimages\fR. +The results are printed in tabular form with the fields listed in the order +they are specified in the fields parameter. The available fields are the +following. + +.nf + image - the image name + npix - the number of pixels used to do the statistics + mean - the mean of the pixel distribution + midpt - estimate of the median of the pixel distribution + mode - the mode of the pixel distribution + stddev - the standard deviation of the pixel distribution + skew - the skew of the pixel distribution + kurtosis - the kurtosis of the pixel distribution + min - the minimum pixel value + max - the maximum pixel value +.fi + +The mean, standard deviation, skew, kurtosis, min and max are computed in a +single pass through the image using the expressions listed below. +Only the quantities selected by the fields parameter are actually computed. + +.nf + mean = sum (x1,...,xN) / N + y = x - mean + variance = sum (y1 ** 2,...,yN ** 2) / (N-1) + stddev = sqrt (variance) + skew = sum ((y1 / stddev) ** 3,...,(yN / stddev) ** 3) / (N-1) + kurtosis = sum ((y1 / stddev) ** 4,...,(yN / stddev) ** 4) / (N-1) - 3 +.fi + +The midpoint and mode are computed in two passes through the image. In the +first pass the standard deviation of the pixels is calculated and used +with the \fIbinwidth\fR parameter to compute the resolution of the data +histogram. The midpoint is estimated by integrating the histogram and +computing by interpolation the data value at which exactly half the +pixels are below that data value and half are above it. The mode is +computed by locating the maximum of the data histogram and fitting the +peak by parabolic interpolation. + +.ih +EXAMPLES +1. To find the number of pixels, mean, standard deviation and the minimum +and maximum pixel value of a bias region in an image. + +.nf + cl> imstat flat*[*,1] + # IMAGE NPIX MEAN STDDEV MIN MAX + flat1[*,1] 800 999.5 14.09 941. 1062. + flat2[*,1] 800 999.4 28.87 918. 1413. +.fi + +The string "flat*" uses a wildcard to select all images beginning with the +word flat. The string "[*,1]" is an image section selecting row 1. + +2. Compute the mean, midpoint, mode and standard deviation of a pixel +distribution. + +.nf + cl> imstat m51 fields="image,mean,midpt,mode,stddev" + # IMAGE PIXELS MEAN MIDPT MODE STDDEV + M51 262144 108.3 88.75 49.4 131.3 +.fi + +.ih +BUGS +When using a very large number of pixels the accumulation of the sums +of the pixel values to the various powers may +encounter roundoff error. This is significant when the true standard +deviation is small compared to the mean. +.ih +SEE ALSO +.endhelp diff --git a/pkg/images/imutil/doc/imsum.hlp b/pkg/images/imutil/doc/imsum.hlp new file mode 100644 index 00000000..a6eb07a5 --- /dev/null +++ b/pkg/images/imutil/doc/imsum.hlp @@ -0,0 +1,132 @@ +.help imsum Sep87 images.imutil +.ih +NAME +imsum -- sum, average, or median images +.ih +USAGE +imsum input output +.ih +PARAMETERS +.ls input +Input images. +.le +.ls output +Output image. +.le +.ls title = "" +Image title for the output image. If null ("") then the title of the +first image is used. +.le +.ls hparams = "" +List of image header parameters to be summed or averaged. This feature +is only used when summing or averaging and no correction is made for +rejected pixels. It is primarily used to sum exposure times. +.le +.ls pixtype = "" +Pixel datatype for the output image. The pixel datatypes are "double", +"real", "long", "integer", "ushort", and "short" in order of precedence. +If null ("") then the calculation type is used. +The datatypes may be abbreviated to a single character. +.le +.ls calctype = "" +Calculation type. The calculation types are "double", "real", "long", +"integer", and "short" in order of precedence. If null ("") then the +highest precedence datatype of the input images is used. +If there is a mixture of "short" and "ushort" images then the highest +precedence datatype will be "int". +The calculation types may be abbreviated to a single character. +.le +.ls option = "sum" +Output options are "sum", "average", or "median". The "median" of an +even number of images takes pixel nimages/2 + 1, where nimages is the +number of images. +.le +.ls low_reject = 0 +If the option is sum or average then when this parameter +is less than 1 reject this fraction of low pixels from the sum or average +otherwise reject this number of low pixels from the sum or average. +.le +.ls high_reject = 0 +If the option is sum or average then when this parameter +is less than 1 reject this fraction of high pixels from the sum or average +otherwise reject this number of high pixels from the sum or average. +.le +.ls verbose = no +Print a log of the operation? +.le +.ih +DESCRIPTION +The input images are summed, averaged, or medianed pixel by pixel and the +result recorded in the output image. All input images must be the same +size but not necessarily of the same pixel datatype. For the sum or average +option a selected fraction or number of pixels may be rejected. The output +option "average" divides the sum by the number of pixels in the sum. The +pixel datatype of the output image may be selected or defaulted to the +calculation datatype. The calculation type may be selected or defaulted +to the highest precedence datatype of the input images. Note that a +mixture of "short" and "ushort" images has a highest precedence datatype +of "int". If all the image pixel datatypes are the same and agree with the +calculation type then this operation is maximally efficient. However, +beware of integer overflows with images of datatype short or ushort. A log +of the task name, the input image names, the output image name, the output +pixel datatype, the output option, and the pixel rejection parameters is +printed when the verbose parameter is yes. + +In addition to summing the pixels the specified image header parameters may +be summed or averaged. This is primarily used for summing image exposure +times. No correction is made for rejected pixels. +.ih +EXAMPLES +1. To sum three images: + + im> imsum frame1,frame2,frame3 sum hparams="itime,exposure" + +2. To make a median image of a set of images: + + im> imsum obs* median option=median + +where '*' is a template wildcard. + +3. To reject the lowest and highest 2 pixels and average the rest: + + im> imsum obs* avg option=average low=2 high=2 +.ih +REVISIONS +.ls IMSUM V2.11 +Now allows "ushort" data types. +.le +.ih +TIME REQUIREMENTS +The following timings are for 512 x 512 short images in which the output +image is also short and the calculation type is short. + +.nf + OPERATION CPU(sec) + 1. Sum of 3 7.4 + 2. Average of 3 13.0 + 3. Median of 3 9.9 + 4. Sum of 5 13.0 + 5. Median of 5 23.0 + 6. Sum of middle 3 of 5 45.5 + 7. Median of 7 77.8 +.fi +.ih +NOTES +Any number of images may be used. However, there is a maximum number of +images which may be open at one time. If the number of images +(of dimension >= 2) exceeds this maximum and median or pixel rejection is +used then the performance of this task will suffer due to the need to +repeatedly open and close the excess images. The maximum number is a +configurable parameter in the include file "imsum.h". + +This task has been largely replaced by the task \fBimcombine\fR. It is +still available but may be removed in the future. \fBImcombine\fR is +specially designed to deal with the case of large numbers of images. +.ih +BUGS +It is an error for the output image to have the same name as an +existing image. Beware of integer overflows when summing short images. +.ih +SEE ALSO +imcombine +.endhelp diff --git a/pkg/images/imutil/doc/imtile.hlp b/pkg/images/imutil/doc/imtile.hlp new file mode 100644 index 00000000..b3a26924 --- /dev/null +++ b/pkg/images/imutil/doc/imtile.hlp @@ -0,0 +1,151 @@ +.help imtile Jan97 images.imutil +.ih +NAME +imtile -- mosaic a list of same size images into a tile pattern +.ih +USAGE +imtile input output nctile nltile +.ih +PARAMETERS +.ls input +The list of input image tiles to be mosaiced. The image tile list is assumed +to be ordered by row, column, or in a raster pattern. If the image tile list +is not in order then the files or sections tasks plus the editor must be used +to construct an ordered image tile list. The images in the input list must +all be the same size. +.le +.ls output +The name of the output image. +.le +.ls nctile +The number of image tiles to be placed along a row of the output image. +.le +.ls nltile +The number of image tiles to be placed along a column of the output image. +.le +.ls trim_section = "[*,*]" +The section of the input image tiles to be inserted into the output image. +Trim_section can be used to flip and / or trim the individual image tiles +before adding them to the mosaic. For example if we want to flip each +image tile around the y axis before adding it to the mosaic, then +\fItrim_section\fR should be set to "[*,-*]". +.le +.ls missing_input = "" +The list of missing image tiles. For example if image tiles 3 to 5 and +10 from a sequence of image tiles are missing then \fImissing_input\fR = +"3-5,10". This parameter uses the IRAF ranges syntax. The number of missing +image tiles plus the number of input image tiles must equal \fInctile\fR * +\fInltile\fR. +.le +.ls start_tile = "ll" +The position of the first input image tile placed in the output image mosaic. +The four options are "ll" for lower left corner, "lr" for lower right corner, +"ul" for upper left corner and "ur" for upper right corner. +.le +.ls row_order = yes +Add the input image tiles to the output image in row order. If row_order is +"no" then column order is used instead. +.le +.ls raster_order = no +Add the input image tiles to the output image in a raster pattern or return +to the start of a column or a row before adding a new image tile ? +.le +.ls median_section = "" +The section of each input image tile used to compute the median value. If +\fImedian_section\fR is the null string then the medians are not computed. +If \fImedian_section\fR is "[*,*]" the entire input image tile is used to +compute the median. +.le +.ls subtract = no +Subtract the median value from each input image tile before placing the +tile in the output image? +.le +.ls ncols = INDEF +The number of columns in the output image. If \fIncols\fR is INDEF then +the program will compute the number of columns using the size of the input +image tiles, \fInctile\fR, and \fIncoverlap\fR. +.le +.ls nlines = INDEF +The number of lines in the output image. If \fInlines\fR is INDEF then +the program will compute the number of lines using the size of the input +image tiles, \fInltile\fR and \fInloverlap\fR. +.le +.ls ncoverlap = -1 +The number of columns between adjacent tiles in the output image. A negative +value specifies the amount of column space between adjacent tiles. A positive +value specifies the amount of column overlap on adjacent tiles. +.le +.ls nloverlap = -1 +The number of lines between adjacent tiles in the output image. A negative +value specifies the amount of lines space between adjacent tiles. A positive +value specifies the amount of line overlap on adjacent tiles. +.le +.ls ovalue = 0.0 +The output image pixel value in regions undefined by the list of input +image tiles. +.le +.ls opixtype = "r" +The pixel type of the output image. The options are "s" (short integer), +"i" (integer), "u" (ushort), "l" (long integer), "r" (real) and +"d" for double precision. +.le +.ls verbose = yes +Print messages about the progress of the task? +.le + +.ih +DESCRIPTION + +IMTILE takes the list of same size input images (image tiles) specified by +\fIinput\fR and combines them into a tiled output image mosaic \fIoutput\fR. +The order in which the input image tiles are placed in the output image is +determined by the parameters \fIstart_tile\fR, \fIrow_order\fR and +\fIraster_order\fR. The orientation of each individual image tile in the +output image is set by the \fItrim_section\fR parameter. + +IMTILE uses the input image tile size, the number of image tiles, the +\fIncoverlap\fR and \fRnloverlap\fI parameters, and the \fInctile\fR and +\fInltile\fR parameters to compute the size of the output image. An image +of size larger than the minimum required can be specified by setting the +\fIncols\fR and \fInlines\fR parameters. The pixel type of the output +image is specified by the \fIopixtype\fR parameter and undefined +regions of the output image are assigned the value \fIovalue\fR. + +The median of a section of each input image tile is computed by setting +the \fImedian_section\fR parameter, and the computed median is subtracted +from the input image tiles if the \fIsubtract\fR parameter is set to "yes". +Task action messages will be printed on the standard output +if \fIverbose\fR is set to yes. + +.ih +EXAMPLES + +1. Mosaic a list of 64 images onto an 8 by 8 grid in column order +starting in the upper right hand corner. Allow one blank column and row +between each subraster. + +.nf + cl> imtile @imlist mosaic 8 8 ncoverlap=-1 nloverlap=-1 \ + start_tile="ur" row- +.fi + +2. Mosaic a list of 62 images onto an 8 by 8 grid in column order +starting in the upper right hand corner. Allow one blank column and row +between each subraster. Subrasters 3 and 9 in the sequence do not exist +and are to be replaced in the output image with an unknown value of -1.0. + +.nf + cl> imtile @imlist mosaic 8 8 nxoverlap=-1 nyoverlap=-1 \ + start_corner="ur" row- missing_input="3,9", ovalue=-1.0 +.fi + +.ih +TIME REQUIREMENTS + +.ih +BUGS + +.ih +SEE ALSO +imcombine +.endhelp diff --git a/pkg/images/imutil/doc/listpixels.hlp b/pkg/images/imutil/doc/listpixels.hlp new file mode 100644 index 00000000..48ea89eb --- /dev/null +++ b/pkg/images/imutil/doc/listpixels.hlp @@ -0,0 +1,191 @@ +.help listpixels Apr92 images.imutil +.ih +NAME +listpixels -- print the pixel values for a list of images +.ih +USAGE +listpixels images +.ih +PARAMETERS +.ls images +Images or list of image sections whose pixels are to be printed. +.le +.ls wcs = "logical" +The world coordinate system to be used for coordinate output. The following +standard systems are defined. +.ls logical +Logical coordinates are image pixel coordinates relative to the input +image. For example the pixel coordinates of the lower left corner +of an image section will always be (1,1) in logical units regardless of +their values in the original image. +.le +.ls physical +Physical coordinates are image pixel coordinates with respect to the original +image. For example the pixel coordinates of the lower left corner +of an image section will be its coordinates in the original image, +including the effects of any linear transformations done on that image. +Physical coordinates are invariant with respect to transformations +of the physical image matrix. +.le +.ls world +World coordinates are image pixel coordinates with respect to the +current default world coordinate system. For example in the case +of spectra world coordinates would most likely be in angstroms. +The default world coordinate system is the system named by the environment +variable \fIdefwcs\fR if defined in the user environment and present in +the image world coordinate system description, else it is the first user +world coordinate system defined for the image, else physical coordinates +are returned. +.le + +In addition to these three reserved world coordinate system names, the names +of any user world coordinate system defined for the image may be given. +.le +.ls formats = "" +The default output formats for the pixel coordinates, one format +per axis, with the individual formats separated by whitespace . +If formats are undefined, listpixels uses the formatting options +stored with the WCS in the image header. If the WCS formatting options +are not stored in the image header, then listpixels uses a default +value. +.le +.ls verbose = no +Print a title line for each image whose pixels are to be listed. +.le +.ih +DESCRIPTION +The pixel coordinates in the world coordinates system specified by +\fIwcs\fR and using the formats specified by \fIformats\fR are +printed on the standard output on the standard output followed by +the pixel value. +.ih +FORMATS +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi +.ih +EXAMPLES +1. List the pixels of an image on the standard output. + +.nf + cl> listpix m81 +.fi + +2. List a subraster of the above image in logical coordinates. + +.nf + cl> listpix m81[51:55,151:155] + 1. 1. ... + 2. 1. ... + 3. 1. ... + 4. 1. ... + 5. 1. ... + 1. 2. ... + .. .. ... +.fi + +3. List the same subraster in physical coordinates. + +.nf + cl> listpix m81[51:55,151:155] wcs=physical + 51. 151. ... + 52. 151. ... + 53. 151. ... + 54. 151. ... + 55. 151. ... + 51. 152. ... + ... .... ... +.fi + +4. List a spectrum that has been dispersion corrected in angstrom units. + +.nf + cl> listpix n7027 wcs=world +.fi + +5. List the RA and DEC coordinates in hms and dms format and pixels value +for an image section where axis 1 is RA and axis 2 is DEC. + +.nf + cl> listpix m51 wcs=world formats="%H %h" +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +imheader, imgets, imhistogram +.endhelp diff --git a/pkg/images/imutil/doc/minmax.hlp b/pkg/images/imutil/doc/minmax.hlp new file mode 100644 index 00000000..6e3f39b2 --- /dev/null +++ b/pkg/images/imutil/doc/minmax.hlp @@ -0,0 +1,84 @@ +.help minmax May91 images.imutil +.ih +NAME +minmax -- compute the minimum and maximum pixel values of an image +.ih +USAGE +minmax images +.ih +PARAMETERS +.ls images +Image template specifying the images to be examined. +.le +.ls force = no +Force recomputation of the minimum and maximum pixel and pixel values even if +they are noted as up to date in the image header. +.le +.ls update = yes +Update the image header with the new values (requires write permission). +.le +.ls verbose = yes +Print the image name, minimum value, and maximum value of each image +processed. +.le +.ls minval = INDEF +Set to the minimum pixel value of the last image processed. +If the pixel type of the last input image was complex, this is the real +part of the minimum value. +.le +.ls maxval = INDEF +Set to the maximum pixel value of the last image processed. +If the pixel type of the last input image was complex, this is the real +part of the maximum value. +.le +.ls iminval = INDEF +Set to the minimum imaginary part of the pixel value of the last image +processed. Only used if the pixel type of the last input image was complex. +.le +.ls imaxval = INDEF +Set to the maximum imaginary part of the pixel value of the last image +processed. Only used if the pixel type of the last input image was complex. +.le +.ls minpix = "" +Set to the minimum pixel specification of the last image processed. +.le +.ls maxpix = "" +Set to the maximum pixel specification of the last image processed. +.le +.ih +DESCRIPTION + + The \fIminmax\fR task computes the minimum and maximum pixel and pixel +values of +each of the images or image sections listed in the image template \fIimages\fR. +If the \fIforce\fR option is set the extreme values will be recomputed by +physical examination of the data, otherwise the image is examined only if the +extreme values stored in the image header are flagged as invalid. +The minimum and maximum pixel will be printed only if the force option +is enabled or if the image minimum and maximum is out of date. +If the \fIupdate\fR option is set the image header will be updated with the +newly computed values. Updating is not allowed when a section is used to +compute the new values. +.ih +EXAMPLES +1. Compute and print the minimum and maximum values of the images \fIimage1\fR +and \fIimage2\fR, updating the image header with the new values when done. + +.nf + cl> minmax image1,image2 +.fi + +2. Force update the minimum and maximum values in the image headers of all +images matching the template in the background, without printing the computed +values on the terminal. + + cl> minmax nite1.* force+ verbose- & +.ih +BUGS +The minimum and maximum pixel values are stored in the image header as values +of type real, hence some precision may be lost for images of type long integer +or double precision floating. +.ih +SEE ALSO +imheader, hedit +.endhelp diff --git a/pkg/images/imutil/doc/nhedit.hlp b/pkg/images/imutil/doc/nhedit.hlp new file mode 100644 index 00000000..27efffcc --- /dev/null +++ b/pkg/images/imutil/doc/nhedit.hlp @@ -0,0 +1,499 @@ +.help nhedit Aug08 images.imutil +.ih +NAME +nhedit - edit or view an image header interactively or using a command file +.ih +USAGE +.nf +nhedit images fields value comment +.fi +.ih +PARAMETERS +.ls images +Template specifying the images to be edited. +.le +.ls fields +Template specifying the fields to be edited in each image. The template is +expanded independently for each image against the set of all fields in the +image header. Special values for fields includes 'default_pars' that works only +with a command file; 'add_blank' to add a blank field value with a string as +value; 'add_textf' to add a text file content to the header. See description +for more details. +.le +.ls value +Either a string constant or a general expression (if the first character is +a left parenthesis) to be evaluated to compute the new value of each field. +With the rename switch the value is the new field name (keyword). +A single expression is used for all fields. The special value "." causes the +value of each field to be printed rather than edited. +.le +.ls comment +String constant for the comment section of the header card. This value will +replace the existing comment of a header or clear it if is empty (""). +The special value "." causes the field to be printed rather than edited. +.le +.ls comfile = "" +Alternate command file. If specified, the \fIfields\fR, \fIvalue\fR, and +\fIcomment\fR parameters are ignored and commands are taken from the named +file. See below for a detailed discussion and examples. +.le +.ls after = "" +Insert the new field after the named "pivot keyword". If this keyword +does not exist in the header, the new keyword is added to the end of the +image header. +.le +.ls before = "" +Insert the new field before the named "pivot keyword". If this keyword +does not exist in the header, the new keyword is added to the end of the +image header. +.le +.ls add = no +Change the operation of the editor from update to add new field. If the +field already exists it is edited. If this option is selected the field +list may name only a single field. The add switch takes precedence +over the addonly, delete, and rename switches. +.le +.ls addonly = no +Change the operation of the editor from update to add a new field. If the +field already exists it is not changed. If this option is selected the field +list may name only a single field. The addonly switch takes precedence over +the delete and rename switches. +.le +.ls delete = no +Change the operation of the editor from update to delete field. +The listed fields are deleted from each image. This takes precedence +or the rename switch. +.le +.ls rename = no +Change the operation of the editor from update field to rename field. +The listed fields are renamed in each image if they exist. The value +is parameter specifies the new keyword name. There is +no error if the field does not exist. The comment value is ignored +since this operation only affects the field name. +.le +.ls verify = yes +Interactively verify all operations which modify the image database. +The editor will describe the operation to be performed, prompting with the +new value of the parameter in the case of a field edit. Type carriage +return or "yes" to complete the operation, or enter a new value explicitly +as a string. Respond with "no" if you do not wish to change the value of +the parameter. +.le +.ls show = yes +Print a record of each operation which modifies the database upon the standard +output. Old values are given as well as new values, making it possible to +undo an edit operation. +.le +.ls update = yes +Enable updating of the image database. If updating is disabled the edit +operations are performed in memory but image headers will not be updated +on disk. +.le +.ih +DESCRIPTION + +1. Basic Usage + + The most basic functions of the image header editor are modification and +inspection of the fields of an image header. Both the "standard" and +"user" fields may be edited in the same fashion, although not all standard +fields are writable. For example, to change the value of the standard field +"title" of the image "m74" to "sky flat" and enter a comment field we +would enter the following command. + + cl> nhedit m74 title "sky flat" "comment field" + +If \fIverify\fR mode is selected the editor will print the old value of the +field and query with the new value, allowing some other value to be entered +instead, e.g.: + +.nf + cl> nhedit m74 title "sky flat" "comment field" + m74,i_title ("old title" -> "sky flat"): +.fi + +To accept the new value shown to the right of the arrow, type carriage +return or "yes" or "y" followed by carriage return. To continue without +changing the value of the field in question enter "no" or "n" followed by +carriage return. To enter some other value merely type in the new value. +If the new value is one of the reserved strings, e.g., "yes" or "no", +enter it preceded by a backslash. If verification is enabled you will +also be asked if you want to update the header, once all header fields +have been edited. This is your last chance to change your mind before +the header is modified on disk. If you respond negatively the image header +will not be updated, and editing will continue with the next image. +If the response is "q" the editor will exit entirely. + +To conveniently print the value of the field "title" without modifying +the image header, we repeat the command with the special value "." and "." +for the comment portion. + + cl> nhedit m74 title . . + +To print (or edit) the values of all header fields a field template may be +given. + + cl> nhedit m74 * . . + +To print (or edit) the values of only a few fields the field template may +be given as a list. + + cl> nhedit m74 w0,wpc . . + +To print the value of one or more fields in a set of images, an image template +may be given. Both image templates and field templates may be given if +desired. + + cl> nhedit n1.* exp . . + +Abbreviations are not permitted for field names, i.e., the given template +must match the full field name. Currently, field name matches are case +insensitive since image headers are often converted to and from FITS headers, +which are case insensitive. + + +2. Advanced Usage + + The header editor is capable of performing global edits on entire image +databases wherein the new value of each field is computed automatically at +edit time and may depend on the values of other fields in the image header. +Editing may be performed in either batch or interactive mode. An audit trail +may be maintained (via the \fIshow\fR switch and i/o redirection), permitting +restoration of the database in the event of an error. Trial runs may be made +with updating disabled, before committing to an actual edit which modifies the +database. + +The major editing functions of the \fInhedit\fR task are the following: + +.nf + update modify the value of a field or fields + addonly add a new field + add add a new field or modify an old one + delete delete a set of fields + rename rename a set of fields +.fi + +In addition, \fInhedit\fR may be used merely to inspect the values of the header +fields, without modification of the image database. + +2.1 Special header fields + +.ks +.nf + add_blank Add blank keyword field with optional comment + ex: nhedit add_blank " this is a comment with no kw" + add_textf Add the content of a text file into the header + ex: nhedit add_textf "my_text.txt" add+ +.fi +.ke + +All keyword addition can be inserted after or before an existent keyword; use +the 'after' and 'before' parameter. + +2.2 Input commands from a command file. + +All header editing command can be put together in a text file and run it as: + +nhedit file*.fits comfile=command_file.txt + +2.3 Standard header fields + + The header editor may be used to access both the standard image header +fields and any user or application defined fields. The standard header fields +currently defined are shown below. There is no guarantee that the names and/or +usage of these fields will not change in the future. + + +.ks +.nf + i_ctime int create time + i_history string history comments + i_limtime int time when min,max last updated + i_maxpixval real maximum pixel value + i_minpixval real minimum pixel value + i_mtime int time of last modify + i_naxis int number of axes (dimensionality) + i_naxis[1-7] int length of each axis + i_pixfile string pathname of pixel storage file + i_pixtype int pixel datatype code + i_title string title string +.fi +.ke + + +The standard header field names have an "i_" prefix to reduce the possibility +of a name collision with a user field name, and to distinguish the two classes +of parameters in templates. The prefix may be omitted provided the simple +name is unique. + + +2.4 Field name template + + The form of the field name list or template parameter \fIfields\fR is +equivalent to that of a filename template except that "@listfile" is not +supported, and of course the template is expanded upon the field name list +of an image, rather than upon a directory. Abbreviations are not permitted +in field names and case is not significant. Case is ignored in this context +due to the present internal storage format for the user parameters (FITS), +which also limits the length of a user field name to 8 characters. + + +2.5 Value expression + + The \fIvalue\fR parameter is a string type parameter. If the first +character in the string is a left parenthesis the string is interpreted as +an algebraic expression wherein the operands may be constants, image header +variables (field names), special variables (defined below), or calls to +intrinsic functions. The expression syntax is equivalent to that used in +the CL and SPP languages. If the value string is not parenthesized it is +assumed to be a string constant. The \fIvalue\fR string will often contain +blanks, quotes, parenthesis, etc., and hence must usually be quoted to avoid +interpretation by the CL rather than by the header editor. + +For example, the command + + cl> nhedit m74 title "title // ';ss'" "." + +would change the title to the literal string constant "title // ';ss'", +whereas the command + + cl> nhedit m74 title "(title // ';ss')" "." + +would concatenate the string ";ss" to the old title string. We require +parenthesis for expression evaluation to avoid the need to doubly quote +simple string constant values, which would be even more confusing for the +user than using parenthesis. For example, if expressions did not have to +be parenthesized, the first example in the basic usage section would have +to be entered as shown below. + + cl> nhedit m74 title '"sky flat"' # invalid command + +Expression evaluation for \fInhedit\fR, \fIhselect\fR, and similar tasks +is carried out internally by the FMTIO library routine \fBevexpr\fR. +For completeness minimal documentation is given here, but the documentation +for \fIevexpr\fR itself should be consulted if additional detail is required +or if problems occur. + + +2.5.1 operators + + The following operators are recognized in value expressions. With the +exception of the operators "?", "?=", and "@", the operator set is equivalent +to that available in the CL and SPP languages. + + +.nf + + - * / arithmetic operators + ** exponentiation + // string concatenation + ! - boolean not, unary negation + < <= > >= order comparison (works for strings) + == != && || equals, not equals, and, or + ?= string equals pattern + ? : conditional expression + @ reference a variable +.fi + + +The operators "==", "&&", and "||" may be abbreviated as "=", "&", and "|" +if desired. The ?= operator performs pattern matching upon strings. +For example, the boolean expression shown below will be true whenever the +field "title" contains the substring "sky". + + (title ?= '*sky*') + +The conditional expression operator '?', which is patterned after a similar +operator in C, is used to make IF ELSE like decisions within an expression. +The syntax is as follows: + + <bool_expr> '?' <true_expr> ':' <false_expr> + +e.g., the expression + + ((a > b) ? 1 : 0) + +has the value 1 if A is greater than B, and 0 otherwise. The datatypes +of the true and false expressions need not be the same, unlike a compiled +language. Note that if the parenthesis are omitted ambiguous forms of +the expression are possible, e.g.: + + (a > b) ? 1 : a + 1 + +could be interpreted either as + + ((a > b) ? 1 : a) + 1 +or as + (a > b) ? 1 : (a + 1) + +If the parenthesis are omitted the latter interpretation is assumed. + +The operator @ must be used to dereference variables that have names with +funny (nonalphanumeric) characters in them, forcing the variable name to +be given as a string constant. For example, the value of the expression + + @"co-flag" + +is the value of the variable "co-flag". If the variable were referenced +directly by name the "-" would be interpreted as the subtraction operator, +causing an unknown variable reference (e.g., to "co"). +The operand following the @ may be any string valued expression. +The @ operator is right associative, hence the construct "@@param" is the +value of the parameter named by the value of the parameter "param". + +An expression may contain operands of datatypes bool, int, real, and string. +Mixed mode expressions are permitted with automatic type coercion. Most type +coercions from boolean or string to other datatypes are illegal. The boolean +constants "yes" and "no" are predefined and may be used within expressions. + + +2.5.2 intrinsic functions + + A number of standard intrinsic functions are recognized within expressions. +The set of functions currently supported is shown below. + + +.nf + abs acos asin atan atan2 bool cos + exp int log log10 max min mod + nint real sin sqrt str tan +.fi + + +The trigonometric functions operate in units of degrees rather than radians. +The \fImin\fR and \fImax\fR functions may have any number of arguments up +to a maximum of sixteen or so (configurable). The arguments need not all +be of the same datatype. + +A function call may take either of the following forms: + +.nf + <identifier> '(' arglist ')' +or + <string_expr> '(' arglist ')' +.fi + +The first form is the conventional form found in all programming languages. +The second permits the generation of function names by string valued +expressions and might be useful on rare occasions. + + +2.5.3 special operands + + As noted earlier, expression operands may be constants, variables (header +fields), function calls, or references to any of the special variables. +The following special variables are recognized within expressions: + + +.nf + . A string constant, used to flag printing + $ The value of the "current field" + $F The name of the "current field" + $I The name of the "current image" + $T The current clock time (an integer value) +.fi + + +These builtin variables are especially useful for constructing context +dependent expressions. For example, the value of a field may be incremented +by 100 by assigning it the value "$ + 100". + +.ih +EXAMPLES + +1. Globally edit the database "n1", setting the value of the string parameter +"obs" to "sky" if "s-flag" is 1, to "obj" otherwise. + + cl> nhedit n1.* obs '(@"s-flag" == 1 ? "sky" : "obj")' "Observation value" + +2. Globally edit the same database, replacing the value of the parameter +"variance" by the square root of the original value. + + cl> nhedit n1.* var '(sqrt(var))' "Variance value" + +3. Replace the values of the fields A and B by the absolute value of the +original value: + + cl> nhedit n1.* a,b '(abs($))' 'Absolute value' + +4. Add a blank field with a comment after a given field (K5DX). + + cl> nhedit file.fits add_blank "INSTRUMENT DESCRIPTION " after=k5dx add+ + + Notice the use of the special field value 'add_blank' which will be +replaced by a blank keyword in the header. + +5. Add HISTORY card before a given keyword + +.nf + cl> nhedit file.fits history \ + "History text from column 9 to 80, no quotes" before=wcsdim add+ + +.fi +6. Run a command file through the first 50 extensions +.nf + + cl> for(i=1;i<51;i=i+1) { + nhedit("mymef["//i//"]",comfile="home$hh.in") + } + +.fi +7. Add a text file to the header. This will be put as HISTORY lines with +text appropriately split when long lines are encountered. Start putting the +text after the keyword KEYWN. +.nf + + cl> nhedit add_textf "mytext_file.tx" after=KEYWN add+ + + +.fi +8. Run nhedit through all the extensions in a MEF file. Assuming it is 6, then: +.nf + + cl> for(i=1;i<7;i=i+1) + nhedit("mymef.fits["//i//"]",comfi="home$myheader.txt") + +.fi +9. Run several fits files with the same set of header commands from the file +"hdrc.txt". + + cl> nhedit file*.fits commfile=hdrc.txt + +As an example the 'hdrc.txt' content can be: (Notice the 'default_pars' command) + +.nf +# +# Sample command file for nhedit task. +# +# Establish the default parameters for the rest of the commands. + +default_pars upda+ add+ show- veri- + +# Notice the use of commas if you desire. +"DETECTOR" 'Newfirm', "comment string" +ONELE 'A' "comment to A" +# +# Now delete a keyword +ONELE1 del+ show+ +add_blank " /blank keyw" + +# add a boolean value T +ONELE1 '(1==1)', "comment to A" + + "DETSIZE", '[1:2048,1:2048]' + "ENVTEM", 1.5600000000000E+01 + +# Add a field with string value 'T' +ONELEi2 'T' + +bafkeyw1 123.456 "comment to key1" before="WCSDIM" addonly+ show- +add_blank "COMMENT FOR A BLANK" after="FR-SCALE" add+ show- +history "this is a hist to append" add+ show- +history "this is a hist 22 after trim pkey" after="TRIM" add+ show- +comment "this is a comment" after="FR-SCALE" add+ show- +# END OF HDRC.TXT FILE + +.fi +.ih +SEE ALSO +hselect, hedit, mkheader, imgets, imheader +.endhelp diff --git a/pkg/images/imutil/doc/sections.hlp b/pkg/images/imutil/doc/sections.hlp new file mode 100644 index 00000000..13579b62 --- /dev/null +++ b/pkg/images/imutil/doc/sections.hlp @@ -0,0 +1,119 @@ +.help sections Dec85 images.imutil +.ih +NAME +sections -- expand an image template +.ih +USAGE +sections images +.ih +PARAMETERS +.ls images +Image template or list of images. There is no check that the names are +images and any name may be used. The thing which distinguishes an image +template from a file template is that the special characters '[' and +']' are interpreted as image sections rather than a character class +wildcard unless preceded by the escape character '!'. To explicitly +limit a wildcard template to images one should use an appropriate +extension such as ".imh". +.le +.ls option = "fullname" +The options are: +.ls "nolist" +Do not print list. +.le +.ls "fullname" +Print the full image name for each image in the template. +.le +.ls "root" +Print the root name for each image in the template. +.le +.ls "section" +Print the section for each image in the template. +.le +.le +.ls nimages +The number of images in the image template. +.le +.ih +DESCRIPTION +The image template list \fIimages\fR is expanded and the images are printed +one per line on the standard output unless the "nolist" option is given. +Other options allow selection of a portion of the image name. The number +of images in the list is determined and stored in the parameter \fInimages\fR. + +This task is used for several purposes: +.ls (1) +To verify that an image template is expanded as the user desires. +.le +.ls (2) +To create a file of image names which include image sections. +.le +.ls (3) +To create a file of new image names using the concatenation feature of the +image templates. +.le +.ls (4) +To determine the number of images specified by the user in a command language +script. +.le + +There is no check that the names are images and any name may be used. +The thing which distinguishes an \fIimage template\fR from a \fIfile +template\fR is that the special characters '[' and ']' are interpreted +as image sections rather than a character class wildcard unless +preceded by the escape character '!'. To explicitly limit a wildcard +template to images one should use an appropriate extension such as ".imh". +.ih +EXAMPLES +1. Calculate and print the number of images in a template: + +.nf + cl> sections fits*.imh opti=no + cl> = sections.nimages + cl> 7 +.fi + +2. Expand an image template: + +.nf + cl> sections fits*![3-9].imh[1:10,*] + fits003.imh[1:10,*] + fits004.imh[1:10,*] + <etc.> +.fi + +Note the use of the character class escape, image section appending, +and explicit use of the .imh extension. + +3. Create a new list of image names by adding the suffix "new": + +.nf + cl> sections jan18???//new + jan18001new + jan18002new + <etc.> +.fi + +Note the use of the append syntax. Also there is no guarantee that the +files are actually images. + +4. Subtract two sets of images: + +.nf + cl> sections objs*.imh[100:200,300:400] > objslist + cl> sections skys*.imh[100:200,300:400] > skyslist + cl> sections %objs%bck%* > bcklist + cl> imarith @objslist - @skyslist @bcklist +.fi + +Note the use of the substitution syntax. + +.ih +TIME REQUIREMENTS +.ih +BUGS +The image list is not sorted. +.ih +SEE ALSO +files +.endhelp diff --git a/pkg/images/imutil/hedit.par b/pkg/images/imutil/hedit.par new file mode 100644 index 00000000..660f5eea --- /dev/null +++ b/pkg/images/imutil/hedit.par @@ -0,0 +1,9 @@ +images,s,a,,,,images to be edited +fields,s,a,,,,fields to be edited +value,s,a,,,,value expression +add,b,h,no,,,add rather than edit fields +addonly,b,h,no,,,add only if field does not exist +delete,b,h,no,,,delete rather than edit fields +verify,b,h,yes,,,verify each edit operation +show,b,h,yes,,,print record of each edit operation +update,b,h,yes,,,enable updating of the image header diff --git a/pkg/images/imutil/hselect.par b/pkg/images/imutil/hselect.par new file mode 100644 index 00000000..86fcf819 --- /dev/null +++ b/pkg/images/imutil/hselect.par @@ -0,0 +1,4 @@ +images,s,a,,,,images from which selection is to be drawn +fields,s,a,,,,fields to be extracted +expr,s,a,,,,boolean expression governing selection +missing,s,h,"INDEF",,,Value for missing keywords diff --git a/pkg/images/imutil/imarith.par b/pkg/images/imutil/imarith.par new file mode 100644 index 00000000..f0ea05ae --- /dev/null +++ b/pkg/images/imutil/imarith.par @@ -0,0 +1,11 @@ +operand1,f,a,,,,Operand image or numerical constant +op,s,a,"+","+|-|*|/|min|max",,Operator +operand2,f,a,,,,Operand image or numerical constant +result,f,a,,,,Resultant image +title,s,h,"",,,Title for resultant image +divzero,r,h,0.,,,Replacement value for division by zero +hparams,s,h,"",,,List of header parameters +pixtype,s,h,"",,,Pixel type for resultant image +calctype,s,h,"",,,Calculation data type +verbose,b,h,no,,,Print operations? +noact,b,h,no,,,Print operations without performing them? diff --git a/pkg/images/imutil/imcopy.par b/pkg/images/imutil/imcopy.par new file mode 100644 index 00000000..c72e68b7 --- /dev/null +++ b/pkg/images/imutil/imcopy.par @@ -0,0 +1,6 @@ +# Task parameters for IMCOPY. + +input,s,a,,,,Input images +output,s,a,,,,Output images or directory +verbose,b,h,yes,,,Print operations performed? +mode,s,h,ql diff --git a/pkg/images/imutil/imdelete.par b/pkg/images/imutil/imdelete.par new file mode 100644 index 00000000..c9ebf99b --- /dev/null +++ b/pkg/images/imutil/imdelete.par @@ -0,0 +1,7 @@ +# Task parameters for IMDELETE. + +images,s,a,,,,List of images to be deleted +verify,b,h,no,,,Verify operation before deleting each image? +default_action,b,h,yes,,,Default delete action for verify query +go_ahead,b,q,yes,,," ?" +mode,s,h,ql diff --git a/pkg/images/imutil/imdivide.par b/pkg/images/imutil/imdivide.par new file mode 100644 index 00000000..a7521611 --- /dev/null +++ b/pkg/images/imutil/imdivide.par @@ -0,0 +1,10 @@ +# Parameters for task imdivide. + +numerator,f,a,,,,Numerator image +denominator,f,a,,,,Denominator image +resultant,f,a,,,,Resultant image +title,s,h,'*',,,Title for the resultant image +constant,r,h,0,,,Constant replacement for zero division +rescale,s,h,numerator,,,"Rescale resultant mean (norescale, mean, numerator)" +mean,s,h,1,,,Mean for rescaling +verbose,b,h,no,,,Verbose output? diff --git a/pkg/images/imutil/imexpr.par b/pkg/images/imutil/imexpr.par new file mode 100644 index 00000000..8f019d70 --- /dev/null +++ b/pkg/images/imutil/imexpr.par @@ -0,0 +1,44 @@ +# IMEXPR parameters + +expr,s,a,,,,expression +output,f,a,,,,output image +dims,s,h,auto,,,output image dimensions +intype,s,h,auto,,,minimum type for input operands +outtype,s,h,auto,,,output image pixel datatype +refim,s,h,auto,,,reference image for wcs etc +bwidth,i,h,0,0,,boundary extension width +btype,s,h,nearest,"constant|nearest|reflect|wrap|project",,\ +"boundary extension type" +bpixval,r,h,0,,,boundary pixel value +rangecheck,b,h,yes,,,perform range checking +verbose,b,h,yes,,,print informative messages +exprdb,s,h,none,,,expression database +lastout,s,h,,,,last output image + +# Input image operands. +a,s,a,,,,operand a +b,s,a,,,,operand b +c,s,a,,,,operand c +d,s,a,,,,operand d +e,s,a,,,,operand e +f,s,a,,,,operand f +g,s,a,,,,operand g +h,s,a,,,,operand h +i,s,a,,,,operand i +j,s,a,,,,operand j +k,s,a,,,,operand k +l,s,a,,,,operand l +m,s,a,,,,operand m +n,s,a,,,,operand n +o,s,a,,,,operand o +p,s,a,,,,operand p +q,s,a,,,,operand q +r,s,a,,,,operand r +s,s,a,,,,operand s +t,s,a,,,,operand t +u,s,a,,,,operand u +v,s,a,,,,operand v +w,s,a,,,,operand w +x,s,a,,,,operand x +y,s,a,,,,operand y +z,s,a,,,,operand z diff --git a/pkg/images/imutil/imfunction.par b/pkg/images/imutil/imfunction.par new file mode 100644 index 00000000..f2c56184 --- /dev/null +++ b/pkg/images/imutil/imfunction.par @@ -0,0 +1,6 @@ +# Parameter file for IMFUNCTION + +input,s,a,,,,Input images +output,s,a,,,,Output images +function,s,a,,"log10|alog10|ln|aln|sqrt|square|cbrt|cube|abs|neg|cos|sin|tan|acos|asin|atan|hcos|hsin|htan|reciprocal",,Function +verbose,b,h,yes,,,Verbose mode? diff --git a/pkg/images/imutil/imgets.par b/pkg/images/imutil/imgets.par new file mode 100644 index 00000000..92f81f62 --- /dev/null +++ b/pkg/images/imutil/imgets.par @@ -0,0 +1,3 @@ +image,s,a,,,,image name +param,s,a,,,,image parameter to be returned +value,s,h,,,,output value of image parameter diff --git a/pkg/images/imutil/imheader.par b/pkg/images/imutil/imheader.par new file mode 100644 index 00000000..f8f9cc60 --- /dev/null +++ b/pkg/images/imutil/imheader.par @@ -0,0 +1,6 @@ +# Task parameters for IMHEADER. + +images,s,a,,,,image names +imlist,s,h,"*.imh,*.fits,*.pl,*.qp,*.hhh",,,default image names +longheader,b,h,no,,,print header in multi-line format +userfields,b,h,yes,,,print the user fields (instrument parameters) diff --git a/pkg/images/imutil/imhistogram.par b/pkg/images/imutil/imhistogram.par new file mode 100644 index 00000000..12911e63 --- /dev/null +++ b/pkg/images/imutil/imhistogram.par @@ -0,0 +1,13 @@ +image,s,a,,,,Image name +z1,r,h,INDEF,,,Minimum histogram intensity +z2,r,h,INDEF,,,Maximum histogram intensity +binwidth,r,h,INDEF,,,Resolution of histogram in intensity units +nbins,i,h,512,1,,Number of bins in histogram +autoscale,b,h,yes,,,Adjust nbins and z2 for integer data? +top_closed,b,h,no,,,Include z2 in the top bin? +hist_type,s,h,"normal","normal|cumulative|difference|second_difference",,"Type of histogram" +listout,b,h,no,,,List instead of plot histogram? +plot_type,s,h,"line","line|box",,Type of vectors to plot +logy,b,h,yes,,,Log scale y-axis? +device,s,h,"stdgraph",,,output graphics device +mode,s,h,ql,,, diff --git a/pkg/images/imutil/imjoin.par b/pkg/images/imutil/imjoin.par new file mode 100644 index 00000000..3588c1bc --- /dev/null +++ b/pkg/images/imutil/imjoin.par @@ -0,0 +1,5 @@ +input,s,a,,,,"Input images" +output,s,a,,,,"Output image" +join_dimension,i,a,,1,,"Dimension to be joined" +pixtype,s,h,"",,,"Output image pixel type" +verbose,s,h,yes,,,Print messages about progress of task ? diff --git a/pkg/images/imutil/imrename.par b/pkg/images/imutil/imrename.par new file mode 100644 index 00000000..0df86d66 --- /dev/null +++ b/pkg/images/imutil/imrename.par @@ -0,0 +1,3 @@ +oldnames,s,a,,,,images to be renamed +newnames,s,a,,,,new image names +verbose,b,h,no,,,report each rename operation diff --git a/pkg/images/imutil/imreplace.par b/pkg/images/imutil/imreplace.par new file mode 100644 index 00000000..57ba5108 --- /dev/null +++ b/pkg/images/imutil/imreplace.par @@ -0,0 +1,8 @@ +# Parameters for the IMREPLACE task. + +images,s,a,,,,Images to be edited +value,r,a,,,,Replacement pixel value +imaginary,r,h,0.,,,Imaginary component for complex +lower,r,h,INDEF,,,Lower limit of replacement window +upper,r,h,INDEF,,,Upper limit of replacement window +radius,r,h,0.,,,Replacement radius diff --git a/pkg/images/imutil/imslice.par b/pkg/images/imutil/imslice.par new file mode 100644 index 00000000..02823711 --- /dev/null +++ b/pkg/images/imutil/imslice.par @@ -0,0 +1,7 @@ +# IMSLICE + +input,f,a,,,,Input images +output,f,a,,,,Output images +slice_dimension,i,a,,,,Dimension to be sliced +verbose,b,h,y,,,Verbose mode +mode,s,h,'ql' diff --git a/pkg/images/imutil/imstack.par b/pkg/images/imutil/imstack.par new file mode 100644 index 00000000..c10d2120 --- /dev/null +++ b/pkg/images/imutil/imstack.par @@ -0,0 +1,7 @@ + +# Parmeter file for IMSTACK + +images,s,a,,,,Images to be stacked +output,f,a,,,,Output image +title,s,h,'*',,,Title of output image +pixtype,s,h,'*',,,Pixel datatype of output image diff --git a/pkg/images/imutil/imstatistics.par b/pkg/images/imutil/imstatistics.par new file mode 100644 index 00000000..34702430 --- /dev/null +++ b/pkg/images/imutil/imstatistics.par @@ -0,0 +1,10 @@ +images,s,a,,,,List of input images +fields,s,h,"image,npix,mean,stddev,min,max",,,Fields to be printed +lower,r,h,INDEF,,,Lower limit for pixel values +upper,r,h,INDEF,,,Upper limit for pixel values +nclip,i,h,0,0,,Number of clipping iterations +lsigma,r,h,3.0,0,,Lower side clipping factor in sigma +usigma,r,h,3.0,0,,Upper side clipping factor in sigma +binwidth,r,h,0.1,,,Bin width of histogram in sigma +format,b,h,yes,,,Format output and print column labels ? +cache,b,h,no,,,Cache image in memory ? diff --git a/pkg/images/imutil/imsum.par b/pkg/images/imutil/imsum.par new file mode 100644 index 00000000..956ba9a0 --- /dev/null +++ b/pkg/images/imutil/imsum.par @@ -0,0 +1,10 @@ +input,s,a,,,,Input images +output,s,a,,,,Output image +title,s,h,"",,,Title for output image +hparams,s,h,"",,,List of header parameters +pixtype,s,h,"",,,Pixel datatype of output image +calctype,s,h,"",,,Calculation type +option,s,h,"sum","sum|average|median",,Output option +low_reject,r,h,0,,,Fraction or number of low pixels to reject +high_reject,r,h,0,,,Fraction or number of high pixels to reject +verbose,b,h,no,,,Print log of operation? diff --git a/pkg/images/imutil/imtile.par b/pkg/images/imutil/imtile.par new file mode 100644 index 00000000..e009d919 --- /dev/null +++ b/pkg/images/imutil/imtile.par @@ -0,0 +1,21 @@ +# IMTILE + +input,f,a,,,,List of input image tiles +output,f,a,,,,Output tiled image +nctile,i,a,,,,Number of input tiles in the output column direction +nltile,i,a,,,,Number of input tiles in the output line direction +trim_section,s,h,"[*,*]",,,Input tile section +missing_input,s,h,"",,,List of missing image tiles +start_tile,s,h,"ll",,,Position in output image of first input tile +row_order,b,h,yes,,,Insert input tiles in row order ? +raster_order,b,h,no,,,Insert input tiles in raster scan order ? +median_section,s,h,"",,,Input tile section used to compute the median +subtract,b,h,no,,,Subtract the median pixel value from each input tile ? +ncols,i,h,INDEF,,,The number of columns in the output image +nlines,i,h,INDEF,,,The number of lines in the output image +ncoverlap,i,h,-1,,,Number of columns of overlap between adjacent tiles +nloverlap,i,h,-1,,,Number of lines of overlap between adjacent tiles +opixtype,s,h,"r",,,Output image pixel type +ovalue,r,h,0.0,,,Value of undefined output image pixels +verbose,b,h,yes,,,Print messages about progress of the task ? +mode,s,h,'ql' diff --git a/pkg/images/imutil/imutil.cl b/pkg/images/imutil/imutil.cl new file mode 100644 index 00000000..c7a853a3 --- /dev/null +++ b/pkg/images/imutil/imutil.cl @@ -0,0 +1,35 @@ +#{ IMUTIL -- The Image Utilities Package. + +set imutil = "images$imutil/" + +package imutil + +# Tasks. + +task chpixtype, + hedit, + hselect, + imarith, + _imaxes, + imcopy, + imdelete, + imdivide, + imexpr, + imfunction, + imgets, + imheader, + imhistogram, + imjoin, + imrename, + imreplace, + imslice, + imstack, + imsum, + imtile, + imstatistics, + listpixels, + minmax, + nhedit, + sections = "imutil$x_images.e" + +clbye() diff --git a/pkg/images/imutil/imutil.hd b/pkg/images/imutil/imutil.hd new file mode 100644 index 00000000..59206d90 --- /dev/null +++ b/pkg/images/imutil/imutil.hd @@ -0,0 +1,31 @@ +# Help directory for the IMUTIL package + +$doc = "images$imutil/doc/" +$src = "images$imutil/src/" + +chpixtype hlp=doc$chpix.hlp, src=src$t_chpix.x +hedit hlp=doc$hedit.hlp, src=src$hedit.x +nhedit hlp=doc$nhedit.hlp, src=src$nhedit.x +hselect hlp=doc$hselect.hlp, src=src$hselect.x +imarith hlp=doc$imarith.hlp, src=src$t_imarith.x +imcopy hlp=doc$imcopy.hlp, src=src$t_imcopy.x +imdelete hlp=doc$imdelete.hlp, src=src$imdelete.x +imdivide hlp=doc$imdivide.hlp, src=src$t_imdivide.x +imexpr hlp=doc$imexpr.hlp, src=src$imexpr.gx +imfunction hlp=doc$imfunction.hlp, src=src$imfunction.x +imgets hlp=doc$imgets.hlp, src=src$imgets.x +imheader hlp=doc$imheader.hlp, src=src$imheader.x +imhistogram hlp=doc$imhistogram.hlp, src=src$imhistogram.x +imjoin hlp=doc$imjoin.hlp, src=src$t_imjoin.x +imrename hlp=doc$imrename.hlp, src=src$t_imrename.x +imreplace hlp=doc$imreplace.hlp, src=src$t_imreplace.x +imslice hlp=doc$imslice.hlp, src=src$t_imslice.x +imstack hlp=doc$imstack.hlp, src=src$t_imstack.x +imstatistics hlp=doc$imstat.hlp, src=src$t_imstat.x +imsum hlp=doc$imsum.hlp, src=src$t_imsum.x +imtile hlp=doc$imtile.hlp, src=src$t_imtile.x +listpixels hlp=doc$listpixels.hlp, src=src$listpixels.x +minmax hlp=doc$minmax.hlp, src=src$t_minmax.x +sections hlp=doc$sections.hlp, src=src$t_sections.x +revisions sys=Revisions + diff --git a/pkg/images/imutil/imutil.men b/pkg/images/imutil/imutil.men new file mode 100644 index 00000000..137bc6a8 --- /dev/null +++ b/pkg/images/imutil/imutil.men @@ -0,0 +1,25 @@ + chpixtype - Change the pixel type of a list of images + hedit - Header editor + nhedit - Edit image header using a command file + hselect - Select a subset of images satisfying a boolean expression + imarith - Simple image arithmetic + imcopy - Copy an image + imdelete - Delete a list of images + imdivide - Image division with zero checking and rescaling + imexpr - Evaluate a general image expression + imfunction - Apply a single argument function to a list of images + imgets - Return the value of an image header parameter as a string + imheader - Print an image header + imhistogram - Compute and plot or print an image histogram + imjoin - Join images along a given dimension + imrename - Rename one or more images + imreplace - Replace a range of pixel values with a constant + imslice - Slice images into images of lower dimension + imstack - Stack images into a single image of higher dimension + imsum - Compute the sum, average, or median of a set of images + imtile - Tile same sized 2D images into a 2D mosaic + imstatistics - Compute and print statistics for a list of images + listpixels - Convert an image section into a list of pixels + minmax - Compute the minimum and maximum pixel values in an image + sections - Expand an image template on the standard output + diff --git a/pkg/images/imutil/imutil.par b/pkg/images/imutil/imutil.par new file mode 100644 index 00000000..cef3f3ff --- /dev/null +++ b/pkg/images/imutil/imutil.par @@ -0,0 +1 @@ +version,s,h,"Jan97" diff --git a/pkg/images/imutil/listpixels.par b/pkg/images/imutil/listpixels.par new file mode 100644 index 00000000..a5a00d4c --- /dev/null +++ b/pkg/images/imutil/listpixels.par @@ -0,0 +1,4 @@ +images,f,a,,,,Images to be converted to list form +wcs,s,h,"logical",,,Output world coordinate system name +formats,s,h,"",,,List of pixel coordinate formats +verbose,b,h,no,,,Print banner for each input image diff --git a/pkg/images/imutil/minmax.par b/pkg/images/imutil/minmax.par new file mode 100644 index 00000000..8f87d352 --- /dev/null +++ b/pkg/images/imutil/minmax.par @@ -0,0 +1,10 @@ +images,s,a,,,,Images to be examined +force,b,h,no,,,Force recomputation of extreme values? +update,b,h,yes,,,Update the image header? +verbose,b,h,yes,,,Print computed values? +minval,r,h,INDEF,,,Minimum pixel value in image (real part) +maxval,r,h,INDEF,,,Maximum pixel value in image (real part) +iminval,r,h,INDEF,,,Minimum pixel value in image (imaginary part) +imaxval,r,h,INDEF,,,Maximum pixel value in image (imaginary part) +minpix,s,h,,,,Minimum pixel (section notation) +maxpix,s,h,,,,Maximum pixel (section notation) diff --git a/pkg/images/imutil/mkpkg b/pkg/images/imutil/mkpkg new file mode 100644 index 00000000..01b517b0 --- /dev/null +++ b/pkg/images/imutil/mkpkg @@ -0,0 +1,5 @@ +# MKPKG for the IMUTIL Package + +libpkg.a: + @src + ; diff --git a/pkg/images/imutil/nhedit.par b/pkg/images/imutil/nhedit.par new file mode 100644 index 00000000..76eab2c5 --- /dev/null +++ b/pkg/images/imutil/nhedit.par @@ -0,0 +1,14 @@ +images,s,a,,,,Images to be operated upon +fields,s,a,,,,fields to be edited +value,s,a,.,,,value expression +comment,s,a,'.',,,Keyword comment +comfile,s,h,"",,,Command file +after,s,h,"",,,keyword name to insert after +before,s,h,"",,,keyword name to insert before +update,b,h,yes,,,Update image header? +add,b,h,no,,,add rather than edit fields +addonly,b,h,no,,,add only if field does not exist +delete,b,h,no,,,delete rather than edit fields +rename,b,h,no,,,rename field names +verify,b,h,yes,,,verify each edit operation +show,b,h,yes,,,print record of each edit operation diff --git a/pkg/images/imutil/sections.par b/pkg/images/imutil/sections.par new file mode 100644 index 00000000..1f585d6c --- /dev/null +++ b/pkg/images/imutil/sections.par @@ -0,0 +1,5 @@ +# SECTIONS -- Expand an image template. + +images,s,a,,,,Image template +option,s,h,"fullname",,,"Option (nolist, fullname, root, section)" +nimages,i,h,,,,Number of images in template diff --git a/pkg/images/imutil/src/generic/imaadd.x b/pkg/images/imutil/src/generic/imaadd.x new file mode 100644 index 00000000..cd492467 --- /dev/null +++ b/pkg/images/imutil/src/generic/imaadd.x @@ -0,0 +1,255 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + + +# IMA_ADD -- Image arithmetic addition. + +procedure ima_adds (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +short a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nls() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector/scalar + # addition to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nls (im, buf, v, 2) != EOF) { + if (a == 0) + call amovs (Mems[buf[2]], Mems[buf[1]], len) + else + call aaddks (Mems[buf[2]], a, Mems[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # addition to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nls (im, buf, v, 2) != EOF) { + if (b == 0) + call amovs (Mems[buf[2]], Mems[buf[1]], len) + else + call aaddks (Mems[buf[2]], b, Mems[buf[1]], len) + } + + # Read imagea and imageb and do a vector addition into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nls (im, buf, v, 3) != EOF) + call aadds (Mems[buf[2]], Mems[buf[3]], Mems[buf[1]], len) + } +end + +# IMA_ADD -- Image arithmetic addition. + +procedure ima_addi (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +int a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nli() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector/scalar + # addition to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nli (im, buf, v, 2) != EOF) { + if (a == 0) + call amovi (Memi[buf[2]], Memi[buf[1]], len) + else + call aaddki (Memi[buf[2]], a, Memi[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # addition to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nli (im, buf, v, 2) != EOF) { + if (b == 0) + call amovi (Memi[buf[2]], Memi[buf[1]], len) + else + call aaddki (Memi[buf[2]], b, Memi[buf[1]], len) + } + + # Read imagea and imageb and do a vector addition into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nli (im, buf, v, 3) != EOF) + call aaddi (Memi[buf[2]], Memi[buf[3]], Memi[buf[1]], len) + } +end + +# IMA_ADD -- Image arithmetic addition. + +procedure ima_addl (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +long a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nll() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector/scalar + # addition to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nll (im, buf, v, 2) != EOF) { + if (a == 0) + call amovl (Meml[buf[2]], Meml[buf[1]], len) + else + call aaddkl (Meml[buf[2]], a, Meml[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # addition to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nll (im, buf, v, 2) != EOF) { + if (b == 0) + call amovl (Meml[buf[2]], Meml[buf[1]], len) + else + call aaddkl (Meml[buf[2]], b, Meml[buf[1]], len) + } + + # Read imagea and imageb and do a vector addition into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nll (im, buf, v, 3) != EOF) + call aaddl (Meml[buf[2]], Meml[buf[3]], Meml[buf[1]], len) + } +end + +# IMA_ADD -- Image arithmetic addition. + +procedure ima_addr (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +real a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nlr() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector/scalar + # addition to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nlr (im, buf, v, 2) != EOF) { + if (a == 0.0) + call amovr (Memr[buf[2]], Memr[buf[1]], len) + else + call aaddkr (Memr[buf[2]], a, Memr[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # addition to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nlr (im, buf, v, 2) != EOF) { + if (b == 0.0) + call amovr (Memr[buf[2]], Memr[buf[1]], len) + else + call aaddkr (Memr[buf[2]], b, Memr[buf[1]], len) + } + + # Read imagea and imageb and do a vector addition into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nlr (im, buf, v, 3) != EOF) + call aaddr (Memr[buf[2]], Memr[buf[3]], Memr[buf[1]], len) + } +end + +# IMA_ADD -- Image arithmetic addition. + +procedure ima_addd (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +double a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nld() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector/scalar + # addition to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nld (im, buf, v, 2) != EOF) { + if (a == 0.0D0) + call amovd (Memd[buf[2]], Memd[buf[1]], len) + else + call aaddkd (Memd[buf[2]], a, Memd[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # addition to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nld (im, buf, v, 2) != EOF) { + if (b == 0.0D0) + call amovd (Memd[buf[2]], Memd[buf[1]], len) + else + call aaddkd (Memd[buf[2]], b, Memd[buf[1]], len) + } + + # Read imagea and imageb and do a vector addition into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nld (im, buf, v, 3) != EOF) + call aaddd (Memd[buf[2]], Memd[buf[3]], Memd[buf[1]], len) + } +end + diff --git a/pkg/images/imutil/src/generic/imadiv.x b/pkg/images/imutil/src/generic/imadiv.x new file mode 100644 index 00000000..1de8b194 --- /dev/null +++ b/pkg/images/imutil/src/generic/imadiv.x @@ -0,0 +1,347 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_DIV -- Image arithmetic division. + + +procedure ima_divs (im_a, im_b, im_c, a, b, c) + +pointer im_a, im_b, im_c +short a, b, c + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nls() +short ima_efncs() +extern ima_efncs + +short divzero +common /imadcoms/ divzero + +begin + # Loop through all of the image lines. + divzero = c + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector + # reciprical to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nls (im, buf, v, 2) != EOF) + call arczs (a, Mems[buf[2]], Mems[buf[1]], len, + ima_efncs) + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector/scalar + # divide to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nls (im, buf, v, 2) != EOF) { + if (b == 0) + call amovks (divzero, Mems[buf[1]], len) + else if (b == 1) + call amovs (Mems[buf[2]], Mems[buf[1]], len) + else + call adivks (Mems[buf[2]], b, Mems[buf[1]], len) + } + + # Read imagea and imageb and do the vector divide to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nls (im, buf, v, 3) != EOF) + call advzs (Mems[buf[2]], Mems[buf[3]], Mems[buf[1]], + len, ima_efncs) + } +end + + +# IMA_EFNC -- Error function for division by zero. + +short procedure ima_efncs (a) + +short a +short divzero +common /imadcoms/ divzero + +begin + return (divzero) +end + +procedure ima_divi (im_a, im_b, im_c, a, b, c) + +pointer im_a, im_b, im_c +int a, b, c + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nli() +int ima_efnci() +extern ima_efnci + +int divzero +common /imadcomi/ divzero + +begin + # Loop through all of the image lines. + divzero = c + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector + # reciprical to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nli (im, buf, v, 2) != EOF) + call arczi (a, Memi[buf[2]], Memi[buf[1]], len, + ima_efnci) + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector/scalar + # divide to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nli (im, buf, v, 2) != EOF) { + if (b == 0) + call amovki (divzero, Memi[buf[1]], len) + else if (b == 1) + call amovi (Memi[buf[2]], Memi[buf[1]], len) + else + call adivki (Memi[buf[2]], b, Memi[buf[1]], len) + } + + # Read imagea and imageb and do the vector divide to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nli (im, buf, v, 3) != EOF) + call advzi (Memi[buf[2]], Memi[buf[3]], Memi[buf[1]], + len, ima_efnci) + } +end + + +# IMA_EFNC -- Error function for division by zero. + +int procedure ima_efnci (a) + +int a +int divzero +common /imadcomi/ divzero + +begin + return (divzero) +end + +procedure ima_divl (im_a, im_b, im_c, a, b, c) + +pointer im_a, im_b, im_c +long a, b, c + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nll() +long ima_efncl() +extern ima_efncl + +long divzero +common /imadcoml/ divzero + +begin + # Loop through all of the image lines. + divzero = c + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector + # reciprical to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nll (im, buf, v, 2) != EOF) + call arczl (a, Meml[buf[2]], Meml[buf[1]], len, + ima_efncl) + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector/scalar + # divide to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nll (im, buf, v, 2) != EOF) { + if (b == 0) + call amovkl (divzero, Meml[buf[1]], len) + else if (b == 1) + call amovl (Meml[buf[2]], Meml[buf[1]], len) + else + call adivkl (Meml[buf[2]], b, Meml[buf[1]], len) + } + + # Read imagea and imageb and do the vector divide to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nll (im, buf, v, 3) != EOF) + call advzl (Meml[buf[2]], Meml[buf[3]], Meml[buf[1]], + len, ima_efncl) + } +end + + +# IMA_EFNC -- Error function for division by zero. + +long procedure ima_efncl (a) + +long a +long divzero +common /imadcoml/ divzero + +begin + return (divzero) +end + +procedure ima_divr (im_a, im_b, im_c, a, b, c) + +pointer im_a, im_b, im_c +real a, b, c + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nlr() +real ima_efncr() +extern ima_efncr + +real divzero +common /imadcomr/ divzero + +begin + # Loop through all of the image lines. + divzero = c + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector + # reciprical to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nlr (im, buf, v, 2) != EOF) + call arczr (a, Memr[buf[2]], Memr[buf[1]], len, + ima_efncr) + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector/scalar + # divide to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nlr (im, buf, v, 2) != EOF) { + if (b == 0.0) + call amovkr (divzero, Memr[buf[1]], len) + else if (b == 1.0) + call amovr (Memr[buf[2]], Memr[buf[1]], len) + else + call adivkr (Memr[buf[2]], b, Memr[buf[1]], len) + } + + # Read imagea and imageb and do the vector divide to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nlr (im, buf, v, 3) != EOF) + call advzr (Memr[buf[2]], Memr[buf[3]], Memr[buf[1]], + len, ima_efncr) + } +end + + +# IMA_EFNC -- Error function for division by zero. + +real procedure ima_efncr (a) + +real a +real divzero +common /imadcomr/ divzero + +begin + return (divzero) +end + +procedure ima_divd (im_a, im_b, im_c, a, b, c) + +pointer im_a, im_b, im_c +double a, b, c + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nld() +double ima_efncd() +extern ima_efncd + +double divzero +common /imadcomd/ divzero + +begin + # Loop through all of the image lines. + divzero = c + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector + # reciprical to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nld (im, buf, v, 2) != EOF) + call arczd (a, Memd[buf[2]], Memd[buf[1]], len, + ima_efncd) + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector/scalar + # divide to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nld (im, buf, v, 2) != EOF) { + if (b == 0.0D0) + call amovkd (divzero, Memd[buf[1]], len) + else if (b == 1.0D0) + call amovd (Memd[buf[2]], Memd[buf[1]], len) + else + call adivkd (Memd[buf[2]], b, Memd[buf[1]], len) + } + + # Read imagea and imageb and do the vector divide to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nld (im, buf, v, 3) != EOF) + call advzd (Memd[buf[2]], Memd[buf[3]], Memd[buf[1]], + len, ima_efncd) + } +end + + +# IMA_EFNC -- Error function for division by zero. + +double procedure ima_efncd (a) + +double a +double divzero +common /imadcomd/ divzero + +begin + return (divzero) +end + diff --git a/pkg/images/imutil/src/generic/imamax.x b/pkg/images/imutil/src/generic/imamax.x new file mode 100644 index 00000000..36fec944 --- /dev/null +++ b/pkg/images/imutil/src/generic/imamax.x @@ -0,0 +1,212 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_MAX -- Image arithmetic maximum value. + + +procedure ima_maxs (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +short a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nls() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # maximum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nls (im, buf, v, 2) != EOF) + call amaxks (Mems[buf[2]], a, Mems[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # maximum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nls (im, buf, v, 2) != EOF) + call amaxks (Mems[buf[2]], b, Mems[buf[1]], len) + + # Read imagea and imageb and do a vector-vector maximum + # operation to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nls (im, buf, v, 3) != EOF) + call amaxs (Mems[buf[2]], Mems[buf[3]], Mems[buf[1]], len) + } +end + +procedure ima_maxi (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +int a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nli() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # maximum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nli (im, buf, v, 2) != EOF) + call amaxki (Memi[buf[2]], a, Memi[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # maximum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nli (im, buf, v, 2) != EOF) + call amaxki (Memi[buf[2]], b, Memi[buf[1]], len) + + # Read imagea and imageb and do a vector-vector maximum + # operation to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nli (im, buf, v, 3) != EOF) + call amaxi (Memi[buf[2]], Memi[buf[3]], Memi[buf[1]], len) + } +end + +procedure ima_maxl (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +long a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nll() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # maximum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nll (im, buf, v, 2) != EOF) + call amaxkl (Meml[buf[2]], a, Meml[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # maximum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nll (im, buf, v, 2) != EOF) + call amaxkl (Meml[buf[2]], b, Meml[buf[1]], len) + + # Read imagea and imageb and do a vector-vector maximum + # operation to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nll (im, buf, v, 3) != EOF) + call amaxl (Meml[buf[2]], Meml[buf[3]], Meml[buf[1]], len) + } +end + +procedure ima_maxr (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +real a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nlr() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # maximum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nlr (im, buf, v, 2) != EOF) + call amaxkr (Memr[buf[2]], a, Memr[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # maximum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nlr (im, buf, v, 2) != EOF) + call amaxkr (Memr[buf[2]], b, Memr[buf[1]], len) + + # Read imagea and imageb and do a vector-vector maximum + # operation to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nlr (im, buf, v, 3) != EOF) + call amaxr (Memr[buf[2]], Memr[buf[3]], Memr[buf[1]], len) + } +end + +procedure ima_maxd (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +double a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nld() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # maximum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nld (im, buf, v, 2) != EOF) + call amaxkd (Memd[buf[2]], a, Memd[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # maximum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nld (im, buf, v, 2) != EOF) + call amaxkd (Memd[buf[2]], b, Memd[buf[1]], len) + + # Read imagea and imageb and do a vector-vector maximum + # operation to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nld (im, buf, v, 3) != EOF) + call amaxd (Memd[buf[2]], Memd[buf[3]], Memd[buf[1]], len) + } +end + diff --git a/pkg/images/imutil/src/generic/imamin.x b/pkg/images/imutil/src/generic/imamin.x new file mode 100644 index 00000000..5124db41 --- /dev/null +++ b/pkg/images/imutil/src/generic/imamin.x @@ -0,0 +1,212 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_MIN -- Image arithmetic minimum value. + + +procedure ima_mins (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +short a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nls() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # minimum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nls (im, buf, v, 2) != EOF) + call aminks (Mems[buf[2]], a, Mems[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # minimum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nls (im, buf, v, 2) != EOF) + call aminks (Mems[buf[2]], b, Mems[buf[1]], len) + + # Read imagea and imageb and do a vector-vector minimum operation + # to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nls (im, buf, v, 3) != EOF) + call amins (Mems[buf[2]], Mems[buf[3]], Mems[buf[1]], len) + } +end + +procedure ima_mini (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +int a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nli() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # minimum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nli (im, buf, v, 2) != EOF) + call aminki (Memi[buf[2]], a, Memi[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # minimum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nli (im, buf, v, 2) != EOF) + call aminki (Memi[buf[2]], b, Memi[buf[1]], len) + + # Read imagea and imageb and do a vector-vector minimum operation + # to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nli (im, buf, v, 3) != EOF) + call amini (Memi[buf[2]], Memi[buf[3]], Memi[buf[1]], len) + } +end + +procedure ima_minl (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +long a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nll() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # minimum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nll (im, buf, v, 2) != EOF) + call aminkl (Meml[buf[2]], a, Meml[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # minimum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nll (im, buf, v, 2) != EOF) + call aminkl (Meml[buf[2]], b, Meml[buf[1]], len) + + # Read imagea and imageb and do a vector-vector minimum operation + # to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nll (im, buf, v, 3) != EOF) + call aminl (Meml[buf[2]], Meml[buf[3]], Meml[buf[1]], len) + } +end + +procedure ima_minr (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +real a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nlr() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # minimum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nlr (im, buf, v, 2) != EOF) + call aminkr (Memr[buf[2]], a, Memr[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # minimum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nlr (im, buf, v, 2) != EOF) + call aminkr (Memr[buf[2]], b, Memr[buf[1]], len) + + # Read imagea and imageb and do a vector-vector minimum operation + # to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nlr (im, buf, v, 3) != EOF) + call aminr (Memr[buf[2]], Memr[buf[3]], Memr[buf[1]], len) + } +end + +procedure ima_mind (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +double a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nld() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # minimum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nld (im, buf, v, 2) != EOF) + call aminkd (Memd[buf[2]], a, Memd[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # minimum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nld (im, buf, v, 2) != EOF) + call aminkd (Memd[buf[2]], b, Memd[buf[1]], len) + + # Read imagea and imageb and do a vector-vector minimum operation + # to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nld (im, buf, v, 3) != EOF) + call amind (Memd[buf[2]], Memd[buf[3]], Memd[buf[1]], len) + } +end + diff --git a/pkg/images/imutil/src/generic/imamul.x b/pkg/images/imutil/src/generic/imamul.x new file mode 100644 index 00000000..05fdf8a4 --- /dev/null +++ b/pkg/images/imutil/src/generic/imamul.x @@ -0,0 +1,257 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_MUL -- Image arithmetic multiplication. + + +procedure ima_muls (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +short a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nls() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nls (im, buf, v, 2) != EOF) { + if (a == 1) + call amovs (Mems[buf[2]], Mems[buf[1]], len) + else + call amulks (Mems[buf[2]], a, Mems[buf[1]], len) + } + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nls (im, buf, v, 2) != EOF) { + if (b == 1) + call amovs (Mems[buf[2]], Mems[buf[1]], len) + else + call amulks (Mems[buf[2]], b, Mems[buf[1]], len) + } + + # Read imagea and imageb and do the vector multiply to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nls (im, buf, v, 3) != EOF) + call amuls (Mems[buf[2]], Mems[buf[3]], Mems[buf[1]], len) + } +end + +procedure ima_muli (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +int a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nli() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nli (im, buf, v, 2) != EOF) { + if (a == 1) + call amovi (Memi[buf[2]], Memi[buf[1]], len) + else + call amulki (Memi[buf[2]], a, Memi[buf[1]], len) + } + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nli (im, buf, v, 2) != EOF) { + if (b == 1) + call amovi (Memi[buf[2]], Memi[buf[1]], len) + else + call amulki (Memi[buf[2]], b, Memi[buf[1]], len) + } + + # Read imagea and imageb and do the vector multiply to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nli (im, buf, v, 3) != EOF) + call amuli (Memi[buf[2]], Memi[buf[3]], Memi[buf[1]], len) + } +end + +procedure ima_mull (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +long a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nll() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nll (im, buf, v, 2) != EOF) { + if (a == 1) + call amovl (Meml[buf[2]], Meml[buf[1]], len) + else + call amulkl (Meml[buf[2]], a, Meml[buf[1]], len) + } + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nll (im, buf, v, 2) != EOF) { + if (b == 1) + call amovl (Meml[buf[2]], Meml[buf[1]], len) + else + call amulkl (Meml[buf[2]], b, Meml[buf[1]], len) + } + + # Read imagea and imageb and do the vector multiply to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nll (im, buf, v, 3) != EOF) + call amull (Meml[buf[2]], Meml[buf[3]], Meml[buf[1]], len) + } +end + +procedure ima_mulr (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +real a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nlr() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nlr (im, buf, v, 2) != EOF) { + if (a == 1.0) + call amovr (Memr[buf[2]], Memr[buf[1]], len) + else + call amulkr (Memr[buf[2]], a, Memr[buf[1]], len) + } + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nlr (im, buf, v, 2) != EOF) { + if (b == 1.0) + call amovr (Memr[buf[2]], Memr[buf[1]], len) + else + call amulkr (Memr[buf[2]], b, Memr[buf[1]], len) + } + + # Read imagea and imageb and do the vector multiply to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nlr (im, buf, v, 3) != EOF) + call amulr (Memr[buf[2]], Memr[buf[3]], Memr[buf[1]], len) + } +end + +procedure ima_muld (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +double a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nld() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nld (im, buf, v, 2) != EOF) { + if (a == 1.0D0) + call amovd (Memd[buf[2]], Memd[buf[1]], len) + else + call amulkd (Memd[buf[2]], a, Memd[buf[1]], len) + } + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nld (im, buf, v, 2) != EOF) { + if (b == 1.0D0) + call amovd (Memd[buf[2]], Memd[buf[1]], len) + else + call amulkd (Memd[buf[2]], b, Memd[buf[1]], len) + } + + # Read imagea and imageb and do the vector multiply to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nld (im, buf, v, 3) != EOF) + call amuld (Memd[buf[2]], Memd[buf[3]], Memd[buf[1]], len) + } +end + diff --git a/pkg/images/imutil/src/generic/imanl.x b/pkg/images/imutil/src/generic/imanl.x new file mode 100644 index 00000000..8ec958c4 --- /dev/null +++ b/pkg/images/imutil/src/generic/imanl.x @@ -0,0 +1,159 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_NL -- For each line in the output image lines from the input images +# are returned. The input images are repeated as necessary. EOF is returned +# when the last line of the output image has been reached. One dimensional +# images are read only once and the data pointers are assumed to be unchanged +# from previous calls. The image line vectors must be initialized externally +# and then left untouched. +# +# This procedure is typically used when operations upon lines or pixels +# make sense in mixed dimensioned images. For example to add a one dimensional +# image to all lines of a higher dimensional image or to subtract a +# two dimensional image from all bands of three dimensional image. +# The lengths of the common dimensions should generally be checked +# for equality with xt_imleneq. + + +int procedure ima_nls (im, data, v, nimages) + +pointer im[nimages] # IMIO pointers; the first one is the output +pointer data[nimages] # Returned data pointers +long v[IM_MAXDIM, nimages] # Line vectors +int nimages # Number of images + +int i + +int impnls(), imgnls() + +begin + if (impnls (im[1], data[1], v[1,1]) == EOF) + return (EOF) + + for (i=2; i <= nimages; i=i+1) { + if (imgnls (im[i], data[i], v[1,i]) == EOF) { + if (IM_NDIM(im[i]) > 1) { + call amovkl (long(1), v[1,i], IM_MAXDIM) + if (imgnls (im[i], data[i], v[1,i]) == EOF) + call error (0, "Error reading image line") + } + } + } + + return (OK) +end + +int procedure ima_nli (im, data, v, nimages) + +pointer im[nimages] # IMIO pointers; the first one is the output +pointer data[nimages] # Returned data pointers +long v[IM_MAXDIM, nimages] # Line vectors +int nimages # Number of images + +int i + +int impnli(), imgnli() + +begin + if (impnli (im[1], data[1], v[1,1]) == EOF) + return (EOF) + + for (i=2; i <= nimages; i=i+1) { + if (imgnli (im[i], data[i], v[1,i]) == EOF) { + if (IM_NDIM(im[i]) > 1) { + call amovkl (long(1), v[1,i], IM_MAXDIM) + if (imgnli (im[i], data[i], v[1,i]) == EOF) + call error (0, "Error reading image line") + } + } + } + + return (OK) +end + +int procedure ima_nll (im, data, v, nimages) + +pointer im[nimages] # IMIO pointers; the first one is the output +pointer data[nimages] # Returned data pointers +long v[IM_MAXDIM, nimages] # Line vectors +int nimages # Number of images + +int i + +int impnll(), imgnll() + +begin + if (impnll (im[1], data[1], v[1,1]) == EOF) + return (EOF) + + for (i=2; i <= nimages; i=i+1) { + if (imgnll (im[i], data[i], v[1,i]) == EOF) { + if (IM_NDIM(im[i]) > 1) { + call amovkl (long(1), v[1,i], IM_MAXDIM) + if (imgnll (im[i], data[i], v[1,i]) == EOF) + call error (0, "Error reading image line") + } + } + } + + return (OK) +end + +int procedure ima_nlr (im, data, v, nimages) + +pointer im[nimages] # IMIO pointers; the first one is the output +pointer data[nimages] # Returned data pointers +long v[IM_MAXDIM, nimages] # Line vectors +int nimages # Number of images + +int i + +int impnlr(), imgnlr() + +begin + if (impnlr (im[1], data[1], v[1,1]) == EOF) + return (EOF) + + for (i=2; i <= nimages; i=i+1) { + if (imgnlr (im[i], data[i], v[1,i]) == EOF) { + if (IM_NDIM(im[i]) > 1) { + call amovkl (long(1), v[1,i], IM_MAXDIM) + if (imgnlr (im[i], data[i], v[1,i]) == EOF) + call error (0, "Error reading image line") + } + } + } + + return (OK) +end + +int procedure ima_nld (im, data, v, nimages) + +pointer im[nimages] # IMIO pointers; the first one is the output +pointer data[nimages] # Returned data pointers +long v[IM_MAXDIM, nimages] # Line vectors +int nimages # Number of images + +int i + +int impnld(), imgnld() + +begin + if (impnld (im[1], data[1], v[1,1]) == EOF) + return (EOF) + + for (i=2; i <= nimages; i=i+1) { + if (imgnld (im[i], data[i], v[1,i]) == EOF) { + if (IM_NDIM(im[i]) > 1) { + call amovkl (long(1), v[1,i], IM_MAXDIM) + if (imgnld (im[i], data[i], v[1,i]) == EOF) + call error (0, "Error reading image line") + } + } + } + + return (OK) +end + diff --git a/pkg/images/imutil/src/generic/imasub.x b/pkg/images/imutil/src/generic/imasub.x new file mode 100644 index 00000000..1a0fcb2c --- /dev/null +++ b/pkg/images/imutil/src/generic/imasub.x @@ -0,0 +1,252 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_SUB -- Image arithmetic subtraction. + + +procedure ima_subs (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +short a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nls() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. Do a vector/scalar + # subtraction and then negate the result. + if (im_a == NULL) { + im[2] = im_b + while (ima_nls (im, buf, v, 2) != EOF) { + if (a != 0) { + call asubks (Mems[buf[2]], a, Mems[buf[1]], len) + call anegs (Mems[buf[1]], Mems[buf[1]], len) + } else + call anegs (Mems[buf[2]], Mems[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # subtraction to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nls (im, buf, v, 2) != EOF) { + if (b == 0) + call amovs (Mems[buf[2]], Mems[buf[1]], len) + else + call asubks (Mems[buf[2]], b, Mems[buf[1]], len) + } + + # Read imagea and imageb and do a vector subtraction into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nls (im, buf, v, 3) != EOF) + call asubs (Mems[buf[2]], Mems[buf[3]], Mems[buf[1]], len) + } +end + +procedure ima_subi (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +int a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nli() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. Do a vector/scalar + # subtraction and then negate the result. + if (im_a == NULL) { + im[2] = im_b + while (ima_nli (im, buf, v, 2) != EOF) { + if (a != 0) { + call asubki (Memi[buf[2]], a, Memi[buf[1]], len) + call anegi (Memi[buf[1]], Memi[buf[1]], len) + } else + call anegi (Memi[buf[2]], Memi[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # subtraction to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nli (im, buf, v, 2) != EOF) { + if (b == 0) + call amovi (Memi[buf[2]], Memi[buf[1]], len) + else + call asubki (Memi[buf[2]], b, Memi[buf[1]], len) + } + + # Read imagea and imageb and do a vector subtraction into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nli (im, buf, v, 3) != EOF) + call asubi (Memi[buf[2]], Memi[buf[3]], Memi[buf[1]], len) + } +end + +procedure ima_subl (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +long a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nll() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. Do a vector/scalar + # subtraction and then negate the result. + if (im_a == NULL) { + im[2] = im_b + while (ima_nll (im, buf, v, 2) != EOF) { + if (a != 0) { + call asubkl (Meml[buf[2]], a, Meml[buf[1]], len) + call anegl (Meml[buf[1]], Meml[buf[1]], len) + } else + call anegl (Meml[buf[2]], Meml[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # subtraction to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nll (im, buf, v, 2) != EOF) { + if (b == 0) + call amovl (Meml[buf[2]], Meml[buf[1]], len) + else + call asubkl (Meml[buf[2]], b, Meml[buf[1]], len) + } + + # Read imagea and imageb and do a vector subtraction into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nll (im, buf, v, 3) != EOF) + call asubl (Meml[buf[2]], Meml[buf[3]], Meml[buf[1]], len) + } +end + +procedure ima_subr (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +real a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nlr() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. Do a vector/scalar + # subtraction and then negate the result. + if (im_a == NULL) { + im[2] = im_b + while (ima_nlr (im, buf, v, 2) != EOF) { + if (a != 0.0) { + call asubkr (Memr[buf[2]], a, Memr[buf[1]], len) + call anegr (Memr[buf[1]], Memr[buf[1]], len) + } else + call anegr (Memr[buf[2]], Memr[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # subtraction to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nlr (im, buf, v, 2) != EOF) { + if (b == 0.0) + call amovr (Memr[buf[2]], Memr[buf[1]], len) + else + call asubkr (Memr[buf[2]], b, Memr[buf[1]], len) + } + + # Read imagea and imageb and do a vector subtraction into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nlr (im, buf, v, 3) != EOF) + call asubr (Memr[buf[2]], Memr[buf[3]], Memr[buf[1]], len) + } +end + +procedure ima_subd (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +double a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nld() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. Do a vector/scalar + # subtraction and then negate the result. + if (im_a == NULL) { + im[2] = im_b + while (ima_nld (im, buf, v, 2) != EOF) { + if (a != 0.0D0) { + call asubkd (Memd[buf[2]], a, Memd[buf[1]], len) + call anegd (Memd[buf[1]], Memd[buf[1]], len) + } else + call anegd (Memd[buf[2]], Memd[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # subtraction to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nld (im, buf, v, 2) != EOF) { + if (b == 0.0D0) + call amovd (Memd[buf[2]], Memd[buf[1]], len) + else + call asubkd (Memd[buf[2]], b, Memd[buf[1]], len) + } + + # Read imagea and imageb and do a vector subtraction into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nld (im, buf, v, 3) != EOF) + call asubd (Memd[buf[2]], Memd[buf[3]], Memd[buf[1]], len) + } +end + diff --git a/pkg/images/imutil/src/generic/imfuncs.x b/pkg/images/imutil/src/generic/imfuncs.x new file mode 100644 index 00000000..67bc4ed5 --- /dev/null +++ b/pkg/images/imutil/src/generic/imfuncs.x @@ -0,0 +1,1613 @@ +include <imhdr.h> +include <mach.h> +include <math.h> + + + +# IF_LOG10 -- Compute the base 10 logarithm of image1 and write the results to +# image2. + +procedure if_log10r (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +real if_elogr() +extern if_elogr() +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call alogr (Memr[buf1], Memr[buf2], npix, if_elogr) +end + + +# IF_ELOG -- The error function for log10. Note that MAX_EXPONENT is +# currently an integer so it is converted to the appropriate data type +# before being returned. + +real procedure if_elogr (x) + +real x # the input pixel value + +begin + return (real(-MAX_EXPONENT)) +end + + +# IF_ALOG10 -- Take the power of 10 of image1 and write the results to image2. + +procedure if_alog10r (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_va10r (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VA10 -- Take the antilog (base 10) of a vector. + +procedure if_va10r (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of points + +int i +real maxexp, maxval + +begin + maxexp = MAX_EXPONENT + maxval = MAX_REAL + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= (-maxexp)) + b[i] = 0.0 + else + b[i] = 10.0 ** a[i] + } +end + + +# IF_LN -- Take the natural log of the pixels in image1 and write the results +# to image2. + +procedure if_lnr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 + +real if_elnr() +extern if_elnr() +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call allnr (Memr[buf1], Memr[buf2], npix, if_elnr) +end + + +# IF_ELN -- The error function for the natural logarithm. + +real procedure if_elnr (x) + +real x # input value + +begin + return (real (LN_10) * real(-MAX_EXPONENT)) +end + + +# IF_ALN -- Take the natural antilog of the pixels in image1 and write the +# results to image2. + +procedure if_alnr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_valnr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VALN -- Take the natural antilog of a vector. + +procedure if_valnr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i +real maxexp, maxval, eval + +begin + maxexp = log (10.0 ** real (MAX_EXPONENT)) + maxval = MAX_REAL + eval = real (BASE_E) + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= -maxexp) + b[i] = 0.0 + else + b[i] = eval ** a[i] + } +end + + +# IF_SQR -- Take the square root of pixels in image1 and write the results +# to image2. + +procedure if_sqrr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +real if_esqrr() +extern if_esqrr() +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call asqrr (Memr[buf1], Memr[buf2], npix, if_esqrr) +end + + +# IF_ESQR -- Error function for the square root. + +real procedure if_esqrr (x) + +real x # input value + +begin + return (0.0) +end + + +# IF_SQUARE -- Take the square of the pixels in image1 and write to image2. +procedure if_squarer (im1, im2) + +pointer im1 # the input image pointer +pointer im2 # the output image pointer + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call apowkr (Memr[buf1], 2, Memr[buf2], npix) +end + + +# IF_CBRT -- Take the cube root of the pixels in image1 and write the results +# to image2. + +procedure if_cbrtr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vcbrtr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VCBRT -- Compute the cube root of a vector. + +procedure if_vcbrtr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i +real onethird + +begin + onethird = 1.0 / 3.0 + do i = 1, n { + if (a[i] >= 0.0) { + b[i] = a[i] ** onethird + } else { + b[i] = -a[i] + b[i] = - (b[i] ** onethird) + } + } +end + + +# IF_CUBE -- Take the cube of the pixels in image1 and write the results to +# image2. + +procedure if_cuber (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call apowkr (Memr[buf1], 3, Memr[buf2], npix) +end + + +# IF_COS -- Take cosine of pixels in image1 and write the results to image2. + +procedure if_cosr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vcosr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VCOS - Compute the cosine of a vector. + +procedure if_vcosr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = cos(a[i]) +end + + +# IF_SIN -- Take sine of the pixels in image1 and write the results to image2. + +procedure if_sinr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vsinr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VSIN - Take the sine of a vector. + +procedure if_vsinr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = sin(a[i]) +end + + +# IF_TAN -- Take tangent of pixels in image1 and write the results to image2. + +procedure if_tanr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vtanr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VTAN - Take the tangent of a vector. + +procedure if_vtanr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = tan(a[i]) +end + + +# IF_ACOS -- Take arccosine of pixels in image1 and write the results to image2. + +procedure if_acosr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vacosr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VACOS - Take the arccosine of a vector. + +procedure if_vacosr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n { + if (a[i] > 1.0) + b[i] = acos (1.0) + else if (a[i] < -1.0) + b[i] = acos (-1.0) + else + b[i] = acos(a[i]) + } +end + + +# IF_ASIN -- Take arcsine of pixels in image1 and write the results to image2. + +procedure if_asinr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vasinr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VASIN - Take arcsine of vector + +procedure if_vasinr (a, b, n) + +real a[n] +real b[n] +int n + +int i + +begin + do i = 1, n { + if (a[i] > 1.0) + b[i] = asin (1.0) + else if (a[i] < -1.0) + b[i] = asin (-1.0) + else + b[i] = asin(a[i]) + } +end + + +# IF_ATAN -- Take arctangent of pixels in image1 and write the results to +# image2. + +procedure if_atanr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vatanr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VATAN - Take the arctangent of a vector. + +procedure if_vatanr (a, b, n) + +real a[n] +real b[n] +int n + +int i + +begin + do i = 1, n + b[i] = atan(a[i]) +end + + +# IF_HCOS -- Take the hyperbolic cosine of pixels in image1 and write the +# results to image2. + +procedure if_hcosr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vhcosr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VHCOS - Take the hyperbolic cosine of a vector. + +procedure if_vhcosr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i +real maxexp, maxval + +begin + maxexp = log (10.0 ** real(MAX_EXPONENT)) + maxval = MAX_REAL + + do i = 1, n { + if (abs (a[i]) >= maxexp) + b[i] = maxval + else + b[i] = cosh (a[i]) + } +end + + +# IF_HSIN -- Take the hyperbolic sine of pixels in image1 and write the +# results to image2. + +procedure if_hsinr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vhsinr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VHSIN - Take the hyperbolic sine of a vector. + +procedure if_vhsinr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i +real maxexp, maxval + +begin + maxexp = log (10.0 ** real(MAX_EXPONENT)) + maxval = MAX_REAL + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= -maxexp) + b[i] = -maxval + else + b[i] = sinh(a[i]) + } +end + + +# IF_HTAN -- Take the hyperbolic tangent of pixels in image1 and write the +# results to image2. + +procedure if_htanr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call if_vhtanr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_VHTAN - Take the hyperbolic tangent of a vector. + +procedure if_vhtanr (a, b, n) + +real a[n] # the input vector +real b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = tanh(a[i]) +end + + +# IF_RECIP -- Take the reciprocal of the pixels in image1 and write the +# results to image2. + +procedure if_recipr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +real if_erecipr() +extern if_erecipr() +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call arczr (1.0, Memr[buf1], Memr[buf2], npix, if_erecipr) +end + + +# IF_ERECIP -- Error function for the reciprocal computation. + +real procedure if_erecipr (x) + +real x + +begin + return (0.0) +end + + + +# IF_LOG10 -- Compute the base 10 logarithm of image1 and write the results to +# image2. + +procedure if_log10d (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +double if_elogd() +extern if_elogd() +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call alogd (Memd[buf1], Memd[buf2], npix, if_elogd) +end + + +# IF_ELOG -- The error function for log10. Note that MAX_EXPONENT is +# currently an integer so it is converted to the appropriate data type +# before being returned. + +double procedure if_elogd (x) + +double x # the input pixel value + +begin + return (double(-MAX_EXPONENT)) +end + + +# IF_ALOG10 -- Take the power of 10 of image1 and write the results to image2. + +procedure if_alog10d (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_va10d (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VA10 -- Take the antilog (base 10) of a vector. + +procedure if_va10d (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of points + +int i +double maxexp, maxval + +begin + maxexp = MAX_EXPONENT + maxval = MAX_REAL + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= (-maxexp)) + b[i] = 0.0D0 + else + b[i] = 10.0D0 ** a[i] + } +end + + +# IF_LN -- Take the natural log of the pixels in image1 and write the results +# to image2. + +procedure if_lnd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 + +double if_elnd() +extern if_elnd() +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call allnd (Memd[buf1], Memd[buf2], npix, if_elnd) +end + + +# IF_ELN -- The error function for the natural logarithm. + +double procedure if_elnd (x) + +double x # input value + +begin + return (double (LN_10) * double(-MAX_EXPONENT)) +end + + +# IF_ALN -- Take the natural antilog of the pixels in image1 and write the +# results to image2. + +procedure if_alnd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_valnd (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VALN -- Take the natural antilog of a vector. + +procedure if_valnd (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i +double maxexp, maxval, eval + +begin + maxexp = log (10.0D0 ** double (MAX_EXPONENT)) + maxval = MAX_REAL + eval = double (BASE_E) + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= -maxexp) + b[i] = 0.0D0 + else + b[i] = eval ** a[i] + } +end + + +# IF_SQR -- Take the square root of pixels in image1 and write the results +# to image2. + +procedure if_sqrd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +double if_esqrd() +extern if_esqrd() +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call asqrd (Memd[buf1], Memd[buf2], npix, if_esqrd) +end + + +# IF_ESQR -- Error function for the square root. + +double procedure if_esqrd (x) + +double x # input value + +begin + return (0.0D0) +end + + +# IF_SQUARE -- Take the square of the pixels in image1 and write to image2. +procedure if_squared (im1, im2) + +pointer im1 # the input image pointer +pointer im2 # the output image pointer + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call apowkd (Memd[buf1], 2, Memd[buf2], npix) +end + + +# IF_CBRT -- Take the cube root of the pixels in image1 and write the results +# to image2. + +procedure if_cbrtd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vcbrtd (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VCBRT -- Compute the cube root of a vector. + +procedure if_vcbrtd (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i +double onethird + +begin + onethird = 1.0D0 / 3.0D0 + do i = 1, n { + if (a[i] >= 0.0D0) { + b[i] = a[i] ** onethird + } else { + b[i] = -a[i] + b[i] = - (b[i] ** onethird) + } + } +end + + +# IF_CUBE -- Take the cube of the pixels in image1 and write the results to +# image2. + +procedure if_cubed (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call apowkd (Memd[buf1], 3, Memd[buf2], npix) +end + + +# IF_COS -- Take cosine of pixels in image1 and write the results to image2. + +procedure if_cosd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vcosd (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VCOS - Compute the cosine of a vector. + +procedure if_vcosd (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = cos(a[i]) +end + + +# IF_SIN -- Take sine of the pixels in image1 and write the results to image2. + +procedure if_sind (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vsind (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VSIN - Take the sine of a vector. + +procedure if_vsind (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = sin(a[i]) +end + + +# IF_TAN -- Take tangent of pixels in image1 and write the results to image2. + +procedure if_tand (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vtand (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VTAN - Take the tangent of a vector. + +procedure if_vtand (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = tan(a[i]) +end + + +# IF_ACOS -- Take arccosine of pixels in image1 and write the results to image2. + +procedure if_acosd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vacosd (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VACOS - Take the arccosine of a vector. + +procedure if_vacosd (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n { + if (a[i] > 1.0D0) + b[i] = acos (1.0D0) + else if (a[i] < -1.0D0) + b[i] = acos (-1.0D0) + else + b[i] = acos(a[i]) + } +end + + +# IF_ASIN -- Take arcsine of pixels in image1 and write the results to image2. + +procedure if_asind (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vasind (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VASIN - Take arcsine of vector + +procedure if_vasind (a, b, n) + +double a[n] +double b[n] +int n + +int i + +begin + do i = 1, n { + if (a[i] > 1.0D0) + b[i] = asin (1.0D0) + else if (a[i] < -1.0D0) + b[i] = asin (-1.0D0) + else + b[i] = asin(a[i]) + } +end + + +# IF_ATAN -- Take arctangent of pixels in image1 and write the results to +# image2. + +procedure if_atand (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vatand (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VATAN - Take the arctangent of a vector. + +procedure if_vatand (a, b, n) + +double a[n] +double b[n] +int n + +int i + +begin + do i = 1, n + b[i] = atan(a[i]) +end + + +# IF_HCOS -- Take the hyperbolic cosine of pixels in image1 and write the +# results to image2. + +procedure if_hcosd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vhcosd (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VHCOS - Take the hyperbolic cosine of a vector. + +procedure if_vhcosd (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i +double maxexp, maxval + +begin + maxexp = log (10.0D0 ** double(MAX_EXPONENT)) + maxval = MAX_REAL + + do i = 1, n { + if (abs (a[i]) >= maxexp) + b[i] = maxval + else + b[i] = cosh (a[i]) + } +end + + +# IF_HSIN -- Take the hyperbolic sine of pixels in image1 and write the +# results to image2. + +procedure if_hsind (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vhsind (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VHSIN - Take the hyperbolic sine of a vector. + +procedure if_vhsind (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i +double maxexp, maxval + +begin + maxexp = log (10.0D0 ** double(MAX_EXPONENT)) + maxval = MAX_REAL + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= -maxexp) + b[i] = -maxval + else + b[i] = sinh(a[i]) + } +end + + +# IF_HTAN -- Take the hyperbolic tangent of pixels in image1 and write the +# results to image2. + +procedure if_htand (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call if_vhtand (Memd[buf1], Memd[buf2], npix) +end + + +# IF_VHTAN - Take the hyperbolic tangent of a vector. + +procedure if_vhtand (a, b, n) + +double a[n] # the input vector +double b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = tanh(a[i]) +end + + +# IF_RECIP -- Take the reciprocal of the pixels in image1 and write the +# results to image2. + +procedure if_recipd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +double if_erecipd() +extern if_erecipd() +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call arczd (1.0, Memd[buf1], Memd[buf2], npix, if_erecipd) +end + + +# IF_ERECIP -- Error function for the reciprocal computation. + +double procedure if_erecipd (x) + +double x + +begin + return (0.0D0) +end + + + + + +# IF_ABS -- Take the absolute value of pixels in image1 and write the results +# to image2. + +procedure if_absl (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnll(), impnll() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnll (im1, buf1, v1) != EOF) && + (impnll (im2, buf2, v2) != EOF)) + call aabsl (Meml[buf1], Meml[buf2], npix) +end + + +# IF_NEG -- Take negative of pixels in image1 and write the results to image2. + +procedure if_negl (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnll(), impnll() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnll (im1, buf1, v1) != EOF) && + (impnll (im2, buf2, v2) != EOF)) + call anegl (Meml[buf1], Meml[buf2], npix) +end + + + +# IF_ABS -- Take the absolute value of pixels in image1 and write the results +# to image2. + +procedure if_absr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call aabsr (Memr[buf1], Memr[buf2], npix) +end + + +# IF_NEG -- Take negative of pixels in image1 and write the results to image2. + +procedure if_negr (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnlr(), impnlr() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnlr (im1, buf1, v1) != EOF) && + (impnlr (im2, buf2, v2) != EOF)) + call anegr (Memr[buf1], Memr[buf2], npix) +end + + + +# IF_ABS -- Take the absolute value of pixels in image1 and write the results +# to image2. + +procedure if_absd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call aabsd (Memd[buf1], Memd[buf2], npix) +end + + +# IF_NEG -- Take negative of pixels in image1 and write the results to image2. + +procedure if_negd (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnld (im1, buf1, v1) != EOF) && + (impnld (im2, buf2, v2) != EOF)) + call anegd (Memd[buf1], Memd[buf2], npix) +end + + diff --git a/pkg/images/imutil/src/generic/imjoin.x b/pkg/images/imutil/src/generic/imjoin.x new file mode 100644 index 00000000..83b02541 --- /dev/null +++ b/pkg/images/imutil/src/generic/imjoin.x @@ -0,0 +1,527 @@ +include <imhdr.h> + +define VPTR Memi[$1+$2-1] # Array of axis vector pointers + + + +# IMJOIN -- Join the set of input images into an output image along the +# specified axis, any dimension. + +procedure imjoins (inptr, nimages, out, joindim, outtype) + +pointer inptr[nimages] #I Input IMIO pointers +int nimages #I Number of input images +pointer out #I Output IMIO pointer +int joindim #I Dimension along which to join images +int outtype #I Output datatype + +int i, image, line, nlines, nbands, stat, cum_len +pointer sp, vin, vout, in, inbuf, outbuf + +pointer imgnls() +pointer impnls() + +begin + # Allocate working space. + call smark (sp) + call salloc (vin, nimages, TY_INT) + call salloc (vout, IM_MAXDIM, TY_LONG) + + # Initialize the v vectors. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + do image = 1, nimages { + call salloc (VPTR(vin,image), IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[VPTR(vin,image)], IM_MAXDIM) + } + + # Join input images along the specified dimension. Joins along + # columns and lines require processing in special order, all others + # in the same order. In the first two cases we process all input + # images in inner loops, so we have to keep all those image + # descriptors open. + + switch (joindim) { + case 1: # join columns + nlines = 1 + do i = 2, IM_NDIM(out) + nlines = nlines * IM_LEN(out,i) + do i = 1, nlines { + stat = impnls (out, outbuf, Meml[vout]) + cum_len = 0 + do image = 1, nimages { + in = inptr[image] + stat = imgnls (in, inbuf, Meml[VPTR(vin,image)]) + call amovs (Mems[inbuf], Mems[outbuf+cum_len], + IM_LEN(in,1)) + cum_len = cum_len + IM_LEN(in,1) + } + } + + case 2: # join lines + nbands = 1 + do i = 3, IM_NDIM(out) + nbands = nbands * IM_LEN(out,i) + do i = 1, nbands { + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnls (out, outbuf, Meml[vout]) + stat = imgnls (in, inbuf, Meml[VPTR(vin,image)]) + call amovs (Mems[inbuf], Mems[outbuf], IM_LEN(in,1)) + } + } + } + + default: # join bands or higher + do image = 1, nimages { + in = inptr[image] + nlines = 1 + do i = 2, IM_NDIM(in) + nlines = nlines * IM_LEN(in,i) + do i = 1, nlines { + stat = impnls (out, outbuf, Meml[vout]) + stat = imgnls (in, inbuf, Meml[VPTR(vin,image)]) + call amovs (Mems[inbuf], Mems[outbuf], IM_LEN(in,1)) + } + } + } + + call sfree (sp) +end + + + +# IMJOIN -- Join the set of input images into an output image along the +# specified axis, any dimension. + +procedure imjoini (inptr, nimages, out, joindim, outtype) + +pointer inptr[nimages] #I Input IMIO pointers +int nimages #I Number of input images +pointer out #I Output IMIO pointer +int joindim #I Dimension along which to join images +int outtype #I Output datatype + +int i, image, line, nlines, nbands, stat, cum_len +pointer sp, vin, vout, in, inbuf, outbuf + +pointer imgnli() +pointer impnli() + +begin + # Allocate working space. + call smark (sp) + call salloc (vin, nimages, TY_INT) + call salloc (vout, IM_MAXDIM, TY_LONG) + + # Initialize the v vectors. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + do image = 1, nimages { + call salloc (VPTR(vin,image), IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[VPTR(vin,image)], IM_MAXDIM) + } + + # Join input images along the specified dimension. Joins along + # columns and lines require processing in special order, all others + # in the same order. In the first two cases we process all input + # images in inner loops, so we have to keep all those image + # descriptors open. + + switch (joindim) { + case 1: # join columns + nlines = 1 + do i = 2, IM_NDIM(out) + nlines = nlines * IM_LEN(out,i) + do i = 1, nlines { + stat = impnli (out, outbuf, Meml[vout]) + cum_len = 0 + do image = 1, nimages { + in = inptr[image] + stat = imgnli (in, inbuf, Meml[VPTR(vin,image)]) + call amovi (Memi[inbuf], Memi[outbuf+cum_len], + IM_LEN(in,1)) + cum_len = cum_len + IM_LEN(in,1) + } + } + + case 2: # join lines + nbands = 1 + do i = 3, IM_NDIM(out) + nbands = nbands * IM_LEN(out,i) + do i = 1, nbands { + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnli (out, outbuf, Meml[vout]) + stat = imgnli (in, inbuf, Meml[VPTR(vin,image)]) + call amovi (Memi[inbuf], Memi[outbuf], IM_LEN(in,1)) + } + } + } + + default: # join bands or higher + do image = 1, nimages { + in = inptr[image] + nlines = 1 + do i = 2, IM_NDIM(in) + nlines = nlines * IM_LEN(in,i) + do i = 1, nlines { + stat = impnli (out, outbuf, Meml[vout]) + stat = imgnli (in, inbuf, Meml[VPTR(vin,image)]) + call amovi (Memi[inbuf], Memi[outbuf], IM_LEN(in,1)) + } + } + } + + call sfree (sp) +end + + + +# IMJOIN -- Join the set of input images into an output image along the +# specified axis, any dimension. + +procedure imjoinl (inptr, nimages, out, joindim, outtype) + +pointer inptr[nimages] #I Input IMIO pointers +int nimages #I Number of input images +pointer out #I Output IMIO pointer +int joindim #I Dimension along which to join images +int outtype #I Output datatype + +int i, image, line, nlines, nbands, stat, cum_len +pointer sp, vin, vout, in, inbuf, outbuf + +pointer imgnll() +pointer impnll() + +begin + # Allocate working space. + call smark (sp) + call salloc (vin, nimages, TY_INT) + call salloc (vout, IM_MAXDIM, TY_LONG) + + # Initialize the v vectors. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + do image = 1, nimages { + call salloc (VPTR(vin,image), IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[VPTR(vin,image)], IM_MAXDIM) + } + + # Join input images along the specified dimension. Joins along + # columns and lines require processing in special order, all others + # in the same order. In the first two cases we process all input + # images in inner loops, so we have to keep all those image + # descriptors open. + + switch (joindim) { + case 1: # join columns + nlines = 1 + do i = 2, IM_NDIM(out) + nlines = nlines * IM_LEN(out,i) + do i = 1, nlines { + stat = impnll (out, outbuf, Meml[vout]) + cum_len = 0 + do image = 1, nimages { + in = inptr[image] + stat = imgnll (in, inbuf, Meml[VPTR(vin,image)]) + call amovl (Meml[inbuf], Meml[outbuf+cum_len], + IM_LEN(in,1)) + cum_len = cum_len + IM_LEN(in,1) + } + } + + case 2: # join lines + nbands = 1 + do i = 3, IM_NDIM(out) + nbands = nbands * IM_LEN(out,i) + do i = 1, nbands { + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnll (out, outbuf, Meml[vout]) + stat = imgnll (in, inbuf, Meml[VPTR(vin,image)]) + call amovl (Meml[inbuf], Meml[outbuf], IM_LEN(in,1)) + } + } + } + + default: # join bands or higher + do image = 1, nimages { + in = inptr[image] + nlines = 1 + do i = 2, IM_NDIM(in) + nlines = nlines * IM_LEN(in,i) + do i = 1, nlines { + stat = impnll (out, outbuf, Meml[vout]) + stat = imgnll (in, inbuf, Meml[VPTR(vin,image)]) + call amovl (Meml[inbuf], Meml[outbuf], IM_LEN(in,1)) + } + } + } + + call sfree (sp) +end + + + +# IMJOIN -- Join the set of input images into an output image along the +# specified axis, any dimension. + +procedure imjoinr (inptr, nimages, out, joindim, outtype) + +pointer inptr[nimages] #I Input IMIO pointers +int nimages #I Number of input images +pointer out #I Output IMIO pointer +int joindim #I Dimension along which to join images +int outtype #I Output datatype + +int i, image, line, nlines, nbands, stat, cum_len +pointer sp, vin, vout, in, inbuf, outbuf + +pointer imgnlr() +pointer impnlr() + +begin + # Allocate working space. + call smark (sp) + call salloc (vin, nimages, TY_INT) + call salloc (vout, IM_MAXDIM, TY_LONG) + + # Initialize the v vectors. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + do image = 1, nimages { + call salloc (VPTR(vin,image), IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[VPTR(vin,image)], IM_MAXDIM) + } + + # Join input images along the specified dimension. Joins along + # columns and lines require processing in special order, all others + # in the same order. In the first two cases we process all input + # images in inner loops, so we have to keep all those image + # descriptors open. + + switch (joindim) { + case 1: # join columns + nlines = 1 + do i = 2, IM_NDIM(out) + nlines = nlines * IM_LEN(out,i) + do i = 1, nlines { + stat = impnlr (out, outbuf, Meml[vout]) + cum_len = 0 + do image = 1, nimages { + in = inptr[image] + stat = imgnlr (in, inbuf, Meml[VPTR(vin,image)]) + call amovr (Memr[inbuf], Memr[outbuf+cum_len], + IM_LEN(in,1)) + cum_len = cum_len + IM_LEN(in,1) + } + } + + case 2: # join lines + nbands = 1 + do i = 3, IM_NDIM(out) + nbands = nbands * IM_LEN(out,i) + do i = 1, nbands { + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnlr (out, outbuf, Meml[vout]) + stat = imgnlr (in, inbuf, Meml[VPTR(vin,image)]) + call amovr (Memr[inbuf], Memr[outbuf], IM_LEN(in,1)) + } + } + } + + default: # join bands or higher + do image = 1, nimages { + in = inptr[image] + nlines = 1 + do i = 2, IM_NDIM(in) + nlines = nlines * IM_LEN(in,i) + do i = 1, nlines { + stat = impnlr (out, outbuf, Meml[vout]) + stat = imgnlr (in, inbuf, Meml[VPTR(vin,image)]) + call amovr (Memr[inbuf], Memr[outbuf], IM_LEN(in,1)) + } + } + } + + call sfree (sp) +end + + + +# IMJOIN -- Join the set of input images into an output image along the +# specified axis, any dimension. + +procedure imjoind (inptr, nimages, out, joindim, outtype) + +pointer inptr[nimages] #I Input IMIO pointers +int nimages #I Number of input images +pointer out #I Output IMIO pointer +int joindim #I Dimension along which to join images +int outtype #I Output datatype + +int i, image, line, nlines, nbands, stat, cum_len +pointer sp, vin, vout, in, inbuf, outbuf + +pointer imgnld() +pointer impnld() + +begin + # Allocate working space. + call smark (sp) + call salloc (vin, nimages, TY_INT) + call salloc (vout, IM_MAXDIM, TY_LONG) + + # Initialize the v vectors. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + do image = 1, nimages { + call salloc (VPTR(vin,image), IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[VPTR(vin,image)], IM_MAXDIM) + } + + # Join input images along the specified dimension. Joins along + # columns and lines require processing in special order, all others + # in the same order. In the first two cases we process all input + # images in inner loops, so we have to keep all those image + # descriptors open. + + switch (joindim) { + case 1: # join columns + nlines = 1 + do i = 2, IM_NDIM(out) + nlines = nlines * IM_LEN(out,i) + do i = 1, nlines { + stat = impnld (out, outbuf, Meml[vout]) + cum_len = 0 + do image = 1, nimages { + in = inptr[image] + stat = imgnld (in, inbuf, Meml[VPTR(vin,image)]) + call amovd (Memd[inbuf], Memd[outbuf+cum_len], + IM_LEN(in,1)) + cum_len = cum_len + IM_LEN(in,1) + } + } + + case 2: # join lines + nbands = 1 + do i = 3, IM_NDIM(out) + nbands = nbands * IM_LEN(out,i) + do i = 1, nbands { + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnld (out, outbuf, Meml[vout]) + stat = imgnld (in, inbuf, Meml[VPTR(vin,image)]) + call amovd (Memd[inbuf], Memd[outbuf], IM_LEN(in,1)) + } + } + } + + default: # join bands or higher + do image = 1, nimages { + in = inptr[image] + nlines = 1 + do i = 2, IM_NDIM(in) + nlines = nlines * IM_LEN(in,i) + do i = 1, nlines { + stat = impnld (out, outbuf, Meml[vout]) + stat = imgnld (in, inbuf, Meml[VPTR(vin,image)]) + call amovd (Memd[inbuf], Memd[outbuf], IM_LEN(in,1)) + } + } + } + + call sfree (sp) +end + + + +# IMJOIN -- Join the set of input images into an output image along the +# specified axis, any dimension. + +procedure imjoinx (inptr, nimages, out, joindim, outtype) + +pointer inptr[nimages] #I Input IMIO pointers +int nimages #I Number of input images +pointer out #I Output IMIO pointer +int joindim #I Dimension along which to join images +int outtype #I Output datatype + +int i, image, line, nlines, nbands, stat, cum_len +pointer sp, vin, vout, in, inbuf, outbuf + +pointer imgnlx() +pointer impnlx() + +begin + # Allocate working space. + call smark (sp) + call salloc (vin, nimages, TY_INT) + call salloc (vout, IM_MAXDIM, TY_LONG) + + # Initialize the v vectors. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + do image = 1, nimages { + call salloc (VPTR(vin,image), IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[VPTR(vin,image)], IM_MAXDIM) + } + + # Join input images along the specified dimension. Joins along + # columns and lines require processing in special order, all others + # in the same order. In the first two cases we process all input + # images in inner loops, so we have to keep all those image + # descriptors open. + + switch (joindim) { + case 1: # join columns + nlines = 1 + do i = 2, IM_NDIM(out) + nlines = nlines * IM_LEN(out,i) + do i = 1, nlines { + stat = impnlx (out, outbuf, Meml[vout]) + cum_len = 0 + do image = 1, nimages { + in = inptr[image] + stat = imgnlx (in, inbuf, Meml[VPTR(vin,image)]) + call amovx (Memx[inbuf], Memx[outbuf+cum_len], + IM_LEN(in,1)) + cum_len = cum_len + IM_LEN(in,1) + } + } + + case 2: # join lines + nbands = 1 + do i = 3, IM_NDIM(out) + nbands = nbands * IM_LEN(out,i) + do i = 1, nbands { + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnlx (out, outbuf, Meml[vout]) + stat = imgnlx (in, inbuf, Meml[VPTR(vin,image)]) + call amovx (Memx[inbuf], Memx[outbuf], IM_LEN(in,1)) + } + } + } + + default: # join bands or higher + do image = 1, nimages { + in = inptr[image] + nlines = 1 + do i = 2, IM_NDIM(in) + nlines = nlines * IM_LEN(in,i) + do i = 1, nlines { + stat = impnlx (out, outbuf, Meml[vout]) + stat = imgnlx (in, inbuf, Meml[VPTR(vin,image)]) + call amovx (Memx[inbuf], Memx[outbuf], IM_LEN(in,1)) + } + } + } + + call sfree (sp) +end + + diff --git a/pkg/images/imutil/src/generic/imrep.x b/pkg/images/imutil/src/generic/imrep.x new file mode 100644 index 00000000..bcc29d0a --- /dev/null +++ b/pkg/images/imutil/src/generic/imrep.x @@ -0,0 +1,1423 @@ +include <imhdr.h> +include <mach.h> + + + +# IMREP -- Replace pixels in an image between lower and upper by value. + +procedure imreps (im, lower, upper, value, img) + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real value # Replacement value +real img # Imaginary value for complex + +pointer buf1, buf2 +int npix, junk +real ilower +short floor, ceil, newval +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnls(), impnls() + +bool fp_equalr() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im, 1) + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnls (im, buf2, v2) != EOF) + call amovks (newval, Mems[buf2], npix) + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + ceil = int (upper) + while (imgnls (im, buf1, v1) != EOF) { + junk = impnls (im, buf2, v2) + call amovs (Mems[buf1], Mems[buf2], npix) + call arles (Mems[buf2], npix, ceil, newval) + } + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + while (imgnls (im, buf1, v1) != EOF) { + junk = impnls (im, buf2, v2) + call amovs (Mems[buf1], Mems[buf2], npix) + call arges (Mems[buf2], npix, floor, newval) + } + + # Replace pixels between lower and upper by value. + } else { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = int (upper) + while (imgnls (im, buf1, v1) != EOF) { + junk = impnls (im, buf2, v2) + call amovs (Mems[buf1], Mems[buf2], npix) + call areps (Mems[buf2], npix, floor, ceil, newval) + } + } +end + + +# IMRREP -- Replace pixels in an image between lower and upper by value +# and a radius around those pixels. + +procedure imrreps (im, lower, upper, radius, value, img) + + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real radius # Radius +real value # Replacement value +real img # Imaginary value for complex + +pointer buf, buf1, buf2, ptr +int i, j, k, l, nc, nl, nradius, nbufs +real ilower +short floor, ceil, newval, val1, val2 +real radius2, y2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] # IMIO vectors +int imgnls(), impnls() +bool fp_equalr() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + nc = IM_LEN(im, 1) + if (IM_NDIM(im) > 1) + nl = IM_LEN(im,2) + else + nl = 1 + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnls (im, buf2, v2) != EOF) + call amovks (newval, Mems[buf2], nc) + return + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + floor = -MAX_SHORT + ceil = int (upper) + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = MAX_SHORT + + # Replace pixels between lower and upper by value. + } else { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = int (upper) + } + + # Initialize buffering. + radius2 = radius * radius + nradius = int (radius) + nbufs = min (1 + 2 * nradius, nl) + call calloc (buf, nc*nbufs, TY_SHORT) + + while (imgnls (im, buf1, v1) != EOF) { + j = v1[2] - 1 + buf2 = buf + mod (j, nbufs) * nc + do i = 1, nc { + val1 = Mems[buf1] + val2 = Mems[buf2] + if ((val1 >= floor) && (val1 <= ceil)) { + do k = max(1,j-nradius), min (nl,j+nradius) { + ptr = buf + mod (k, nbufs) * nc - 1 + y2 = (k - j) ** 2 + do l = max(1,i-nradius), min (nc,i+nradius) { + if ((l-i)**2 + y2 > radius2) + next + Mems[ptr+l] = INDEFS + } + } + } else { + if (!IS_INDEFS(val2)) + Mems[buf2] = val1 + } + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (j > nradius) { + while (impnls (im, buf2, v2) != EOF) { + k = v2[2] - 1 + buf1 = buf + mod (k, nbufs) * nc + do i = 1, nc { + val1 = Mems[buf1] + if (IS_INDEFS(Mems[buf1])) + Mems[buf2] = newval + else + Mems[buf2] = val1 + Mems[buf1] = 0. + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + if (j != nl) + break + } + } + } + + call mfree (buf, TY_SHORT) +end + + +# AREP -- Replace array values which are between floor and ceil by value. + +procedure areps (a, npts, floor, ceil, newval) + +short a[npts] # Input arrays +int npts # Number of points +short floor, ceil # Replacement limits +short newval # Replacement value + +int i + +begin + + do i = 1, npts { + if ((a[i] >= floor) && (a[i] <= ceil)) + a[i] = newval + } +end + + +# ARLE -- If A[i] is less than or equal to FLOOR replace by NEWVAL. + +procedure arles (a, npts, floor, newval) + +short a[npts] +int npts +short floor, newval + +int i + +begin + + do i = 1, npts + if (a[i] <= floor) + a[i] = newval +end + + +# ARGE -- If A[i] is greater than or equal to CEIL replace by NEWVAL. + +procedure arges (a, npts, ceil, newval) + +short a[npts] +int npts +short ceil, newval + +int i + +begin + + do i = 1, npts + if (a[i] >= ceil) + a[i] = newval +end + + + +# IMREP -- Replace pixels in an image between lower and upper by value. + +procedure imrepi (im, lower, upper, value, img) + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real value # Replacement value +real img # Imaginary value for complex + +pointer buf1, buf2 +int npix, junk +real ilower +int floor, ceil, newval +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnli(), impnli() + +bool fp_equalr() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im, 1) + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnli (im, buf2, v2) != EOF) + call amovki (newval, Memi[buf2], npix) + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + ceil = int (upper) + while (imgnli (im, buf1, v1) != EOF) { + junk = impnli (im, buf2, v2) + call amovi (Memi[buf1], Memi[buf2], npix) + call arlei (Memi[buf2], npix, ceil, newval) + } + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + while (imgnli (im, buf1, v1) != EOF) { + junk = impnli (im, buf2, v2) + call amovi (Memi[buf1], Memi[buf2], npix) + call argei (Memi[buf2], npix, floor, newval) + } + + # Replace pixels between lower and upper by value. + } else { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = int (upper) + while (imgnli (im, buf1, v1) != EOF) { + junk = impnli (im, buf2, v2) + call amovi (Memi[buf1], Memi[buf2], npix) + call arepi (Memi[buf2], npix, floor, ceil, newval) + } + } +end + + +# IMRREP -- Replace pixels in an image between lower and upper by value +# and a radius around those pixels. + +procedure imrrepi (im, lower, upper, radius, value, img) + + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real radius # Radius +real value # Replacement value +real img # Imaginary value for complex + +pointer buf, buf1, buf2, ptr +int i, j, k, l, nc, nl, nradius, nbufs +real ilower +int floor, ceil, newval, val1, val2 +real radius2, y2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] # IMIO vectors +int imgnli(), impnli() +bool fp_equalr() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + nc = IM_LEN(im, 1) + if (IM_NDIM(im) > 1) + nl = IM_LEN(im,2) + else + nl = 1 + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnli (im, buf2, v2) != EOF) + call amovki (newval, Memi[buf2], nc) + return + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + floor = -MAX_INT + ceil = int (upper) + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = MAX_INT + + # Replace pixels between lower and upper by value. + } else { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = int (upper) + } + + # Initialize buffering. + radius2 = radius * radius + nradius = int (radius) + nbufs = min (1 + 2 * nradius, nl) + call calloc (buf, nc*nbufs, TY_INT) + + while (imgnli (im, buf1, v1) != EOF) { + j = v1[2] - 1 + buf2 = buf + mod (j, nbufs) * nc + do i = 1, nc { + val1 = Memi[buf1] + val2 = Memi[buf2] + if ((val1 >= floor) && (val1 <= ceil)) { + do k = max(1,j-nradius), min (nl,j+nradius) { + ptr = buf + mod (k, nbufs) * nc - 1 + y2 = (k - j) ** 2 + do l = max(1,i-nradius), min (nc,i+nradius) { + if ((l-i)**2 + y2 > radius2) + next + Memi[ptr+l] = INDEFI + } + } + } else { + if (!IS_INDEFI(val2)) + Memi[buf2] = val1 + } + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (j > nradius) { + while (impnli (im, buf2, v2) != EOF) { + k = v2[2] - 1 + buf1 = buf + mod (k, nbufs) * nc + do i = 1, nc { + val1 = Memi[buf1] + if (IS_INDEFI(Memi[buf1])) + Memi[buf2] = newval + else + Memi[buf2] = val1 + Memi[buf1] = 0. + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + if (j != nl) + break + } + } + } + + call mfree (buf, TY_INT) +end + + +# AREP -- Replace array values which are between floor and ceil by value. + +procedure arepi (a, npts, floor, ceil, newval) + +int a[npts] # Input arrays +int npts # Number of points +int floor, ceil # Replacement limits +int newval # Replacement value + +int i + +begin + + do i = 1, npts { + if ((a[i] >= floor) && (a[i] <= ceil)) + a[i] = newval + } +end + + +# ARLE -- If A[i] is less than or equal to FLOOR replace by NEWVAL. + +procedure arlei (a, npts, floor, newval) + +int a[npts] +int npts +int floor, newval + +int i + +begin + + do i = 1, npts + if (a[i] <= floor) + a[i] = newval +end + + +# ARGE -- If A[i] is greater than or equal to CEIL replace by NEWVAL. + +procedure argei (a, npts, ceil, newval) + +int a[npts] +int npts +int ceil, newval + +int i + +begin + + do i = 1, npts + if (a[i] >= ceil) + a[i] = newval +end + + + +# IMREP -- Replace pixels in an image between lower and upper by value. + +procedure imrepl (im, lower, upper, value, img) + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real value # Replacement value +real img # Imaginary value for complex + +pointer buf1, buf2 +int npix, junk +real ilower +long floor, ceil, newval +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnll(), impnll() + +bool fp_equalr() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im, 1) + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnll (im, buf2, v2) != EOF) + call amovkl (newval, Meml[buf2], npix) + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + ceil = int (upper) + while (imgnll (im, buf1, v1) != EOF) { + junk = impnll (im, buf2, v2) + call amovl (Meml[buf1], Meml[buf2], npix) + call arlel (Meml[buf2], npix, ceil, newval) + } + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + while (imgnll (im, buf1, v1) != EOF) { + junk = impnll (im, buf2, v2) + call amovl (Meml[buf1], Meml[buf2], npix) + call argel (Meml[buf2], npix, floor, newval) + } + + # Replace pixels between lower and upper by value. + } else { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = int (upper) + while (imgnll (im, buf1, v1) != EOF) { + junk = impnll (im, buf2, v2) + call amovl (Meml[buf1], Meml[buf2], npix) + call arepl (Meml[buf2], npix, floor, ceil, newval) + } + } +end + + +# IMRREP -- Replace pixels in an image between lower and upper by value +# and a radius around those pixels. + +procedure imrrepl (im, lower, upper, radius, value, img) + + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real radius # Radius +real value # Replacement value +real img # Imaginary value for complex + +pointer buf, buf1, buf2, ptr +int i, j, k, l, nc, nl, nradius, nbufs +real ilower +long floor, ceil, newval, val1, val2 +real radius2, y2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] # IMIO vectors +int imgnll(), impnll() +bool fp_equalr() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + nc = IM_LEN(im, 1) + if (IM_NDIM(im) > 1) + nl = IM_LEN(im,2) + else + nl = 1 + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnll (im, buf2, v2) != EOF) + call amovkl (newval, Meml[buf2], nc) + return + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + floor = -MAX_LONG + ceil = int (upper) + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = MAX_LONG + + # Replace pixels between lower and upper by value. + } else { + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = int (upper) + } + + # Initialize buffering. + radius2 = radius * radius + nradius = int (radius) + nbufs = min (1 + 2 * nradius, nl) + call calloc (buf, nc*nbufs, TY_LONG) + + while (imgnll (im, buf1, v1) != EOF) { + j = v1[2] - 1 + buf2 = buf + mod (j, nbufs) * nc + do i = 1, nc { + val1 = Meml[buf1] + val2 = Meml[buf2] + if ((val1 >= floor) && (val1 <= ceil)) { + do k = max(1,j-nradius), min (nl,j+nradius) { + ptr = buf + mod (k, nbufs) * nc - 1 + y2 = (k - j) ** 2 + do l = max(1,i-nradius), min (nc,i+nradius) { + if ((l-i)**2 + y2 > radius2) + next + Meml[ptr+l] = INDEFL + } + } + } else { + if (!IS_INDEFL(val2)) + Meml[buf2] = val1 + } + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (j > nradius) { + while (impnll (im, buf2, v2) != EOF) { + k = v2[2] - 1 + buf1 = buf + mod (k, nbufs) * nc + do i = 1, nc { + val1 = Meml[buf1] + if (IS_INDEFL(Meml[buf1])) + Meml[buf2] = newval + else + Meml[buf2] = val1 + Meml[buf1] = 0. + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + if (j != nl) + break + } + } + } + + call mfree (buf, TY_LONG) +end + + +# AREP -- Replace array values which are between floor and ceil by value. + +procedure arepl (a, npts, floor, ceil, newval) + +long a[npts] # Input arrays +int npts # Number of points +long floor, ceil # Replacement limits +long newval # Replacement value + +int i + +begin + + do i = 1, npts { + if ((a[i] >= floor) && (a[i] <= ceil)) + a[i] = newval + } +end + + +# ARLE -- If A[i] is less than or equal to FLOOR replace by NEWVAL. + +procedure arlel (a, npts, floor, newval) + +long a[npts] +int npts +long floor, newval + +int i + +begin + + do i = 1, npts + if (a[i] <= floor) + a[i] = newval +end + + +# ARGE -- If A[i] is greater than or equal to CEIL replace by NEWVAL. + +procedure argel (a, npts, ceil, newval) + +long a[npts] +int npts +long ceil, newval + +int i + +begin + + do i = 1, npts + if (a[i] >= ceil) + a[i] = newval +end + + + +# IMREP -- Replace pixels in an image between lower and upper by value. + +procedure imrepr (im, lower, upper, value, img) + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real value # Replacement value +real img # Imaginary value for complex + +pointer buf1, buf2 +int npix, junk +real floor, ceil, newval +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnlr(), impnlr() + + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im, 1) + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnlr (im, buf2, v2) != EOF) + call amovkr (newval, Memr[buf2], npix) + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + ceil = double (upper) + while (imgnlr (im, buf1, v1) != EOF) { + junk = impnlr (im, buf2, v2) + call amovr (Memr[buf1], Memr[buf2], npix) + call arler (Memr[buf2], npix, ceil, newval) + } + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + floor = double (lower) + while (imgnlr (im, buf1, v1) != EOF) { + junk = impnlr (im, buf2, v2) + call amovr (Memr[buf1], Memr[buf2], npix) + call arger (Memr[buf2], npix, floor, newval) + } + + # Replace pixels between lower and upper by value. + } else { + floor = double (lower) + ceil = double (upper) + while (imgnlr (im, buf1, v1) != EOF) { + junk = impnlr (im, buf2, v2) + call amovr (Memr[buf1], Memr[buf2], npix) + call arepr (Memr[buf2], npix, floor, ceil, newval) + } + } +end + + +# IMRREP -- Replace pixels in an image between lower and upper by value +# and a radius around those pixels. + +procedure imrrepr (im, lower, upper, radius, value, img) + + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real radius # Radius +real value # Replacement value +real img # Imaginary value for complex + +pointer buf, buf1, buf2, ptr +int i, j, k, l, nc, nl, nradius, nbufs +real floor, ceil, newval, val1, val2 +real radius2, y2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] # IMIO vectors +int imgnlr(), impnlr() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + nc = IM_LEN(im, 1) + if (IM_NDIM(im) > 1) + nl = IM_LEN(im,2) + else + nl = 1 + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnlr (im, buf2, v2) != EOF) + call amovkr (newval, Memr[buf2], nc) + return + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + floor = -MAX_REAL + ceil = double (upper) + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + floor = double (lower) + ceil = MAX_REAL + + # Replace pixels between lower and upper by value. + } else { + floor = double (lower) + ceil = double (upper) + } + + # Initialize buffering. + radius2 = radius * radius + nradius = int (radius) + nbufs = min (1 + 2 * nradius, nl) + call calloc (buf, nc*nbufs, TY_REAL) + + while (imgnlr (im, buf1, v1) != EOF) { + j = v1[2] - 1 + buf2 = buf + mod (j, nbufs) * nc + do i = 1, nc { + val1 = Memr[buf1] + val2 = Memr[buf2] + if ((val1 >= floor) && (val1 <= ceil)) { + do k = max(1,j-nradius), min (nl,j+nradius) { + ptr = buf + mod (k, nbufs) * nc - 1 + y2 = (k - j) ** 2 + do l = max(1,i-nradius), min (nc,i+nradius) { + if ((l-i)**2 + y2 > radius2) + next + Memr[ptr+l] = INDEFR + } + } + } else { + if (!IS_INDEFR(val2)) + Memr[buf2] = val1 + } + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (j > nradius) { + while (impnlr (im, buf2, v2) != EOF) { + k = v2[2] - 1 + buf1 = buf + mod (k, nbufs) * nc + do i = 1, nc { + val1 = Memr[buf1] + if (IS_INDEFR(Memr[buf1])) + Memr[buf2] = newval + else + Memr[buf2] = val1 + Memr[buf1] = 0. + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + if (j != nl) + break + } + } + } + + call mfree (buf, TY_REAL) +end + + +# AREP -- Replace array values which are between floor and ceil by value. + +procedure arepr (a, npts, floor, ceil, newval) + +real a[npts] # Input arrays +int npts # Number of points +real floor, ceil # Replacement limits +real newval # Replacement value + +int i + +begin + + do i = 1, npts { + if ((a[i] >= floor) && (a[i] <= ceil)) + a[i] = newval + } +end + + +# ARLE -- If A[i] is less than or equal to FLOOR replace by NEWVAL. + +procedure arler (a, npts, floor, newval) + +real a[npts] +int npts +real floor, newval + +int i + +begin + + do i = 1, npts + if (a[i] <= floor) + a[i] = newval +end + + +# ARGE -- If A[i] is greater than or equal to CEIL replace by NEWVAL. + +procedure arger (a, npts, ceil, newval) + +real a[npts] +int npts +real ceil, newval + +int i + +begin + + do i = 1, npts + if (a[i] >= ceil) + a[i] = newval +end + + + +# IMREP -- Replace pixels in an image between lower and upper by value. + +procedure imrepd (im, lower, upper, value, img) + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real value # Replacement value +real img # Imaginary value for complex + +pointer buf1, buf2 +int npix, junk +double floor, ceil, newval +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnld(), impnld() + + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im, 1) + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnld (im, buf2, v2) != EOF) + call amovkd (newval, Memd[buf2], npix) + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + ceil = double (upper) + while (imgnld (im, buf1, v1) != EOF) { + junk = impnld (im, buf2, v2) + call amovd (Memd[buf1], Memd[buf2], npix) + call arled (Memd[buf2], npix, ceil, newval) + } + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + floor = double (lower) + while (imgnld (im, buf1, v1) != EOF) { + junk = impnld (im, buf2, v2) + call amovd (Memd[buf1], Memd[buf2], npix) + call arged (Memd[buf2], npix, floor, newval) + } + + # Replace pixels between lower and upper by value. + } else { + floor = double (lower) + ceil = double (upper) + while (imgnld (im, buf1, v1) != EOF) { + junk = impnld (im, buf2, v2) + call amovd (Memd[buf1], Memd[buf2], npix) + call arepd (Memd[buf2], npix, floor, ceil, newval) + } + } +end + + +# IMRREP -- Replace pixels in an image between lower and upper by value +# and a radius around those pixels. + +procedure imrrepd (im, lower, upper, radius, value, img) + + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real radius # Radius +real value # Replacement value +real img # Imaginary value for complex + +pointer buf, buf1, buf2, ptr +int i, j, k, l, nc, nl, nradius, nbufs +double floor, ceil, newval, val1, val2 +real radius2, y2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] # IMIO vectors +int imgnld(), impnld() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + nc = IM_LEN(im, 1) + if (IM_NDIM(im) > 1) + nl = IM_LEN(im,2) + else + nl = 1 + newval = double (value) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnld (im, buf2, v2) != EOF) + call amovkd (newval, Memd[buf2], nc) + return + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + floor = -MAX_DOUBLE + ceil = double (upper) + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + floor = double (lower) + ceil = MAX_DOUBLE + + # Replace pixels between lower and upper by value. + } else { + floor = double (lower) + ceil = double (upper) + } + + # Initialize buffering. + radius2 = radius * radius + nradius = int (radius) + nbufs = min (1 + 2 * nradius, nl) + call calloc (buf, nc*nbufs, TY_DOUBLE) + + while (imgnld (im, buf1, v1) != EOF) { + j = v1[2] - 1 + buf2 = buf + mod (j, nbufs) * nc + do i = 1, nc { + val1 = Memd[buf1] + val2 = Memd[buf2] + if ((val1 >= floor) && (val1 <= ceil)) { + do k = max(1,j-nradius), min (nl,j+nradius) { + ptr = buf + mod (k, nbufs) * nc - 1 + y2 = (k - j) ** 2 + do l = max(1,i-nradius), min (nc,i+nradius) { + if ((l-i)**2 + y2 > radius2) + next + Memd[ptr+l] = INDEFD + } + } + } else { + if (!IS_INDEFD(val2)) + Memd[buf2] = val1 + } + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (j > nradius) { + while (impnld (im, buf2, v2) != EOF) { + k = v2[2] - 1 + buf1 = buf + mod (k, nbufs) * nc + do i = 1, nc { + val1 = Memd[buf1] + if (IS_INDEFD(Memd[buf1])) + Memd[buf2] = newval + else + Memd[buf2] = val1 + Memd[buf1] = 0. + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + if (j != nl) + break + } + } + } + + call mfree (buf, TY_DOUBLE) +end + + +# AREP -- Replace array values which are between floor and ceil by value. + +procedure arepd (a, npts, floor, ceil, newval) + +double a[npts] # Input arrays +int npts # Number of points +double floor, ceil # Replacement limits +double newval # Replacement value + +int i + +begin + + do i = 1, npts { + if ((a[i] >= floor) && (a[i] <= ceil)) + a[i] = newval + } +end + + +# ARLE -- If A[i] is less than or equal to FLOOR replace by NEWVAL. + +procedure arled (a, npts, floor, newval) + +double a[npts] +int npts +double floor, newval + +int i + +begin + + do i = 1, npts + if (a[i] <= floor) + a[i] = newval +end + + +# ARGE -- If A[i] is greater than or equal to CEIL replace by NEWVAL. + +procedure arged (a, npts, ceil, newval) + +double a[npts] +int npts +double ceil, newval + +int i + +begin + + do i = 1, npts + if (a[i] >= ceil) + a[i] = newval +end + + + +# IMREP -- Replace pixels in an image between lower and upper by value. + +procedure imrepx (im, lower, upper, value, img) + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real value # Replacement value +real img # Imaginary value for complex + +pointer buf1, buf2 +int npix, junk +complex floor, ceil, newval +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnlx(), impnlx() + + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im, 1) + newval = complex (value, img) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnlx (im, buf2, v2) != EOF) + call amovkx (newval, Memx[buf2], npix) + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + ceil = double (upper) + while (imgnlx (im, buf1, v1) != EOF) { + junk = impnlx (im, buf2, v2) + call amovx (Memx[buf1], Memx[buf2], npix) + call arlex (Memx[buf2], npix, ceil, newval) + } + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + floor = double (lower) + while (imgnlx (im, buf1, v1) != EOF) { + junk = impnlx (im, buf2, v2) + call amovx (Memx[buf1], Memx[buf2], npix) + call argex (Memx[buf2], npix, floor, newval) + } + + # Replace pixels between lower and upper by value. + } else { + floor = double (lower) + ceil = double (upper) + while (imgnlx (im, buf1, v1) != EOF) { + junk = impnlx (im, buf2, v2) + call amovx (Memx[buf1], Memx[buf2], npix) + call arepx (Memx[buf2], npix, floor, ceil, newval) + } + } +end + + +# IMRREP -- Replace pixels in an image between lower and upper by value +# and a radius around those pixels. + +procedure imrrepx (im, lower, upper, radius, value, img) + + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real radius # Radius +real value # Replacement value +real img # Imaginary value for complex + +pointer buf, buf1, buf2, ptr +int i, j, k, l, nc, nl, nradius, nbufs +complex floor, ceil, newval, val1, val2 +real abs_floor, abs_ceil +real radius2, y2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] # IMIO vectors +int imgnlx(), impnlx() + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + nc = IM_LEN(im, 1) + if (IM_NDIM(im) > 1) + nl = IM_LEN(im,2) + else + nl = 1 + newval = complex (value, img) + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnlx (im, buf2, v2) != EOF) + call amovkx (newval, Memx[buf2], nc) + return + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + floor = 0 + ceil = real (upper) + abs_floor = abs (floor) + abs_ceil = abs (ceil) + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + floor = real (lower) + ceil = MAX_REAL + abs_floor = abs (floor) + abs_ceil = abs (ceil) + + # Replace pixels between lower and upper by value. + } else { + floor = real (lower) + ceil = real (upper) + abs_floor = abs (floor) + abs_ceil = abs (ceil) + } + + # Initialize buffering. + radius2 = radius * radius + nradius = int (radius) + nbufs = min (1 + 2 * nradius, nl) + call calloc (buf, nc*nbufs, TY_COMPLEX) + + while (imgnlx (im, buf1, v1) != EOF) { + j = v1[2] - 1 + buf2 = buf + mod (j, nbufs) * nc + do i = 1, nc { + val1 = Memx[buf1] + val2 = Memx[buf2] + if ((abs (val1) >= abs_floor) && (abs (val1) <= abs_ceil)) { + do k = max(1,j-nradius), min (nl,j+nradius) { + ptr = buf + mod (k, nbufs) * nc - 1 + y2 = (k - j) ** 2 + do l = max(1,i-nradius), min (nc,i+nradius) { + if ((l-i)**2 + y2 > radius2) + next + Memx[ptr+l] = INDEFX + } + } + } else { + if (!IS_INDEFX(val2)) + Memx[buf2] = val1 + } + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (j > nradius) { + while (impnlx (im, buf2, v2) != EOF) { + k = v2[2] - 1 + buf1 = buf + mod (k, nbufs) * nc + do i = 1, nc { + val1 = Memx[buf1] + if (IS_INDEFX(Memx[buf1])) + Memx[buf2] = newval + else + Memx[buf2] = val1 + Memx[buf1] = 0. + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + if (j != nl) + break + } + } + } + + call mfree (buf, TY_COMPLEX) +end + + +# AREP -- Replace array values which are between floor and ceil by value. + +procedure arepx (a, npts, floor, ceil, newval) + +complex a[npts] # Input arrays +int npts # Number of points +complex floor, ceil # Replacement limits +complex newval # Replacement value + +int i +real abs_floor +real abs_ceil + +begin + abs_floor = abs (floor) + abs_ceil = abs (ceil) + + do i = 1, npts { + if ((abs (a[i]) >= abs_floor) && (abs (a[i]) <= abs_ceil)) + a[i] = newval + } +end + + +# ARLE -- If A[i] is less than or equal to FLOOR replace by NEWVAL. + +procedure arlex (a, npts, floor, newval) + +complex a[npts] +int npts +complex floor, newval + +int i +real abs_floor + +begin + abs_floor = abs (floor) + + do i = 1, npts + if (abs (a[i]) <= abs_floor) + a[i] = newval +end + + +# ARGE -- If A[i] is greater than or equal to CEIL replace by NEWVAL. + +procedure argex (a, npts, ceil, newval) + +complex a[npts] +int npts +complex ceil, newval + +int i +real abs_ceil + +begin + abs_ceil = abs (ceil) + + do i = 1, npts + if (abs (a[i]) >= abs_ceil) + a[i] = newval +end + + diff --git a/pkg/images/imutil/src/generic/imsum.x b/pkg/images/imutil/src/generic/imsum.x new file mode 100644 index 00000000..fcb43716 --- /dev/null +++ b/pkg/images/imutil/src/generic/imsum.x @@ -0,0 +1,1902 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../imsum.h" + +define TMINSW 1.00 # Relative timings for nvecs = 5 +define TMXMNSW 1.46 +define TMED3 0.18 +define TMED5 0.55 + +# IMSUM -- Sum or average images with optional high and low pixel rejection. +# +# This procedure has to be clever in not exceeding the maximum number of images +# which can be mapped at one time. If no pixels are being rejected then the +# images can be summed (or averaged) in blocks using the output image to hold +# intermediate results. If pixels are being rejected then lines from all +# images must be obtained. If the number of images exceeds the maximum +# then only a subset of the images are kept mapped and the remainder are +# mapped and unmapped for each line. This, of course, is inefficient but +# there is no other way. + + +procedure imsums (list, output, im_out, nlow, nhigh, option) + +int list # List of input images +char output[ARB] # Output image +pointer im_out # Output image pointer +int nlow # Number of low pixels to reject +int nhigh # Number of high pixels to reject +char option[ARB] # Output option + +int i, n, nimages, naccept, npix, ndone, pass +short const +pointer sp, input, v1, v2, im, buf, buf1, buf_in, buf_out + +bool streq() +int imtlen(), imtgetim(), imtrgetim() +pointer immap(), imgnls(), impnls() +errchk immap, imunmap, imgnls, impnls + +begin + # Initialize. + nimages = imtlen (list) + naccept = nimages - nlow - nhigh + const = naccept + npix = IM_LEN(im_out, 1) + if (naccept < 1) + call error (0, "Number of rejected pixels is too large") + + # Allocate memory. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (im, nimages, TY_INT) + + # If there are no pixels to be rejected avoid calls to reject pixels + # and do the operation in blocks so that the number of images mapped + # does not exceed the maximum. The output image is used to + # store intermediate results. + + if ((nlow == 0) && (nhigh == 0)) { + pass = 0 + ndone = 0 + repeat { + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX) + break + } + ndone = ndone + n + + pass = pass + 1 + if (pass > 1) { + call imunmap (im_out) + im_out = immap (output, READ_WRITE, 0) + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # For each input line compute an output line. + while (impnls (im_out, buf_out, Meml[v2]) != EOF) { + + # Clear the output buffer during the first pass and + # read in the partial sum from the output image during + # subsequent passes. + + if (pass == 1) + call aclrs (Mems[buf_out], npix) + else { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnls (im_out, buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call amovs (Mems[buf_in], Mems[buf_out], npix) + } + + # Accumulate lines from each input image. + do i = 1, n { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnls (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call aadds (Mems[buf_in], Mems[buf_out], + Mems[buf_out], npix) + } + + # If all images have been accumulated and averaging then + # divide by the number of images. + if ((ndone == nimages) && streq (option, "average")) + call adivks (Mems[buf_out], const, Mems[buf_out], + npix) + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + do i = 1, n + call imunmap (Memi[im+i-1]) + } until (ndone == nimages) + + # Finish up. + call sfree (sp) + return + } + + + # Map the input images up to the maximum allowed. The remainder + # will be mapped during each line. + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX - 1) + break + } + + # Allocate additional buffer space. + call salloc (buf, nimages, TY_INT) + if (nimages - n > 0) + call salloc (buf1, (nimages-n)*npix, TY_SHORT) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # Compute output lines for each input line. + while (impnls (im_out, buf_out, Meml[v2]) != EOF) { + + # Read lines from the images which remain open. + for (i = 1; i <= n; i = i + 1) { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnls (Memi[im+i-1], Memi[buf+i-1], Meml[v2]) == EOF) + call error (0, "Error reading input image") + } + + # For all additional images map the image, read a line, copy the + # data to a buffer since the image buffer is reused, and unmap + # the image. + for (; i <= nimages; i = i + 1) { + if (imtrgetim (list, i, Memc[input], SZ_FNAME) == EOF) + break + Memi[im+i-1] = immap (Memc[input], READ_ONLY, 0) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnls (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + Memi[buf+i-1] = buf1 + (i - n - 1) * npix + call amovs (Mems[buf_in], Mems[Memi[buf+i-1]], npix) + call imunmap (Memi[im+i-1]) + } + + # Reject pixels. + call imrejs (Memi[buf], nimages, Mems[buf_out], npix, nlow, nhigh) + + # If averaging divide the sum by the number of images averaged. + if ((naccept > 1) && streq (option, "average")) { + const = naccept + call adivks (Mems[buf_out], const, Mems[buf_out], npix) + } + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Finish up. + do i = 1, n + call imunmap (Memi[im+i-1]) + call sfree (sp) +end + + +# IMREJ -- Reject the number of high and low points and sum the rest. + +procedure imrejs (a, nvecs, b, npts, nlow, nhigh) + +pointer a[nvecs] # Pointers to set of vectors +int nvecs # Number of vectors +short b[npts] # Output vector +int npts # Number of points in the vectors +int nlow # Number of low points to be rejected +int nhigh # Number of high points to be rejected + +int i, j +int naccept, minrej, npairs, nlow1, nhigh1 +real tmedian, time1, time2 + +begin + naccept = nvecs - nlow - nhigh + + # If no points are rejected return the sum. + + if (naccept == nvecs) { + call amovs (Mems[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aadds (Mems[a[j]], b, b, npts) + return + } + + minrej = min (nlow, nhigh) + npairs = minrej + nlow1 = nlow - npairs + nhigh1 = nhigh - npairs + + if ((naccept == 1) && (npairs > 0)) { + if (npairs == 1) { + tmedian = TMED3 + npairs = npairs - 1 + } else { + tmedian = TMED5 + npairs = npairs - 2 + } + } else + tmedian = 0 + + # Compare the time required to reject the minimum number + # of low or high points and extract the number of points to accept + # with the time to reject pairs and the excess number of low or + # high points to either reach a median of 3 or 5 points or isolate + # the acceptable points. + + time1 = TMINSW * (minrej + naccept) + time2 = tmedian + TMXMNSW * npairs + TMINSW * (nlow1 + nhigh1) + + i = nvecs + if (time1 < time2) { + + # Sort the nlow and naccept points + if (nlow < nhigh) { + for (j = 1; j <= nlow + naccept; j = j + 1) { + call minsws (a, i, npts) + i = i - 1 + } + call amovs (Mems[a[nhigh+1]], b, npts) + for (j = nhigh+2; j <= nhigh+naccept; j = j + 1) + call aadds (Mems[a[j]], b, b, npts) + + # Sort the nhigh and naccept points + } else { + for (j = 1; j <= nhigh + naccept; j = j + 1) { + call maxsws (a, i, npts) + i = i - 1 + } + call amovs (Mems[a[nlow+1]], b, npts) + for (j = nlow+2; j <= nlow+naccept; j = j + 1) + call aadds (Mems[a[j]], b, b, npts) + } + + } else { + # Reject the npairs low and high points. + for (j = 1; j <= npairs; j = j + 1) { + call mxmnsws (a, i, npts) + i = i - 2 + } + # Reject the excess low points. + for (j = 1; j <= nlow1; j = j + 1) { + call minsws (a, i, npts) + i = i - 1 + } + # Reject the excess high points. + for (j = 1; j <= nhigh1; j = j + 1) { + call maxsws (a, i, npts) + i = i - 1 + } + + # Check if the remaining points constitute a 3 or 5 point median + # or the set of desired points. + if (tmedian == 0.) { + call amovs (Mems[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aadds (Mems[a[j]], b, b, npts) + } else if (tmedian == TMED3) { + call amed3s (Mems[a[1]], Mems[a[2]], Mems[a[3]], b, npts) + } else { + call amed5s (Mems[a[1]], Mems[a[2]], Mems[a[3]], + Mems[a[4]], Mems[a[5]], b, npts) + } + } +end + + +# MINSW -- Given an array of vector pointers for each element in the vectors +# swap the minimum element with that of the last vector. + +procedure minsws (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmin +short temp + +begin + do i = 0, npts - 1 { + kmin = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Mems[k] < Mems[kmin]) + kmin = k + } + if (k != kmin) { + temp = Mems[k] + Mems[k] = Mems[kmin] + Mems[kmin] = temp + } + } +end + + +# MAXSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector. + +procedure maxsws (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax +short temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Mems[k] > Mems[kmax]) + kmax = k + } + if (k != kmax) { + temp = Mems[k] + Mems[k] = Mems[kmax] + Mems[kmax] = temp + } + } +end + + +# MXMNSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector and the minimum element +# with that of the next to last vector. The number of vectors must be greater +# than 1. + +procedure mxmnsws (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax, kmin +short temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + kmin = kmax + do j = 2, nvecs { + k = a[j] + i + if (Mems[k] > Mems[kmax]) + kmax = k + else if (Mems[k] < Mems[kmin]) + kmin = k + } + temp = Mems[k] + Mems[k] = Mems[kmax] + Mems[kmax] = temp + if (kmin == k) { + j = a[nvecs - 1] + i + temp = Mems[j] + Mems[j] = Mems[kmax] + Mems[kmax] = temp + } else { + j = a[nvecs - 1] + i + temp = Mems[j] + Mems[j] = Mems[kmin] + Mems[kmin] = temp + } + } +end + +procedure imsumi (list, output, im_out, nlow, nhigh, option) + +int list # List of input images +char output[ARB] # Output image +pointer im_out # Output image pointer +int nlow # Number of low pixels to reject +int nhigh # Number of high pixels to reject +char option[ARB] # Output option + +int i, n, nimages, naccept, npix, ndone, pass +int const +pointer sp, input, v1, v2, im, buf, buf1, buf_in, buf_out + +bool streq() +int imtlen(), imtgetim(), imtrgetim() +pointer immap(), imgnli(), impnli() +errchk immap, imunmap, imgnli, impnli + +begin + # Initialize. + nimages = imtlen (list) + naccept = nimages - nlow - nhigh + const = naccept + npix = IM_LEN(im_out, 1) + if (naccept < 1) + call error (0, "Number of rejected pixels is too large") + + # Allocate memory. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (im, nimages, TY_INT) + + # If there are no pixels to be rejected avoid calls to reject pixels + # and do the operation in blocks so that the number of images mapped + # does not exceed the maximum. The output image is used to + # store intermediate results. + + if ((nlow == 0) && (nhigh == 0)) { + pass = 0 + ndone = 0 + repeat { + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX) + break + } + ndone = ndone + n + + pass = pass + 1 + if (pass > 1) { + call imunmap (im_out) + im_out = immap (output, READ_WRITE, 0) + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # For each input line compute an output line. + while (impnli (im_out, buf_out, Meml[v2]) != EOF) { + + # Clear the output buffer during the first pass and + # read in the partial sum from the output image during + # subsequent passes. + + if (pass == 1) + call aclri (Memi[buf_out], npix) + else { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnli (im_out, buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call amovi (Memi[buf_in], Memi[buf_out], npix) + } + + # Accumulate lines from each input image. + do i = 1, n { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnli (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call aaddi (Memi[buf_in], Memi[buf_out], + Memi[buf_out], npix) + } + + # If all images have been accumulated and averaging then + # divide by the number of images. + if ((ndone == nimages) && streq (option, "average")) + call adivki (Memi[buf_out], const, Memi[buf_out], + npix) + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + do i = 1, n + call imunmap (Memi[im+i-1]) + } until (ndone == nimages) + + # Finish up. + call sfree (sp) + return + } + + + # Map the input images up to the maximum allowed. The remainder + # will be mapped during each line. + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX - 1) + break + } + + # Allocate additional buffer space. + call salloc (buf, nimages, TY_INT) + if (nimages - n > 0) + call salloc (buf1, (nimages-n)*npix, TY_INT) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # Compute output lines for each input line. + while (impnli (im_out, buf_out, Meml[v2]) != EOF) { + + # Read lines from the images which remain open. + for (i = 1; i <= n; i = i + 1) { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnli (Memi[im+i-1], Memi[buf+i-1], Meml[v2]) == EOF) + call error (0, "Error reading input image") + } + + # For all additional images map the image, read a line, copy the + # data to a buffer since the image buffer is reused, and unmap + # the image. + for (; i <= nimages; i = i + 1) { + if (imtrgetim (list, i, Memc[input], SZ_FNAME) == EOF) + break + Memi[im+i-1] = immap (Memc[input], READ_ONLY, 0) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnli (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + Memi[buf+i-1] = buf1 + (i - n - 1) * npix + call amovi (Memi[buf_in], Memi[Memi[buf+i-1]], npix) + call imunmap (Memi[im+i-1]) + } + + # Reject pixels. + call imreji (Memi[buf], nimages, Memi[buf_out], npix, nlow, nhigh) + + # If averaging divide the sum by the number of images averaged. + if ((naccept > 1) && streq (option, "average")) { + const = naccept + call adivki (Memi[buf_out], const, Memi[buf_out], npix) + } + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Finish up. + do i = 1, n + call imunmap (Memi[im+i-1]) + call sfree (sp) +end + + +# IMREJ -- Reject the number of high and low points and sum the rest. + +procedure imreji (a, nvecs, b, npts, nlow, nhigh) + +pointer a[nvecs] # Pointers to set of vectors +int nvecs # Number of vectors +int b[npts] # Output vector +int npts # Number of points in the vectors +int nlow # Number of low points to be rejected +int nhigh # Number of high points to be rejected + +int i, j +int naccept, minrej, npairs, nlow1, nhigh1 +real tmedian, time1, time2 + +begin + naccept = nvecs - nlow - nhigh + + # If no points are rejected return the sum. + + if (naccept == nvecs) { + call amovi (Memi[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aaddi (Memi[a[j]], b, b, npts) + return + } + + minrej = min (nlow, nhigh) + npairs = minrej + nlow1 = nlow - npairs + nhigh1 = nhigh - npairs + + if ((naccept == 1) && (npairs > 0)) { + if (npairs == 1) { + tmedian = TMED3 + npairs = npairs - 1 + } else { + tmedian = TMED5 + npairs = npairs - 2 + } + } else + tmedian = 0 + + # Compare the time required to reject the minimum number + # of low or high points and extract the number of points to accept + # with the time to reject pairs and the excess number of low or + # high points to either reach a median of 3 or 5 points or isolate + # the acceptable points. + + time1 = TMINSW * (minrej + naccept) + time2 = tmedian + TMXMNSW * npairs + TMINSW * (nlow1 + nhigh1) + + i = nvecs + if (time1 < time2) { + + # Sort the nlow and naccept points + if (nlow < nhigh) { + for (j = 1; j <= nlow + naccept; j = j + 1) { + call minswi (a, i, npts) + i = i - 1 + } + call amovi (Memi[a[nhigh+1]], b, npts) + for (j = nhigh+2; j <= nhigh+naccept; j = j + 1) + call aaddi (Memi[a[j]], b, b, npts) + + # Sort the nhigh and naccept points + } else { + for (j = 1; j <= nhigh + naccept; j = j + 1) { + call maxswi (a, i, npts) + i = i - 1 + } + call amovi (Memi[a[nlow+1]], b, npts) + for (j = nlow+2; j <= nlow+naccept; j = j + 1) + call aaddi (Memi[a[j]], b, b, npts) + } + + } else { + # Reject the npairs low and high points. + for (j = 1; j <= npairs; j = j + 1) { + call mxmnswi (a, i, npts) + i = i - 2 + } + # Reject the excess low points. + for (j = 1; j <= nlow1; j = j + 1) { + call minswi (a, i, npts) + i = i - 1 + } + # Reject the excess high points. + for (j = 1; j <= nhigh1; j = j + 1) { + call maxswi (a, i, npts) + i = i - 1 + } + + # Check if the remaining points constitute a 3 or 5 point median + # or the set of desired points. + if (tmedian == 0.) { + call amovi (Memi[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aaddi (Memi[a[j]], b, b, npts) + } else if (tmedian == TMED3) { + call amed3i (Memi[a[1]], Memi[a[2]], Memi[a[3]], b, npts) + } else { + call amed5i (Memi[a[1]], Memi[a[2]], Memi[a[3]], + Memi[a[4]], Memi[a[5]], b, npts) + } + } +end + + +# MINSW -- Given an array of vector pointers for each element in the vectors +# swap the minimum element with that of the last vector. + +procedure minswi (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmin +int temp + +begin + do i = 0, npts - 1 { + kmin = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Memi[k] < Memi[kmin]) + kmin = k + } + if (k != kmin) { + temp = Memi[k] + Memi[k] = Memi[kmin] + Memi[kmin] = temp + } + } +end + + +# MAXSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector. + +procedure maxswi (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax +int temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Memi[k] > Memi[kmax]) + kmax = k + } + if (k != kmax) { + temp = Memi[k] + Memi[k] = Memi[kmax] + Memi[kmax] = temp + } + } +end + + +# MXMNSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector and the minimum element +# with that of the next to last vector. The number of vectors must be greater +# than 1. + +procedure mxmnswi (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax, kmin +int temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + kmin = kmax + do j = 2, nvecs { + k = a[j] + i + if (Memi[k] > Memi[kmax]) + kmax = k + else if (Memi[k] < Memi[kmin]) + kmin = k + } + temp = Memi[k] + Memi[k] = Memi[kmax] + Memi[kmax] = temp + if (kmin == k) { + j = a[nvecs - 1] + i + temp = Memi[j] + Memi[j] = Memi[kmax] + Memi[kmax] = temp + } else { + j = a[nvecs - 1] + i + temp = Memi[j] + Memi[j] = Memi[kmin] + Memi[kmin] = temp + } + } +end + +procedure imsuml (list, output, im_out, nlow, nhigh, option) + +int list # List of input images +char output[ARB] # Output image +pointer im_out # Output image pointer +int nlow # Number of low pixels to reject +int nhigh # Number of high pixels to reject +char option[ARB] # Output option + +int i, n, nimages, naccept, npix, ndone, pass +long const +pointer sp, input, v1, v2, im, buf, buf1, buf_in, buf_out + +bool streq() +int imtlen(), imtgetim(), imtrgetim() +pointer immap(), imgnll(), impnll() +errchk immap, imunmap, imgnll, impnll + +begin + # Initialize. + nimages = imtlen (list) + naccept = nimages - nlow - nhigh + const = naccept + npix = IM_LEN(im_out, 1) + if (naccept < 1) + call error (0, "Number of rejected pixels is too large") + + # Allocate memory. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (im, nimages, TY_INT) + + # If there are no pixels to be rejected avoid calls to reject pixels + # and do the operation in blocks so that the number of images mapped + # does not exceed the maximum. The output image is used to + # store intermediate results. + + if ((nlow == 0) && (nhigh == 0)) { + pass = 0 + ndone = 0 + repeat { + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX) + break + } + ndone = ndone + n + + pass = pass + 1 + if (pass > 1) { + call imunmap (im_out) + im_out = immap (output, READ_WRITE, 0) + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # For each input line compute an output line. + while (impnll (im_out, buf_out, Meml[v2]) != EOF) { + + # Clear the output buffer during the first pass and + # read in the partial sum from the output image during + # subsequent passes. + + if (pass == 1) + call aclrl (Meml[buf_out], npix) + else { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnll (im_out, buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call amovl (Meml[buf_in], Meml[buf_out], npix) + } + + # Accumulate lines from each input image. + do i = 1, n { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnll (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call aaddl (Meml[buf_in], Meml[buf_out], + Meml[buf_out], npix) + } + + # If all images have been accumulated and averaging then + # divide by the number of images. + if ((ndone == nimages) && streq (option, "average")) + call adivkl (Meml[buf_out], const, Meml[buf_out], + npix) + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + do i = 1, n + call imunmap (Memi[im+i-1]) + } until (ndone == nimages) + + # Finish up. + call sfree (sp) + return + } + + + # Map the input images up to the maximum allowed. The remainder + # will be mapped during each line. + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX - 1) + break + } + + # Allocate additional buffer space. + call salloc (buf, nimages, TY_INT) + if (nimages - n > 0) + call salloc (buf1, (nimages-n)*npix, TY_LONG) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # Compute output lines for each input line. + while (impnll (im_out, buf_out, Meml[v2]) != EOF) { + + # Read lines from the images which remain open. + for (i = 1; i <= n; i = i + 1) { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnll (Memi[im+i-1], Memi[buf+i-1], Meml[v2]) == EOF) + call error (0, "Error reading input image") + } + + # For all additional images map the image, read a line, copy the + # data to a buffer since the image buffer is reused, and unmap + # the image. + for (; i <= nimages; i = i + 1) { + if (imtrgetim (list, i, Memc[input], SZ_FNAME) == EOF) + break + Memi[im+i-1] = immap (Memc[input], READ_ONLY, 0) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnll (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + Memi[buf+i-1] = buf1 + (i - n - 1) * npix + call amovl (Meml[buf_in], Meml[Memi[buf+i-1]], npix) + call imunmap (Memi[im+i-1]) + } + + # Reject pixels. + call imrejl (Memi[buf], nimages, Meml[buf_out], npix, nlow, nhigh) + + # If averaging divide the sum by the number of images averaged. + if ((naccept > 1) && streq (option, "average")) { + const = naccept + call adivkl (Meml[buf_out], const, Meml[buf_out], npix) + } + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Finish up. + do i = 1, n + call imunmap (Memi[im+i-1]) + call sfree (sp) +end + + +# IMREJ -- Reject the number of high and low points and sum the rest. + +procedure imrejl (a, nvecs, b, npts, nlow, nhigh) + +pointer a[nvecs] # Pointers to set of vectors +int nvecs # Number of vectors +long b[npts] # Output vector +int npts # Number of points in the vectors +int nlow # Number of low points to be rejected +int nhigh # Number of high points to be rejected + +int i, j +int naccept, minrej, npairs, nlow1, nhigh1 +real tmedian, time1, time2 + +begin + naccept = nvecs - nlow - nhigh + + # If no points are rejected return the sum. + + if (naccept == nvecs) { + call amovl (Meml[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aaddl (Meml[a[j]], b, b, npts) + return + } + + minrej = min (nlow, nhigh) + npairs = minrej + nlow1 = nlow - npairs + nhigh1 = nhigh - npairs + + if ((naccept == 1) && (npairs > 0)) { + if (npairs == 1) { + tmedian = TMED3 + npairs = npairs - 1 + } else { + tmedian = TMED5 + npairs = npairs - 2 + } + } else + tmedian = 0 + + # Compare the time required to reject the minimum number + # of low or high points and extract the number of points to accept + # with the time to reject pairs and the excess number of low or + # high points to either reach a median of 3 or 5 points or isolate + # the acceptable points. + + time1 = TMINSW * (minrej + naccept) + time2 = tmedian + TMXMNSW * npairs + TMINSW * (nlow1 + nhigh1) + + i = nvecs + if (time1 < time2) { + + # Sort the nlow and naccept points + if (nlow < nhigh) { + for (j = 1; j <= nlow + naccept; j = j + 1) { + call minswl (a, i, npts) + i = i - 1 + } + call amovl (Meml[a[nhigh+1]], b, npts) + for (j = nhigh+2; j <= nhigh+naccept; j = j + 1) + call aaddl (Meml[a[j]], b, b, npts) + + # Sort the nhigh and naccept points + } else { + for (j = 1; j <= nhigh + naccept; j = j + 1) { + call maxswl (a, i, npts) + i = i - 1 + } + call amovl (Meml[a[nlow+1]], b, npts) + for (j = nlow+2; j <= nlow+naccept; j = j + 1) + call aaddl (Meml[a[j]], b, b, npts) + } + + } else { + # Reject the npairs low and high points. + for (j = 1; j <= npairs; j = j + 1) { + call mxmnswl (a, i, npts) + i = i - 2 + } + # Reject the excess low points. + for (j = 1; j <= nlow1; j = j + 1) { + call minswl (a, i, npts) + i = i - 1 + } + # Reject the excess high points. + for (j = 1; j <= nhigh1; j = j + 1) { + call maxswl (a, i, npts) + i = i - 1 + } + + # Check if the remaining points constitute a 3 or 5 point median + # or the set of desired points. + if (tmedian == 0.) { + call amovl (Meml[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aaddl (Meml[a[j]], b, b, npts) + } else if (tmedian == TMED3) { + call amed3l (Meml[a[1]], Meml[a[2]], Meml[a[3]], b, npts) + } else { + call amed5l (Meml[a[1]], Meml[a[2]], Meml[a[3]], + Meml[a[4]], Meml[a[5]], b, npts) + } + } +end + + +# MINSW -- Given an array of vector pointers for each element in the vectors +# swap the minimum element with that of the last vector. + +procedure minswl (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmin +long temp + +begin + do i = 0, npts - 1 { + kmin = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Meml[k] < Meml[kmin]) + kmin = k + } + if (k != kmin) { + temp = Meml[k] + Meml[k] = Meml[kmin] + Meml[kmin] = temp + } + } +end + + +# MAXSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector. + +procedure maxswl (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax +long temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Meml[k] > Meml[kmax]) + kmax = k + } + if (k != kmax) { + temp = Meml[k] + Meml[k] = Meml[kmax] + Meml[kmax] = temp + } + } +end + + +# MXMNSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector and the minimum element +# with that of the next to last vector. The number of vectors must be greater +# than 1. + +procedure mxmnswl (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax, kmin +long temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + kmin = kmax + do j = 2, nvecs { + k = a[j] + i + if (Meml[k] > Meml[kmax]) + kmax = k + else if (Meml[k] < Meml[kmin]) + kmin = k + } + temp = Meml[k] + Meml[k] = Meml[kmax] + Meml[kmax] = temp + if (kmin == k) { + j = a[nvecs - 1] + i + temp = Meml[j] + Meml[j] = Meml[kmax] + Meml[kmax] = temp + } else { + j = a[nvecs - 1] + i + temp = Meml[j] + Meml[j] = Meml[kmin] + Meml[kmin] = temp + } + } +end + +procedure imsumr (list, output, im_out, nlow, nhigh, option) + +int list # List of input images +char output[ARB] # Output image +pointer im_out # Output image pointer +int nlow # Number of low pixels to reject +int nhigh # Number of high pixels to reject +char option[ARB] # Output option + +int i, n, nimages, naccept, npix, ndone, pass +real const +pointer sp, input, v1, v2, im, buf, buf1, buf_in, buf_out + +bool streq() +int imtlen(), imtgetim(), imtrgetim() +pointer immap(), imgnlr(), impnlr() +errchk immap, imunmap, imgnlr, impnlr + +begin + # Initialize. + nimages = imtlen (list) + naccept = nimages - nlow - nhigh + const = naccept + npix = IM_LEN(im_out, 1) + if (naccept < 1) + call error (0, "Number of rejected pixels is too large") + + # Allocate memory. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (im, nimages, TY_INT) + + # If there are no pixels to be rejected avoid calls to reject pixels + # and do the operation in blocks so that the number of images mapped + # does not exceed the maximum. The output image is used to + # store intermediate results. + + if ((nlow == 0) && (nhigh == 0)) { + pass = 0 + ndone = 0 + repeat { + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX) + break + } + ndone = ndone + n + + pass = pass + 1 + if (pass > 1) { + call imunmap (im_out) + im_out = immap (output, READ_WRITE, 0) + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # For each input line compute an output line. + while (impnlr (im_out, buf_out, Meml[v2]) != EOF) { + + # Clear the output buffer during the first pass and + # read in the partial sum from the output image during + # subsequent passes. + + if (pass == 1) + call aclrr (Memr[buf_out], npix) + else { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnlr (im_out, buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call amovr (Memr[buf_in], Memr[buf_out], npix) + } + + # Accumulate lines from each input image. + do i = 1, n { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnlr (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call aaddr (Memr[buf_in], Memr[buf_out], + Memr[buf_out], npix) + } + + # If all images have been accumulated and averaging then + # divide by the number of images. + if ((ndone == nimages) && streq (option, "average")) + call adivkr (Memr[buf_out], const, Memr[buf_out], + npix) + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + do i = 1, n + call imunmap (Memi[im+i-1]) + } until (ndone == nimages) + + # Finish up. + call sfree (sp) + return + } + + + # Map the input images up to the maximum allowed. The remainder + # will be mapped during each line. + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX - 1) + break + } + + # Allocate additional buffer space. + call salloc (buf, nimages, TY_INT) + if (nimages - n > 0) + call salloc (buf1, (nimages-n)*npix, TY_REAL) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # Compute output lines for each input line. + while (impnlr (im_out, buf_out, Meml[v2]) != EOF) { + + # Read lines from the images which remain open. + for (i = 1; i <= n; i = i + 1) { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnlr (Memi[im+i-1], Memi[buf+i-1], Meml[v2]) == EOF) + call error (0, "Error reading input image") + } + + # For all additional images map the image, read a line, copy the + # data to a buffer since the image buffer is reused, and unmap + # the image. + for (; i <= nimages; i = i + 1) { + if (imtrgetim (list, i, Memc[input], SZ_FNAME) == EOF) + break + Memi[im+i-1] = immap (Memc[input], READ_ONLY, 0) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnlr (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + Memi[buf+i-1] = buf1 + (i - n - 1) * npix + call amovr (Memr[buf_in], Memr[Memi[buf+i-1]], npix) + call imunmap (Memi[im+i-1]) + } + + # Reject pixels. + call imrejr (Memi[buf], nimages, Memr[buf_out], npix, nlow, nhigh) + + # If averaging divide the sum by the number of images averaged. + if ((naccept > 1) && streq (option, "average")) { + const = naccept + call adivkr (Memr[buf_out], const, Memr[buf_out], npix) + } + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Finish up. + do i = 1, n + call imunmap (Memi[im+i-1]) + call sfree (sp) +end + + +# IMREJ -- Reject the number of high and low points and sum the rest. + +procedure imrejr (a, nvecs, b, npts, nlow, nhigh) + +pointer a[nvecs] # Pointers to set of vectors +int nvecs # Number of vectors +real b[npts] # Output vector +int npts # Number of points in the vectors +int nlow # Number of low points to be rejected +int nhigh # Number of high points to be rejected + +int i, j +int naccept, minrej, npairs, nlow1, nhigh1 +real tmedian, time1, time2 + +begin + naccept = nvecs - nlow - nhigh + + # If no points are rejected return the sum. + + if (naccept == nvecs) { + call amovr (Memr[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aaddr (Memr[a[j]], b, b, npts) + return + } + + minrej = min (nlow, nhigh) + npairs = minrej + nlow1 = nlow - npairs + nhigh1 = nhigh - npairs + + if ((naccept == 1) && (npairs > 0)) { + if (npairs == 1) { + tmedian = TMED3 + npairs = npairs - 1 + } else { + tmedian = TMED5 + npairs = npairs - 2 + } + } else + tmedian = 0 + + # Compare the time required to reject the minimum number + # of low or high points and extract the number of points to accept + # with the time to reject pairs and the excess number of low or + # high points to either reach a median of 3 or 5 points or isolate + # the acceptable points. + + time1 = TMINSW * (minrej + naccept) + time2 = tmedian + TMXMNSW * npairs + TMINSW * (nlow1 + nhigh1) + + i = nvecs + if (time1 < time2) { + + # Sort the nlow and naccept points + if (nlow < nhigh) { + for (j = 1; j <= nlow + naccept; j = j + 1) { + call minswr (a, i, npts) + i = i - 1 + } + call amovr (Memr[a[nhigh+1]], b, npts) + for (j = nhigh+2; j <= nhigh+naccept; j = j + 1) + call aaddr (Memr[a[j]], b, b, npts) + + # Sort the nhigh and naccept points + } else { + for (j = 1; j <= nhigh + naccept; j = j + 1) { + call maxswr (a, i, npts) + i = i - 1 + } + call amovr (Memr[a[nlow+1]], b, npts) + for (j = nlow+2; j <= nlow+naccept; j = j + 1) + call aaddr (Memr[a[j]], b, b, npts) + } + + } else { + # Reject the npairs low and high points. + for (j = 1; j <= npairs; j = j + 1) { + call mxmnswr (a, i, npts) + i = i - 2 + } + # Reject the excess low points. + for (j = 1; j <= nlow1; j = j + 1) { + call minswr (a, i, npts) + i = i - 1 + } + # Reject the excess high points. + for (j = 1; j <= nhigh1; j = j + 1) { + call maxswr (a, i, npts) + i = i - 1 + } + + # Check if the remaining points constitute a 3 or 5 point median + # or the set of desired points. + if (tmedian == 0.) { + call amovr (Memr[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aaddr (Memr[a[j]], b, b, npts) + } else if (tmedian == TMED3) { + call amed3r (Memr[a[1]], Memr[a[2]], Memr[a[3]], b, npts) + } else { + call amed5r (Memr[a[1]], Memr[a[2]], Memr[a[3]], + Memr[a[4]], Memr[a[5]], b, npts) + } + } +end + + +# MINSW -- Given an array of vector pointers for each element in the vectors +# swap the minimum element with that of the last vector. + +procedure minswr (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmin +real temp + +begin + do i = 0, npts - 1 { + kmin = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Memr[k] < Memr[kmin]) + kmin = k + } + if (k != kmin) { + temp = Memr[k] + Memr[k] = Memr[kmin] + Memr[kmin] = temp + } + } +end + + +# MAXSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector. + +procedure maxswr (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax +real temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Memr[k] > Memr[kmax]) + kmax = k + } + if (k != kmax) { + temp = Memr[k] + Memr[k] = Memr[kmax] + Memr[kmax] = temp + } + } +end + + +# MXMNSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector and the minimum element +# with that of the next to last vector. The number of vectors must be greater +# than 1. + +procedure mxmnswr (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax, kmin +real temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + kmin = kmax + do j = 2, nvecs { + k = a[j] + i + if (Memr[k] > Memr[kmax]) + kmax = k + else if (Memr[k] < Memr[kmin]) + kmin = k + } + temp = Memr[k] + Memr[k] = Memr[kmax] + Memr[kmax] = temp + if (kmin == k) { + j = a[nvecs - 1] + i + temp = Memr[j] + Memr[j] = Memr[kmax] + Memr[kmax] = temp + } else { + j = a[nvecs - 1] + i + temp = Memr[j] + Memr[j] = Memr[kmin] + Memr[kmin] = temp + } + } +end + +procedure imsumd (list, output, im_out, nlow, nhigh, option) + +int list # List of input images +char output[ARB] # Output image +pointer im_out # Output image pointer +int nlow # Number of low pixels to reject +int nhigh # Number of high pixels to reject +char option[ARB] # Output option + +int i, n, nimages, naccept, npix, ndone, pass +double const +pointer sp, input, v1, v2, im, buf, buf1, buf_in, buf_out + +bool streq() +int imtlen(), imtgetim(), imtrgetim() +pointer immap(), imgnld(), impnld() +errchk immap, imunmap, imgnld, impnld + +begin + # Initialize. + nimages = imtlen (list) + naccept = nimages - nlow - nhigh + const = naccept + npix = IM_LEN(im_out, 1) + if (naccept < 1) + call error (0, "Number of rejected pixels is too large") + + # Allocate memory. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (im, nimages, TY_INT) + + # If there are no pixels to be rejected avoid calls to reject pixels + # and do the operation in blocks so that the number of images mapped + # does not exceed the maximum. The output image is used to + # store intermediate results. + + if ((nlow == 0) && (nhigh == 0)) { + pass = 0 + ndone = 0 + repeat { + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX) + break + } + ndone = ndone + n + + pass = pass + 1 + if (pass > 1) { + call imunmap (im_out) + im_out = immap (output, READ_WRITE, 0) + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # For each input line compute an output line. + while (impnld (im_out, buf_out, Meml[v2]) != EOF) { + + # Clear the output buffer during the first pass and + # read in the partial sum from the output image during + # subsequent passes. + + if (pass == 1) + call aclrd (Memd[buf_out], npix) + else { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnld (im_out, buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call amovd (Memd[buf_in], Memd[buf_out], npix) + } + + # Accumulate lines from each input image. + do i = 1, n { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnld (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call aaddd (Memd[buf_in], Memd[buf_out], + Memd[buf_out], npix) + } + + # If all images have been accumulated and averaging then + # divide by the number of images. + if ((ndone == nimages) && streq (option, "average")) + call adivkd (Memd[buf_out], const, Memd[buf_out], + npix) + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + do i = 1, n + call imunmap (Memi[im+i-1]) + } until (ndone == nimages) + + # Finish up. + call sfree (sp) + return + } + + + # Map the input images up to the maximum allowed. The remainder + # will be mapped during each line. + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX - 1) + break + } + + # Allocate additional buffer space. + call salloc (buf, nimages, TY_INT) + if (nimages - n > 0) + call salloc (buf1, (nimages-n)*npix, TY_DOUBLE) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # Compute output lines for each input line. + while (impnld (im_out, buf_out, Meml[v2]) != EOF) { + + # Read lines from the images which remain open. + for (i = 1; i <= n; i = i + 1) { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnld (Memi[im+i-1], Memi[buf+i-1], Meml[v2]) == EOF) + call error (0, "Error reading input image") + } + + # For all additional images map the image, read a line, copy the + # data to a buffer since the image buffer is reused, and unmap + # the image. + for (; i <= nimages; i = i + 1) { + if (imtrgetim (list, i, Memc[input], SZ_FNAME) == EOF) + break + Memi[im+i-1] = immap (Memc[input], READ_ONLY, 0) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnld (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + Memi[buf+i-1] = buf1 + (i - n - 1) * npix + call amovd (Memd[buf_in], Memd[Memi[buf+i-1]], npix) + call imunmap (Memi[im+i-1]) + } + + # Reject pixels. + call imrejd (Memi[buf], nimages, Memd[buf_out], npix, nlow, nhigh) + + # If averaging divide the sum by the number of images averaged. + if ((naccept > 1) && streq (option, "average")) { + const = naccept + call adivkd (Memd[buf_out], const, Memd[buf_out], npix) + } + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Finish up. + do i = 1, n + call imunmap (Memi[im+i-1]) + call sfree (sp) +end + + +# IMREJ -- Reject the number of high and low points and sum the rest. + +procedure imrejd (a, nvecs, b, npts, nlow, nhigh) + +pointer a[nvecs] # Pointers to set of vectors +int nvecs # Number of vectors +double b[npts] # Output vector +int npts # Number of points in the vectors +int nlow # Number of low points to be rejected +int nhigh # Number of high points to be rejected + +int i, j +int naccept, minrej, npairs, nlow1, nhigh1 +real tmedian, time1, time2 + +begin + naccept = nvecs - nlow - nhigh + + # If no points are rejected return the sum. + + if (naccept == nvecs) { + call amovd (Memd[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aaddd (Memd[a[j]], b, b, npts) + return + } + + minrej = min (nlow, nhigh) + npairs = minrej + nlow1 = nlow - npairs + nhigh1 = nhigh - npairs + + if ((naccept == 1) && (npairs > 0)) { + if (npairs == 1) { + tmedian = TMED3 + npairs = npairs - 1 + } else { + tmedian = TMED5 + npairs = npairs - 2 + } + } else + tmedian = 0 + + # Compare the time required to reject the minimum number + # of low or high points and extract the number of points to accept + # with the time to reject pairs and the excess number of low or + # high points to either reach a median of 3 or 5 points or isolate + # the acceptable points. + + time1 = TMINSW * (minrej + naccept) + time2 = tmedian + TMXMNSW * npairs + TMINSW * (nlow1 + nhigh1) + + i = nvecs + if (time1 < time2) { + + # Sort the nlow and naccept points + if (nlow < nhigh) { + for (j = 1; j <= nlow + naccept; j = j + 1) { + call minswd (a, i, npts) + i = i - 1 + } + call amovd (Memd[a[nhigh+1]], b, npts) + for (j = nhigh+2; j <= nhigh+naccept; j = j + 1) + call aaddd (Memd[a[j]], b, b, npts) + + # Sort the nhigh and naccept points + } else { + for (j = 1; j <= nhigh + naccept; j = j + 1) { + call maxswd (a, i, npts) + i = i - 1 + } + call amovd (Memd[a[nlow+1]], b, npts) + for (j = nlow+2; j <= nlow+naccept; j = j + 1) + call aaddd (Memd[a[j]], b, b, npts) + } + + } else { + # Reject the npairs low and high points. + for (j = 1; j <= npairs; j = j + 1) { + call mxmnswd (a, i, npts) + i = i - 2 + } + # Reject the excess low points. + for (j = 1; j <= nlow1; j = j + 1) { + call minswd (a, i, npts) + i = i - 1 + } + # Reject the excess high points. + for (j = 1; j <= nhigh1; j = j + 1) { + call maxswd (a, i, npts) + i = i - 1 + } + + # Check if the remaining points constitute a 3 or 5 point median + # or the set of desired points. + if (tmedian == 0.) { + call amovd (Memd[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aaddd (Memd[a[j]], b, b, npts) + } else if (tmedian == TMED3) { + call amed3d (Memd[a[1]], Memd[a[2]], Memd[a[3]], b, npts) + } else { + call amed5d (Memd[a[1]], Memd[a[2]], Memd[a[3]], + Memd[a[4]], Memd[a[5]], b, npts) + } + } +end + + +# MINSW -- Given an array of vector pointers for each element in the vectors +# swap the minimum element with that of the last vector. + +procedure minswd (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmin +double temp + +begin + do i = 0, npts - 1 { + kmin = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Memd[k] < Memd[kmin]) + kmin = k + } + if (k != kmin) { + temp = Memd[k] + Memd[k] = Memd[kmin] + Memd[kmin] = temp + } + } +end + + +# MAXSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector. + +procedure maxswd (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax +double temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Memd[k] > Memd[kmax]) + kmax = k + } + if (k != kmax) { + temp = Memd[k] + Memd[k] = Memd[kmax] + Memd[kmax] = temp + } + } +end + + +# MXMNSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector and the minimum element +# with that of the next to last vector. The number of vectors must be greater +# than 1. + +procedure mxmnswd (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax, kmin +double temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + kmin = kmax + do j = 2, nvecs { + k = a[j] + i + if (Memd[k] > Memd[kmax]) + kmax = k + else if (Memd[k] < Memd[kmin]) + kmin = k + } + temp = Memd[k] + Memd[k] = Memd[kmax] + Memd[kmax] = temp + if (kmin == k) { + j = a[nvecs - 1] + i + temp = Memd[j] + Memd[j] = Memd[kmax] + Memd[kmax] = temp + } else { + j = a[nvecs - 1] + i + temp = Memd[j] + Memd[j] = Memd[kmin] + Memd[kmin] = temp + } + } +end + diff --git a/pkg/images/imutil/src/generic/mkpkg b/pkg/images/imutil/src/generic/mkpkg new file mode 100644 index 00000000..9878bc7b --- /dev/null +++ b/pkg/images/imutil/src/generic/mkpkg @@ -0,0 +1,21 @@ +# Make IMUTIL. + +$checkout libpkg.a ../../../ +$update libpkg.a +$checkin libpkg.a ../../../ +$exit + +libpkg.a: + imaadd.x <imhdr.h> + imadiv.x <imhdr.h> + imamax.x <imhdr.h> + imamin.x <imhdr.h> + imamul.x <imhdr.h> + imanl.x <imhdr.h> + imasub.x <imhdr.h> + imfuncs.x <imhdr.h> <mach.h> <math.h> + imjoin.x <imhdr.h> + imrep.x <imhdr.h> <mach.h> + imsum.x ../imsum.h <imhdr.h> + ; + diff --git a/pkg/images/imutil/src/getcmd.x b/pkg/images/imutil/src/getcmd.x new file mode 100644 index 00000000..2ed08314 --- /dev/null +++ b/pkg/images/imutil/src/getcmd.x @@ -0,0 +1,406 @@ +include <syserr.h> +include <error.h> +include <ctotok.h> +include <lexnum.h> + +# parameter names and values. + +define HS_ADD 1 +define HS_ADDONLY 2 +define HS_UPDATE 3 +define HS_VERIFY 4 +define HS_SHOW 5 +define HS_DELETE 6 +define HS_RENAME 7 +define HS_FIELD 8 +define HS_VALUE 9 +define HS_COMMENT 10 +define HS_BEFORE 11 +define HS_AFTER 12 +define ERROR -2 + +define HADD Memi[$1] +define HADDONLY Memi[$1+1] +define HUPDATE Memi[$1+2] +define HVERIFY Memi[$1+3] +define HSHOW Memi[$1+4] +define HDELETE Memi[$1+5] +define HRENAME Memi[$1+6] +define HBAF Memi[$1+7] +define HFIELD Memc[P2C($1+10)] +define HVALUE Memc[P2C($1+46)] +define HCOMMENT Memc[P2C($1+86)] +define HBAFVALUE Memc[P2C($1+126)] + +define HSZ 200 + +define OP_EDIT 1 # hedit opcodes +define OP_INIT 2 +define OP_ADD 3 +define OP_DELETE 4 +define OP_DEFPAR 5 +define OP_RENAME 6 +define BEFORE 1 +define AFTER 2 + +define LEN_CARD 80 + +# HE_CMDPARS -- Procedure to parse and analyze a string of the form: +# + +procedure he_getcmdf (cmd, operation, fields, valexpr, comment, pkey, baf, + update, verify, show) + + +char cmd[ARB] #I String with kernel section +int operation +char fields[ARB] +char valexpr[ARB] +char comment[ARB] +char pkey[ARB] +int baf +int update +int verify +int show + +pointer hc +char outstr[LEN_CARD] +char identif[LEN_CARD], dot +int ip, nexpr, token, add, addonly, delete, rename, nch +bool streq() +int lex_type, ctotok(), he_ks_lex(), ctowrd() +errchk syserr, syserrs + +begin + # The default values should have been already initialized + # with a call fxf_ksinit(). + + call calloc(hc, HSZ, TY_STRUCT) + call he_ksinit (hc) + + ip = 1 + nexpr = 0 + identif[1] = EOS + + repeat { + # Advance to the next keyword. + if (ip == 1) { + nch= ctowrd(cmd, ip, outstr, LEN_CARD) + token = TOK_IDENTIFIER + } else { + token = ctotok (cmd, ip, outstr, LEN_CARD) + } + + if (token == TOK_CHARCON) { + ip = ip - 2 + nch= ctowrd(cmd, ip, outstr, LEN_CARD) + if (nexpr >= 1) + token = TOK_STRING + if (nch <=3) { + #ctowrd will not parse one letter string, doit in here. + outstr[1]=cmd[ip-2] + outstr[2]=EOS + } + } + + if (token == TOK_STRING && nexpr == 0) + token = TOK_IDENTIFIER + switch (token) { + case TOK_EOS: + break + case TOK_NEWLINE: + break + + case TOK_NUMBER: + if (nexpr != 1) { + call eprintf ("%s\n") + call pargstr (cmd) + call error (13,"Numeric value not allow in this field") + } + call strcpy (outstr, HVALUE(hc), LEN_CARD) + nexpr = nexpr + 1 + case TOK_CHARCON: + ip = ip - 1 + case TOK_STRING: + if (nexpr != 1 && nexpr != 2) { + call eprintf ("%s\n") + call pargstr (cmd) + call error(13, "Value or comment error") + } + if (nexpr == 1) + call strcpy (outstr, HVALUE(hc), LEN_CARD) + if (nexpr == 2) + call strcpy (outstr, HCOMMENT(hc), LEN_CARD) + nexpr = nexpr + 1 + + case TOK_IDENTIFIER: + call strcpy (outstr, identif, LEN_CARD) + call strlwr (outstr) + lex_type = he_ks_lex (outstr) + + if (streq(identif, "comment") && nexpr == 0) + lex_type = 0 + # look for =<value>, + or - + if (lex_type > 0) { + call he_ks_gvalue (lex_type, cmd, ip, hc) + } else { + #if (nexpr == 0 || nexpr == 1) + if (nexpr == 0) + call strcpy (identif, HFIELD(hc), LEN_CARD) + else if (nexpr == 1) + call strcpy (outstr, HVALUE(hc), LEN_CARD) + else { + call eprintf ("%s\n") + call pargstr (cmd) + call error(13, "Field or value error") + } + } + nexpr = nexpr + 1 + + case TOK_OPERATOR: + dot = outstr[1] + if (nexpr == 1 && dot == '.') + call strcpy (outstr, HVALUE(hc), LEN_CARD) + else if (nexpr == 2 && dot == '.') + call strcpy (outstr, HCOMMENT(hc), LEN_CARD) + else { + call eprintf ("%s\n") + call pargstr (cmd) + call error(13,"error in tok_operator value") + } + nexpr = nexpr + 1 + + default: + #call error(13,"error in command line") + } + } + + call strcpy (HFIELD(hc), fields, LEN_CARD) + call strcpy (HVALUE(hc), valexpr, LEN_CARD) + call strcpy (HCOMMENT(hc), comment, LEN_CARD) + call strcpy (HBAFVALUE(hc), pkey, LEN_CARD) + baf = HBAF(hc) + add = HADD(hc) + addonly = HADDONLY(hc) + update = HUPDATE(hc) + verify = HVERIFY(hc) + show = HSHOW(hc) + delete = HDELETE(hc) + rename = HRENAME(hc) + + operation = OP_EDIT + if (add == -1 && addonly == -1 && delete == -1 && rename == -1) + operation = OP_DEFPAR + else if (add == YES) + operation = OP_ADD + else if (addonly == YES) + operation = OP_INIT + else if (delete == YES) + operation = OP_DELETE + else if (rename == YES) + operation = OP_RENAME + + if (streq (fields, "default_pars")) + operation = -operation + + call mfree(hc, TY_STRUCT) +end + + +# HE_KS_LEX -- Map an identifier into a header parameter code. + +int procedure he_ks_lex (outstr) + +char outstr[ARB] + +int len, strlen(), strncmp() +errchk syserr, syserrs + +begin + len = strlen (outstr) + + # Allow for small string to be taken as keyword names + # and not hedit parameters, like 'up' instead of 'up(date)'. + if (len < 3) + return(0) + + # Other kernel keywords. + if (strncmp (outstr, "field", len) == 0) + return (HS_FIELD) + if (strncmp (outstr, "value", len) == 0) + return (HS_VALUE) + if (strncmp (outstr, "comment", len) == 0) + return (HS_COMMENT) + if (strncmp (outstr, "after", len) == 0) + return (HS_AFTER) + if (strncmp (outstr, "before", len) == 0) + return (HS_BEFORE) + if (strncmp (outstr, "add", len) == 0) + return (HS_ADD) + if (strncmp (outstr, "addonly", len) == 0) + return (HS_ADDONLY) + if (strncmp (outstr, "delete", len) == 0) + return (HS_DELETE) + if (strncmp (outstr, "rename", len) == 0) + return (HS_RENAME) + if (strncmp (outstr, "verify", len) == 0) + return (HS_VERIFY) + if (strncmp (outstr, "show", len) == 0) { + return (HS_SHOW) + } + if (strncmp (outstr, "update", len) == 0) + return (HS_UPDATE) + + return (0) # not recognized; probably a value +end + + +# FXF_KS_GVALUE -- Given a parameter code get its value at the 'ip' character +# position in the 'ksection' string. Put the values in the FKS structure. + +procedure he_ks_gvalue (param, cmd, ip, hc) + +int param #I parameter code +char cmd[ARB] #I Ksection +int ip #I Current parsing pointer in ksection +pointer hc #U Update the values in the FKS structure + +pointer sp, ln +int jp, token +int ctotok() +errchk syserr, syserrs + +begin + jp = ip + + call smark (sp) + call salloc (ln, LEN_CARD, TY_CHAR) + + # See if the parameter value is given as par=<value> or '+/-' + if (ctotok (cmd, jp, Memc[ln], LEN_CARD) == TOK_OPERATOR) { + if (Memc[ln] == '=' ) { + token = ctotok (cmd, jp, Memc[ln], LEN_CARD) + if (token != TOK_IDENTIFIER && + token != TOK_STRING && token != TOK_NUMBER) { + call syserr (SYS_FXFKSSYN) + } else { + call he_ks_val (Memc[ln], param, hc) + ip = jp + } + } else if (Memc[ln] == '+' || Memc[ln] == '-') { + call he_ks_pm (Memc[ln], param, hc) + ip = jp + } + } + + call sfree (sp) +end + + +# FXF_KS_VALUE -- Returns the value of a parameter in the kernel section. + +procedure he_ks_val (outstr, param, hc) + +char outstr[ARB] #I Input string with value +int param #I Parameter code +pointer hc #U Fits kernel descriptor + +int ival +int strcmp() +errchk syserr, syserrs + +begin + call strlwr (outstr) + if (strcmp (outstr, "yes") == 0) + ival = YES + else if (strcmp (outstr, "no") == 0) + ival = NO + else + ival = ERROR + + switch (param) { + case HS_FIELD: + call strcpy (outstr, HFIELD(hc), LEN_CARD) + case HS_VALUE: + call strcpy (outstr, HVALUE(hc), LEN_CARD) + case HS_COMMENT: + call strcpy (outstr, HCOMMENT(hc), LEN_CARD) + case HS_BEFORE: + HBAF(hc) = BEFORE + call strcpy (outstr, HBAFVALUE(hc), LEN_CARD) + case HS_AFTER: + HBAF(hc) = AFTER + call strcpy (outstr, HBAFVALUE(hc), LEN_CARD) + case HS_ADD: + HADD(hc) = ival + case HS_ADDONLY: + HADDONLY(hc) = ival + case HS_UPDATE: + HUPDATE(hc) = ival + case HS_VERIFY: + HVERIFY(hc) = ival + case HS_SHOW: + HSHOW(hc) = ival + case HS_DELETE: + HDELETE(hc) = ival + case HS_RENAME: + HRENAME(hc) = ival + default: + call syserr (SYS_FXFKSSYN) + } +end + + +# HE_KS_PM -- Return the character YES or NO based on the value '+' or '-' + +procedure he_ks_pm (pm, param, hc) + +char pm[1] #I contains "+" or "-" +int param #I Parameter code +pointer hc #U Fits kernel descriptor + +int ival +errchk syserr, syserrs + +begin + if (pm[1] == '+') + ival = YES + else + ival = NO + + switch (param) { + case HS_ADD: + HADD(hc) = ival + case HS_ADDONLY: + HADDONLY(hc) = ival + case HS_UPDATE: + HUPDATE(hc) = ival + case HS_VERIFY: + HVERIFY(hc) = ival + case HS_SHOW: + HSHOW(hc) = ival + case HS_DELETE: + HDELETE(hc) = ival + case HS_RENAME: + HRENAME(hc) = ival + default: + call error(13, "ks_pm: invalid value") + } +end + + +# FXF_KSINIT -- Initialize default values for ks parameters. + +procedure he_ksinit (hc) + +pointer hc #I + +begin + HADD(hc) = -1 + HADDONLY(hc) = -1 + HDELETE(hc) = -1 + HRENAME(hc) = -1 + HUPDATE(hc) = -1 + HVERIFY(hc) = -1 + HSHOW(hc) = -1 +end diff --git a/pkg/images/imutil/src/gettok.h b/pkg/images/imutil/src/gettok.h new file mode 100644 index 00000000..d0cfd1ca --- /dev/null +++ b/pkg/images/imutil/src/gettok.h @@ -0,0 +1,22 @@ +# GETTOK.H -- External definitions for gettok.h + +define GT_IDENT (-99) +define GT_NUMBER (-98) +define GT_STRING (-97) +define GT_COMMAND (-96) +define GT_PLUSEQ (-95) +define GT_COLONEQ (-94) +define GT_EXPON (-93) +define GT_CONCAT (-92) +define GT_SE (-91) +define GT_LE (-90) +define GT_GE (-89) +define GT_EQ (-88) +define GT_NE (-87) +define GT_LAND (-86) +define GT_LOR (-85) + +# Optionl flags. +define GT_NOSPECIAL 0003 +define GT_NOFILE 0001 +define GT_NOCOMMAND 0002 diff --git a/pkg/images/imutil/src/gettok.x b/pkg/images/imutil/src/gettok.x new file mode 100644 index 00000000..a0975300 --- /dev/null +++ b/pkg/images/imutil/src/gettok.x @@ -0,0 +1,922 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <error.h> +include <ctype.h> +include <fset.h> +include "gettok.h" + +.help gettok +.nf -------------------------------------------------------------------------- +GETTOK -- Lexical input routines. Used to return tokens from input text, +performing macro expansion and file expansion. The input text may be either +an open file descriptor or a text string. + + nchars = gt_expandtext (text, obuf, len_obuf, gsym, gsym_data) + + gt = gt_open (fd, gsym, gsym_data, pbblen, flags) + gt = gt_opentext (text, gsym, gsym_data, pbblen, flags) + gt_close (gt) + + nchars = gt_expand (gt, obuf, len_obuf) + token = gt_gettok (gt, tokbuf, maxch) + gt_ungettok (gt, tokbuf) + token = gt_rawtok (gt, tokbuf, maxch) + token = gt_nexttok (gt) + +The client get-symbol routine has the following calling sequence, where +"nargs" is an output argument which should be set to the number of macro +arguments, if any. Normally this routine will call SYMTAB to do the +symbol lookup, but this is not required. GSYM may be set to NULL if no +macro replacement is desired. + + textp = gsym (gsym_data, symbol, &nargs) + +PBBLEN is the size of the pushback buffer used for macro expansion, and +determines the size of the largest macro replacement string that can be +pushed back. FLAGS may be used to disable certain types of pushback. +Both PBBLEN and FLAGS may be given as zero if the client is happy with the +builtin defaults. + +Access to the package is gained by opening a text string with GT_OPENTEXT. +This returns a descriptor which is passed to GT_GETTOK to read successive +tokens, which may come from the input text string or from any macros, +include files, etc., referenced in the text or in any substituted text. +GT_UNGETTOK pushes a token back into the GT_GETTOK input stream, to be +returned in the next GT_GETTOK call (following macro expansion). GT_EXPAND +will process the entire input text string, expanding any macro references +therein, returning the fully resolved text in the output buffer. A more +macroscopic version of this is GT_EXPANDTEXT, which does the opentext, +expand, and close operations internally, using the builtin defaults. + +GT_RAWTOK returns the next physical token from an input stream (without +macro expansion), and GT_NEXTTOK returns the type of the next *physical* +token (no macro expansion) without actually fetching it (for look ahead +decision making). + +The tokens that can be returned are as follows: + + GT_IDENT [a-zA-Z][a-zA-Z0-9_]* + GT_NUMBER [0-9][0-9a-zA-Z.]*(e|E)?(+|-)?[0-9]* + GT_STRING if "abc" or 'abc', the abc + 'c' other characters, e.g., =+-*/,;:()[] etc + EOF at end of input + +Macro replacement syntax: + + macro push macro with null arglist + macro(arg,arg,...) push macro with argument substitution + @file push contents of file + @file(arg,arg,...) push file with argument substitution + `cmd` substitute output of CL command "cmd" + +where + macro is an identifier, the name of a global macro + or a datafile local macro (parameter) + +In all cases, occurences of $N in the replacement text are replaced by the +macro arguments if any, and macros are recursively expanded. Whitespace, +including newline, equates to a single space, as does EOF (hence always +delimits tokens). Comments (# to end of line) are ignored. All identifiers +in scanned text are checked to see if they are references to predefined +macros, using the client supplied symbol lookup routine. +.endhelp --------------------------------------------------------------------- + +# General definitions. +define MAX_LEVELS 20 # max include file nesting +define MAX_ARGS 9 # max arguments to a macro +define SZ_CMD 80 # `cmd` +define SZ_IBUF 8192 # buffer for macro replacement +define SZ_OBUF 8192 # buffer for macro replacement +define SZ_ARGBUF 256 # argument list to a macro +define SZ_TOKBUF 1024 # token buffer +define DEF_MAXPUSHBACK 16384 # max pushback, macro replacement +define INC_TOKBUF 4096 # increment if expanded text fills + +# The gettok descriptor. +define LEN_GTDES 50 +define GT_FD Memi[$1] # current input stream +define GT_UFD Memi[$1+1] # user (client) input file +define GT_FLAGS Memi[$1+2] # option flags +define GT_PBBLEN Memi[$1+3] # pushback buffer length +define GT_DEBUG Memi[$1+4] # for debug messages +define GT_GSYM Memi[$1+5] # get symbol routine +define GT_GSYMDATA Memi[$1+6] # client data for above +define GT_NEXTCH Memi[$1+7] # lookahead character +define GT_FTEMP Memi[$1+8] # file on stream is a temp file +define GT_LEVEL Memi[$1+9] # current nesting level +define GT_SVFD Memi[$1+10+$2-1]# stacked file descriptors +define GT_SVFTEMP Memi[$1+30+$2-1]# stacked ftemp flags + +# Set to YES to enable debug messages. +define DEBUG NO + + +# GT_EXPANDTEXT -- Perform macro expansion on a text string returning the +# fully resolved text in the client's output buffer. The number of chars +# in the output string is returned as the function value. + +int procedure gt_expandtext (text, obuf, len_obuf, gsym, gsym_data) + +char text[ARB] #I input text to be expanded +pointer obuf #U output buffer +int len_obuf #U size of output buffer +int gsym #I epa of client get-symbol routine +int gsym_data #I client data for above + +pointer gt +int nchars +int gt_expand() +pointer gt_opentext() +errchk gt_opentext + +begin + gt = gt_opentext (text, gsym, gsym_data, 0, 0) + nchars = gt_expand (gt, obuf, len_obuf) + call gt_close (gt) + + return (nchars) +end + + +# GT_EXPAND -- Perform macro expansion on a GT text stream returning the +# fully resolved text in the client's output buffer. The number of chars +# in the output string is returned as the function value. + +int procedure gt_expand (gt, obuf, len_obuf) + +pointer gt #I gettok descriptor +pointer obuf #U output buffer +int len_obuf #U size of output buffer + +int token, nchars +pointer sp, tokbuf, op, otop +int gt_gettok(), strlen(), gstrcpy() +errchk realloc + +begin + call smark (sp) + call salloc (tokbuf, SZ_TOKBUF, TY_CHAR) + + # Open input text for macro expanded token input. + otop = obuf + len_obuf + op = obuf + + # Copy tokens to the output, inserting a space after every token. + repeat { + token = gt_gettok (gt, Memc[tokbuf], SZ_TOKBUF) + if (token != EOF) { + if (op + strlen(Memc[tokbuf]) + 3 > otop) { + nchars = op - obuf + len_obuf = len_obuf + INC_TOKBUF + call realloc (obuf, len_obuf, TY_CHAR) + otop = obuf + len_obuf + op = obuf + nchars + } + + if (token == GT_STRING) { + Memc[op] = '"' + op = op + 1 + } + op = op + gstrcpy (Memc[tokbuf], Memc[op], otop-op) + if (token == GT_STRING) { + Memc[op] = '"' + op = op + 1 + } + Memc[op] = ' ' + op = op + 1 + } + } until (token == EOF) + + # Cancel the trailing blank and add the EOS. + if (op > 1 && op < otop) + op = op - 1 + Memc[op] = EOS + + call sfree (sp) + return (op - 1) +end + + +# GT_OPEN -- Open the GETTOK descriptor on a file descriptor. + +pointer procedure gt_open (fd, gsym, gsym_data, pbblen, flags) + +int fd #I input file +int gsym #I epa of client get-symbol routine +int gsym_data #I client data for above +int pbblen #I pushback buffer length +int flags #I option flags + +pointer gt +int sz_pbbuf +errchk calloc + +begin + call calloc (gt, LEN_GTDES, TY_STRUCT) + + GT_GSYM(gt) = gsym + GT_GSYMDATA(gt) = gsym_data + GT_FLAGS(gt) = flags + GT_DEBUG(gt) = DEBUG + + GT_FD(gt) = fd + GT_UFD(gt) = fd + + if (pbblen <= 0) + sz_pbbuf = DEF_MAXPUSHBACK + else + sz_pbbuf = pbblen + call fseti (GT_FD(gt), F_PBBSIZE, sz_pbbuf) + GT_PBBLEN(gt) = sz_pbbuf + + return (gt) +end + + +# GT_OPENTEXT -- Open the GT_GETTOK descriptor. The descriptor is initially +# opened on the user supplied string buffer (which is opened as a file and +# which must remain intact while token input is in progress), but include file +# processing etc. may cause arbitrary nesting of file descriptors. + +pointer procedure gt_opentext (text, gsym, gsym_data, pbblen, flags) + +char text[ARB] #I input text to be scanned +int gsym #I epa of client get-symbol routine +int gsym_data #I client data for above +int pbblen #I pushback buffer length +int flags #I option flags + +pointer gt +int sz_pbbuf +int stropen(), strlen() +errchk stropen, calloc + +begin + call calloc (gt, LEN_GTDES, TY_STRUCT) + + GT_GSYM(gt) = gsym + GT_GSYMDATA(gt) = gsym_data + GT_FLAGS(gt) = flags + GT_DEBUG(gt) = DEBUG + + GT_FD(gt) = stropen (text, strlen(text), READ_ONLY) + GT_UFD(gt) = 0 + + if (pbblen <= 0) + sz_pbbuf = DEF_MAXPUSHBACK + else + sz_pbbuf = pbblen + call fseti (GT_FD(gt), F_PBBSIZE, sz_pbbuf) + GT_PBBLEN(gt) = sz_pbbuf + + return (gt) +end + + +# GT_GETTOK -- Return the next token from the input stream. The token ID +# (a predefined integer code or the character value) is returned as the +# function value. The text of the token is returned as an output argument. +# Any macro references, file includes, etc., are performed in the process +# of scanning the input stream, hence only fully resolved tokens are output. + +int procedure gt_gettok (gt, tokbuf, maxch) + +pointer gt #I gettok descriptor +char tokbuf[maxch] #O receives the text of the token +int maxch #I max chars out + +pointer sp, bp, cmd, ibuf, obuf, argbuf, fname, textp +int fd, token, level, margs, nargs, nchars, i_fd, o_fd, ftemp + +int strmac(), open(), stropen() +int gt_rawtok(), gt_nexttok(), gt_arglist(), zfunc3() +errchk gt_rawtok, close, ungetci, ungetline, gt_arglist, +errchk clcmdw, stropen, syserr, zfunc3 +define pushfile_ 91 + + +begin + call smark (sp) + + # Allocate some buffer space. + nchars = SZ_CMD + SZ_IBUF + SZ_OBUF + SZ_ARGBUF + SZ_FNAME + 5 + call salloc (bp, nchars, TY_CHAR) + + cmd = bp + ibuf = cmd + SZ_CMD + 1 + obuf = ibuf + SZ_IBUF + 1 + argbuf = obuf + SZ_OBUF + 1 + fname = argbuf + SZ_ARGBUF + 1 + + # Read raw tokens and push back macro or include file text until we + # get a fully resolved token. + + repeat { + fd = GT_FD(gt) + + # Get a raw token. + token = gt_rawtok (gt, tokbuf, maxch) + + # Process special tokens. + switch (token) { + case EOF: + # EOF has been reached on the current stream. + level = GT_LEVEL(gt) + if (GT_FTEMP(gt) == YES) { + call fstats (fd, F_FILENAME, Memc[fname], SZ_FNAME) + if (level > 0) + call close (fd) + iferr (call delete (Memc[fname])) + call erract (EA_WARN) + } else if (level > 0) + call close (fd) + + if (level > 0) { + # Restore previous stream. + GT_FD(gt) = GT_SVFD(gt,level) + GT_FTEMP(gt) = GT_SVFTEMP(gt,level) + GT_LEVEL(gt) = level - 1 + GT_NEXTCH(gt) = NULL + } else { + # Return EOF token to caller. + call strcpy ("EOF", tokbuf, maxch) + break + } + + case GT_IDENT: + # Lookup the identifier in the symbol table. + textp = NULL + if (GT_GSYM(gt) != NULL) + textp = zfunc3 (GT_GSYM(gt), GT_GSYMDATA(gt), tokbuf, margs) + + # Process a defined macro. + if (textp != NULL) { + # If macro does not have any arguments, merely push back + # the replacement text. + + if (margs == 0) { + if (GT_NEXTCH(gt) > 0) { + call ungetci (fd, GT_NEXTCH(gt)) + GT_NEXTCH(gt) = 0 + } + call ungetline (fd, Memc[textp]) + next + } + + # Extract argument list, if any, perform argument + # substitution on the macro, and push back the edited + # text to be rescanned. + + if (gt_nexttok(gt) == '(') { + nargs = gt_arglist (gt, Memc[argbuf], SZ_ARGBUF) + if (nargs != margs) { + call eprintf ("macro `%s' called with ") + call pargstr (tokbuf) + call eprintf ("wrong number of arguments\n") + } + + # Pushback the text of a macro with arg substitution. + nchars = strmac (Memc[textp], Memc[argbuf], + Memc[obuf], SZ_OBUF) + if (GT_NEXTCH(gt) > 0) { + call ungetci (fd, GT_NEXTCH(gt)) + GT_NEXTCH(gt) = 0 + } + call ungetline (fd, Memc[obuf]) + next + + } else { + call eprintf ("macro `%s' called with no arguments\n") + call pargstr (tokbuf) + } + } + + # Return a regular identifier. + break + + case GT_COMMAND: + # Send a command to the CL and push back the output. + if (and (GT_FLAGS(gt), GT_NOCOMMAND) != 0) + break + + # Execute the command, spooling the output in a temp file. + call mktemp ("tmp$co", Memc[fname], SZ_FNAME) + call sprintf (Memc[cmd], SZ_LINE, "%s > %s") + call pargstr (tokbuf) + call pargstr (Memc[fname]) + call clcmdw (Memc[cmd]) + + # Open the output file as input text. + call strcpy (Memc[fname], tokbuf, maxch) + nargs = 0 + ftemp = YES + goto pushfile_ + + case '@': + # Pushback the contents of a file. + if (and (GT_FLAGS(gt), GT_NOFILE) != 0) + break + + token = gt_rawtok (gt, tokbuf, maxch) + if (token != GT_IDENT && token != GT_STRING) { + call eprintf ("expected a filename after the `@'\n") + next + } else { + nargs = 0 + if (gt_nexttok(gt) == '(') # ) + nargs = gt_arglist (gt, Memc[argbuf], SZ_ARGBUF) + ftemp = NO + } +pushfile_ + # Attempt to open the file. + iferr (i_fd = open (tokbuf, READ_ONLY, TEXT_FILE)) { + call eprintf ("cannot open `%s'\n") + call pargstr (tokbuf) + next + } + + call fseti (i_fd, F_PBBSIZE, GT_PBBLEN(gt)) + + # Cancel lookahead. + if (GT_NEXTCH(gt) > 0) { + call ungetci (fd, GT_NEXTCH(gt)) + GT_NEXTCH(gt) = 0 + } + + # If the macro was called with a nonnull argument list, + # attempt to perform argument substitution on the file + # contents. Otherwise merely push the fd. + + if (nargs > 0) { + # Pushback file contents with argument substitution. + o_fd = stropen (Memc[ibuf], SZ_IBUF, NEW_FILE) + + call fcopyo (i_fd, o_fd) + nchars = strmac (Memc[ibuf],Memc[argbuf],Memc[obuf],SZ_OBUF) + call ungetline (fd, Memc[obuf]) + + call close (o_fd) + call close (i_fd) + + } else { + # Push a new input stream. + level = GT_LEVEL(gt) + 1 + if (level > MAX_LEVELS) + call syserr (SYS_FPBOVFL) + + GT_SVFD(gt,level) = GT_FD(gt) + GT_SVFTEMP(gt,level) = GT_FTEMP(gt) + GT_LEVEL(gt) = level + + fd = i_fd + GT_FD(gt) = fd + GT_FTEMP(gt) = ftemp + } + + default: + break + } + } + + if (GT_DEBUG(gt) > 0) { + call eprintf ("token=%d(%o), `%s'\n") + call pargi (token) + call pargi (max(0,token)) + if (IS_PRINT(tokbuf[1])) + call pargstr (tokbuf) + else + call pargstr ("") + } + + call sfree (sp) + return (token) +end + + +# GT_UNGETTOK -- Push a token back into the GT_GETTOK input stream, to be +# returned as the next token by GT_GETTOK. + +procedure gt_ungettok (gt, tokbuf) + +pointer gt #I gettok descriptor +char tokbuf[ARB] #I text of token + +int fd +errchk ungetci + +begin + fd = GT_FD(gt) + + if (GT_DEBUG(gt) > 0) { + call eprintf ("unget token `%s'\n") + call pargstr (tokbuf) + } + + # Cancel lookahead. + if (GT_NEXTCH(gt) > 0) { + call ungetci (fd, GT_NEXTCH(gt)) + GT_NEXTCH(gt) = 0 + } + + # First push back a space to ensure that the token is recognized + # when the input is rescanned. + + call ungetci (fd, ' ') + + # Now push the token text. + call ungetline (fd, tokbuf) +end + + +# GT_RAWTOK -- Get a raw token from the input stream, without performing any +# macro expansion or file inclusion. The text of the token in returned in +# tokbuf, and the token type is returened as the function value. + +int procedure gt_rawtok (gt, outstr, maxch) + +pointer gt #I gettok descriptor +char outstr[maxch] #O receives text of token. +int maxch #I max chars out + +int token, delim, fd, ch, last_ch, op +define again_ 91 +int getci() + +begin + fd = GT_FD(gt) +again_ + # Get lookahead char if we don't already have one. + ch = GT_NEXTCH(gt) + GT_NEXTCH(gt) = NULL + if (ch <= 0 || IS_WHITE(ch) || ch == '\n') { + while (getci (fd, ch) != EOF) + if (!(IS_WHITE(ch) || ch == '\n')) + break + } + + # Output the first character. + op = 1 + if (ch != EOF && ch != '"' && ch != '\'' && ch != '`') { + outstr[op] = ch + op = op + 1 + } + + # Accumulate token. Some of the token recognition logic used here + # (especially for numbers) is crude, but it is not clear that rigour + # is justified for this application. + + if (ch == EOF) { + call strcpy ("EOF", outstr, maxch) + token = EOF + + } else if (ch == '#') { + # Ignore a comment. + while (getci (fd, ch) != '\n') + if (ch == EOF) + break + goto again_ + + } else if (IS_ALPHA(ch) || ch == '_' || ch == '$' || ch == '.') { + # Identifier. + token = GT_IDENT + while (getci (fd, ch) != EOF) + if (IS_ALNUM(ch) || ch == '_' || ch == '$' || ch == '.') { + outstr[op] = ch + op = min (maxch, op+1) + } else + break + + } else if (IS_DIGIT(ch)) { + # Number. + token = GT_NUMBER + + # Get number. + while (getci (fd, ch) != EOF) + if (IS_ALNUM(ch) || ch == '.') { + outstr[op] = ch + last_ch = ch + op = min (maxch, op+1) + } else + break + + # Get exponent if any. + if (last_ch == 'E' || last_ch == 'e') { + outstr[op] = ch + op = min (maxch, op+1) + while (getci (fd, ch) != EOF) + if (IS_DIGIT(ch) || ch == '+' || ch == '-') { + outstr[op] = ch + op = min (maxch, op+1) + } else + break + } + + } else if (ch == '"' || ch == '\'' || ch == '`') { + # Quoted string or command. + + if (ch == '`') + token = GT_COMMAND + else + token = GT_STRING + + delim = ch + while (getci (fd, ch) != EOF) + if (ch==delim && (op>1 && outstr[op-1] != '\\') || ch == '\n') + break + else { + outstr[op] = ch + op = min (maxch, op+1) + } + ch = getci (fd, ch) + + } else if (ch == '+') { + # May be the += operator. + if (getci (fd, ch) != EOF) + if (ch == '=') { + token = GT_PLUSEQ + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '+' + + } else if (ch == ':') { + # May be the := operator. + if (getci (fd, ch) != EOF) + if (ch == '=') { + token = GT_COLONEQ + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = ':' + + } else if (ch == '*') { + if (getci (fd, ch) != EOF) + if (ch == '*') { + token = GT_EXPON + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '*' + + } else if (ch == '/') { + if (getci (fd, ch) != EOF) + if (ch == '/') { + token = GT_CONCAT + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '/' + + } else if (ch == '?') { + if (getci (fd, ch) != EOF) + if (ch == '=') { + token = GT_SE + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '?' + + } else if (ch == '<') { + if (getci (fd, ch) != EOF) + if (ch == '=') { + token = GT_LE + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '<' + + } else if (ch == '>') { + if (getci (fd, ch) != EOF) + if (ch == '=') { + token = GT_GE + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '>' + + } else if (ch == '=') { + if (getci (fd, ch) != EOF) + if (ch == '=') { + token = GT_EQ + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '=' + + } else if (ch == '!') { + if (getci (fd, ch) != EOF) + if (ch == '=') { + token = GT_NE + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '!' + + } else if (ch == '&') { + if (getci (fd, ch) != EOF) + if (ch == '&') { + token = GT_LAND + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '&' + + } else if (ch == '|') { + if (getci (fd, ch) != EOF) + if (ch == '|') { + token = GT_LOR + outstr[op] = ch + op = op + 1 + ch = getci (fd, ch) + } else + token = '|' + + } else { + # Other characters. + token = ch + ch = getci (fd, ch) + } + + # Process the lookahead character. + if (IS_WHITE(ch) || ch == '\n') { + repeat { + ch = getci (fd, ch) + } until (!(IS_WHITE(ch) || ch == '\n')) + } + + if (ch != EOF) + GT_NEXTCH(gt) = ch + + outstr[op] = EOS + return (token) +end + + +# GT_NEXTTOK -- Determine the type of the next raw token in the input stream, +# without actually fetching the token. Operators such as GT_EQ etc. are not +# recognized at this level. Note that this is at the same level as +# GT_RAWTOK, i.e., no macro expansion is performed, and the lookahead token +# is that which would be returned by the next gt_rawtok, which is not +# necessarily what gt_gettok would return after macro replacement. + +int procedure gt_nexttok (gt) + +pointer gt #I gettok descriptor + +int token, fd, ch +int getci() + +begin + fd = GT_FD(gt) + + # Get lookahead char if we don't already have one. + ch = GT_NEXTCH(gt) + if (ch <= 0 || IS_WHITE(ch) || ch == '\n') + while (getci (fd, ch) != EOF) + if (!(IS_WHITE(ch) || ch == '\n')) + break + + if (ch == EOF) + token = EOF + else if (IS_ALPHA(ch) || ch == '_' || ch == '$' || ch == '.') + token = GT_IDENT + else if (IS_DIGIT(ch)) + token = GT_NUMBER + else if (ch == '"' || ch == '\'') + token = GT_STRING + else if (ch == '`') + token = GT_COMMAND + else + token = ch + + if (GT_DEBUG(gt) > 0) { + call eprintf ("nexttok=%d(%o) `%c'\n") + call pargi (token) + call pargi (max(0,token)) + if (IS_PRINT(ch)) + call pargi (ch) + else + call pargi (0) + } + + return (token) +end + + +# GT_CLOSE -- Close the gettok descriptor and any files opened thereon. + +procedure gt_close (gt) + +pointer gt #I gettok descriptor + +int level, fd +pointer sp, fname + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + for (level=GT_LEVEL(gt); level >= 0; level=level-1) { + fd = GT_FD(gt) + if (GT_FTEMP(gt) == YES) { + call fstats (fd, F_FILENAME, Memc[fname], SZ_FNAME) + call close (fd) + iferr (call delete (Memc[fname])) + call erract (EA_WARN) + } else if (fd != GT_UFD(gt)) + call close (fd) + + if (level > 0) { + GT_FD(gt) = GT_SVFD(gt,level) + GT_FTEMP(gt) = GT_SVFTEMP(gt,level) + } + } + + call mfree (gt, TY_STRUCT) + call sfree (sp) +end + + +# GT_ARGLIST -- Extract a paren and comma delimited argument list to be used +# for substitution into a macro replacement string. Since the result will be +# pushed back and rescanned, we do not have to perform macro substitution on +# the argument list at this level. + +int procedure gt_arglist (gt, argbuf, maxch) + +pointer gt #I gettok descriptor +char argbuf[maxch] #O receives parsed arguments +int maxch #I max chars out + +int level, quote, nargs, op, ch, fd +int getci() + +begin + fd = GT_FD(gt) + + # Get lookahead char if we don't already have one. + ch = GT_NEXTCH(gt) + if (ch <= 0 || IS_WHITE(ch) || ch == '\n') + while (getci (fd, ch) != EOF) + if (!(IS_WHITE(ch) || ch == '\n')) + break + + quote = 0 + level = 1 + nargs = 0 + op = 1 + + if (ch == '(') { + while (getci (fd, ch) != EOF) { + if (ch == '"' || ch == '\'') { + if (quote == 0) + quote = ch + else if (quote == ch) + quote = 0 + + } else if (ch == '(' && quote == 0) { + level = level + 1 + } else if (ch == ')' && quote == 0) { + level = level - 1 + if (level <= 0) { + if (op > 1 && argbuf[op-1] != EOS) + nargs = nargs + 1 + break + } + + } else if (ch == ',' && level == 1 && quote == 0) { + ch = EOS + nargs = nargs + 1 + } else if (ch == '\n') { + ch = ' ' + } else if (ch == '\\' && quote == 0) { + ch = getci (fd, ch) + next + } else if (ch == '#' && quote == 0) { + while (getci (fd, ch) != EOF) + if (ch == '\n') + break + next + } + + argbuf[op] = ch + op = min (maxch, op + 1) + } + + GT_NEXTCH(gt) = NULL + } + + argbuf[op] = EOS + return (nargs) +end diff --git a/pkg/images/imutil/src/hedit.x b/pkg/images/imutil/src/hedit.x new file mode 100644 index 00000000..4dd553bb --- /dev/null +++ b/pkg/images/imutil/src/hedit.x @@ -0,0 +1,806 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <evexpr.h> +include <imset.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 OP_EDIT 1 # hedit opcodes +define OP_INIT 2 +define OP_ADD 3 +define OP_DELETE 4 + + +# HEDIT -- Edit or view selected fields of an image header or headers. This +# editor performs a single edit operation upon a relation, e.g., upon a set +# of fields of a set of images. Templates and expressions may be used to +# automatically select the images and fields to be edited, and to compute +# the new value of each field. + +procedure t_hedit() + +pointer fields # template listing fields to be processed +pointer valexpr # the value expression (if op=edit|add) + +bool noupdate, quit +int imlist, flist, nfields, up, min_lenuserarea +pointer sp, field, sections, s_fields, s_valexpr, im, ip, image, buf +int operation, verify, show, update + +pointer immap() +bool clgetb(), streq() +int btoi(), imtopenp(), imtgetim(), imofnlu(), imgnfn(), getline() +int envfind(), ctoi() + +begin + call smark (sp) + call salloc (buf, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (field, SZ_FNAME, TY_CHAR) + call salloc (s_fields, SZ_LINE, TY_CHAR) + call salloc (s_valexpr, SZ_LINE, TY_CHAR) + call salloc (sections, SZ_FNAME, TY_CHAR) + + # Get the primary operands. + imlist = imtopenp ("images") + + # Determine type of operation to be performed. The default operation + # is edit. + + operation = OP_EDIT + if (clgetb ("add")) + operation = OP_ADD + else if (clgetb ("addonly")) + operation = OP_INIT + else if (clgetb ("delete")) + operation = OP_DELETE + + # Get list of fields to be edited, added, or deleted. + call clgstr ("fields", Memc[s_fields], SZ_LINE) + for (ip=s_fields; IS_WHITE (Memc[ip]); ip=ip+1) + ; + fields = ip + + # The value expression parameter is not used for the delete operation. + if (operation != OP_DELETE) { + call clgstr ("value", Memc[s_valexpr], SZ_LINE) + for (ip=s_valexpr; IS_WHITE (Memc[ip]); ip=ip+1) + ; + valexpr = ip + while (Memc[ip] != EOS) + ip = ip + 1 + while (ip > valexpr && IS_WHITE (Memc[ip-1])) + ip = ip - 1 + Memc[ip] = EOS + } else { + Memc[s_valexpr] = EOS + valexpr = s_valexpr + } + + # Get switches. If the expression value is ".", meaning print value + # rather than edit, then we do not use the switches. + + if (operation == OP_EDIT && streq (Memc[valexpr], ".")) { + update = NO + verify = NO + show = NO + } else { + update = btoi (clgetb ("update")) + verify = btoi (clgetb ("verify")) + show = btoi (clgetb ("show")) + } + + # Main processing loop. An image is processed in each pass through + # the loop. + + while (imtgetim (imlist, Memc[image], SZ_FNAME) != EOF) { + + # set the length of the user area + if (envfind ("min_lenuserarea", Memc[sections], SZ_FNAME) > 0) { + up = 1 + if (ctoi (Memc[sections], up, min_lenuserarea) <= 0) + min_lenuserarea = LEN_USERAREA + else + min_lenuserarea = max (LEN_USERAREA, min_lenuserarea) + } else + min_lenuserarea = LEN_USERAREA + + # Open the image. + iferr { + if (update == YES) + im = immap (Memc[image], READ_WRITE, min_lenuserarea) + else + im = immap (Memc[image], READ_ONLY, min_lenuserarea) + } then { + call erract (EA_WARN) + next + } + + if (operation == OP_INIT || operation == OP_ADD) { + # Add a field to the image header. This cannot be done within + # the IMGNFN loop because template expansion on the existing + # fields of the image header would discard the new field name + # since it does not yet exist. + + nfields = 1 + call he_getopsetimage (im, Memc[image], Memc[field]) + switch (operation) { + case OP_INIT: + call he_initfield (im, Memc[image], Memc[fields], + Memc[valexpr], verify, show, update) + case OP_ADD: + call he_addfield (im, Memc[image], Memc[fields], + Memc[valexpr], verify, show, update) + } + + } else { + # Open list of fields to be processed. + flist = imofnlu (im, Memc[fields]) + + nfields = 0 + while (imgnfn (flist, Memc[field], SZ_FNAME) != EOF) { + call he_getopsetimage (im, Memc[image], Memc[field]) + + switch (operation) { + case OP_EDIT: + call he_editfield (im, Memc[image], Memc[field], + Memc[valexpr], verify, show, update) + case OP_DELETE: + call he_deletefield (im, Memc[image], Memc[field], + Memc[valexpr], verify, show, update) + } + nfields = nfields + 1 + } + + call imcfnl (flist) + } + + # Update the image header and unmap the image. + + noupdate = false + quit = false + + if (update == YES) { + if (nfields == 0) + noupdate = true + else if (verify == YES) { + call eprintf ("update %s ? (yes): ") + call pargstr (Memc[image]) + call flush (STDERR) + + if (getline (STDIN, Memc[buf]) == EOF) + noupdate = true + else { + # Strip leading whitespace and trailing newline. + for (ip=buf; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == 'q') { + quit = true + noupdate = true + } else if (! (Memc[ip] == '\n' || Memc[ip] == 'y')) + noupdate = true + } + } + + if (noupdate) { + call imseti (im, IM_WHEADER, NO) + call imunmap (im) + } else { + call imunmap (im) + if (show == YES) { + call printf ("%s updated\n") + call pargstr (Memc[image]) + } + } + } else + call imunmap (im) + + call flush (STDOUT) + if (quit) + break + } + + call imtclose (imlist) + call sfree (sp) +end + + +# HE_EDITFIELD -- Edit the value of the named field of the indicated image. +# The value expression is evaluated, interactively inspected if desired, +# and the resulting value put to the image. + +procedure he_editfield (im, image, field, valexpr, verify, show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # value expression +int verify # verify new value interactively +int show # print record of edit +int update # enable updating of the image + +int goahead, nl +pointer sp, ip, oldval, newval, defval, o + +bool streq() +pointer evexpr() +extern he_getop() +int getline(), imaccf(), strldxs(), locpr() +errchk evexpr, getline, imaccf, he_gval + +begin + call smark (sp) + call salloc (oldval, SZ_LINE, TY_CHAR) + call salloc (newval, SZ_LINE, TY_CHAR) + call salloc (defval, SZ_LINE, TY_CHAR) + + # Verify that the named field exists before going any further. + if (field[1] != '$') + if (imaccf (im, field) == NO) { + call eprintf ("parameter %s,%s not found\n") + call pargstr (image) + call pargstr (field) + call sfree (sp) + return + } + + # Get the old value. + call he_gval (im, image, field, Memc[oldval], SZ_LINE) + + # Evaluate the expression. Encode the result operand as a string. + # If the expression is not parenthesized, assume that is is already + # a string literal. + + if (valexpr[1] == '(') { + o = evexpr (valexpr, locpr (he_getop), 0) + call he_encodeop (o, Memc[newval], SZ_LINE) + call xev_freeop (o) + call mfree (o, TY_STRUCT) + } else + call strcpy (valexpr, Memc[newval], SZ_LINE) + + if (streq (Memc[newval], ".")) { + # Merely print the value of the field. + + call printf ("%s,%s = %s\n") + call pargstr (image) + call pargstr (field) + call he_pargstr (Memc[oldval]) + + } else if (verify == YES) { + # Query for new value and edit the field. If the response is a + # blank line, use the default new value. If the response is "$" + # or EOF, do not change the value of the parameter. + + call strcpy (Memc[newval], Memc[defval], SZ_LINE) + call eprintf ("%s,%s (%s -> %s): ") + call pargstr (image) + call pargstr (field) + call he_pargstr (Memc[oldval]) + call he_pargstr (Memc[defval]) + call flush (STDERR) + + if (getline (STDIN, Memc[newval]) != EOF) { + # Do not skip leading whitespace; may be significant in a + # string literal. + + ip = newval + + # Do strip trailing newline since it is an artifact of getline. + nl = strldxs ("\n", Memc[ip]) + if (nl > 0) + Memc[ip+nl-1] = EOS + + # Decode user response. + if (Memc[ip] == '\\') { + ip = ip + 1 + goahead = YES + } else if (streq(Memc[ip],"n") || streq(Memc[ip],"no")) { + goahead = NO + } else if (streq(Memc[ip],"y") || streq(Memc[ip],"yes") || + Memc[ip] == EOS) { + call strcpy (Memc[defval], Memc[newval], SZ_LINE) + goahead = YES + } else { + if (ip > newval) + call strcpy (Memc[ip], Memc[newval], SZ_LINE) + goahead = YES + } + + # Edit field if so indicated. + if (goahead == YES) + call he_updatefield (im, image, field, Memc[oldval], + Memc[newval], show) + + call flush (STDOUT) + } + + } else { + call he_updatefield (im, image, field, Memc[oldval], Memc[newval], + show) + } + + call sfree (sp) +end + + +# HE_INITFIELD -- Add a new field to the indicated image. If the field already +# exists do not set its value. The value expression is evaluated and the +# resulting value used as the initial value in adding the field to the image. + +procedure he_initfield (im, image, field, valexpr, verify, show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # value expression +int verify # verify new value interactively +int show # print record of edit +int update # enable updating of the image + +bool numeric +int numlen, ip +pointer sp, newval, o +pointer evexpr() +int imaccf(), locpr(), strlen(), lexnum() +extern he_getop() +errchk imaccf, evexpr, imaddb, imastr, imaddi, imaddr + +begin + call smark (sp) + call salloc (newval, SZ_LINE, TY_CHAR) + + # If the named field already exists, this is really an edit operation + # rather than an add. Call editfield so that the usual verification + # can take place. + + if (imaccf (im, field) == YES) { + call eprintf ("parameter %s,%s already exists\n") + call pargstr (image) + call pargstr (field) + call sfree (sp) + return + } + + # If the expression is not parenthesized, assume that is is already + # a string literal. If the expression is a string check for a simple + # numeric field. + + ip = 1 + numeric = (lexnum (valexpr, ip, numlen) != LEX_NONNUM) + if (numeric) + numeric = (numlen == strlen (valexpr)) + + if (numeric || valexpr[1] == '(') + o = evexpr (valexpr, locpr(he_getop), 0) + else { + call malloc (o, LEN_OPERAND, TY_STRUCT) + call xev_initop (o, max(1,strlen(valexpr)), TY_CHAR) + call strcpy (valexpr, O_VALC(o), ARB) + } + + # Add the field to the image (or update the value). The datatype of + # the expression value operand determines the datatype of the new + # parameter. + + switch (O_TYPE(o)) { + case TY_BOOL: + call imaddb (im, field, O_VALB(o)) + case TY_CHAR: + call imastr (im, field, O_VALC(o)) + case TY_INT: + call imaddi (im, field, O_VALI(o)) + case TY_REAL: + call imaddr (im, field, O_VALR(o)) + default: + call error (1, "unknown expression datatype") + } + + if (show == YES) { + call he_encodeop (o, Memc[newval], SZ_LINE) + call printf ("add %s,%s = %s\n") + call pargstr (image) + call pargstr (field) + call he_pargstr (Memc[newval]) + } + + call xev_freeop (o) + call mfree (o, TY_STRUCT) + call sfree (sp) +end + + +# HE_ADDFIELD -- Add a new field to the indicated image. If the field already +# exists, merely set its value. The value expression is evaluated and the +# resulting value used as the initial value in adding the field to the image. + +procedure he_addfield (im, image, field, valexpr, verify, show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # value expression +int verify # verify new value interactively +int show # print record of edit +int update # enable updating of the image + +bool numeric +int numlen, ip +pointer sp, newval, o +pointer evexpr() +int imaccf(), locpr(), strlen(), lexnum() +extern he_getop() +errchk imaccf, evexpr, imaddb, imastr, imaddi, imaddr + +begin + call smark (sp) + call salloc (newval, SZ_LINE, TY_CHAR) + + # If the named field already exists, this is really an edit operation + # rather than an add. Call editfield so that the usual verification + # can take place. + + if (imaccf (im, field) == YES) { + call he_editfield (im, image, field, valexpr, verify, show, update) + call sfree (sp) + return + } + + # If the expression is not parenthesized, assume that is is already + # a string literal. If the expression is a string check for a simple + # numeric field. + + ip = 1 + numeric = (lexnum (valexpr, ip, numlen) != LEX_NONNUM) + if (numeric) + numeric = (numlen == strlen (valexpr)) + + if (numeric || valexpr[1] == '(') + o = evexpr (valexpr, locpr(he_getop), 0) + else { + call malloc (o, LEN_OPERAND, TY_STRUCT) + call xev_initop (o, max(1,strlen(valexpr)), TY_CHAR) + call strcpy (valexpr, O_VALC(o), ARB) + } + + # Add the field to the image (or update the value). The datatype of + # the expression value operand determines the datatype of the new + # parameter. + + switch (O_TYPE(o)) { + case TY_BOOL: + call imaddb (im, field, O_VALB(o)) + case TY_CHAR: + call imastr (im, field, O_VALC(o)) + case TY_INT: + call imaddi (im, field, O_VALI(o)) + case TY_REAL: + call imaddr (im, field, O_VALR(o)) + default: + call error (1, "unknown expression datatype") + } + + if (show == YES) { + call he_encodeop (o, Memc[newval], SZ_LINE) + call printf ("add %s,%s = %s\n") + call pargstr (image) + call pargstr (field) + call he_pargstr (Memc[newval]) + } + + call xev_freeop (o) + call mfree (o, TY_STRUCT) + call sfree (sp) +end + + +# HE_DELETEFIELD -- Delete a field from the indicated image. If the field does +# not exist, print a warning message. + +procedure he_deletefield (im, image, field, valexpr, verify, show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # not used +int verify # verify deletion interactively +int show # print record of edit +int update # enable updating of the image + +pointer sp, ip, newval +int getline(), imaccf() + +begin + call smark (sp) + call salloc (newval, SZ_LINE, TY_CHAR) + + if (imaccf (im, field) == NO) { + call eprintf ("nonexistent field %s,%s\n") + call pargstr (image) + call pargstr (field) + call sfree (sp) + return + } + + if (verify == YES) { + # Delete pending verification. + + call eprintf ("delete %s,%s ? (yes): ") + call pargstr (image) + call pargstr (field) + call flush (STDERR) + + if (getline (STDIN, Memc[newval]) != EOF) { + # Strip leading whitespace and trailing newline. + for (ip=newval; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '\n' || Memc[ip] == 'y') { + call imdelf (im, field) + if (show == YES) { + call printf ("%s,%s deleted\n") + call pargstr (image) + call pargstr (field) + } + } + } + + } else { + # Delete without verification. + + iferr (call imdelf (im, field)) + call erract (EA_WARN) + else if (show == YES) { + call printf ("%s,%s deleted\n") + call pargstr (image) + call pargstr (field) + } + } + + call sfree (sp) +end + + +# HE_UPDATEFIELD -- Update the value of an image header field. + +procedure he_updatefield (im, image, field, oldval, newval, show) + +pointer im # image descriptor +char image[ARB] # image name +char field[ARB] # field name +char oldval[ARB] # old value, encoded as a string +char newval[ARB] # old value, encoded as a string +int show # print record of update + +begin + iferr (call impstr (im, field, newval)) { + call eprintf ("cannot update %s,%s\n") + call pargstr (image) + call pargstr (field) + return + } + + if (show == YES) { + call printf ("%s,%s: %s -> %s\n") + call pargstr (image) + call pargstr (field) + call he_pargstr (oldval) + call he_pargstr (newval) + } +end + + +# HE_GVAL -- Get the value of an image header field and return it as a string. +# The ficticious special field "$I" (the image name) is recognized in this +# context in addition to the actual header fields. + +procedure he_gval (im, image, field, strval, maxch) + +pointer im # image descriptor +char image[ARB] # image name +char field[ARB] # field whose value is to be returned +char strval[ARB] # string value of field (output) +int maxch # max chars out + +begin + if (field[1] == '$' && field[2] == 'I') + call strcpy (image, strval, maxch) + else if (field[1] == '$') + call imgstr (im, field[2], strval, maxch) + else + call imgstr (im, field, strval, maxch) +end + + +# HE_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 he_getop (operand, o) + +char operand[ARB] # operand name +pointer o # operand (output) + +pointer h_im # getop common +char h_image[SZ_IMAGENAME] +char h_field[SZ_FIELDNAME] +common /hegopm/ h_im, h_image, h_field +bool streq() +long clktime() +errchk he_getfield + +begin + if (streq (operand, ".")) { + call xev_initop (o, 1, TY_CHAR) + call strcpy (".", O_VALC(o), 1) + + } else if (streq (operand, "$")) { + call he_getfield (h_im, h_field, o) + + } else if (streq (operand, "$F")) { + call xev_initop (o, SZ_FIELDNAME, TY_CHAR) + call strcpy (h_field, O_VALC(o), SZ_FIELDNAME) + + } else if (streq (operand, "$I")) { + call xev_initop (o, SZ_IMAGENAME, TY_CHAR) + call strcpy (h_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 he_getfield (h_im, operand, o) +end + + +# HE_GETFIELD -- Return the value of the named field of the image header as +# an EVEXPR type operand structure. + +procedure he_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 imgeti(), imgftype() +real imgetr() + +begin + switch (imgftype (im, field)) { + 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 + + +# HE_GETOPSETIMAGE -- Set the image pointer, image name, and field name (context +# of getop) in preparation for a getop call by EVEXPR. + +procedure he_getopsetimage (im, image, field) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited + +pointer h_im # getop common +char h_image[SZ_IMAGENAME] +char h_field[SZ_FIELDNAME] +common /hegopm/ h_im, h_image, h_field + +begin + h_im = im + call strcpy (image, h_image, SZ_IMAGENAME) + call strcpy (field, h_field, SZ_FIELDNAME) +end + + +# HE_ENCODEOP -- Encode an operand as returned by EVEXPR as a string. EVEXPR +# operands are restricted to the datatypes bool, int, real, and string. + +procedure he_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 + + +# HE_PARGSTR -- Pass a string to a printf statement, enclosing the string +# in quotes if it contains any whitespace. + +procedure he_pargstr (str) + +char str[ARB] # string to be printed +int ip +bool quoteit +pointer sp, op, buf + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + op = buf + Memc[op] = '"' + op = op + 1 + + # Copy string to scratch buffer, enclosed in quotes. Check for + # embedded whitespace. + + quoteit = false + for (ip=1; str[ip] != EOS; ip=ip+1) { + if (IS_WHITE(str[ip])) { # detect whitespace + quoteit = true + Memc[op] = str[ip] + } else if (str[ip] == '\n') { # prettyprint newlines + Memc[op] = '\\' + op = op + 1 + Memc[op] = 'n' + } else # normal characters + Memc[op] = str[ip] + + if (ip < SZ_LINE) + op = op + 1 + } + + # If whitespace was seen pass the quoted string, otherwise pass the + # original input string. + + if (quoteit) { + Memc[op] = '"' + op = op + 1 + Memc[op] = EOS + call pargstr (Memc[buf]) + } else + call pargstr (str) + + call sfree (sp) +end diff --git a/pkg/images/imutil/src/hselect.x b/pkg/images/imutil/src/hselect.x new file mode 100644 index 00000000..5be85627 --- /dev/null +++ b/pkg/images/imutil/src/hselect.x @@ -0,0 +1,132 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <evexpr.h> +include <ctype.h> + +define LEN_USERAREA 28800 # allow for the largest possible header + + +# HSELECT -- Perform a relational select operation upon a set of images. +# Our function is to select all images from the input set matching some +# criteria, printing the listed fields of each selected image on the standard +# output in list form. +# +# N.B.: this task shares code with the HEDIT task. + +procedure t_hselect() + +pointer sp, im, image, fields, expr, missing, section +int imlist, ip, min_lenuserarea +int imtopenp(), imtgetim(), envfind(), ctoi() +pointer immap() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (fields, SZ_LINE, TY_CHAR) + call salloc (expr, SZ_LINE, TY_CHAR) + call salloc (missing, SZ_LINE, TY_CHAR) + call salloc (section, SZ_FNAME, TY_CHAR) + + # Get the primary operands. + imlist = imtopenp ("images") + call clgstr ("fields", Memc[fields], SZ_LINE) + call clgstr ("expr", Memc[expr], SZ_LINE) + call clgstr ("missing", Memc[missing], SZ_LINE) + + # Main processing loop. An image is processed in each pass through + # the loop. + + while (imtgetim (imlist, Memc[image], SZ_FNAME) != EOF) { + + # Check size of user area + if (envfind ("min_lenuserarea", Memc[section], SZ_FNAME) > 0) { + ip = 1 + if (ctoi (Memc[section], ip, min_lenuserarea) <= 0) + min_lenuserarea = LEN_USERAREA + else + min_lenuserarea = max (LEN_USERAREA, min_lenuserarea) + } else + min_lenuserarea = LEN_USERAREA + + # Open the image. + iferr (im = immap (Memc[image], READ_ONLY, min_lenuserarea)) { + call erract (EA_WARN) + next + } + + call he_getopsetimage (im, Memc[image], Memc[image]) + call hs_select (im, Memc[image], Memc[fields], Memc[expr], + Memc[missing]) + + call imunmap (im) + call flush (STDOUT) + } + + call imtclose (imlist) + call sfree (sp) +end + + +# HS_SELECT -- Evaluate the user supplied boolean expression using the +# header parameter values for an image, and print the values of the listed +# parameters on the standard output if the expression is true. + +procedure hs_select (im, image, fields, expr, missing) + +pointer im # image descriptor +char image[ARB] # name of image being evaluated +char fields[ARB] # fields to be passed if record is selected +char expr[ARB] # exression to be evaluated +char missing[ARB] # missing output value + +int fieldno +pointer o, sp, field, value, flist +pointer evexpr(), imofnlu() +int locpr(), imgnfn() +extern he_getop() +errchk evexpr, imofnlu, imgnfn + +begin + call smark (sp) + call salloc (field, SZ_FNAME, TY_CHAR) + call salloc (value, SZ_LINE, TY_CHAR) + + # Evaluate selection criteria. + o = evexpr (expr, locpr(he_getop), 0) + if (O_TYPE(o) != TY_BOOL) + call error (1, "expression must be boolean") + + # Print the values of the listed fields if the record was selected. + if (O_VALB(o)) { + flist = imofnlu (im, fields) + + fieldno = 1 + while (imgnfn (flist, Memc[field], SZ_FNAME) != EOF) { + iferr { + call he_gval (im, image, Memc[field], Memc[value], SZ_LINE) + } then { + call printf ("\t%s") + call pargstr (missing) + } else { + if (fieldno == 1) { + call printf ("%s") + call he_pargstr (Memc[value]) + } else { + call printf ("\t%s") + call he_pargstr (Memc[value]) + } + } + fieldno = fieldno + 1 + } + call printf ("\n") + + call imcfnl (flist) + call flush (STDOUT) + } + + call xev_freeop (o) + call mfree (o, TY_STRUCT) + call sfree (sp) +end diff --git a/pkg/images/imutil/src/iegsym.x b/pkg/images/imutil/src/iegsym.x new file mode 100644 index 00000000..6b7fbabf --- /dev/null +++ b/pkg/images/imutil/src/iegsym.x @@ -0,0 +1,37 @@ +include <ctotok.h> +include <imhdr.h> +include <ctype.h> +include <mach.h> +include <imset.h> +include <fset.h> +include <lexnum.h> +include <evvexpr.h> +include "gettok.h" + + +# Expression database symbol. +define LEN_SYM 2 +define SYM_TEXT Memi[$1] +define SYM_NARGS Memi[$1+1] + + + +# IE_GSYM -- Get symbol routine for the gettok package. + +pointer procedure ie_gsym (st, symname, nargs) + +pointer st #I symbol table +char symname[ARB] #I symbol to be looked up +int nargs #O number of macro arguments + +pointer sym +pointer strefsbuf(), stfind() + +begin + sym = stfind (st, symname) + if (sym == NULL) + return (NULL) + + nargs = SYM_NARGS(sym) + return (strefsbuf (st, SYM_TEXT(sym))) +end diff --git a/pkg/images/imutil/src/imaadd.gx b/pkg/images/imutil/src/imaadd.gx new file mode 100644 index 00000000..a31b47fc --- /dev/null +++ b/pkg/images/imutil/src/imaadd.gx @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +$for (silrd) +# IMA_ADD -- Image arithmetic addition. + +procedure ima_add$t (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +PIXEL a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nl$t() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector/scalar + # addition to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nl$t (im, buf, v, 2) != EOF) { + if (a == 0$f) + call amov$t (Mem$t[buf[2]], Mem$t[buf[1]], len) + else + call aaddk$t (Mem$t[buf[2]], a, Mem$t[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # addition to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nl$t (im, buf, v, 2) != EOF) { + if (b == 0$f) + call amov$t (Mem$t[buf[2]], Mem$t[buf[1]], len) + else + call aaddk$t (Mem$t[buf[2]], b, Mem$t[buf[1]], len) + } + + # Read imagea and imageb and do a vector addition into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nl$t (im, buf, v, 3) != EOF) + call aadd$t (Mem$t[buf[2]], Mem$t[buf[3]], Mem$t[buf[1]], len) + } +end +$endfor diff --git a/pkg/images/imutil/src/imadiv.gx b/pkg/images/imutil/src/imadiv.gx new file mode 100644 index 00000000..0aaac952 --- /dev/null +++ b/pkg/images/imutil/src/imadiv.gx @@ -0,0 +1,75 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_DIV -- Image arithmetic division. + +$for (silrd) +procedure ima_div$t (im_a, im_b, im_c, a, b, c) + +pointer im_a, im_b, im_c +PIXEL a, b, c + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nl$t() +PIXEL ima_efnc$t() +extern ima_efnc$t + +PIXEL divzero +common /imadcom$t/ divzero + +begin + # Loop through all of the image lines. + divzero = c + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do a vector + # reciprical to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nl$t (im, buf, v, 2) != EOF) + call arcz$t (a, Mem$t[buf[2]], Mem$t[buf[1]], len, + ima_efnc$t) + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector/scalar + # divide to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nl$t (im, buf, v, 2) != EOF) { + if (b == 0$f) + call amovk$t (divzero, Mem$t[buf[1]], len) + else if (b == 1$f) + call amov$t (Mem$t[buf[2]], Mem$t[buf[1]], len) + else + call adivk$t (Mem$t[buf[2]], b, Mem$t[buf[1]], len) + } + + # Read imagea and imageb and do the vector divide to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nl$t (im, buf, v, 3) != EOF) + call advz$t (Mem$t[buf[2]], Mem$t[buf[3]], Mem$t[buf[1]], + len, ima_efnc$t) + } +end + + +# IMA_EFNC -- Error function for division by zero. + +PIXEL procedure ima_efnc$t (a) + +PIXEL a +PIXEL divzero +common /imadcom$t/ divzero + +begin + return (divzero) +end +$endfor diff --git a/pkg/images/imutil/src/imamax.gx b/pkg/images/imutil/src/imamax.gx new file mode 100644 index 00000000..5804825f --- /dev/null +++ b/pkg/images/imutil/src/imamax.gx @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_MAX -- Image arithmetic maximum value. + +$for (silrd) +procedure ima_max$t (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +PIXEL a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nl$t() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # maximum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nl$t (im, buf, v, 2) != EOF) + call amaxk$t (Mem$t[buf[2]], a, Mem$t[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # maximum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nl$t (im, buf, v, 2) != EOF) + call amaxk$t (Mem$t[buf[2]], b, Mem$t[buf[1]], len) + + # Read imagea and imageb and do a vector-vector maximum + # operation to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nl$t (im, buf, v, 3) != EOF) + call amax$t (Mem$t[buf[2]], Mem$t[buf[3]], Mem$t[buf[1]], len) + } +end +$endfor diff --git a/pkg/images/imutil/src/imamin.gx b/pkg/images/imutil/src/imamin.gx new file mode 100644 index 00000000..b0360510 --- /dev/null +++ b/pkg/images/imutil/src/imamin.gx @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_MIN -- Image arithmetic minimum value. + +$for (silrd) +procedure ima_min$t (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +PIXEL a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nl$t() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb and do the vector/scalar + # minimum to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nl$t (im, buf, v, 2) != EOF) + call amink$t (Mem$t[buf[2]], a, Mem$t[buf[1]], len) + + # If imageb is constant then read imagea and do the vector/scalar + # minimum to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nl$t (im, buf, v, 2) != EOF) + call amink$t (Mem$t[buf[2]], b, Mem$t[buf[1]], len) + + # Read imagea and imageb and do a vector-vector minimum operation + # to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nl$t (im, buf, v, 3) != EOF) + call amin$t (Mem$t[buf[2]], Mem$t[buf[3]], Mem$t[buf[1]], len) + } +end +$endfor diff --git a/pkg/images/imutil/src/imamul.gx b/pkg/images/imutil/src/imamul.gx new file mode 100644 index 00000000..a2c2a4d9 --- /dev/null +++ b/pkg/images/imutil/src/imamul.gx @@ -0,0 +1,57 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_MUL -- Image arithmetic multiplication. + +$for (silrd) +procedure ima_mul$t (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +PIXEL a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nl$t() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + if (im_a == NULL) { + im[2] = im_b + while (ima_nl$t (im, buf, v, 2) != EOF) { + if (a == 1$f) + call amov$t (Mem$t[buf[2]], Mem$t[buf[1]], len) + else + call amulk$t (Mem$t[buf[2]], a, Mem$t[buf[1]], len) + } + + # If imageb is constant then read imagea. If the constant + # is 1 do a vector move to imagec otherwise do a vector + # multiply to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nl$t (im, buf, v, 2) != EOF) { + if (b == 1$f) + call amov$t (Mem$t[buf[2]], Mem$t[buf[1]], len) + else + call amulk$t (Mem$t[buf[2]], b, Mem$t[buf[1]], len) + } + + # Read imagea and imageb and do the vector multiply to imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nl$t (im, buf, v, 3) != EOF) + call amul$t (Mem$t[buf[2]], Mem$t[buf[3]], Mem$t[buf[1]], len) + } +end +$endfor diff --git a/pkg/images/imutil/src/imanl.gx b/pkg/images/imutil/src/imanl.gx new file mode 100644 index 00000000..c91631f7 --- /dev/null +++ b/pkg/images/imutil/src/imanl.gx @@ -0,0 +1,47 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_NL -- For each line in the output image lines from the input images +# are returned. The input images are repeated as necessary. EOF is returned +# when the last line of the output image has been reached. One dimensional +# images are read only once and the data pointers are assumed to be unchanged +# from previous calls. The image line vectors must be initialized externally +# and then left untouched. +# +# This procedure is typically used when operations upon lines or pixels +# make sense in mixed dimensioned images. For example to add a one dimensional +# image to all lines of a higher dimensional image or to subtract a +# two dimensional image from all bands of three dimensional image. +# The lengths of the common dimensions should generally be checked +# for equality with xt_imleneq. + +$for (silrd) +int procedure ima_nl$t (im, data, v, nimages) + +pointer im[nimages] # IMIO pointers; the first one is the output +pointer data[nimages] # Returned data pointers +long v[IM_MAXDIM, nimages] # Line vectors +int nimages # Number of images + +int i + +int impnl$t(), imgnl$t() + +begin + if (impnl$t (im[1], data[1], v[1,1]) == EOF) + return (EOF) + + for (i=2; i <= nimages; i=i+1) { + if (imgnl$t (im[i], data[i], v[1,i]) == EOF) { + if (IM_NDIM(im[i]) > 1) { + call amovkl (long(1), v[1,i], IM_MAXDIM) + if (imgnl$t (im[i], data[i], v[1,i]) == EOF) + call error (0, "Error reading image line") + } + } + } + + return (OK) +end +$endfor diff --git a/pkg/images/imutil/src/imasub.gx b/pkg/images/imutil/src/imasub.gx new file mode 100644 index 00000000..4eb2a2c2 --- /dev/null +++ b/pkg/images/imutil/src/imasub.gx @@ -0,0 +1,56 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMA_SUB -- Image arithmetic subtraction. + +$for (silrd) +procedure ima_sub$t (im_a, im_b, im_c, a, b) + +pointer im_a, im_b, im_c +PIXEL a, b + +int len +pointer im[3], buf[3] +long v[IM_MAXDIM, 3] + +int ima_nl$t() + +begin + # Loop through all of the image lines. + im[1] = im_c + len = IM_LEN (im[1], 1) + call amovkl (long(1), v, 3 * IM_MAXDIM) + + # If imagea is constant then read imageb. Do a vector/scalar + # subtraction and then negate the result. + if (im_a == NULL) { + im[2] = im_b + while (ima_nl$t (im, buf, v, 2) != EOF) { + if (a != 0$f) { + call asubk$t (Mem$t[buf[2]], a, Mem$t[buf[1]], len) + call aneg$t (Mem$t[buf[1]], Mem$t[buf[1]], len) + } else + call aneg$t (Mem$t[buf[2]], Mem$t[buf[1]], len) + } + + # If imageb is constant then read imagea and do a vector/scalar + # subtraction to imagec. + } else if (im_b == NULL) { + im[2] = im_a + while (ima_nl$t (im, buf, v, 2) != EOF) { + if (b == 0$f) + call amov$t (Mem$t[buf[2]], Mem$t[buf[1]], len) + else + call asubk$t (Mem$t[buf[2]], b, Mem$t[buf[1]], len) + } + + # Read imagea and imageb and do a vector subtraction into imagec. + } else { + im[2] = im_a + im[3] = im_b + while (ima_nl$t (im, buf, v, 3) != EOF) + call asub$t (Mem$t[buf[2]], Mem$t[buf[3]], Mem$t[buf[1]], len) + } +end +$endfor diff --git a/pkg/images/imutil/src/imdelete.x b/pkg/images/imutil/src/imdelete.x new file mode 100644 index 00000000..204ff7fa --- /dev/null +++ b/pkg/images/imutil/src/imdelete.x @@ -0,0 +1,85 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> + +# IMDELETE -- Delete a list of images. If image cannot be deleted, warn but do +# not abort. Verify before deleting each image if user wishes. + +procedure t_imdelete() + +bool verify +int list, nchars +pointer sp, tty, imname, im + +pointer ttyodes(), immap() +int imtopenp(), imtgetim(), imaccess(), strlen(), strncmp() +bool clgetb() + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + list = imtopenp ("images") + verify = clgetb ("verify") + if (verify) + tty = ttyodes ("terminal") + + while (imtgetim (list, Memc[imname], SZ_FNAME) != EOF) { + + if (verify) { + # If image does not exist, warn user (since verify mode is + # in effect). + + if (imaccess (Memc[imname], 0) == NO) { + call eprintf ("Warning: %s `%s'\n") + call pargstr ("Cannot delete nonexistent image") + call pargstr (Memc[imname]) + next + } + + # Set default action of verify prompt (override learning of + # most recent response). + + call clputb ("go_ahead", clgetb ("default_action")) + + # Output prompt, with image name. + call printf ("delete image ") + call ttyso (STDOUT, tty, YES) + call printf ("`%s'") + call pargstr (Memc[imname]) + call ttyso (STDOUT, tty, NO) + + # Include portion of image title in prompt. + ifnoerr (im = immap (Memc[imname], READ_ONLY, 0)) { + nchars = strlen (IM_TITLE(im)) + if (nchars > 0) { + call printf (" - %0.28s") + call pargstr (IM_TITLE(im)) + if (nchars > 28) + call printf ("...") + } + iferr (call imunmap (im)) + ; + } + + # Do the query. + if (! clgetb ("go_ahead")) + next + } + + iferr (call imdelete (Memc[imname])) + call erract (EA_WARN) + } + + # Reset the go_ahead parameter, overiding learn mode, in case delete + # is subsequently called from the background. Close tty descriptor. + + if (verify) { + call clputb ("go_ahead", true) + call ttycdes (tty) + } + + call imtclose (list) + call sfree (sp) +end diff --git a/pkg/images/imutil/src/imexpr.gx b/pkg/images/imutil/src/imexpr.gx new file mode 100644 index 00000000..139761fc --- /dev/null +++ b/pkg/images/imutil/src/imexpr.gx @@ -0,0 +1,1183 @@ +include <ctotok.h> +include <imhdr.h> +include <ctype.h> +include <mach.h> +include <imset.h> +include <fset.h> +include <lexnum.h> +include <evvexpr.h> +include "gettok.h" + + +# IMEXPR.X -- Image expression evaluator. + +define MAX_OPERANDS 26 +define MAX_ALIASES 10 +define DEF_LENINDEX 97 +define DEF_LENSTAB 1024 +define DEF_LENSBUF 8192 +define DEF_LINELEN 32768 + +# Input image operands. +define LEN_IMOPERAND 18 +define IO_OPNAME Memi[$1] # symbolic operand name +define IO_TYPE Memi[$1+1] # operand type +define IO_IM Memi[$1+2] # image pointer if image +define IO_V Memi[$1+3+($2)-1] # image i/o pointer +define IO_DATA Memi[$1+10] # current image line + # align +define IO_OP ($1+12) # pointer to evvexpr operand + +# Image operand types (IO_TYPE). +define IMAGE 1 # image (vector) operand +define NUMERIC 2 # numeric constant +define PARAMETER 3 # image parameter reference + +# Main imexpr descriptor. +define LEN_IMEXPR (24+LEN_IMOPERAND*MAX_OPERANDS) +define IE_ST Memi[$1] # symbol table +define IE_IM Memi[$1+1] # output image +define IE_NDIM Memi[$1+2] # dimension of output image +define IE_AXLEN Memi[$1+3+($2)-1] # dimensions of output image +define IE_INTYPE Memi[$1+10] # minimum input operand type +define IE_OUTTYPE Memi[$1+11] # datatype of output image +define IE_BWIDTH Memi[$1+12] # npixels boundary extension +define IE_BTYPE Memi[$1+13] # type of boundary extension +define IE_BPIXVAL Memr[P2R($1+14)] # boundary pixel value +define IE_V Memi[$1+15+($2)-1] # position in output image +define IE_NOPERANDS Memi[$1+22] # number of input operands + # align +define IE_IMOP ($1+24+(($2)-1)*LEN_IMOPERAND) # image operand array + +# Expression database symbol. +define LEN_SYM 2 +define SYM_TEXT Memi[$1] +define SYM_NARGS Memi[$1+1] + +# Argument list symbol +define LEN_ARGSYM 1 +define ARGNO Memi[$1] + + +# IMEXPR -- Task procedure for the image expression evaluator. This task +# generates an image by evaluating an arbitrary vector expression, which may +# reference other images as input operands. +# +# The input expression may be any legal EVVEXPR expression. Input operands +# must be specified using the reserved names "a" through "z", hence there are +# a maximum of 26 input operands. An input operand may be an image name or +# image section, an image header parameter, a numeric constant, or the name +# of a builtin keyword. Image header parameters are specified as, e.g., +# "a.naxis1" where the operand "a" must be assigned to an input image. The +# special image name "." refers to the output image generated in the last +# call to imexpr, making it easier to perform a sequence of operations. + +procedure t_imexpr() + +double dval +bool verbose, rangecheck +pointer out, st, sp, ie, dims, intype, outtype, ref_im +pointer outim, fname, expr, xexpr, output, section, data, imname +pointer oplist, opnam, opval, param, io, ip, op, o, im, ia, emsg +int len_exprbuf, fd, nchars, noperands, dtype, status, i, j +int ndim, npix, ch, percent, nlines, totlines, flags, mapflag + +real clgetr() +double imgetd() +int imgftype(), clgwrd(), ctod() +bool clgetb(), imgetb(), streq(), strne() +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld() +int impnls(), impnli(), impnll(), impnlr(), impnld() +int open(), getci(), ie_getops(), lexnum(), stridxs() +int imgeti(), ctoi(), btoi(), locpr(), clgeti(), strncmp() +pointer ie_getexprdb(), ie_expandtext(), immap() +extern ie_getop(), ie_fcn() +pointer evvexpr() +long fstatl() + +string s_nodata "bad image: no data" +string s_badtype "unknown image type" +define numeric_ 91 +define image_ 92 + +begin + # call memlog ("--------- START IMEXPR -----------") + + call smark (sp) + call salloc (ie, LEN_IMEXPR, TY_STRUCT) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (output, SZ_PATHNAME, TY_CHAR) + call salloc (imname, SZ_PATHNAME, TY_CHAR) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (intype, SZ_FNAME, TY_CHAR) + call salloc (outtype, SZ_FNAME, TY_CHAR) + call salloc (oplist, SZ_LINE, TY_CHAR) + call salloc (opval, SZ_LINE, TY_CHAR) + call salloc (dims, SZ_LINE, TY_CHAR) + call salloc (emsg, SZ_LINE, TY_CHAR) + + # Initialize the main imexpr descriptor. + call aclri (Memi[ie], LEN_IMEXPR) + + verbose = clgetb ("verbose") + rangecheck = clgetb ("rangecheck") + + # Load the expression database, if any. + st = NULL + call clgstr ("exprdb", Memc[fname], SZ_PATHNAME) + if (strne (Memc[fname], "none")) + st = ie_getexprdb (Memc[fname]) + IE_ST(ie) = st + + # Get the expression to be evaluated and expand any file inclusions + # or macro references. + + len_exprbuf = SZ_COMMAND + call malloc (expr, len_exprbuf, TY_CHAR) + call clgstr ("expr", Memc[expr], len_exprbuf) + + if (Memc[expr] == '@') { + fd = open (Memc[expr+1], READ_ONLY, TEXT_FILE) + nchars = fstatl (fd, F_FILESIZE) + if (nchars > len_exprbuf) { + len_exprbuf = nchars + call realloc (expr, len_exprbuf, TY_CHAR) + } + for (op=expr; getci(fd,ch) != EOF; op = op + 1) { + if (ch == '\n') + Memc[op] = ' ' + else + Memc[op] = ch + } + Memc[op] = EOS + call close (fd) + } + + if (st != NULL) { + xexpr = ie_expandtext (st, Memc[expr]) + call mfree (expr, TY_CHAR) + expr = xexpr + if (verbose) { + call printf ("%s\n") + call pargstr (Memc[expr]) + call flush (STDOUT) + } + } + + # Get output image name. + call clgstr ("output", Memc[output], SZ_PATHNAME) + call imgimage (Memc[output], Memc[imname], SZ_PATHNAME) + + IE_BWIDTH(ie) = clgeti ("bwidth") + IE_BTYPE(ie) = clgwrd ("btype", Memc[oplist], SZ_LINE, + "|constant|nearest|reflect|wrap|project|") + IE_BPIXVAL(ie) = clgetr ("bpixval") + + # Determine the minimum input operand type. + call clgstr ("intype", Memc[intype], SZ_FNAME) + + if (strncmp (Memc[intype], "auto", 4) == 0) + IE_INTYPE(ie) = 0 + else { + switch (Memc[intype]) { + case 'i', 'l': + IE_INTYPE(ie) = TY_INT + case 'r': + IE_INTYPE(ie) = TY_REAL + case 'd': + IE_INTYPE(ie) = TY_DOUBLE + default: + IE_INTYPE(ie) = 0 + } + } + + # Parse the expression and generate a list of input operands. + noperands = ie_getops (st, Memc[expr], Memc[oplist], SZ_LINE) + IE_NOPERANDS(ie) = noperands + + # Process the list of input operands and initialize each operand. + # This means fetch the value of the operand from the CL, determine + # the operand type, and initialize the image operand descriptor. + # The operand list is returned as a sequence of EOS delimited strings. + + opnam = oplist + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (Memc[opnam] == EOS) + call error (1, "malformed operand list") + + call clgstr (Memc[opnam], Memc[opval], SZ_LINE) + IO_OPNAME(io) = Memc[opnam] + ip = opval + + # Initialize the input operand; these values are overwritten below. + o = IO_OP(io) + call aclri (Memi[o], LEN_OPERAND) + + if (Memc[ip] == '.' && (Memc[ip+1] == EOS || Memc[ip+1] == '[')) { + # A "." is shorthand for the last output image. + call strcpy (Memc[ip+1], Memc[section], SZ_FNAME) + call clgstr ("lastout", Memc[opval], SZ_LINE) + call strcat (Memc[section], Memc[opval], SZ_LINE) + goto image_ + + } else if (IS_LOWER(Memc[ip]) && Memc[ip+1] == '.') { + # "a.foo" refers to parameter foo of image A. Mark this as + # a parameter operand for now, and patch it up later. + + IO_TYPE(io) = PARAMETER + IO_DATA(io) = ip + call salloc (IO_DATA(io), SZ_LINE, TY_CHAR) + call strcpy (Memc[ip], Memc[IO_DATA(io)], SZ_LINE) + + } else if (ctod (Memc, ip, dval) > 0) { + if (Memc[ip] != EOS) + goto image_ + + # A numeric constant. +numeric_ IO_TYPE(io) = NUMERIC + + ip = opval + switch (lexnum (Memc, ip, nchars)) { + case LEX_REAL: + dtype = TY_REAL + if (stridxs("dD",Memc[opval]) > 0 || nchars > NDIGITS_RP+3) + dtype = TY_DOUBLE + O_TYPE(o) = dtype + if (dtype == TY_REAL) + O_VALR(o) = dval + else + O_VALD(o) = dval + default: + O_TYPE(o) = TY_INT + O_LEN(o) = 0 + O_VALI(o) = int(dval) + } + + } else { + # Anything else is assumed to be an image name. +image_ + ip = opval + call imgimage (Memc[ip], Memc[fname], SZ_PATHNAME) + if (streq (Memc[fname], Memc[imname])) + call error (2, "input and output images cannot be the same") + + im = immap (Memc[ip], READ_ONLY, 0) + + # Set any image options. + if (IE_BWIDTH(ie) > 0) { + call imseti (im, IM_NBNDRYPIX, IE_BWIDTH(ie)) + call imseti (im, IM_TYBNDRY, IE_BTYPE(ie)) + call imsetr (im, IM_BNDRYPIXVAL, IE_BPIXVAL(ie)) + } + + IO_TYPE(io) = IMAGE + call amovkl (1, IO_V(io,1), IM_MAXDIM) + IO_IM(io) = im + + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE: + O_TYPE(o) = IM_PIXTYPE(im) + case TY_COMPLEX: + O_TYPE(o) = TY_REAL + default: # TY_USHORT + O_TYPE(o) = TY_INT + } + + O_TYPE(o) = max (IE_INTYPE(ie), O_TYPE(o)) + O_LEN(o) = IM_LEN(im,1) + O_FLAGS(o) = 0 + + # If one dimensional image read in data and be done with it. + if (IM_NDIM(im) == 1) { + switch (O_TYPE(o)) { + $for (silrd) + case TY_PIXEL: + if (imgnl$t (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (3, s_nodata) + $endfor + default: + call error (4, s_badtype) + } + } + } + + + # Get next operand name. + while (Memc[opnam] != EOS) + opnam = opnam + 1 + opnam = opnam + 1 + } + + # Go back and patch up any "a.foo" type parameter references. The + # reference input operand (e.g. "a") must be of type IMAGE and must + # point to a valid open image. + + do i = 1, noperands { + mapflag = NO + io = IE_IMOP(ie,i) + ip = IO_DATA(io) + if (IO_TYPE(io) != PARAMETER) + next + + # Locate referenced symbolic image operand (e.g. "a"). + ia = NULL + do j = 1, noperands { + ia = IE_IMOP(ie,j) + if (IO_OPNAME(ia) == Memc[ip] && IO_TYPE(ia) == IMAGE) + break + ia = NULL + } + if (ia == NULL && (IS_LOWER(Memc[ip]) && Memc[ip+1] == '.')) { + # The parameter operand is something like 'a.foo' however + # the image operand 'a' is not in the list derived from the + # expression, perhaps because we just want to use a parameter + # from a reference image and not the image itself. In this + # case map the image so we can get the parameter. + + call strcpy (Memc[ip], Memc[opval], 1) + call clgstr (Memc[opval], Memc[opnam], SZ_LINE) + call imgimage (Memc[opnam], Memc[fname], SZ_PATHNAME) + + iferr (im = immap (Memc[fname], READ_ONLY, 0)) { + call sprintf (Memc[emsg], SZ_LINE, + "bad image parameter reference %s") + call pargstr (Memc[ip]) + call error (5, Memc[emsg]) + } else + mapflag = YES + + } else if (ia == NULL) { + call sprintf (Memc[emsg], SZ_LINE, + "bad image parameter reference %s") + call pargstr (Memc[ip]) + call error (5, Memc[emsg]) + + } else + im = IO_IM(ia) + + # Get the parameter value and set up operand struct. + param = ip + 2 + IO_TYPE(io) = NUMERIC + o = IO_OP(io) + O_LEN(o) = 0 + + switch (imgftype (im, Memc[param])) { + case TY_BOOL: + O_TYPE(o) = TY_BOOL + O_VALI(o) = btoi (imgetb (im, Memc[param])) + + case TY_CHAR: + O_TYPE(o) = TY_CHAR + O_LEN(o) = SZ_LINE + call malloc (O_VALP(o), SZ_LINE, TY_CHAR) + call imgstr (im, Memc[param], O_VALC(o), SZ_LINE) + + case TY_INT: + O_TYPE(o) = TY_INT + O_VALI(o) = imgeti (im, Memc[param]) + + case TY_REAL: + O_TYPE(o) = TY_DOUBLE + O_VALD(o) = imgetd (im, Memc[param]) + + default: + call sprintf (Memc[emsg], SZ_LINE, "param %s not found\n") + call pargstr (Memc[ip]) + call error (6, Memc[emsg]) + } + + if (mapflag == YES) + call imunmap (im) + } + + # Determine the reference image from which we will inherit image + # attributes such as the WCS. If the user specifies this we use + # the indicated image, otherwise we use the input image operand with + # the highest dimension. + + call clgstr ("refim", Memc[fname], SZ_PATHNAME) + if (streq (Memc[fname], "auto")) { + # Locate best reference image (highest dimension). + ndim = 0 + ref_im = NULL + + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (IO_TYPE(io) != IMAGE || IO_IM(io) == NULL) + next + + im = IO_IM(io) + if (IM_NDIM(im) > ndim) { + ref_im = im + ndim = IM_NDIM(im) + } + } + } else { + # Locate referenced symbolic image operand (e.g. "a"). + io = NULL + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (IO_OPNAME(io) == Memc[fname] && IO_TYPE(io) == IMAGE) + break + io = NULL + } + if (io == NULL) { + call sprintf (Memc[emsg], SZ_LINE, + "bad wcsimage reference image %s") + call pargstr (Memc[fname]) + call error (7, Memc[emsg]) + } + ref_im = IO_IM(io) + } + + # Determine the dimension and size of the output image. If the "dims" + # parameter is set this determines the image dimension, otherwise we + # determine the best output image dimension and size from the input + # images. The exception is the line length, which is determined by + # the image line operand returned when the first line of the image + # is evaluated. + + call clgstr ("dims", Memc[dims], SZ_LINE) + if (streq (Memc[dims], "auto")) { + # Determine the output image dimensions from the input images. + call amovki (1, IE_AXLEN(ie,2), IM_MAXDIM-1) + IE_AXLEN(ie,1) = 0 + ndim = 1 + + do i = 1, noperands { + io = IE_IMOP(ie,i) + im = IO_IM(io) + if (IO_TYPE(io) != IMAGE || im == NULL) + next + + ndim = max (ndim, IM_NDIM(im)) + do j = 2, IM_NDIM(im) { + npix = IM_LEN(im,j) + if (npix > 1) { + if (IE_AXLEN(ie,j) <= 1) + IE_AXLEN(ie,j) = npix + else + IE_AXLEN(ie,j) = min (IE_AXLEN(ie,j), npix) + } + } + } + IE_NDIM(ie) = ndim + + } else { + # Use user specified output image dimensions. + ndim = 0 + for (ip=dims; ctoi(Memc,ip,npix) > 0; ) { + ndim = ndim + 1 + IE_AXLEN(ie,ndim) = npix + for (ch=Memc[ip]; IS_WHITE(ch) || ch == ','; ch=Memc[ip]) + ip = ip + 1 + } + IE_NDIM(ie) = ndim + } + + # Determine the pixel type of the output image. + call clgstr ("outtype", Memc[outtype], SZ_FNAME) + + if (strncmp (Memc[outtype], "auto", 4) == 0) { + IE_OUTTYPE(ie) = 0 + } else if (strncmp (Memc[outtype], "ref", 3) == 0) { + if (ref_im != NULL) + IE_OUTTYPE(ie) = IM_PIXTYPE(ref_im) + else + IE_OUTTYPE(ie) = 0 + } else { + switch (Memc[outtype]) { + case 'u': + IE_OUTTYPE(ie) = TY_USHORT + case 's': + IE_OUTTYPE(ie) = TY_SHORT + case 'i': + IE_OUTTYPE(ie) = TY_INT + case 'l': + IE_OUTTYPE(ie) = TY_LONG + case 'r': + IE_OUTTYPE(ie) = TY_REAL + case 'd': + IE_OUTTYPE(ie) = TY_DOUBLE + default: + call error (8, "bad outtype") + } + } + + # Open the output image. If the output image name has a section we + # are writing to a section of an existing image. + + call imgsection (Memc[output], Memc[section], SZ_FNAME) + if (Memc[section] != EOS && Memc[section] != NULL) { + outim = immap (Memc[output], READ_WRITE, 0) + IE_AXLEN(ie,1) = IM_LEN(outim,1) + } else { + if (ref_im != NULL) + outim = immap (Memc[output], NEW_COPY, ref_im) + else + outim = immap (Memc[output], NEW_IMAGE, 0) + IM_LEN(outim,1) = 0 + call amovl (IE_AXLEN(ie,2), IM_LEN(outim,2), IM_MAXDIM-1) + IM_NDIM(outim) = IE_NDIM(ie) + IM_PIXTYPE(outim) = 0 + } + + # Initialize output image line pointer. + call amovkl (1, IE_V(ie,1), IM_MAXDIM) + + percent = 0 + nlines = 0 + totlines = 1 + do i = 2, IM_NDIM(outim) + totlines = totlines * IM_LEN(outim,i) + + # Generate the pixel data for the output image line by line, + # evaluating the user supplied expression to produce each image + # line. Images may be any dimension, datatype, or size. + + # call memlog ("--------- PROCESS IMAGE -----------") + + out = NULL + repeat { + # call memlog1 ("--------- line %d ----------", nlines + 1) + + # Output image line generated by last iteration. + if (out != NULL) { + op = data + if (O_LEN(out) == 0) { + # Output image line is a scalar. + + switch (O_TYPE(out)) { + case TY_BOOL: + Memi[op] = O_VALI(out) + call amovki (O_VALI(out), Memi[op], IM_LEN(outim,1)) + $for (silrd) + case TY_PIXEL: + call amovk$t (O_VAL$T(out), Mem$t[op], IM_LEN(outim,1)) + $endfor + } + + } else { + # Output image line is a vector. + + npix = min (O_LEN(out), IM_LEN(outim,1)) + ip = O_VALP(out) + switch (O_TYPE(out)) { + case TY_BOOL: + call amovi (Memi[ip], Memi[op], npix) + $for (silrd) + case TY_PIXEL: + call amov$t (Mem$t[ip], Mem$t[op], npix) + $endfor + } + } + + call evvfree (out) + out = NULL + } + + # Get the next line in all input images. If EOF is seen on the + # image we merely rewind and keep going. This allows a vector, + # plane, etc. to be applied to each line, band, etc. of a higher + # dimensioned image. + + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (IO_TYPE(io) != IMAGE || IO_IM(io) == NULL) + next + + im = IO_IM(io) + o = IO_OP(io) + + # Data for a 1D image was read in above. + if (IM_NDIM(im) == 1) + next + + switch (O_TYPE(o)) { + $for (silrd) + case TY_PIXEL: + if (imgnl$t (im, IO_DATA(io), IO_V(io,1)) == EOF) { + call amovkl (1, IO_V(io,1), IM_MAXDIM) + if (imgnl$t (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (9, s_nodata) + } + $endfor + default: + call error (10, s_badtype) + } + } + + # call memlog (".......... enter evvexpr ..........") + + # This is it! Evaluate the vector expression. + flags = 0 + if (rangecheck) + flags = or (flags, EV_RNGCHK) + + out = evvexpr (Memc[expr], + locpr(ie_getop), ie, locpr(ie_fcn), ie, flags) + + # call memlog (".......... exit evvexpr ..........") + + # If the pixel type and line length of the output image are + # still undetermined set them to match the output operand. + + if (IM_PIXTYPE(outim) == 0) { + if (IE_OUTTYPE(ie) == 0) { + if (O_TYPE(out) == TY_BOOL) + IE_OUTTYPE(ie) = TY_INT + else + IE_OUTTYPE(ie) = O_TYPE(out) + IM_PIXTYPE(outim) = IE_OUTTYPE(ie) + } else + IM_PIXTYPE(outim) = IE_OUTTYPE(ie) + } + if (IM_LEN(outim,1) == 0) { + if (IE_AXLEN(ie,1) == 0) { + if (O_LEN(out) == 0) { + IE_AXLEN(ie,1) = 1 + IM_LEN(outim,1) = 1 + } else { + IE_AXLEN(ie,1) = O_LEN(out) + IM_LEN(outim,1) = O_LEN(out) + } + } else + IM_LEN(outim,1) = IE_AXLEN(ie,1) + } + + # Print percent done. + if (verbose) { + nlines = nlines + 1 + if (nlines * 100 / totlines >= percent + 10) { + percent = percent + 10 + call printf ("%2d%% ") + call pargi (percent) + call flush (STDOUT) + } + } + + switch (O_TYPE(out)) { + case TY_BOOL: + status = impnli (outim, data, IE_V(ie,1)) + $for (silrd) + case TY_PIXEL: + status = impnl$t (outim, data, IE_V(ie,1)) + $endfor + default: + call error (11, "expression type incompatible with image") + } + } until (status == EOF) + + # call memlog ("--------- DONE PROCESSING IMAGE -----------") + + if (verbose) { + call printf ("- done\n") + call flush (STDOUT) + } + + # All done. Unmap images. + call imunmap (outim) + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (IO_TYPE(io) == IMAGE && IO_IM(io) != NULL) + call imunmap (IO_IM(io)) + } + + # Clean up. + do i = 1, noperands { + io = IE_IMOP(ie,i) + o = IO_OP(io) + if (O_TYPE(o) == TY_CHAR) + call mfree (O_VALP(o), TY_CHAR) + } + + call evvfree (out) + call mfree (expr, TY_CHAR) + if (st != NULL) + call stclose (st) + + call clpstr ("lastout", Memc[output]) + call sfree (sp) +end + + +# IE_GETOP -- Called by evvexpr to fetch an input image operand. + +procedure ie_getop (ie, opname, o) + +pointer ie #I imexpr descriptor +char opname[ARB] #I operand name +pointer o #I output operand to be filled in + +int axis, i +pointer param, data +pointer sp, im, io, v + +bool imgetb() +int imgeti() +double imgetd() +int imgftype(), btoi() +errchk malloc +define err_ 91 + +begin + call smark (sp) + + if (IS_LOWER(opname[1]) && opname[2] == EOS) { + # Image operand. + + io = NULL + do i = 1, IE_NOPERANDS(ie) { + io = IE_IMOP(ie,i) + if (IO_OPNAME(io) == opname[1]) + break + io = NULL + } + + if (io == NULL) + goto err_ + else + v = IO_OP(io) + + call amovi (Memi[v], Memi[o], LEN_OPERAND) + if (IO_TYPE(io) == IMAGE) { + O_VALP(o) = IO_DATA(io) + O_FLAGS(o) = 0 + } + + call sfree (sp) + return + + } else if (IS_LOWER(opname[1]) && opname[2] == '.') { + # Image parameter reference, e.g., "a.foo". + call salloc (param, SZ_FNAME, TY_CHAR) + + # Locate referenced symbolic image operand (e.g. "a"). + io = NULL + do i = 1, IE_NOPERANDS(ie) { + io = IE_IMOP(ie,i) + if (IO_OPNAME(io) == opname[1] && IO_TYPE(io) == IMAGE) + break + io = NULL + } + if (io == NULL) + goto err_ + + # Get the parameter value and set up operand struct. + call strcpy (opname[3], Memc[param], SZ_FNAME) + im = IO_IM(io) + + iferr (O_TYPE(o) = imgftype (im, Memc[param])) + goto err_ + + switch (O_TYPE(o)) { + case TY_BOOL: + iferr (O_VALI(o) = btoi (imgetb (im, Memc[param]))) + goto err_ + + case TY_CHAR: + O_LEN(o) = SZ_LINE + O_FLAGS(o) = O_FREEVAL + iferr { + call malloc (O_VALP(o), SZ_LINE, TY_CHAR) + call imgstr (im, Memc[param], O_VALC(o), SZ_LINE) + } then + goto err_ + + case TY_INT: + iferr (O_VALI(o) = imgeti (im, Memc[param])) + goto err_ + + case TY_REAL: + O_TYPE(o) = TY_DOUBLE + iferr (O_VALD(o) = imgetd (im, Memc[param])) + goto err_ + + default: + goto err_ + } + + call sfree (sp) + return + + } else if (IS_UPPER(opname[1]) && opname[2] == EOS) { + # The current pixel coordinate [I,J,K,...]. The line coordinate + # is a special case since the image is computed a line at a time. + # If "I" is requested return a vector where v[i] = i. For J, K, + # etc. just return the scalar index value. + + axis = opname[1] - 'I' + 1 + if (axis == 1) { + O_TYPE(o) = TY_INT + if (IE_AXLEN(ie,1) > 0) + O_LEN(o) = IE_AXLEN(ie,1) + else { + # Line length not known yet. + O_LEN(o) = DEF_LINELEN + } + call malloc (data, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[data+i-1] = i + O_VALP(o) = data + O_FLAGS(o) = O_FREEVAL + } else { + O_TYPE(o) = TY_INT + #O_LEN(o) = 0 + #if (axis < 1 || axis > IM_MAXDIM) + #O_VALI(o) = 1 + #else + #O_VALI(o) = IE_V(ie,axis) + #O_FLAGS(o) = 0 + if (IE_AXLEN(ie,1) > 0) + O_LEN(o) = IE_AXLEN(ie,1) + else + # Line length not known yet. + O_LEN(o) = DEF_LINELEN + call malloc (data, O_LEN(o), TY_INT) + if (axis < 1 || axis > IM_MAXDIM) + call amovki (1, Memi[data], O_LEN(o)) + else + call amovki (IE_V(ie,axis), Memi[data], O_LEN(o)) + O_VALP(o) = data + O_FLAGS(o) = O_FREEVAL + } + + call sfree (sp) + return + } + +err_ + O_TYPE(o) = ERR + call sfree (sp) +end + + +# IE_FCN -- Called by evvexpr to execute an imexpr special function. + +procedure ie_fcn (ie, fcn, args, nargs, o) + +pointer ie #I imexpr descriptor +char fcn[ARB] #I function name +pointer args[ARB] #I input arguments +int nargs #I number of input arguments +pointer o #I output operand to be filled in + +begin + # No functions yet. + O_TYPE(o) = ERR +end + + +# IE_GETEXPRDB -- Read the expression database into a symbol table. The +# input file has the following structure: +# +# <symbol>['(' arg-list ')'][':'|'='] replacement-text +# +# Symbols must be at the beginning of a line. The expression text is +# terminated by a nonempty, noncomment line with no leading whitespace. + +pointer procedure ie_getexprdb (fname) + +char fname[ARB] #I file to be read + +pointer sym, sp, lbuf, st, a_st, ip, symname, tokbuf, text +int tok, fd, line, nargs, op, token, buflen, offset, stpos, n +errchk open, getlline, stopen, stenter, ie_puttok +int open(), getlline(), ctotok(), stpstr() +pointer stopen(), stenter() +define skip_ 91 + +begin + call smark (sp) + call salloc (lbuf, SZ_COMMAND, TY_CHAR) + call salloc (text, SZ_COMMAND, TY_CHAR) + call salloc (tokbuf, SZ_COMMAND, TY_CHAR) + call salloc (symname, SZ_FNAME, TY_CHAR) + + fd = open (fname, READ_ONLY, TEXT_FILE) + st = stopen ("imexpr", DEF_LENINDEX, DEF_LENSTAB, DEF_LENSBUF) + a_st = stopen ("args", DEF_LENINDEX, DEF_LENSTAB, DEF_LENSBUF) + line = 0 + + while (getlline (fd, Memc[lbuf], SZ_COMMAND) != EOF) { + line = line + 1 + + # Replace single quotes by double quotes because things + # should behave like the command line but this routine + # uses ctotok which treats single quotes as character + # constants. + + for (ip=lbuf; Memc[ip]!=EOS; ip=ip+1) { + if (Memc[ip] == '\'') + Memc[ip] = '"' + } + + # Skip comments and blank lines. + ip = lbuf + while (IS_WHITE(Memc[ip])) + ip = ip + 1 + if (Memc[ip] == '\n' || Memc[ip] == '#') + next + + # Get symbol name. + if (ctotok (Memc,ip,Memc[symname],SZ_FNAME) != TOK_IDENTIFIER) { + call eprintf ("exprdb: expected identifier at line %d\n") + call pargi (line) +skip_ while (getlline (fd, Memc[lbuf], SZ_COMMAND) != EOF) { + line = line + 1 + if (Memc[lbuf] == '\n') + break + } + } + + call stmark (a_st, stpos) + + # Check for the optional argument-symbol list. Allow only a + # single space between the symbol name and its argument list, + # otherwise we can't tell the difference between an argument + # list and the parenthesized expression which follows. + + if (Memc[ip] == ' ') + ip = ip + 1 + + if (Memc[ip] == '(') { + ip = ip + 1 + n = 0 + repeat { + tok = ctotok (Memc, ip, Memc[tokbuf], SZ_FNAME) + if (tok == TOK_IDENTIFIER) { + sym = stenter (a_st, Memc[tokbuf], LEN_ARGSYM) + n = n + 1 + ARGNO(sym) = n + } else if (Memc[tokbuf] == ',') { + ; + } else if (Memc[tokbuf] != ')') { + call eprintf ("exprdb: bad arglist at line %d\n") + call pargi (line) + call stfree (a_st, stpos) + goto skip_ + } + } until (Memc[tokbuf] == ')') + } + + # Check for the optional ":" or "=". + while (IS_WHITE(Memc[ip])) + ip = ip + 1 + if (Memc[ip] == ':' || Memc[ip] == '=') + ip = ip + 1 + + # Accumulate the expression text. + buflen = SZ_COMMAND + op = 1 + + repeat { + repeat { + token = ctotok (Memc, ip, Memc[tokbuf+1], SZ_COMMAND) + if (Memc[tokbuf] == '#') + break + else if (token != TOK_EOS && token != TOK_NEWLINE) { + if (token == TOK_STRING) { + Memc[tokbuf] = '"' + call strcat ("""", Memc[tokbuf], SZ_COMMAND) + call ie_puttok (a_st, text, op, buflen, + Memc[tokbuf]) + } else + call ie_puttok (a_st, text, op, buflen, + Memc[tokbuf+1]) + } + } until (token == TOK_EOS) + + if (getlline (fd, Memc[lbuf], SZ_COMMAND) == EOF) + break + else + line = line + 1 + + for (ip=lbuf; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (ip == lbuf) { + call ungetline (fd, Memc[lbuf]) + line = line - 1 + break + } + } + + # Free any argument list symbols. + call stfree (a_st, stpos) + + # Scan the expression text and count the number of $N arguments. + nargs = 0 + for (ip=text; Memc[ip] != EOS; ip=ip+1) + if (Memc[ip] == '$' && IS_DIGIT(Memc[ip+1])) { + nargs = max (nargs, TO_INTEG(Memc[ip+1])) + ip = ip + 1 + } + + # Enter symbol in table. + sym = stenter (st, Memc[symname], LEN_SYM) + offset = stpstr (st, Memc[text], 0) + SYM_TEXT(sym) = offset + SYM_NARGS(sym) = nargs + } + + call stclose (a_st) + call sfree (sp) + + return (st) +end + + +# IE_PUTTOK -- Append a token string to a text buffer. + +procedure ie_puttok (a_st, text, op, buflen, token) + +pointer a_st #I argument-symbol table +pointer text #U text buffer +int op #U output pointer +int buflen #U buffer length, chars +char token[ARB] #I token string + +pointer sym +int ip, ch1, ch2 +pointer stfind() +errchk realloc + +begin + # Replace any symbolic arguments by "$N". + if (a_st != NULL && IS_ALPHA(token[1])) { + sym = stfind (a_st, token) + if (sym != NULL) { + token[1] = '$' + token[2] = TO_DIGIT(ARGNO(sym)) + token[3] = EOS + } + } + + # Append the token string to the text buffer. + for (ip=1; token[ip] != EOS; ip=ip+1) { + if (op + 1 > buflen) { + buflen = buflen + SZ_COMMAND + call realloc (text, buflen, TY_CHAR) + } + + # The following is necessary because ctotok parses tokens such as + # "$N", "==", "!=", etc. as two tokens. We need to rejoin these + # characters to make one token. + + if (op > 1 && token[ip+1] == EOS) { + ch1 = Memc[text+op-3] + ch2 = token[ip] + + if (ch1 == '$' && IS_DIGIT(ch2)) + op = op - 1 + else if (ch1 == '*' && ch2 == '*') + op = op - 1 + else if (ch1 == '/' && ch2 == '/') + op = op - 1 + else if (ch1 == '<' && ch2 == '=') + op = op - 1 + else if (ch1 == '>' && ch2 == '=') + op = op - 1 + else if (ch1 == '=' && ch2 == '=') + op = op - 1 + else if (ch1 == '!' && ch2 == '=') + op = op - 1 + else if (ch1 == '?' && ch2 == '=') + op = op - 1 + else if (ch1 == '&' && ch2 == '&') + op = op - 1 + else if (ch1 == '|' && ch2 == '|') + op = op - 1 + } + + Memc[text+op-1] = token[ip] + op = op + 1 + } + + # Append a space to ensure that tokens are delimited. + Memc[text+op-1] = ' ' + op = op + 1 + + Memc[text+op-1] = EOS +end + + +# IE_EXPANDTEXT -- Scan an expression, performing macro substitution on the +# contents and returning a fully expanded string. + +pointer procedure ie_expandtext (st, expr) + +pointer st #I symbol table (macros) +char expr[ARB] #I input expression + +pointer buf, gt +int buflen, nchars +int locpr(), gt_expand() +pointer gt_opentext() +extern ie_gsym() + +begin + buflen = SZ_COMMAND + call malloc (buf, buflen, TY_CHAR) + + gt = gt_opentext (expr, locpr(ie_gsym), st, 0, GT_NOFILE) + nchars = gt_expand (gt, buf, buflen) + call gt_close (gt) + + return (buf) +end + + +# IE_GETOPS -- Parse the expression and generate a list of input operands. +# The output operand list is returned as a sequence of EOS delimited strings. + +int procedure ie_getops (st, expr, oplist, maxch) + +pointer st #I symbol table +char expr[ARB] #I input expression +char oplist[ARB] #O operand list +int maxch #I max chars out + +int noperands, ch, i +int ops[MAX_OPERANDS] +pointer gt, sp, tokbuf, op + +extern ie_gsym() +pointer gt_opentext() +int locpr(), gt_rawtok(), gt_nexttok() +errchk gt_opentext, gt_rawtok + +begin + call smark (sp) + call salloc (tokbuf, SZ_LINE, TY_CHAR) + + call aclri (ops, MAX_OPERANDS) + gt = gt_opentext (expr, locpr(ie_gsym), st, 0, GT_NOFILE+GT_NOCOMMAND) + + # This assumes that operand names are the letters "a" to "z". + while (gt_rawtok (gt, Memc[tokbuf], SZ_LINE) != EOF) { + ch = Memc[tokbuf] + if (IS_LOWER(ch) && Memc[tokbuf+1] == EOS) + if (gt_nexttok (gt) != '(') + ops[ch-'a'+1] = 1 + } + + call gt_close (gt) + + op = 1 + noperands = 0 + do i = 1, MAX_OPERANDS + if (ops[i] != 0 && op < maxch) { + oplist[op] = 'a' + i - 1 + op = op + 1 + oplist[op] = EOS + op = op + 1 + noperands = noperands + 1 + } + + oplist[op] = EOS + op = op + 1 + + call sfree (sp) + return (noperands) +end diff --git a/pkg/images/imutil/src/imexpr.x b/pkg/images/imutil/src/imexpr.x new file mode 100644 index 00000000..f23c04d6 --- /dev/null +++ b/pkg/images/imutil/src/imexpr.x @@ -0,0 +1,1263 @@ +include <ctotok.h> +include <imhdr.h> +include <ctype.h> +include <mach.h> +include <imset.h> +include <fset.h> +include <lexnum.h> +include <evvexpr.h> +include "gettok.h" + + +# IMEXPR.X -- Image expression evaluator. + +define MAX_OPERANDS 26 +define MAX_ALIASES 10 +define DEF_LENINDEX 97 +define DEF_LENSTAB 1024 +define DEF_LENSBUF 8192 +define DEF_LINELEN 32768 + +# Input image operands. +define LEN_IMOPERAND 18 +define IO_OPNAME Memi[$1] # symbolic operand name +define IO_TYPE Memi[$1+1] # operand type +define IO_IM Memi[$1+2] # image pointer if image +define IO_V Memi[$1+3+($2)-1] # image i/o pointer +define IO_DATA Memi[$1+10] # current image line + # align +define IO_OP ($1+12) # pointer to evvexpr operand + +# Image operand types (IO_TYPE). +define IMAGE 1 # image (vector) operand +define NUMERIC 2 # numeric constant +define PARAMETER 3 # image parameter reference + +# Main imexpr descriptor. +define LEN_IMEXPR (24+LEN_IMOPERAND*MAX_OPERANDS) +define IE_ST Memi[$1] # symbol table +define IE_IM Memi[$1+1] # output image +define IE_NDIM Memi[$1+2] # dimension of output image +define IE_AXLEN Memi[$1+3+($2)-1] # dimensions of output image +define IE_INTYPE Memi[$1+10] # minimum input operand type +define IE_OUTTYPE Memi[$1+11] # datatype of output image +define IE_BWIDTH Memi[$1+12] # npixels boundary extension +define IE_BTYPE Memi[$1+13] # type of boundary extension +define IE_BPIXVAL Memr[P2R($1+14)] # boundary pixel value +define IE_V Memi[$1+15+($2)-1] # position in output image +define IE_NOPERANDS Memi[$1+22] # number of input operands + # align +define IE_IMOP ($1+24+(($2)-1)*LEN_IMOPERAND) # image operand array + +# Expression database symbol. +define LEN_SYM 2 +define SYM_TEXT Memi[$1] +define SYM_NARGS Memi[$1+1] + +# Argument list symbol +define LEN_ARGSYM 1 +define ARGNO Memi[$1] + + +# IMEXPR -- Task procedure for the image expression evaluator. This task +# generates an image by evaluating an arbitrary vector expression, which may +# reference other images as input operands. +# +# The input expression may be any legal EVVEXPR expression. Input operands +# must be specified using the reserved names "a" through "z", hence there are +# a maximum of 26 input operands. An input operand may be an image name or +# image section, an image header parameter, a numeric constant, or the name +# of a builtin keyword. Image header parameters are specified as, e.g., +# "a.naxis1" where the operand "a" must be assigned to an input image. The +# special image name "." refers to the output image generated in the last +# call to imexpr, making it easier to perform a sequence of operations. + +procedure t_imexpr() + +double dval +bool verbose, rangecheck +pointer out, st, sp, ie, dims, intype, outtype, ref_im +pointer outim, fname, expr, xexpr, output, section, data, imname +pointer oplist, opnam, opval, param, io, ip, op, o, im, ia, emsg +int len_exprbuf, fd, nchars, noperands, dtype, status, i, j +int ndim, npix, ch, percent, nlines, totlines, flags, mapflag + +real clgetr() +double imgetd() +int imgftype(), clgwrd(), ctod() +bool clgetb(), imgetb(), streq(), strne() +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld() +int impnls(), impnli(), impnll(), impnlr(), impnld() +int open(), getci(), ie_getops(), lexnum(), stridxs() +int imgeti(), ctoi(), btoi(), locpr(), clgeti(), strncmp() +pointer ie_getexprdb(), ie_expandtext(), immap() +extern ie_getop(), ie_fcn() +pointer evvexpr() +long fstatl() + +string s_nodata "bad image: no data" +string s_badtype "unknown image type" +define numeric_ 91 +define image_ 92 + +begin + # call memlog ("--------- START IMEXPR -----------") + + call smark (sp) + call salloc (ie, LEN_IMEXPR, TY_STRUCT) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (output, SZ_PATHNAME, TY_CHAR) + call salloc (imname, SZ_PATHNAME, TY_CHAR) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (intype, SZ_FNAME, TY_CHAR) + call salloc (outtype, SZ_FNAME, TY_CHAR) + call salloc (oplist, SZ_LINE, TY_CHAR) + call salloc (opval, SZ_LINE, TY_CHAR) + call salloc (dims, SZ_LINE, TY_CHAR) + call salloc (emsg, SZ_LINE, TY_CHAR) + + # Initialize the main imexpr descriptor. + call aclri (Memi[ie], LEN_IMEXPR) + + verbose = clgetb ("verbose") + rangecheck = clgetb ("rangecheck") + + # Load the expression database, if any. + st = NULL + call clgstr ("exprdb", Memc[fname], SZ_PATHNAME) + if (strne (Memc[fname], "none")) + st = ie_getexprdb (Memc[fname]) + IE_ST(ie) = st + + # Get the expression to be evaluated and expand any file inclusions + # or macro references. + + len_exprbuf = SZ_COMMAND + call malloc (expr, len_exprbuf, TY_CHAR) + call clgstr ("expr", Memc[expr], len_exprbuf) + + if (Memc[expr] == '@') { + fd = open (Memc[expr+1], READ_ONLY, TEXT_FILE) + nchars = fstatl (fd, F_FILESIZE) + if (nchars > len_exprbuf) { + len_exprbuf = nchars + call realloc (expr, len_exprbuf, TY_CHAR) + } + for (op=expr; getci(fd,ch) != EOF; op = op + 1) { + if (ch == '\n') + Memc[op] = ' ' + else + Memc[op] = ch + } + Memc[op] = EOS + call close (fd) + } + + if (st != NULL) { + xexpr = ie_expandtext (st, Memc[expr]) + call mfree (expr, TY_CHAR) + expr = xexpr + if (verbose) { + call printf ("%s\n") + call pargstr (Memc[expr]) + call flush (STDOUT) + } + } + + # Get output image name. + call clgstr ("output", Memc[output], SZ_PATHNAME) + call imgimage (Memc[output], Memc[imname], SZ_PATHNAME) + + IE_BWIDTH(ie) = clgeti ("bwidth") + IE_BTYPE(ie) = clgwrd ("btype", Memc[oplist], SZ_LINE, + "|constant|nearest|reflect|wrap|project|") + IE_BPIXVAL(ie) = clgetr ("bpixval") + + # Determine the minimum input operand type. + call clgstr ("intype", Memc[intype], SZ_FNAME) + + if (strncmp (Memc[intype], "auto", 4) == 0) + IE_INTYPE(ie) = 0 + else { + switch (Memc[intype]) { + case 'i', 'l': + IE_INTYPE(ie) = TY_INT + case 'r': + IE_INTYPE(ie) = TY_REAL + case 'd': + IE_INTYPE(ie) = TY_DOUBLE + default: + IE_INTYPE(ie) = 0 + } + } + + # Parse the expression and generate a list of input operands. + noperands = ie_getops (st, Memc[expr], Memc[oplist], SZ_LINE) + IE_NOPERANDS(ie) = noperands + + # Process the list of input operands and initialize each operand. + # This means fetch the value of the operand from the CL, determine + # the operand type, and initialize the image operand descriptor. + # The operand list is returned as a sequence of EOS delimited strings. + + opnam = oplist + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (Memc[opnam] == EOS) + call error (1, "malformed operand list") + + call clgstr (Memc[opnam], Memc[opval], SZ_LINE) + IO_OPNAME(io) = Memc[opnam] + ip = opval + + # Initialize the input operand; these values are overwritten below. + o = IO_OP(io) + call aclri (Memi[o], LEN_OPERAND) + + if (Memc[ip] == '.' && (Memc[ip+1] == EOS || Memc[ip+1] == '[')) { + # A "." is shorthand for the last output image. + call strcpy (Memc[ip+1], Memc[section], SZ_FNAME) + call clgstr ("lastout", Memc[opval], SZ_LINE) + call strcat (Memc[section], Memc[opval], SZ_LINE) + goto image_ + + } else if (IS_LOWER(Memc[ip]) && Memc[ip+1] == '.') { + # "a.foo" refers to parameter foo of image A. Mark this as + # a parameter operand for now, and patch it up later. + + IO_TYPE(io) = PARAMETER + IO_DATA(io) = ip + call salloc (IO_DATA(io), SZ_LINE, TY_CHAR) + call strcpy (Memc[ip], Memc[IO_DATA(io)], SZ_LINE) + + } else if (ctod (Memc, ip, dval) > 0) { + if (Memc[ip] != EOS) + goto image_ + + # A numeric constant. +numeric_ IO_TYPE(io) = NUMERIC + + ip = opval + switch (lexnum (Memc, ip, nchars)) { + case LEX_REAL: + dtype = TY_REAL + if (stridxs("dD",Memc[opval]) > 0 || nchars > NDIGITS_RP+3) + dtype = TY_DOUBLE + O_TYPE(o) = dtype + if (dtype == TY_REAL) + O_VALR(o) = dval + else + O_VALD(o) = dval + default: + O_TYPE(o) = TY_INT + O_LEN(o) = 0 + O_VALI(o) = int(dval) + } + + } else { + # Anything else is assumed to be an image name. +image_ + ip = opval + call imgimage (Memc[ip], Memc[fname], SZ_PATHNAME) + if (streq (Memc[fname], Memc[imname])) + call error (2, "input and output images cannot be the same") + + im = immap (Memc[ip], READ_ONLY, 0) + + # Set any image options. + if (IE_BWIDTH(ie) > 0) { + call imseti (im, IM_NBNDRYPIX, IE_BWIDTH(ie)) + call imseti (im, IM_TYBNDRY, IE_BTYPE(ie)) + call imsetr (im, IM_BNDRYPIXVAL, IE_BPIXVAL(ie)) + } + + IO_TYPE(io) = IMAGE + call amovkl (1, IO_V(io,1), IM_MAXDIM) + IO_IM(io) = im + + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE: + O_TYPE(o) = IM_PIXTYPE(im) + case TY_COMPLEX: + O_TYPE(o) = TY_REAL + default: # TY_USHORT + O_TYPE(o) = TY_INT + } + + O_TYPE(o) = max (IE_INTYPE(ie), O_TYPE(o)) + O_LEN(o) = IM_LEN(im,1) + O_FLAGS(o) = 0 + + # If one dimensional image read in data and be done with it. + if (IM_NDIM(im) == 1) { + switch (O_TYPE(o)) { + + case TY_SHORT: + if (imgnls (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (3, s_nodata) + + case TY_INT: + if (imgnli (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (3, s_nodata) + + case TY_LONG: + if (imgnll (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (3, s_nodata) + + case TY_REAL: + if (imgnlr (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (3, s_nodata) + + case TY_DOUBLE: + if (imgnld (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (3, s_nodata) + + default: + call error (4, s_badtype) + } + } + } + + + # Get next operand name. + while (Memc[opnam] != EOS) + opnam = opnam + 1 + opnam = opnam + 1 + } + + # Go back and patch up any "a.foo" type parameter references. The + # reference input operand (e.g. "a") must be of type IMAGE and must + # point to a valid open image. + + do i = 1, noperands { + mapflag = NO + io = IE_IMOP(ie,i) + ip = IO_DATA(io) + if (IO_TYPE(io) != PARAMETER) + next + + # Locate referenced symbolic image operand (e.g. "a"). + ia = NULL + do j = 1, noperands { + ia = IE_IMOP(ie,j) + if (IO_OPNAME(ia) == Memc[ip] && IO_TYPE(ia) == IMAGE) + break + ia = NULL + } + if (ia == NULL && (IS_LOWER(Memc[ip]) && Memc[ip+1] == '.')) { + # The parameter operand is something like 'a.foo' however + # the image operand 'a' is not in the list derived from the + # expression, perhaps because we just want to use a parameter + # from a reference image and not the image itself. In this + # case map the image so we can get the parameter. + + call strcpy (Memc[ip], Memc[opval], 1) + call clgstr (Memc[opval], Memc[opnam], SZ_LINE) + call imgimage (Memc[opnam], Memc[fname], SZ_PATHNAME) + + iferr (im = immap (Memc[fname], READ_ONLY, 0)) { + call sprintf (Memc[emsg], SZ_LINE, + "bad image parameter reference %s") + call pargstr (Memc[ip]) + call error (5, Memc[emsg]) + } else + mapflag = YES + + } else if (ia == NULL) { + call sprintf (Memc[emsg], SZ_LINE, + "bad image parameter reference %s") + call pargstr (Memc[ip]) + call error (5, Memc[emsg]) + + } else + im = IO_IM(ia) + + # Get the parameter value and set up operand struct. + param = ip + 2 + IO_TYPE(io) = NUMERIC + o = IO_OP(io) + O_LEN(o) = 0 + + switch (imgftype (im, Memc[param])) { + case TY_BOOL: + O_TYPE(o) = TY_BOOL + O_VALI(o) = btoi (imgetb (im, Memc[param])) + + case TY_CHAR: + O_TYPE(o) = TY_CHAR + O_LEN(o) = SZ_LINE + call malloc (O_VALP(o), SZ_LINE, TY_CHAR) + call imgstr (im, Memc[param], O_VALC(o), SZ_LINE) + + case TY_INT: + O_TYPE(o) = TY_INT + O_VALI(o) = imgeti (im, Memc[param]) + + case TY_REAL: + O_TYPE(o) = TY_DOUBLE + O_VALD(o) = imgetd (im, Memc[param]) + + default: + call sprintf (Memc[emsg], SZ_LINE, "param %s not found\n") + call pargstr (Memc[ip]) + call error (6, Memc[emsg]) + } + + if (mapflag == YES) + call imunmap (im) + } + + # Determine the reference image from which we will inherit image + # attributes such as the WCS. If the user specifies this we use + # the indicated image, otherwise we use the input image operand with + # the highest dimension. + + call clgstr ("refim", Memc[fname], SZ_PATHNAME) + if (streq (Memc[fname], "auto")) { + # Locate best reference image (highest dimension). + ndim = 0 + ref_im = NULL + + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (IO_TYPE(io) != IMAGE || IO_IM(io) == NULL) + next + + im = IO_IM(io) + if (IM_NDIM(im) > ndim) { + ref_im = im + ndim = IM_NDIM(im) + } + } + } else { + # Locate referenced symbolic image operand (e.g. "a"). + io = NULL + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (IO_OPNAME(io) == Memc[fname] && IO_TYPE(io) == IMAGE) + break + io = NULL + } + if (io == NULL) { + call sprintf (Memc[emsg], SZ_LINE, + "bad wcsimage reference image %s") + call pargstr (Memc[fname]) + call error (7, Memc[emsg]) + } + ref_im = IO_IM(io) + } + + # Determine the dimension and size of the output image. If the "dims" + # parameter is set this determines the image dimension, otherwise we + # determine the best output image dimension and size from the input + # images. The exception is the line length, which is determined by + # the image line operand returned when the first line of the image + # is evaluated. + + call clgstr ("dims", Memc[dims], SZ_LINE) + if (streq (Memc[dims], "auto")) { + # Determine the output image dimensions from the input images. + call amovki (1, IE_AXLEN(ie,2), IM_MAXDIM-1) + IE_AXLEN(ie,1) = 0 + ndim = 1 + + do i = 1, noperands { + io = IE_IMOP(ie,i) + im = IO_IM(io) + if (IO_TYPE(io) != IMAGE || im == NULL) + next + + ndim = max (ndim, IM_NDIM(im)) + do j = 2, IM_NDIM(im) { + npix = IM_LEN(im,j) + if (npix > 1) { + if (IE_AXLEN(ie,j) <= 1) + IE_AXLEN(ie,j) = npix + else + IE_AXLEN(ie,j) = min (IE_AXLEN(ie,j), npix) + } + } + } + IE_NDIM(ie) = ndim + + } else { + # Use user specified output image dimensions. + ndim = 0 + for (ip=dims; ctoi(Memc,ip,npix) > 0; ) { + ndim = ndim + 1 + IE_AXLEN(ie,ndim) = npix + for (ch=Memc[ip]; IS_WHITE(ch) || ch == ','; ch=Memc[ip]) + ip = ip + 1 + } + IE_NDIM(ie) = ndim + } + + # Determine the pixel type of the output image. + call clgstr ("outtype", Memc[outtype], SZ_FNAME) + + if (strncmp (Memc[outtype], "auto", 4) == 0) { + IE_OUTTYPE(ie) = 0 + } else if (strncmp (Memc[outtype], "ref", 3) == 0) { + if (ref_im != NULL) + IE_OUTTYPE(ie) = IM_PIXTYPE(ref_im) + else + IE_OUTTYPE(ie) = 0 + } else { + switch (Memc[outtype]) { + case 'u': + IE_OUTTYPE(ie) = TY_USHORT + case 's': + IE_OUTTYPE(ie) = TY_SHORT + case 'i': + IE_OUTTYPE(ie) = TY_INT + case 'l': + IE_OUTTYPE(ie) = TY_LONG + case 'r': + IE_OUTTYPE(ie) = TY_REAL + case 'd': + IE_OUTTYPE(ie) = TY_DOUBLE + default: + call error (8, "bad outtype") + } + } + + # Open the output image. If the output image name has a section we + # are writing to a section of an existing image. + + call imgsection (Memc[output], Memc[section], SZ_FNAME) + if (Memc[section] != EOS && Memc[section] != NULL) { + outim = immap (Memc[output], READ_WRITE, 0) + IE_AXLEN(ie,1) = IM_LEN(outim,1) + } else { + if (ref_im != NULL) + outim = immap (Memc[output], NEW_COPY, ref_im) + else + outim = immap (Memc[output], NEW_IMAGE, 0) + IM_LEN(outim,1) = 0 + call amovl (IE_AXLEN(ie,2), IM_LEN(outim,2), IM_MAXDIM-1) + IM_NDIM(outim) = IE_NDIM(ie) + IM_PIXTYPE(outim) = 0 + } + + # Initialize output image line pointer. + call amovkl (1, IE_V(ie,1), IM_MAXDIM) + + percent = 0 + nlines = 0 + totlines = 1 + do i = 2, IM_NDIM(outim) + totlines = totlines * IM_LEN(outim,i) + + # Generate the pixel data for the output image line by line, + # evaluating the user supplied expression to produce each image + # line. Images may be any dimension, datatype, or size. + + # call memlog ("--------- PROCESS IMAGE -----------") + + out = NULL + repeat { + # call memlog1 ("--------- line %d ----------", nlines + 1) + + # Output image line generated by last iteration. + if (out != NULL) { + op = data + if (O_LEN(out) == 0) { + # Output image line is a scalar. + + switch (O_TYPE(out)) { + case TY_BOOL: + Memi[op] = O_VALI(out) + call amovki (O_VALI(out), Memi[op], IM_LEN(outim,1)) + + case TY_SHORT: + call amovks (O_VALS(out), Mems[op], IM_LEN(outim,1)) + + case TY_INT: + call amovki (O_VALI(out), Memi[op], IM_LEN(outim,1)) + + case TY_LONG: + call amovkl (O_VALL(out), Meml[op], IM_LEN(outim,1)) + + case TY_REAL: + call amovkr (O_VALR(out), Memr[op], IM_LEN(outim,1)) + + case TY_DOUBLE: + call amovkd (O_VALD(out), Memd[op], IM_LEN(outim,1)) + + } + + } else { + # Output image line is a vector. + + npix = min (O_LEN(out), IM_LEN(outim,1)) + ip = O_VALP(out) + switch (O_TYPE(out)) { + case TY_BOOL: + call amovi (Memi[ip], Memi[op], npix) + + case TY_SHORT: + call amovs (Mems[ip], Mems[op], npix) + + case TY_INT: + call amovi (Memi[ip], Memi[op], npix) + + case TY_LONG: + call amovl (Meml[ip], Meml[op], npix) + + case TY_REAL: + call amovr (Memr[ip], Memr[op], npix) + + case TY_DOUBLE: + call amovd (Memd[ip], Memd[op], npix) + + } + } + + call evvfree (out) + out = NULL + } + + # Get the next line in all input images. If EOF is seen on the + # image we merely rewind and keep going. This allows a vector, + # plane, etc. to be applied to each line, band, etc. of a higher + # dimensioned image. + + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (IO_TYPE(io) != IMAGE || IO_IM(io) == NULL) + next + + im = IO_IM(io) + o = IO_OP(io) + + # Data for a 1D image was read in above. + if (IM_NDIM(im) == 1) + next + + switch (O_TYPE(o)) { + + case TY_SHORT: + if (imgnls (im, IO_DATA(io), IO_V(io,1)) == EOF) { + call amovkl (1, IO_V(io,1), IM_MAXDIM) + if (imgnls (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (9, s_nodata) + } + + case TY_INT: + if (imgnli (im, IO_DATA(io), IO_V(io,1)) == EOF) { + call amovkl (1, IO_V(io,1), IM_MAXDIM) + if (imgnli (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (9, s_nodata) + } + + case TY_LONG: + if (imgnll (im, IO_DATA(io), IO_V(io,1)) == EOF) { + call amovkl (1, IO_V(io,1), IM_MAXDIM) + if (imgnll (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (9, s_nodata) + } + + case TY_REAL: + if (imgnlr (im, IO_DATA(io), IO_V(io,1)) == EOF) { + call amovkl (1, IO_V(io,1), IM_MAXDIM) + if (imgnlr (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (9, s_nodata) + } + + case TY_DOUBLE: + if (imgnld (im, IO_DATA(io), IO_V(io,1)) == EOF) { + call amovkl (1, IO_V(io,1), IM_MAXDIM) + if (imgnld (im, IO_DATA(io), IO_V(io,1)) == EOF) + call error (9, s_nodata) + } + + default: + call error (10, s_badtype) + } + } + + # call memlog (".......... enter evvexpr ..........") + + # This is it! Evaluate the vector expression. + flags = 0 + if (rangecheck) + flags = or (flags, EV_RNGCHK) + + out = evvexpr (Memc[expr], + locpr(ie_getop), ie, locpr(ie_fcn), ie, flags) + + # call memlog (".......... exit evvexpr ..........") + + # If the pixel type and line length of the output image are + # still undetermined set them to match the output operand. + + if (IM_PIXTYPE(outim) == 0) { + if (IE_OUTTYPE(ie) == 0) { + if (O_TYPE(out) == TY_BOOL) + IE_OUTTYPE(ie) = TY_INT + else + IE_OUTTYPE(ie) = O_TYPE(out) + IM_PIXTYPE(outim) = IE_OUTTYPE(ie) + } else + IM_PIXTYPE(outim) = IE_OUTTYPE(ie) + } + if (IM_LEN(outim,1) == 0) { + if (IE_AXLEN(ie,1) == 0) { + if (O_LEN(out) == 0) { + IE_AXLEN(ie,1) = 1 + IM_LEN(outim,1) = 1 + } else { + IE_AXLEN(ie,1) = O_LEN(out) + IM_LEN(outim,1) = O_LEN(out) + } + } else + IM_LEN(outim,1) = IE_AXLEN(ie,1) + } + + # Print percent done. + if (verbose) { + nlines = nlines + 1 + if (nlines * 100 / totlines >= percent + 10) { + percent = percent + 10 + call printf ("%2d%% ") + call pargi (percent) + call flush (STDOUT) + } + } + + switch (O_TYPE(out)) { + case TY_BOOL: + status = impnli (outim, data, IE_V(ie,1)) + + case TY_SHORT: + status = impnls (outim, data, IE_V(ie,1)) + + case TY_INT: + status = impnli (outim, data, IE_V(ie,1)) + + case TY_LONG: + status = impnll (outim, data, IE_V(ie,1)) + + case TY_REAL: + status = impnlr (outim, data, IE_V(ie,1)) + + case TY_DOUBLE: + status = impnld (outim, data, IE_V(ie,1)) + + default: + call error (11, "expression type incompatible with image") + } + } until (status == EOF) + + # call memlog ("--------- DONE PROCESSING IMAGE -----------") + + if (verbose) { + call printf ("- done\n") + call flush (STDOUT) + } + + # All done. Unmap images. + call imunmap (outim) + do i = 1, noperands { + io = IE_IMOP(ie,i) + if (IO_TYPE(io) == IMAGE && IO_IM(io) != NULL) + call imunmap (IO_IM(io)) + } + + # Clean up. + do i = 1, noperands { + io = IE_IMOP(ie,i) + o = IO_OP(io) + if (O_TYPE(o) == TY_CHAR) + call mfree (O_VALP(o), TY_CHAR) + } + + call evvfree (out) + call mfree (expr, TY_CHAR) + if (st != NULL) + call stclose (st) + + call clpstr ("lastout", Memc[output]) + call sfree (sp) +end + + +# IE_GETOP -- Called by evvexpr to fetch an input image operand. + +procedure ie_getop (ie, opname, o) + +pointer ie #I imexpr descriptor +char opname[ARB] #I operand name +pointer o #I output operand to be filled in + +int axis, i +pointer param, data +pointer sp, im, io, v + +bool imgetb() +int imgeti() +double imgetd() +int imgftype(), btoi() +errchk malloc +define err_ 91 + +begin + call smark (sp) + + if (IS_LOWER(opname[1]) && opname[2] == EOS) { + # Image operand. + + io = NULL + do i = 1, IE_NOPERANDS(ie) { + io = IE_IMOP(ie,i) + if (IO_OPNAME(io) == opname[1]) + break + io = NULL + } + + if (io == NULL) + goto err_ + else + v = IO_OP(io) + + call amovi (Memi[v], Memi[o], LEN_OPERAND) + if (IO_TYPE(io) == IMAGE) { + O_VALP(o) = IO_DATA(io) + O_FLAGS(o) = 0 + } + + call sfree (sp) + return + + } else if (IS_LOWER(opname[1]) && opname[2] == '.') { + # Image parameter reference, e.g., "a.foo". + call salloc (param, SZ_FNAME, TY_CHAR) + + # Locate referenced symbolic image operand (e.g. "a"). + io = NULL + do i = 1, IE_NOPERANDS(ie) { + io = IE_IMOP(ie,i) + if (IO_OPNAME(io) == opname[1] && IO_TYPE(io) == IMAGE) + break + io = NULL + } + if (io == NULL) + goto err_ + + # Get the parameter value and set up operand struct. + call strcpy (opname[3], Memc[param], SZ_FNAME) + im = IO_IM(io) + + iferr (O_TYPE(o) = imgftype (im, Memc[param])) + goto err_ + + switch (O_TYPE(o)) { + case TY_BOOL: + iferr (O_VALI(o) = btoi (imgetb (im, Memc[param]))) + goto err_ + + case TY_CHAR: + O_LEN(o) = SZ_LINE + O_FLAGS(o) = O_FREEVAL + iferr { + call malloc (O_VALP(o), SZ_LINE, TY_CHAR) + call imgstr (im, Memc[param], O_VALC(o), SZ_LINE) + } then + goto err_ + + case TY_INT: + iferr (O_VALI(o) = imgeti (im, Memc[param])) + goto err_ + + case TY_REAL: + O_TYPE(o) = TY_DOUBLE + iferr (O_VALD(o) = imgetd (im, Memc[param])) + goto err_ + + default: + goto err_ + } + + call sfree (sp) + return + + } else if (IS_UPPER(opname[1]) && opname[2] == EOS) { + # The current pixel coordinate [I,J,K,...]. The line coordinate + # is a special case since the image is computed a line at a time. + # If "I" is requested return a vector where v[i] = i. For J, K, + # etc. just return the scalar index value. + + axis = opname[1] - 'I' + 1 + if (axis == 1) { + O_TYPE(o) = TY_INT + if (IE_AXLEN(ie,1) > 0) + O_LEN(o) = IE_AXLEN(ie,1) + else { + # Line length not known yet. + O_LEN(o) = DEF_LINELEN + } + call malloc (data, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[data+i-1] = i + O_VALP(o) = data + O_FLAGS(o) = O_FREEVAL + } else { + O_TYPE(o) = TY_INT + #O_LEN(o) = 0 + #if (axis < 1 || axis > IM_MAXDIM) + #O_VALI(o) = 1 + #else + #O_VALI(o) = IE_V(ie,axis) + #O_FLAGS(o) = 0 + if (IE_AXLEN(ie,1) > 0) + O_LEN(o) = IE_AXLEN(ie,1) + else + # Line length not known yet. + O_LEN(o) = DEF_LINELEN + call malloc (data, O_LEN(o), TY_INT) + if (axis < 1 || axis > IM_MAXDIM) + call amovki (1, Memi[data], O_LEN(o)) + else + call amovki (IE_V(ie,axis), Memi[data], O_LEN(o)) + O_VALP(o) = data + O_FLAGS(o) = O_FREEVAL + } + + call sfree (sp) + return + } + +err_ + O_TYPE(o) = ERR + call sfree (sp) +end + + +# IE_FCN -- Called by evvexpr to execute an imexpr special function. + +procedure ie_fcn (ie, fcn, args, nargs, o) + +pointer ie #I imexpr descriptor +char fcn[ARB] #I function name +pointer args[ARB] #I input arguments +int nargs #I number of input arguments +pointer o #I output operand to be filled in + +begin + # No functions yet. + O_TYPE(o) = ERR +end + + +# IE_GETEXPRDB -- Read the expression database into a symbol table. The +# input file has the following structure: +# +# <symbol>['(' arg-list ')'][':'|'='] replacement-text +# +# Symbols must be at the beginning of a line. The expression text is +# terminated by a nonempty, noncomment line with no leading whitespace. + +pointer procedure ie_getexprdb (fname) + +char fname[ARB] #I file to be read + +pointer sym, sp, lbuf, st, a_st, ip, symname, tokbuf, text +int tok, fd, line, nargs, op, token, buflen, offset, stpos, n +errchk open, getlline, stopen, stenter, ie_puttok +int open(), getlline(), ctotok(), stpstr() +pointer stopen(), stenter() +define skip_ 91 + +begin + call smark (sp) + call salloc (lbuf, SZ_COMMAND, TY_CHAR) + call salloc (text, SZ_COMMAND, TY_CHAR) + call salloc (tokbuf, SZ_COMMAND, TY_CHAR) + call salloc (symname, SZ_FNAME, TY_CHAR) + + fd = open (fname, READ_ONLY, TEXT_FILE) + st = stopen ("imexpr", DEF_LENINDEX, DEF_LENSTAB, DEF_LENSBUF) + a_st = stopen ("args", DEF_LENINDEX, DEF_LENSTAB, DEF_LENSBUF) + line = 0 + + while (getlline (fd, Memc[lbuf], SZ_COMMAND) != EOF) { + line = line + 1 + + # Replace single quotes by double quotes because things + # should behave like the command line but this routine + # uses ctotok which treats single quotes as character + # constants. + + for (ip=lbuf; Memc[ip]!=EOS; ip=ip+1) { + if (Memc[ip] == '\'') + Memc[ip] = '"' + } + + # Skip comments and blank lines. + ip = lbuf + while (IS_WHITE(Memc[ip])) + ip = ip + 1 + if (Memc[ip] == '\n' || Memc[ip] == '#') + next + + # Get symbol name. + if (ctotok (Memc,ip,Memc[symname],SZ_FNAME) != TOK_IDENTIFIER) { + call eprintf ("exprdb: expected identifier at line %d\n") + call pargi (line) +skip_ while (getlline (fd, Memc[lbuf], SZ_COMMAND) != EOF) { + line = line + 1 + if (Memc[lbuf] == '\n') + break + } + } + + call stmark (a_st, stpos) + + # Check for the optional argument-symbol list. Allow only a + # single space between the symbol name and its argument list, + # otherwise we can't tell the difference between an argument + # list and the parenthesized expression which follows. + + if (Memc[ip] == ' ') + ip = ip + 1 + + if (Memc[ip] == '(') { + ip = ip + 1 + n = 0 + repeat { + tok = ctotok (Memc, ip, Memc[tokbuf], SZ_FNAME) + if (tok == TOK_IDENTIFIER) { + sym = stenter (a_st, Memc[tokbuf], LEN_ARGSYM) + n = n + 1 + ARGNO(sym) = n + } else if (Memc[tokbuf] == ',') { + ; + } else if (Memc[tokbuf] != ')') { + call eprintf ("exprdb: bad arglist at line %d\n") + call pargi (line) + call stfree (a_st, stpos) + goto skip_ + } + } until (Memc[tokbuf] == ')') + } + + # Check for the optional ":" or "=". + while (IS_WHITE(Memc[ip])) + ip = ip + 1 + if (Memc[ip] == ':' || Memc[ip] == '=') + ip = ip + 1 + + # Accumulate the expression text. + buflen = SZ_COMMAND + op = 1 + + repeat { + repeat { + token = ctotok (Memc, ip, Memc[tokbuf+1], SZ_COMMAND) + if (Memc[tokbuf] == '#') + break + else if (token != TOK_EOS && token != TOK_NEWLINE) { + if (token == TOK_STRING) { + Memc[tokbuf] = '"' + call strcat ("""", Memc[tokbuf], SZ_COMMAND) + call ie_puttok (a_st, text, op, buflen, + Memc[tokbuf]) + } else + call ie_puttok (a_st, text, op, buflen, + Memc[tokbuf+1]) + } + } until (token == TOK_EOS) + + if (getlline (fd, Memc[lbuf], SZ_COMMAND) == EOF) + break + else + line = line + 1 + + for (ip=lbuf; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (ip == lbuf) { + call ungetline (fd, Memc[lbuf]) + line = line - 1 + break + } + } + + # Free any argument list symbols. + call stfree (a_st, stpos) + + # Scan the expression text and count the number of $N arguments. + nargs = 0 + for (ip=text; Memc[ip] != EOS; ip=ip+1) + if (Memc[ip] == '$' && IS_DIGIT(Memc[ip+1])) { + nargs = max (nargs, TO_INTEG(Memc[ip+1])) + ip = ip + 1 + } + + # Enter symbol in table. + sym = stenter (st, Memc[symname], LEN_SYM) + offset = stpstr (st, Memc[text], 0) + SYM_TEXT(sym) = offset + SYM_NARGS(sym) = nargs + } + + call stclose (a_st) + call sfree (sp) + + return (st) +end + + +# IE_PUTTOK -- Append a token string to a text buffer. + +procedure ie_puttok (a_st, text, op, buflen, token) + +pointer a_st #I argument-symbol table +pointer text #U text buffer +int op #U output pointer +int buflen #U buffer length, chars +char token[ARB] #I token string + +pointer sym +int ip, ch1, ch2 +pointer stfind() +errchk realloc + +begin + # Replace any symbolic arguments by "$N". + if (a_st != NULL && IS_ALPHA(token[1])) { + sym = stfind (a_st, token) + if (sym != NULL) { + token[1] = '$' + token[2] = TO_DIGIT(ARGNO(sym)) + token[3] = EOS + } + } + + # Append the token string to the text buffer. + for (ip=1; token[ip] != EOS; ip=ip+1) { + if (op + 1 > buflen) { + buflen = buflen + SZ_COMMAND + call realloc (text, buflen, TY_CHAR) + } + + # The following is necessary because ctotok parses tokens such as + # "$N", "==", "!=", etc. as two tokens. We need to rejoin these + # characters to make one token. + + if (op > 1 && token[ip+1] == EOS) { + ch1 = Memc[text+op-3] + ch2 = token[ip] + + if (ch1 == '$' && IS_DIGIT(ch2)) + op = op - 1 + else if (ch1 == '*' && ch2 == '*') + op = op - 1 + else if (ch1 == '/' && ch2 == '/') + op = op - 1 + else if (ch1 == '<' && ch2 == '=') + op = op - 1 + else if (ch1 == '>' && ch2 == '=') + op = op - 1 + else if (ch1 == '=' && ch2 == '=') + op = op - 1 + else if (ch1 == '!' && ch2 == '=') + op = op - 1 + else if (ch1 == '?' && ch2 == '=') + op = op - 1 + else if (ch1 == '&' && ch2 == '&') + op = op - 1 + else if (ch1 == '|' && ch2 == '|') + op = op - 1 + } + + Memc[text+op-1] = token[ip] + op = op + 1 + } + + # Append a space to ensure that tokens are delimited. + Memc[text+op-1] = ' ' + op = op + 1 + + Memc[text+op-1] = EOS +end + + +# IE_EXPANDTEXT -- Scan an expression, performing macro substitution on the +# contents and returning a fully expanded string. + +pointer procedure ie_expandtext (st, expr) + +pointer st #I symbol table (macros) +char expr[ARB] #I input expression + +pointer buf, gt +int buflen, nchars +int locpr(), gt_expand() +pointer gt_opentext() +extern ie_gsym() + +begin + buflen = SZ_COMMAND + call malloc (buf, buflen, TY_CHAR) + + gt = gt_opentext (expr, locpr(ie_gsym), st, 0, GT_NOFILE) + nchars = gt_expand (gt, buf, buflen) + call gt_close (gt) + + return (buf) +end + + +# IE_GETOPS -- Parse the expression and generate a list of input operands. +# The output operand list is returned as a sequence of EOS delimited strings. + +int procedure ie_getops (st, expr, oplist, maxch) + +pointer st #I symbol table +char expr[ARB] #I input expression +char oplist[ARB] #O operand list +int maxch #I max chars out + +int noperands, ch, i +int ops[MAX_OPERANDS] +pointer gt, sp, tokbuf, op + +extern ie_gsym() +pointer gt_opentext() +int locpr(), gt_rawtok(), gt_nexttok() +errchk gt_opentext, gt_rawtok + +begin + call smark (sp) + call salloc (tokbuf, SZ_LINE, TY_CHAR) + + call aclri (ops, MAX_OPERANDS) + gt = gt_opentext (expr, locpr(ie_gsym), st, 0, GT_NOFILE+GT_NOCOMMAND) + + # This assumes that operand names are the letters "a" to "z". + while (gt_rawtok (gt, Memc[tokbuf], SZ_LINE) != EOF) { + ch = Memc[tokbuf] + if (IS_LOWER(ch) && Memc[tokbuf+1] == EOS) + if (gt_nexttok (gt) != '(') + ops[ch-'a'+1] = 1 + } + + call gt_close (gt) + + op = 1 + noperands = 0 + do i = 1, MAX_OPERANDS + if (ops[i] != 0 && op < maxch) { + oplist[op] = 'a' + i - 1 + op = op + 1 + oplist[op] = EOS + op = op + 1 + noperands = noperands + 1 + } + + oplist[op] = EOS + op = op + 1 + + call sfree (sp) + return (noperands) +end diff --git a/pkg/images/imutil/src/imfuncs.gx b/pkg/images/imutil/src/imfuncs.gx new file mode 100644 index 00000000..b63bea59 --- /dev/null +++ b/pkg/images/imutil/src/imfuncs.gx @@ -0,0 +1,786 @@ +include <imhdr.h> +include <mach.h> +include <math.h> + +$for (rd) + +# IF_LOG10 -- Compute the base 10 logarithm of image1 and write the results to +# image2. + +procedure if_log10$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +PIXEL if_elog$t() +extern if_elog$t() +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call alog$t (Mem$t[buf1], Mem$t[buf2], npix, if_elog$t) +end + + +# IF_ELOG -- The error function for log10. Note that MAX_EXPONENT is +# currently an integer so it is converted to the appropriate data type +# before being returned. + +PIXEL procedure if_elog$t (x) + +PIXEL x # the input pixel value + +begin + return (PIXEL(-MAX_EXPONENT)) +end + + +# IF_ALOG10 -- Take the power of 10 of image1 and write the results to image2. + +procedure if_alog10$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_va10$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VA10 -- Take the antilog (base 10) of a vector. + +procedure if_va10$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of points + +int i +PIXEL maxexp, maxval + +begin + maxexp = MAX_EXPONENT + maxval = MAX_REAL + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= (-maxexp)) + b[i] = 0$f + else + b[i] = 10$f ** a[i] + } +end + + +# IF_LN -- Take the natural log of the pixels in image1 and write the results +# to image2. + +procedure if_ln$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 + +PIXEL if_eln$t() +extern if_eln$t() +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call alln$t (Mem$t[buf1], Mem$t[buf2], npix, if_eln$t) +end + + +# IF_ELN -- The error function for the natural logarithm. + +PIXEL procedure if_eln$t (x) + +PIXEL x # input value + +begin + return (PIXEL (LN_10) * PIXEL(-MAX_EXPONENT)) +end + + +# IF_ALN -- Take the natural antilog of the pixels in image1 and write the +# results to image2. + +procedure if_aln$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_valn$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VALN -- Take the natural antilog of a vector. + +procedure if_valn$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i +PIXEL maxexp, maxval, eval + +begin + maxexp = log (10$f ** PIXEL (MAX_EXPONENT)) + maxval = MAX_REAL + eval = PIXEL (BASE_E) + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= -maxexp) + b[i] = 0$f + else + b[i] = eval ** a[i] + } +end + + +# IF_SQR -- Take the square root of pixels in image1 and write the results +# to image2. + +procedure if_sqr$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +PIXEL if_esqr$t() +extern if_esqr$t() +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call asqr$t (Mem$t[buf1], Mem$t[buf2], npix, if_esqr$t) +end + + +# IF_ESQR -- Error function for the square root. + +PIXEL procedure if_esqr$t (x) + +PIXEL x # input value + +begin + return (0$f) +end + + +# IF_SQUARE -- Take the square of the pixels in image1 and write to image2. +procedure if_square$t (im1, im2) + +pointer im1 # the input image pointer +pointer im2 # the output image pointer + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call apowk$t (Mem$t[buf1], 2, Mem$t[buf2], npix) +end + + +# IF_CBRT -- Take the cube root of the pixels in image1 and write the results +# to image2. + +procedure if_cbrt$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vcbrt$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VCBRT -- Compute the cube root of a vector. + +procedure if_vcbrt$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i +PIXEL onethird + +begin + onethird = 1$f / 3$f + do i = 1, n { + if (a[i] >= 0$f) { + b[i] = a[i] ** onethird + } else { + b[i] = -a[i] + b[i] = - (b[i] ** onethird) + } + } +end + + +# IF_CUBE -- Take the cube of the pixels in image1 and write the results to +# image2. + +procedure if_cube$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call apowk$t (Mem$t[buf1], 3, Mem$t[buf2], npix) +end + + +# IF_COS -- Take cosine of pixels in image1 and write the results to image2. + +procedure if_cos$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vcos$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VCOS - Compute the cosine of a vector. + +procedure if_vcos$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = cos(a[i]) +end + + +# IF_SIN -- Take sine of the pixels in image1 and write the results to image2. + +procedure if_sin$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vsin$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VSIN - Take the sine of a vector. + +procedure if_vsin$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = sin(a[i]) +end + + +# IF_TAN -- Take tangent of pixels in image1 and write the results to image2. + +procedure if_tan$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vtan$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VTAN - Take the tangent of a vector. + +procedure if_vtan$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = tan(a[i]) +end + + +# IF_ACOS -- Take arccosine of pixels in image1 and write the results to image2. + +procedure if_acos$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vacos$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VACOS - Take the arccosine of a vector. + +procedure if_vacos$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n { + if (a[i] > 1$f) + b[i] = acos (1$f) + else if (a[i] < -1$f) + b[i] = acos (-1$f) + else + b[i] = acos(a[i]) + } +end + + +# IF_ASIN -- Take arcsine of pixels in image1 and write the results to image2. + +procedure if_asin$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vasin$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VASIN - Take arcsine of vector + +procedure if_vasin$t (a, b, n) + +PIXEL a[n] +PIXEL b[n] +int n + +int i + +begin + do i = 1, n { + if (a[i] > 1$f) + b[i] = asin (1$f) + else if (a[i] < -1$f) + b[i] = asin (-1$f) + else + b[i] = asin(a[i]) + } +end + + +# IF_ATAN -- Take arctangent of pixels in image1 and write the results to +# image2. + +procedure if_atan$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vatan$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VATAN - Take the arctangent of a vector. + +procedure if_vatan$t (a, b, n) + +PIXEL a[n] +PIXEL b[n] +int n + +int i + +begin + do i = 1, n + b[i] = atan(a[i]) +end + + +# IF_HCOS -- Take the hyperbolic cosine of pixels in image1 and write the +# results to image2. + +procedure if_hcos$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vhcos$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VHCOS - Take the hyperbolic cosine of a vector. + +procedure if_vhcos$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i +PIXEL maxexp, maxval + +begin + maxexp = log (10$f ** PIXEL(MAX_EXPONENT)) + maxval = MAX_REAL + + do i = 1, n { + if (abs (a[i]) >= maxexp) + b[i] = maxval + else + b[i] = cosh (a[i]) + } +end + + +# IF_HSIN -- Take the hyperbolic sine of pixels in image1 and write the +# results to image2. + +procedure if_hsin$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vhsin$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VHSIN - Take the hyperbolic sine of a vector. + +procedure if_vhsin$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i +PIXEL maxexp, maxval + +begin + maxexp = log (10$f ** PIXEL(MAX_EXPONENT)) + maxval = MAX_REAL + + do i = 1, n { + if (a[i] >= maxexp) + b[i] = maxval + else if (a[i] <= -maxexp) + b[i] = -maxval + else + b[i] = sinh(a[i]) + } +end + + +# IF_HTAN -- Take the hyperbolic tangent of pixels in image1 and write the +# results to image2. + +procedure if_htan$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +pointer buf1, buf2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call if_vhtan$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_VHTAN - Take the hyperbolic tangent of a vector. + +procedure if_vhtan$t (a, b, n) + +PIXEL a[n] # the input vector +PIXEL b[n] # the output vector +int n # the number of pixels + +int i + +begin + do i = 1, n + b[i] = tanh(a[i]) +end + + +# IF_RECIP -- Take the reciprocal of the pixels in image1 and write the +# results to image2. + +procedure if_recip$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +PIXEL if_erecip$t() +extern if_erecip$t() +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call arcz$t (1.0, Mem$t[buf1], Mem$t[buf2], npix, if_erecip$t) +end + + +# IF_ERECIP -- Error function for the reciprocal computation. + +PIXEL procedure if_erecip$t (x) + +PIXEL x + +begin + return (0$f) +end + +$endfor + +$for (lrd) + +# IF_ABS -- Take the absolute value of pixels in image1 and write the results +# to image2. + +procedure if_abs$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call aabs$t (Mem$t[buf1], Mem$t[buf2], npix) +end + + +# IF_NEG -- Take negative of pixels in image1 and write the results to image2. + +procedure if_neg$t (im1, im2) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image + +int npix +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnl$t(), impnl$t() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im1, 1) + while ((imgnl$t (im1, buf1, v1) != EOF) && + (impnl$t (im2, buf2, v2) != EOF)) + call aneg$t (Mem$t[buf1], Mem$t[buf2], npix) +end + +$endfor diff --git a/pkg/images/imutil/src/imfunction.x b/pkg/images/imutil/src/imfunction.x new file mode 100644 index 00000000..08c4813a --- /dev/null +++ b/pkg/images/imutil/src/imfunction.x @@ -0,0 +1,306 @@ +include <imhdr.h> + +define IF_LOG10 1 +define IF_ALOG10 2 +define IF_LN 3 +define IF_ALN 4 +define IF_SQRT 5 +define IF_SQUARE 6 +define IF_CBRT 7 +define IF_CUBE 8 +define IF_ABS 9 +define IF_NEG 10 +define IF_COS 11 +define IF_SIN 12 +define IF_TAN 13 +define IF_ACOS 14 +define IF_ASIN 15 +define IF_ATAN 16 +define IF_COSH 17 +define IF_SINH 18 +define IF_TANH 19 +define IF_RECIPROCAL 20 + +define FUNCS "|log10|alog10|ln|aln|sqrt|square|cbrt|cube|abs|neg|\ +cos|sin|tan|acos|asin|atan|hcos|hsin|htan|reciprocal|" + +# T_FUNCTION -- Apply a function to a list of images. + +procedure t_imfunction () + +pointer input # input images +pointer output # output images +int func # function +int verbose # verbose mode + +int list1, list2 +pointer sp, image1, image2, image3, function, im1, im2 +bool clgetb() +int clgwrd(), imtopen(), imtgetim(), imtlen(), btoi() +pointer immap() + +begin + # Allocate working space. + + call smark (sp) + call salloc (input, SZ_LINE, TY_CHAR) + call salloc (output, SZ_LINE, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call salloc (image2, SZ_FNAME, TY_CHAR) + call salloc (image3, SZ_FNAME, TY_CHAR) + call salloc (function, SZ_FNAME, TY_CHAR) + + # Get image template list. + + call clgstr ("input", Memc[input], SZ_LINE) + call clgstr ("output", Memc[output], SZ_LINE) + func = clgwrd ("function", Memc[function], SZ_FNAME, FUNCS) + verbose = btoi (clgetb ("verbose")) + + list1 = imtopen (Memc[input]) + list2 = imtopen (Memc[output]) + if (imtlen (list1) != imtlen (list2)) { + call imtclose (list1) + call imtclose (list2) + call error (1, "Input and output image lists don't match") + } + + # Apply function to each input image. Optimize IMIO. + + while ((imtgetim (list1, Memc[image1], SZ_FNAME) != EOF) && + (imtgetim (list2, Memc[image2], SZ_FNAME) != EOF)) { + + call xt_mkimtemp (Memc[image1], Memc[image2], Memc[image3], + SZ_FNAME) + im1 = immap (Memc[image1], READ_ONLY, 0) + if (IM_PIXTYPE(im1) == TY_COMPLEX) { + call printf ("%s is datatype complex: skipping\n") + call imunmap (im1) + next + } + im2 = immap (Memc[image2], NEW_COPY, im1) + + switch (func) { + case IF_LOG10: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_log10d (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_log10r (im1, im2) + } + + case IF_ALOG10: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_alog10d (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_alog10r (im1, im2) + } + + case IF_LN: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_lnd (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_lnr (im1, im2) + } + + case IF_ALN: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_alnd (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_alnr (im1, im2) + } + + case IF_SQRT: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_sqrd (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_sqrr (im1, im2) + } + + case IF_SQUARE: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_squared (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_squarer (im1, im2) + } + + case IF_CBRT: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_cbrtd (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_cbrtr (im1, im2) + } + + case IF_CUBE: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_cubed (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_cuber (im1, im2) + } + + case IF_ABS: + switch (IM_PIXTYPE(im1)) { + case TY_SHORT, TY_INT, TY_LONG: + call if_absl (im1, im2) + case TY_DOUBLE: + call if_absd (im1, im2) + default: + call if_absr (im1, im2) + } + + case IF_NEG: + # Preserve the original image type. + switch (IM_PIXTYPE(im1)) { + case TY_SHORT, TY_INT, TY_LONG: + call if_negl (im1, im2) + case TY_DOUBLE: + call if_negd (im1, im2) + default: + call if_negr (im1, im2) + } + + case IF_COS: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_cosd (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_cosr (im1, im2) + } + + case IF_SIN: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_sind (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_sinr (im1, im2) + } + + case IF_TAN: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_tand (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_tanr (im1, im2) + } + + case IF_ACOS: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_acosd (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_acosr (im1, im2) + } + + case IF_ASIN: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_asind (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_asinr (im1, im2) + } + + case IF_ATAN: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_atand (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_atanr (im1, im2) + } + + case IF_COSH: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_hcosd (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_hcosr (im1, im2) + } + + case IF_SINH: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_hsind (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_hsinr (im1, im2) + } + + case IF_TANH: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_htand (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_htanr (im1, im2) + } + + case IF_RECIPROCAL: + switch (IM_PIXTYPE(im1)) { + case TY_DOUBLE: + IM_PIXTYPE (im2) = TY_DOUBLE + call if_recipd (im1, im2) + default: + IM_PIXTYPE (im2) = TY_REAL + call if_recipr (im1, im2) + } + + default: + call error (0, "Undefined function\n") + + } + + if (verbose == YES) { + call printf ("%s -> %s function: %s\n") + call pargstr (Memc[image1]) + call pargstr (Memc[image3]) + call pargstr (Memc[function]) + } + + call imunmap (im1) + call imunmap (im2) + call xt_delimtemp (Memc[image2], Memc[image3]) + + } + + call imtclose (list1) + call imtclose (list2) + call sfree (sp) +end diff --git a/pkg/images/imutil/src/imgets.x b/pkg/images/imutil/src/imgets.x new file mode 100644 index 00000000..c05c14ca --- /dev/null +++ b/pkg/images/imutil/src/imgets.x @@ -0,0 +1,53 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <ctype.h> + +# IMGETS -- Get the value of an image header parameter as a character string. +# The value is returned as a CL parameter of type string; the type coercion +# facilities of the CL may be used to convert to a different datatype if +# desired. + +procedure t_imgets() + +pointer sp, im +pointer image, param, value +pointer immap() +int ip, op, stridxs() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (param, SZ_LINE, TY_CHAR) + call salloc (value, SZ_LINE, TY_CHAR) + + call clgstr ("image", Memc[image], SZ_FNAME) + call clgstr ("param", Memc[param], SZ_LINE) + + im = immap (Memc[image], READ_ONLY, 0) + + iferr (call imgstr (im, Memc[param], Memc[value], SZ_LINE)) { + call erract (EA_WARN) + call clpstr ("value", "0") + } else { + # Check for special case of string with double quotes. + if (stridxs ("\"", Memc[value]) != 0) { + op = param + for (ip=value; Memc[ip]!=EOS; ip=ip+1) { + if (Memc[ip] == '"') { + Memc[op] = '\\' + op = op + 1 + } + Memc[op] = Memc[ip] + op = op + 1 + } + Memc[op] = EOS + call clpstr ("value", Memc[param]) + } else + call clpstr ("value", Memc[value]) + } + + call imunmap (im) + call sfree (sp) +end diff --git a/pkg/images/imutil/src/imheader.x b/pkg/images/imutil/src/imheader.x new file mode 100644 index 00000000..57c496fe --- /dev/null +++ b/pkg/images/imutil/src/imheader.x @@ -0,0 +1,303 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <ctype.h> +include <imhdr.h> +include <imset.h> +include <imio.h> +include <time.h> + +define SZ_DIMSTR (IM_MAXDIM*4) +define SZ_MMSTR 40 +define USER_AREA Memc[($1+IMU-1)*SZ_STRUCT + 1] +define LMARGIN 0 + + +# IMHEADER -- Read contents of an image header and print on STDOUT. + +procedure t_imheader() + +int list, nimages, errcode +bool long_format, user_fields +pointer sp, template, image, errmsg +int imtopen(), imtgetim(), imtlen(), clgeti(), errget() +bool clgetb() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + call salloc (template, SZ_LINE, TY_CHAR) + + if (clgeti ("$nargs") == 0) + call clgstr ("imlist", Memc[template], SZ_LINE) + else + call clgstr ("images", Memc[template], SZ_LINE) + + list = imtopen (Memc[template]) + long_format = clgetb ("longheader") + user_fields = clgetb ("userfields") + nimages = 0 + + if (imtlen (list) <= 0) + call printf ("no images found\n") + else { + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + nimages = nimages + 1 + if (long_format && nimages > 1) + call putci (STDOUT, '\n') + iferr { + call imphdr (STDOUT,Memc[image],long_format,user_fields) + } then { + errcode = errget (Memc[errmsg], SZ_LINE) + call eprintf ("%s: %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[errmsg]) + } + call flush (STDOUT) + } + } + + call imtclose (list) + call sfree (sp) +end + + +# IMPHDR -- Print the contents of an image header. + +procedure imphdr (fd, image, long_format, user_fields) + +int fd +char image[ARB] +bool long_format +bool user_fields + +int hi, i +bool pixfile_ok +pointer im, sp, ctime, mtime, ldim, pdim, title, lbuf, ip +int gstrcpy(), stropen(), getline(), strlen(), stridxs(), imstati() +errchk im_fmt_dimensions, immap, access, stropen, getline +define done_ 91 +pointer immap() + +begin + # Allocate automatic buffers. + call smark (sp) + call salloc (ctime, SZ_TIME, TY_CHAR) + call salloc (mtime, SZ_TIME, TY_CHAR) + call salloc (ldim, SZ_DIMSTR, TY_CHAR) + call salloc (pdim, SZ_DIMSTR, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + im = immap (image, READ_ONLY, 0) + + # Format subscript strings, date strings, mininum and maximum + # pixel values. + + call im_fmt_dimensions (im, Memc[ldim], SZ_DIMSTR, IM_LEN(im,1)) + call im_fmt_dimensions (im, Memc[pdim], SZ_DIMSTR, IM_PHYSLEN(im,1)) + call cnvtime (IM_CTIME(im), Memc[ctime], SZ_TIME) + call cnvtime (IM_MTIME(im), Memc[mtime], SZ_TIME) + + # Strip any trailing whitespace from the title string. + ip = title + gstrcpy (IM_TITLE(im), Memc[title], SZ_LINE) - 1 + while (ip >= title && IS_WHITE(Memc[ip]) || Memc[ip] == '\n') + ip = ip - 1 + Memc[ip+1] = EOS + + # Begin printing image header. + call fprintf (fd, "%s%s[%s]: %s\n") + call pargstr (IM_NAME(im)) + call pargstr (Memc[ldim]) + call pargtype (IM_PIXTYPE(im)) + call pargstr (Memc[title]) + + # All done if not long format. + if (! long_format) + goto done_ + + call fprintf (fd, "%*w%s bad pixels, min=%s, max=%s%s\n") + call pargi (LMARGIN) + if (IM_NBPIX(im) == 0) # num bad pixels + call pargstr ("No") + else + call pargl (IM_NBPIX(im)) + + if (IM_LIMTIME(im) == 0) { # min,max pixel values + do i = 1, 2 + call pargstr ("unknown") + call pargstr ("") + } else { + call pargr (IM_MIN(im)) + call pargr (IM_MAX(im)) + if (IM_LIMTIME(im) < IM_MTIME(im)) + call pargstr (" (old)") + else + call pargstr ("") + } + + call fprintf (fd, + "%*w%s storage mode, physdim %s, length of user area %d s.u.\n") + call pargi (LMARGIN) + call pargstr ("Line") + call pargstr (Memc[pdim]) + call pargi (IM_HDRLEN(im) - LEN_IMHDR) + + call fprintf (fd, "%*wCreated %s, Last modified %s\n") + call pargi (LMARGIN) + call pargstr (Memc[ctime]) # times + call pargstr (Memc[mtime]) + + pixfile_ok = (imstati (im, IM_PIXFD) > 0) + if (!pixfile_ok) { + ifnoerr (call imopsf (im)) + pixfile_ok = (imstati (im, IM_PIXFD) > 0) + if (pixfile_ok) + call close (imstati (im, IM_PIXFD)) + } + if (pixfile_ok) + call strcpy ("[ok]", Memc[lbuf], SZ_LINE) + else + call strcpy ("[NO PIXEL FILE]", Memc[lbuf], SZ_LINE) + + call fprintf (fd, "%*wPixel file \"%s\" %s\n") + call pargi (LMARGIN) + call pargstr (IM_PIXFILE(im)) + call pargstr (Memc[lbuf]) + + # Print the history records. + if (strlen (IM_HISTORY(im)) > 1) { + hi = stropen (IM_HISTORY(im), ARB, READ_ONLY) + while (getline (hi, Memc[lbuf]) != EOF) { + for (i=1; i <= LMARGIN; i=i+1) + call putci (fd, ' ') + call putline (fd, Memc[lbuf]) + if (stridxs ("\n", Memc[lbuf]) == 0) + call putline (fd, "\n") + } + call close (hi) + } + + if (user_fields) + call imh_print_user_area (fd, im) + +done_ + call imunmap (im) + call sfree (sp) +end + + +# IM_FMT_DIMENSIONS -- Format the image dimensions in the form of a subscript, +# i.e., "[nx,ny,nz,...]". + +procedure im_fmt_dimensions (im, outstr, maxch, len_axes) + +pointer im +char outstr[ARB] +int maxch, i, fd, stropen() +long len_axes[ARB] +errchk stropen, fprintf, pargl + +begin + fd = stropen (outstr, maxch, NEW_FILE) + + if (IM_NDIM(im) == 0) { + call fprintf (fd, "[0") + } else { + call fprintf (fd, "[%d") + call pargl (len_axes[1]) + } + + do i = 2, IM_NDIM(im) { + call fprintf (fd, ",%d") + call pargl (len_axes[i]) + } + + call fprintf (fd, "]") + call close (fd) +end + + +# PARGTYPE -- Convert an integer type code into a string, and output the +# string with PARGSTR to FMTIO. + +procedure pargtype (dtype) + +int dtype + +begin + switch (dtype) { + case TY_UBYTE: + call pargstr ("ubyte") + case TY_BOOL: + call pargstr ("bool") + case TY_CHAR: + call pargstr ("char") + case TY_SHORT: + call pargstr ("short") + case TY_USHORT: + call pargstr ("ushort") + case TY_INT: + call pargstr ("int") + case TY_LONG: + call pargstr ("long") + case TY_REAL: + call pargstr ("real") + case TY_DOUBLE: + call pargstr ("double") + case TY_COMPLEX: + call pargstr ("complex") + case TY_POINTER: + call pargstr ("pointer") + case TY_STRUCT: + call pargstr ("struct") + default: + call pargstr ("unknown datatype") + } +end + + +# IMH_PRINT_USER_AREA -- Print the user area of the image, if nonzero length +# and it contains only ascii values. + +procedure imh_print_user_area (out, im) + +int out # output file +pointer im # image descriptor + +pointer sp, lbuf, ip +int in, ncols, min_lenuserarea, i +int stropen(), getline(), envgeti() +errchk stropen, envgeti, getline, putci, putline + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + # Open user area in header. + min_lenuserarea = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1 + in = stropen (USER_AREA(im), min_lenuserarea, READ_ONLY) + ncols = envgeti ("ttyncols") - LMARGIN + + # Copy header records to the output, stripping any trailing + # whitespace and clipping at the right margin. + + while (getline (in, Memc[lbuf]) != EOF) { + for (ip=lbuf; Memc[ip] != EOS && Memc[ip] != '\n'; ip=ip+1) + ; + while (ip > lbuf && Memc[ip-1] == ' ') + ip = ip - 1 + if (ip - lbuf > ncols) + ip = lbuf + ncols + Memc[ip] = '\n' + Memc[ip+1] = EOS + + for (i=1; i <= LMARGIN; i=i+1) + call putci (out, ' ') + call putline (out, Memc[lbuf]) + } + + call close (in) + call sfree (sp) +end diff --git a/pkg/images/imutil/src/imhistogram.x b/pkg/images/imutil/src/imhistogram.x new file mode 100644 index 00000000..b62233b7 --- /dev/null +++ b/pkg/images/imutil/src/imhistogram.x @@ -0,0 +1,332 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imhdr.h> +include <gset.h> + +define SZ_CHOICE 18 + +define HIST_TYPES "|normal|cumulative|difference|second_difference|" +define NORMAL 1 +define CUMULATIVE 2 +define DIFFERENCE 3 +define SECOND_DIFF 4 + +define PLOT_TYPES "|line|box|" +define LINE 1 +define BOX 2 + +define SZ_TITLE 512 # plot title buffer + +# IMHISTOGRAM -- Compute and plot the histogram of an image. + +procedure t_imhistogram() + +long v[IM_MAXDIM] +real z1, z2, dz, z1temp, z2temp, zstart +int npix, nbins, nbins1, nlevels, nwide, z1i, z2i, i, maxch, histtype +pointer gp, im, sp, hgm, hgmr, buf, image, device, str, title, op + +real clgetr() +pointer immap(), gopen() +int clgeti(), clgwrd() +int imgnlr(), imgnli() +bool clgetb(), fp_equalr() + +begin + call smark (sp) + call salloc (image, SZ_LINE, TY_CHAR) + call salloc (str, SZ_CHOICE, TY_CHAR) + + # Get the image name. + call clgstr ("image", Memc[image], SZ_LINE) + im = immap (Memc[image], READ_ONLY, 0) + npix = IM_LEN(im,1) + + # Get histogram range. + z1 = clgetr ("z1") + z2 = clgetr ("z2") + + if (IS_INDEFR(z1) || IS_INDEFR(z2)) { + + if (IM_LIMTIME(im) >= IM_MTIME(im)) { + z1temp = IM_MIN(im) + z2temp = IM_MAX(im) + } else + call im_minmax (im, z1temp, z2temp) + + if (IS_INDEFR(z1)) + z1 = z1temp + + if (IS_INDEFR(z2)) + z2 = z2temp + } + + if (z1 > z2) { + dz = z1; z1 = z2; z2 = dz + } + + # Get default histogram resolution. + dz = clgetr ("binwidth") + if (IS_INDEFR(dz)) + nbins = clgeti ("nbins") + else { + nbins = nint ((z2 - z1) / dz) + z2 = z1 + nbins * dz + } + + # Set the limits for integer images. + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_USHORT, TY_INT, TY_LONG: + z1i = nint (z1) + z2i = nint (z2) + z1 = real (z1i) + z2 = real (z2i) + } + + # Adjust the resolution of the histogram and/or the data range + # so that an integral number of data values map into each + # histogram bin (to avoid aliasing effects). + + if (clgetb ("autoscale")) + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_USHORT, TY_INT, TY_LONG: + nlevels = z2i - z1i + nwide = max (1, nint (real (nlevels) / real (nbins))) + nbins = max (1, nint (real (nlevels) / real (nwide))) + z2i = z1i + nbins * nwide + z2 = real (z2i) + } + + # The extra bin counts the pixels that equal z2 and shifts the + # remaining bins to evenly cover the interval [z1,z2]. + # Real numbers could be handled better - perhaps adjust z2 + # upward by ~ EPSILONR (in ahgm itself). + + nbins1 = nbins + 1 + + # Initialize the histogram buffer and image line vector. + call salloc (hgm, nbins1, TY_INT) + call aclri (Memi[hgm], nbins1) + call amovkl (long(1), v, IM_MAXDIM) + + # Read successive lines of the image and accumulate the histogram. + + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_USHORT, TY_INT, TY_LONG: + # Test for constant valued image, which causes zero divide in ahgm. + if (z1i == z2i) { + call eprintf ("Warning: Image `%s' has no data range.\n") + call pargstr (Memc[image]) + call imunmap (im) + call sfree (sp) + return + } + + while (imgnli (im, buf, v) != EOF) + call ahgmi (Memi[buf], npix, Memi[hgm], nbins1, z1i, z2i) + + default: + # Test for constant valued image, which causes zero divide in ahgm. + if (fp_equalr (z1, z2)) { + call eprintf ("Warning: Image `%s' has no data range.\n") + call pargstr (Memc[image]) + call imunmap (im) + call sfree (sp) + return + } + + while (imgnlr (im, buf, v) != EOF) + call ahgmr (Memr[buf], npix, Memi[hgm], nbins1, z1, z2) + } + + # "Correct" the topmost bin for pixels that equal z2. Each + # histogram bin really wants to be half open. + + if (clgetb ("top_closed")) + Memi[hgm+nbins-1] = Memi[hgm+nbins-1] + Memi[hgm+nbins1-1] + + dz = (z2 - z1) / real (nbins) + + histtype = clgwrd ("hist_type", Memc[str], SZ_CHOICE, HIST_TYPES) + + switch (histtype) { + case NORMAL: + # do nothing + case CUMULATIVE: + call ih_acumi (Memi[hgm], Memi[hgm], nbins) + case DIFFERENCE: + call ih_amrgi (Memi[hgm], Memi[hgm], nbins) + z1 = z1 + dz / 2. + z2 = z2 - dz / 2. + nbins = nbins - 1 + case SECOND_DIFF: + call ih_amrgi (Memi[hgm], Memi[hgm], nbins) + call ih_amrgi (Memi[hgm], Memi[hgm], nbins-1) + z1 = z1 + dz + z2 = z2 - dz + nbins = nbins - 2 + default: + call error (1, "bad switch 1") + } + + # List or plot the histogram. In list format, the bin value is the + # z value of the left side (start) of the bin. + + if (clgetb ("listout")) { + zstart = z1 + dz / 2.0 + do i = 1, nbins { + call printf ("%g %d\n") + call pargr (zstart) + call pargi (Memi[hgm+i-1]) + zstart = zstart + dz + } + } else { + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (title, SZ_TITLE, TY_CHAR) + call salloc (hgmr, nbins, TY_REAL) + call achtir (Memi[hgm], Memr[hgmr], nbins) + + call clgstr ("device", Memc[device], SZ_FNAME) + gp = gopen (Memc[device], NEW_FILE, STDGRAPH) + if (clgetb ("logy")) + call gseti (gp, G_YTRAN, GW_LOG) + call gswind (gp, z1, z2, INDEF, INDEF) + call gascale (gp, Memr[hgmr], nbins, 2) + + # Format the plot title, starting with the system banner. + call sysid (Memc[title], SZ_TITLE) + for (op=title; Memc[op] != '\n' && Memc[op] != EOS; op=op+1) + ; + Memc[op] = '\n'; op = op + 1 + maxch = SZ_TITLE - (op - title) + + # Format the remainder of the plot title. + call sprintf (Memc[op], maxch, + "%s of %s = %s\nFrom z1=%g to z2=%g, nbins=%d, width=%g") + switch (histtype) { + case NORMAL: + call pargstr ("Histogram") + case CUMULATIVE: + call pargstr ("Cumulative histogram") + case DIFFERENCE: + call pargstr ("Difference histogram") + case SECOND_DIFF: + call pargstr ("Second difference histogram") + default: + call error (1, "bad switch 3") + } + + call pargstr (Memc[image]) + call pargstr (IM_TITLE(im)) + call pargr (z1) + call pargr (z2) + call pargi (nbins) + call pargr (dz) + + # Draw the plot. Center the bins for plot_type=line. + call glabax (gp, Memc[title], "", "") + + switch (clgwrd ("plot_type", Memc[str], SZ_LINE, PLOT_TYPES)) { + case LINE: + call gvline (gp, Memr[hgmr], nbins, z1 + dz/2., z2 - dz/2.) + case BOX: + call hgline (gp, Memr[hgmr], nbins, z1, z2) + default: + call error (1, "bad switch 2") + } + + call gclose (gp) + } + + call imunmap (im) + call sfree (sp) +end + + +# HGLINE -- Draw a stepped curve of the histogram data. + +procedure hgline (gp, ydata, npts, x1, x2) + +pointer gp # Graphics descriptor +real ydata[ARB] # Y coordinates of the line endpoints +int npts # Number of line endpoints +real x1, x2 + +int pixel +real x, y, dx + +begin + dx = (x2 - x1) / npts + + # Do the first horizontal line + x = x1 + y = ydata[1] + call gamove (gp, x, y) + x = x + dx + call gadraw (gp, x, y) + + do pixel = 2, npts { + x = x1 + dx * (pixel - 1) + y = ydata[pixel] + # vertical connection + call gadraw (gp, x, y) + # horizontal line + call gadraw (gp, x + dx, y) + } +end + + +# These two routines are intended to be generic vops routines. Only +# the integer versions are included since that's all that's used here. + +# <NOT IMPLEMENTED!> The operation is carried out in such a way that +# the result is the same whether or not the output vector overlaps +# (partially) the input vector. The routines WILL work in place! + +# ACUM -- Compute a cumulative vector (generic). Should b[1] be zero? + +procedure ih_acumi (a, b, npix) + +int a[ARB], b[ARB] +int npix, i + +# int npix, i, a_first, b_first + +begin +# call zlocva (a, a_first) +# call zlocva (b, b_first) +# +# if (b_first <= a_first) { + # Shouldn't use output arguments internally, + # but no reason to use this routine unsafely. + b[1] = a[1] + do i = 2, npix + b[i] = b[i-1] + a[i] +# } else { + # overlapping solution not implemented yet! +# } +end + + +# AMRG -- Compute a marginal (forward difference) vector (generic). + +procedure ih_amrgi (a, b, npix) + +int a[ARB], b[ARB] +int npix, i + +# int npix, i, a_first, b_first + +begin +# call zlocva (a, a_first) +# call zlocva (b, b_first) +# +# if (b_first <= a_first) { + do i = 1, npix-1 + b[i] = a[i+1] - a[i] + b[npix] = 0 +# } else { + # overlapping solution not implemented yet! +# } +end diff --git a/pkg/images/imutil/src/imjoin.gx b/pkg/images/imutil/src/imjoin.gx new file mode 100644 index 00000000..3a6dbde7 --- /dev/null +++ b/pkg/images/imutil/src/imjoin.gx @@ -0,0 +1,92 @@ +include <imhdr.h> + +define VPTR Memi[$1+$2-1] # Array of axis vector pointers + +$for (silrdx) + +# IMJOIN -- Join the set of input images into an output image along the +# specified axis, any dimension. + +procedure imjoin$t (inptr, nimages, out, joindim, outtype) + +pointer inptr[nimages] #I Input IMIO pointers +int nimages #I Number of input images +pointer out #I Output IMIO pointer +int joindim #I Dimension along which to join images +int outtype #I Output datatype + +int i, image, line, nlines, nbands, stat, cum_len +pointer sp, vin, vout, in, inbuf, outbuf + +pointer imgnl$t() +pointer impnl$t() + +begin + # Allocate working space. + call smark (sp) + call salloc (vin, nimages, TY_INT) + call salloc (vout, IM_MAXDIM, TY_LONG) + + # Initialize the v vectors. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + do image = 1, nimages { + call salloc (VPTR(vin,image), IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[VPTR(vin,image)], IM_MAXDIM) + } + + # Join input images along the specified dimension. Joins along + # columns and lines require processing in special order, all others + # in the same order. In the first two cases we process all input + # images in inner loops, so we have to keep all those image + # descriptors open. + + switch (joindim) { + case 1: # join columns + nlines = 1 + do i = 2, IM_NDIM(out) + nlines = nlines * IM_LEN(out,i) + do i = 1, nlines { + stat = impnl$t (out, outbuf, Meml[vout]) + cum_len = 0 + do image = 1, nimages { + in = inptr[image] + stat = imgnl$t (in, inbuf, Meml[VPTR(vin,image)]) + call amov$t (Mem$t[inbuf], Mem$t[outbuf+cum_len], + IM_LEN(in,1)) + cum_len = cum_len + IM_LEN(in,1) + } + } + + case 2: # join lines + nbands = 1 + do i = 3, IM_NDIM(out) + nbands = nbands * IM_LEN(out,i) + do i = 1, nbands { + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnl$t (out, outbuf, Meml[vout]) + stat = imgnl$t (in, inbuf, Meml[VPTR(vin,image)]) + call amov$t (Mem$t[inbuf], Mem$t[outbuf], IM_LEN(in,1)) + } + } + } + + default: # join bands or higher + do image = 1, nimages { + in = inptr[image] + nlines = 1 + do i = 2, IM_NDIM(in) + nlines = nlines * IM_LEN(in,i) + do i = 1, nlines { + stat = impnl$t (out, outbuf, Meml[vout]) + stat = imgnl$t (in, inbuf, Meml[VPTR(vin,image)]) + call amov$t (Mem$t[inbuf], Mem$t[outbuf], IM_LEN(in,1)) + } + } + } + + call sfree (sp) +end + +$endfor diff --git a/pkg/images/imutil/src/imminmax.x b/pkg/images/imutil/src/imminmax.x new file mode 100644 index 00000000..78daff61 --- /dev/null +++ b/pkg/images/imutil/src/imminmax.x @@ -0,0 +1,74 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IM_MINMAX -- Compute the minimum and maximum pixel values of an image. +# Works for images of any dimensionality, size, or datatype, although +# the min and max values can currently only be stored in the image header +# as real values. + +procedure im_minmax (im, min_value, max_value) + +pointer im # image descriptor +real min_value # minimum pixel value in image (out) +real max_value # maximum pixel value in image (out) + +pointer buf +bool first_line +long v[IM_MAXDIM] +short minval_s, maxval_s +long minval_l, maxval_l +real minval_r, maxval_r +int imgnls(), imgnll(), imgnlr() + +begin + call amovkl (long(1), v, IM_MAXDIM) # start vector + first_line = true + min_value = INDEF + max_value = INDEF + + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + while (imgnls (im, buf, v) != EOF) { + call alims (Mems[buf], IM_LEN(im,1), minval_s, maxval_s) + if (first_line) { + min_value = minval_s + max_value = maxval_s + first_line = false + } else { + if (minval_s < min_value) + min_value = minval_s + if (maxval_s > max_value) + max_value = maxval_s + } + } + case TY_USHORT, TY_INT, TY_LONG: + while (imgnll (im, buf, v) != EOF) { + call aliml (Meml[buf], IM_LEN(im,1), minval_l, maxval_l) + if (first_line) { + min_value = minval_l + max_value = maxval_l + first_line = false + } else { + if (minval_l < min_value) + min_value = minval_l + if (maxval_l > max_value) + max_value = maxval_l + } + } + default: + while (imgnlr (im, buf, v) != EOF) { + call alimr (Memr[buf], IM_LEN(im,1), minval_r, maxval_r) + if (first_line) { + min_value = minval_r + max_value = maxval_r + first_line = false + } else { + if (minval_r < min_value) + min_value = minval_r + if (maxval_r > max_value) + max_value = maxval_r + } + } + } +end diff --git a/pkg/images/imutil/src/imrep.gx b/pkg/images/imutil/src/imrep.gx new file mode 100644 index 00000000..89ce581b --- /dev/null +++ b/pkg/images/imutil/src/imrep.gx @@ -0,0 +1,346 @@ +include <imhdr.h> +include <mach.h> + +$for (silrdx) + +# IMREP -- Replace pixels in an image between lower and upper by value. + +procedure imrep$t (im, lower, upper, value, img) + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real value # Replacement value +real img # Imaginary value for complex + +pointer buf1, buf2 +int npix, junk +$if (datatype == sil) +real ilower +$endif +PIXEL floor, ceil, newval +long v1[IM_MAXDIM], v2[IM_MAXDIM] +int imgnl$t(), impnl$t() + +$if (datatype == sil) +bool fp_equalr() +$endif + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + npix = IM_LEN(im, 1) + $if (datatype == x) + newval = complex (value, img) + $else + newval = double (value) + $endif + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnl$t (im, buf2, v2) != EOF) + call amovk$t (newval, Mem$t[buf2], npix) + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + $if (datatype == sil) + ceil = int (upper) + $else + ceil = double (upper) + $endif + while (imgnl$t (im, buf1, v1) != EOF) { + junk = impnl$t (im, buf2, v2) + call amov$t (Mem$t[buf1], Mem$t[buf2], npix) + call arle$t (Mem$t[buf2], npix, ceil, newval) + } + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + $if (datatype == sil) + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + $else + floor = double (lower) + $endif + while (imgnl$t (im, buf1, v1) != EOF) { + junk = impnl$t (im, buf2, v2) + call amov$t (Mem$t[buf1], Mem$t[buf2], npix) + call arge$t (Mem$t[buf2], npix, floor, newval) + } + + # Replace pixels between lower and upper by value. + } else { + $if (datatype == sil) + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = int (upper) + $else + floor = double (lower) + ceil = double (upper) + $endif + while (imgnl$t (im, buf1, v1) != EOF) { + junk = impnl$t (im, buf2, v2) + call amov$t (Mem$t[buf1], Mem$t[buf2], npix) + call arep$t (Mem$t[buf2], npix, floor, ceil, newval) + } + } +end + + +# IMRREP -- Replace pixels in an image between lower and upper by value +# and a radius around those pixels. + +procedure imrrep$t (im, lower, upper, radius, value, img) + + +pointer im # Image descriptor +real lower, upper # Range to be replaced +real radius # Radius +real value # Replacement value +real img # Imaginary value for complex + +pointer buf, buf1, buf2, ptr +int i, j, k, l, nc, nl, nradius, nbufs +$if (datatype == sil) +real ilower +$endif +PIXEL floor, ceil, newval, val1, val2 +$if (datatype == x) +real abs_floor, abs_ceil +$endif +real radius2, y2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] # IMIO vectors +int imgnl$t(), impnl$t() +$if (datatype == sil) +bool fp_equalr() +$endif + +begin + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + nc = IM_LEN(im, 1) + if (IM_NDIM(im) > 1) + nl = IM_LEN(im,2) + else + nl = 1 + $if (datatype == x) + newval = complex (value, img) + $else + newval = double (value) + $endif + + # If both lower and upper are INDEF then replace all pixels by value. + if (IS_INDEFR (lower) && IS_INDEFR (upper)) { + while (impnl$t (im, buf2, v2) != EOF) + call amovk$t (newval, Mem$t[buf2], nc) + return + + # If lower is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (lower)) { + $if (datatype == sil) + floor = -MAX_PIXEL + ceil = int (upper) + $else $if (datatype == x) + floor = 0 + ceil = real (upper) + abs_floor = abs (floor) + abs_ceil = abs (ceil) + $else + floor = -MAX_PIXEL + ceil = double (upper) + $endif $endif + + # If upper is INDEF then all pixels below upper are replaced by value. + } else if (IS_INDEFR (upper)) { + $if (datatype == sil) + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = MAX_PIXEL + $else $if (datatype == x) + floor = real (lower) + ceil = MAX_REAL + abs_floor = abs (floor) + abs_ceil = abs (ceil) + $else + floor = double (lower) + ceil = MAX_PIXEL + $endif $endif + + # Replace pixels between lower and upper by value. + } else { + $if (datatype == sil) + ilower = int (lower) + if (fp_equalr(lower,ilower)) + floor = int (lower) + else + floor = int (lower+1.0) + ceil = int (upper) + $else $if (datatype == x) + floor = real (lower) + ceil = real (upper) + abs_floor = abs (floor) + abs_ceil = abs (ceil) + $else + floor = double (lower) + ceil = double (upper) + $endif $endif + } + + # Initialize buffering. + radius2 = radius * radius + nradius = int (radius) + nbufs = min (1 + 2 * nradius, nl) + call calloc (buf, nc*nbufs, TY_PIXEL) + + while (imgnl$t (im, buf1, v1) != EOF) { + j = v1[2] - 1 + buf2 = buf + mod (j, nbufs) * nc + do i = 1, nc { + val1 = Mem$t[buf1] + val2 = Mem$t[buf2] + $if (datatype == x) + if ((abs (val1) >= abs_floor) && (abs (val1) <= abs_ceil)) { + $else + if ((val1 >= floor) && (val1 <= ceil)) { + $endif + do k = max(1,j-nradius), min (nl,j+nradius) { + ptr = buf + mod (k, nbufs) * nc - 1 + y2 = (k - j) ** 2 + do l = max(1,i-nradius), min (nc,i+nradius) { + if ((l-i)**2 + y2 > radius2) + next + Mem$t[ptr+l] = INDEF + } + } + } else { + if (!IS_INDEF(val2)) + Mem$t[buf2] = val1 + } + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (j > nradius) { + while (impnl$t (im, buf2, v2) != EOF) { + k = v2[2] - 1 + buf1 = buf + mod (k, nbufs) * nc + do i = 1, nc { + val1 = Mem$t[buf1] + if (IS_INDEF(Mem$t[buf1])) + Mem$t[buf2] = newval + else + Mem$t[buf2] = val1 + Mem$t[buf1] = 0. + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + if (j != nl) + break + } + } + } + + call mfree (buf, TY_PIXEL) +end + + +# AREP -- Replace array values which are between floor and ceil by value. + +procedure arep$t (a, npts, floor, ceil, newval) + +PIXEL a[npts] # Input arrays +int npts # Number of points +PIXEL floor, ceil # Replacement limits +PIXEL newval # Replacement value + +int i +$if (datatype == x) +real abs_floor +real abs_ceil +$endif + +begin + $if (datatype == x) + abs_floor = abs (floor) + abs_ceil = abs (ceil) + $endif + + do i = 1, npts { + $if (datatype == x) + if ((abs (a[i]) >= abs_floor) && (abs (a[i]) <= abs_ceil)) + $else + if ((a[i] >= floor) && (a[i] <= ceil)) + $endif + a[i] = newval + } +end + + +# ARLE -- If A[i] is less than or equal to FLOOR replace by NEWVAL. + +procedure arle$t (a, npts, floor, newval) + +PIXEL a[npts] +int npts +PIXEL floor, newval + +int i +$if (datatype == x) +real abs_floor +$endif + +begin + $if (datatype == x) + abs_floor = abs (floor) + $endif + + do i = 1, npts + $if (datatype == x) + if (abs (a[i]) <= abs_floor) + $else + if (a[i] <= floor) + $endif + a[i] = newval +end + + +# ARGE -- If A[i] is greater than or equal to CEIL replace by NEWVAL. + +procedure arge$t (a, npts, ceil, newval) + +PIXEL a[npts] +int npts +PIXEL ceil, newval + +int i +$if (datatype == x) +real abs_ceil +$endif + +begin + $if (datatype == x) + abs_ceil = abs (ceil) + $endif + + do i = 1, npts + $if (datatype == x) + if (abs (a[i]) >= abs_ceil) + $else + if (a[i] >= ceil) + $endif + a[i] = newval +end + +$endfor diff --git a/pkg/images/imutil/src/imstat.h b/pkg/images/imutil/src/imstat.h new file mode 100644 index 00000000..b059bc31 --- /dev/null +++ b/pkg/images/imutil/src/imstat.h @@ -0,0 +1,62 @@ +# Header file for the IMSTATISTTICS task. + +define LEN_IMSTAT 20 + +define IST_SUMX Memd[P2D($1)] +define IST_SUMX2 Memd[P2D($1+2)] +define IST_SUMX3 Memd[P2D($1+4)] +define IST_SUMX4 Memd[P2D($1+6)] +define IST_LO Memr[P2R($1+8)] +define IST_HI Memr[P2R($1+9)] +define IST_MIN Memr[P2R($1+10)] +define IST_MAX Memr[P2R($1+11)] +define IST_MEAN Memr[P2R($1+12)] +define IST_MEDIAN Memr[P2R($1+13)] +define IST_MODE Memr[P2R($1+14)] +define IST_STDDEV Memr[P2R($1+15)] +define IST_SKEW Memr[P2R($1+16)] +define IST_KURTOSIS Memr[P2R($1+17)] +define IST_NPIX Memi[$1+18] +define IST_SW Memi[$1+19] + +define LEN_NSWITCHES 8 + +define IST_SKURTOSIS Memi[$1] +define IST_SSKEW Memi[$1+1] +define IST_SSTDDEV Memi[$1+2] +define IST_SMODE Memi[$1+3] +define IST_SMEDIAN Memi[$1+4] +define IST_SMEAN Memi[$1+5] +define IST_SMINMAX Memi[$1+6] +define IST_SNPIX Memi[$1+7] + +define IST_FIELDS "|image|npix|min|max|mean|midpt|mode|stddev|skew|kurtosis|" + +define IST_NFIELDS 10 + +define IST_KIMAGE "IMAGE" +define IST_KNPIX "NPIX" +define IST_KMIN "MIN" +define IST_KMAX "MAX" +define IST_KMEAN "MEAN" +define IST_KMEDIAN "MIDPT" +define IST_KMODE "MODE" +define IST_KSTDDEV "STDDEV" +define IST_KSKEW "SKEW" +define IST_KKURTOSIS "KURTOSIS" + +define IST_FIMAGE 1 +define IST_FNPIX 2 +define IST_FMIN 3 +define IST_FMAX 4 +define IST_FMEAN 5 +define IST_FMEDIAN 6 +define IST_FMODE 7 +define IST_FSTDDEV 8 +define IST_FSKEW 9 +define IST_FKURTOSIS 10 + +define IST_FCOLUMN "%10d" +define IST_FINTEGER "%10d" +define IST_FREAL "%10.4g" +define IST_FSTRING "%20s" diff --git a/pkg/images/imutil/src/imsum.gx b/pkg/images/imutil/src/imsum.gx new file mode 100644 index 00000000..31afc420 --- /dev/null +++ b/pkg/images/imutil/src/imsum.gx @@ -0,0 +1,398 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../imsum.h" + +define TMINSW 1.00 # Relative timings for nvecs = 5 +define TMXMNSW 1.46 +define TMED3 0.18 +define TMED5 0.55 + +# IMSUM -- Sum or average images with optional high and low pixel rejection. +# +# This procedure has to be clever in not exceeding the maximum number of images +# which can be mapped at one time. If no pixels are being rejected then the +# images can be summed (or averaged) in blocks using the output image to hold +# intermediate results. If pixels are being rejected then lines from all +# images must be obtained. If the number of images exceeds the maximum +# then only a subset of the images are kept mapped and the remainder are +# mapped and unmapped for each line. This, of course, is inefficient but +# there is no other way. + +$for(silrd) +procedure imsum$t (list, output, im_out, nlow, nhigh, option) + +int list # List of input images +char output[ARB] # Output image +pointer im_out # Output image pointer +int nlow # Number of low pixels to reject +int nhigh # Number of high pixels to reject +char option[ARB] # Output option + +int i, n, nimages, naccept, npix, ndone, pass +PIXEL const +pointer sp, input, v1, v2, im, buf, buf1, buf_in, buf_out + +bool streq() +int imtlen(), imtgetim(), imtrgetim() +pointer immap(), imgnl$t(), impnl$t() +errchk immap, imunmap, imgnl$t, impnl$t + +begin + # Initialize. + nimages = imtlen (list) + naccept = nimages - nlow - nhigh + const = naccept + npix = IM_LEN(im_out, 1) + if (naccept < 1) + call error (0, "Number of rejected pixels is too large") + + # Allocate memory. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (im, nimages, TY_INT) + + # If there are no pixels to be rejected avoid calls to reject pixels + # and do the operation in blocks so that the number of images mapped + # does not exceed the maximum. The output image is used to + # store intermediate results. + + if ((nlow == 0) && (nhigh == 0)) { + pass = 0 + ndone = 0 + repeat { + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX) + break + } + ndone = ndone + n + + pass = pass + 1 + if (pass > 1) { + call imunmap (im_out) + im_out = immap (output, READ_WRITE, 0) + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # For each input line compute an output line. + while (impnl$t (im_out, buf_out, Meml[v2]) != EOF) { + + # Clear the output buffer during the first pass and + # read in the partial sum from the output image during + # subsequent passes. + + if (pass == 1) + call aclr$t (Mem$t[buf_out], npix) + else { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnl$t (im_out, buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call amov$t (Mem$t[buf_in], Mem$t[buf_out], npix) + } + + # Accumulate lines from each input image. + do i = 1, n { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnl$t (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + call aadd$t (Mem$t[buf_in], Mem$t[buf_out], + Mem$t[buf_out], npix) + } + + # If all images have been accumulated and averaging then + # divide by the number of images. + if ((ndone == nimages) && streq (option, "average")) + call adivk$t (Mem$t[buf_out], const, Mem$t[buf_out], + npix) + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + do i = 1, n + call imunmap (Memi[im+i-1]) + } until (ndone == nimages) + + # Finish up. + call sfree (sp) + return + } + + + # Map the input images up to the maximum allowed. The remainder + # will be mapped during each line. + n = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + n = n + 1 + if (n == IMS_MAX - 1) + break + } + + # Allocate additional buffer space. + call salloc (buf, nimages, TY_INT) + if (nimages - n > 0) + call salloc (buf1, (nimages-n)*npix, TY_PIXEL) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + + # Compute output lines for each input line. + while (impnl$t (im_out, buf_out, Meml[v2]) != EOF) { + + # Read lines from the images which remain open. + for (i = 1; i <= n; i = i + 1) { + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnl$t (Memi[im+i-1], Memi[buf+i-1], Meml[v2]) == EOF) + call error (0, "Error reading input image") + } + + # For all additional images map the image, read a line, copy the + # data to a buffer since the image buffer is reused, and unmap + # the image. + for (; i <= nimages; i = i + 1) { + if (imtrgetim (list, i, Memc[input], SZ_FNAME) == EOF) + break + Memi[im+i-1] = immap (Memc[input], READ_ONLY, 0) + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + if (imgnl$t (Memi[im+i-1], buf_in, Meml[v2]) == EOF) + call error (0, "Error reading input image") + Memi[buf+i-1] = buf1 + (i - n - 1) * npix + call amov$t (Mem$t[buf_in], Mem$t[Memi[buf+i-1]], npix) + call imunmap (Memi[im+i-1]) + } + + # Reject pixels. + call imrej$t (Memi[buf], nimages, Mem$t[buf_out], npix, nlow, nhigh) + + # If averaging divide the sum by the number of images averaged. + if ((naccept > 1) && streq (option, "average")) { + const = naccept + call adivk$t (Mem$t[buf_out], const, Mem$t[buf_out], npix) + } + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Finish up. + do i = 1, n + call imunmap (Memi[im+i-1]) + call sfree (sp) +end + + +# IMREJ -- Reject the number of high and low points and sum the rest. + +procedure imrej$t (a, nvecs, b, npts, nlow, nhigh) + +pointer a[nvecs] # Pointers to set of vectors +int nvecs # Number of vectors +PIXEL b[npts] # Output vector +int npts # Number of points in the vectors +int nlow # Number of low points to be rejected +int nhigh # Number of high points to be rejected + +int i, j +int naccept, minrej, npairs, nlow1, nhigh1 +real tmedian, time1, time2 + +begin + naccept = nvecs - nlow - nhigh + + # If no points are rejected return the sum. + + if (naccept == nvecs) { + call amov$t (Mem$t[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aadd$t (Mem$t[a[j]], b, b, npts) + return + } + + minrej = min (nlow, nhigh) + npairs = minrej + nlow1 = nlow - npairs + nhigh1 = nhigh - npairs + + if ((naccept == 1) && (npairs > 0)) { + if (npairs == 1) { + tmedian = TMED3 + npairs = npairs - 1 + } else { + tmedian = TMED5 + npairs = npairs - 2 + } + } else + tmedian = 0 + + # Compare the time required to reject the minimum number + # of low or high points and extract the number of points to accept + # with the time to reject pairs and the excess number of low or + # high points to either reach a median of 3 or 5 points or isolate + # the acceptable points. + + time1 = TMINSW * (minrej + naccept) + time2 = tmedian + TMXMNSW * npairs + TMINSW * (nlow1 + nhigh1) + + i = nvecs + if (time1 < time2) { + + # Sort the nlow and naccept points + if (nlow < nhigh) { + for (j = 1; j <= nlow + naccept; j = j + 1) { + call minsw$t (a, i, npts) + i = i - 1 + } + call amov$t (Mem$t[a[nhigh+1]], b, npts) + for (j = nhigh+2; j <= nhigh+naccept; j = j + 1) + call aadd$t (Mem$t[a[j]], b, b, npts) + + # Sort the nhigh and naccept points + } else { + for (j = 1; j <= nhigh + naccept; j = j + 1) { + call maxsw$t (a, i, npts) + i = i - 1 + } + call amov$t (Mem$t[a[nlow+1]], b, npts) + for (j = nlow+2; j <= nlow+naccept; j = j + 1) + call aadd$t (Mem$t[a[j]], b, b, npts) + } + + } else { + # Reject the npairs low and high points. + for (j = 1; j <= npairs; j = j + 1) { + call mxmnsw$t (a, i, npts) + i = i - 2 + } + # Reject the excess low points. + for (j = 1; j <= nlow1; j = j + 1) { + call minsw$t (a, i, npts) + i = i - 1 + } + # Reject the excess high points. + for (j = 1; j <= nhigh1; j = j + 1) { + call maxsw$t (a, i, npts) + i = i - 1 + } + + # Check if the remaining points constitute a 3 or 5 point median + # or the set of desired points. + if (tmedian == 0.) { + call amov$t (Mem$t[a[1]], b, npts) + for (j = 2; j <= naccept; j = j + 1) + call aadd$t (Mem$t[a[j]], b, b, npts) + } else if (tmedian == TMED3) { + call amed3$t (Mem$t[a[1]], Mem$t[a[2]], Mem$t[a[3]], b, npts) + } else { + call amed5$t (Mem$t[a[1]], Mem$t[a[2]], Mem$t[a[3]], + Mem$t[a[4]], Mem$t[a[5]], b, npts) + } + } +end + + +# MINSW -- Given an array of vector pointers for each element in the vectors +# swap the minimum element with that of the last vector. + +procedure minsw$t (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmin +PIXEL temp + +begin + do i = 0, npts - 1 { + kmin = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Mem$t[k] < Mem$t[kmin]) + kmin = k + } + if (k != kmin) { + temp = Mem$t[k] + Mem$t[k] = Mem$t[kmin] + Mem$t[kmin] = temp + } + } +end + + +# MAXSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector. + +procedure maxsw$t (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax +PIXEL temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + do j = 2, nvecs { + k = a[j] + i + if (Mem$t[k] > Mem$t[kmax]) + kmax = k + } + if (k != kmax) { + temp = Mem$t[k] + Mem$t[k] = Mem$t[kmax] + Mem$t[kmax] = temp + } + } +end + + +# MXMNSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector and the minimum element +# with that of the next to last vector. The number of vectors must be greater +# than 1. + +procedure mxmnsw$t (a, nvecs, npts) + +pointer a[nvecs] # Array of vector pointers +int nvecs # Number of vectors +int npts # Number of points in the vectors + +int i, j, k, kmax, kmin +PIXEL temp + +begin + do i = 0, npts - 1 { + kmax = a[1] + i + kmin = kmax + do j = 2, nvecs { + k = a[j] + i + if (Mem$t[k] > Mem$t[kmax]) + kmax = k + else if (Mem$t[k] < Mem$t[kmin]) + kmin = k + } + temp = Mem$t[k] + Mem$t[k] = Mem$t[kmax] + Mem$t[kmax] = temp + if (kmin == k) { + j = a[nvecs - 1] + i + temp = Mem$t[j] + Mem$t[j] = Mem$t[kmax] + Mem$t[kmax] = temp + } else { + j = a[nvecs - 1] + i + temp = Mem$t[j] + Mem$t[j] = Mem$t[kmin] + Mem$t[kmin] = temp + } + } +end +$endfor diff --git a/pkg/images/imutil/src/imsum.h b/pkg/images/imutil/src/imsum.h new file mode 100644 index 00000000..190d277c --- /dev/null +++ b/pkg/images/imutil/src/imsum.h @@ -0,0 +1,4 @@ +# Definitions for IMSUM + +define IMS_MAX 15 # Maximum number of images which are mapped + # at the same time. diff --git a/pkg/images/imutil/src/imtile.h b/pkg/images/imutil/src/imtile.h new file mode 100644 index 00000000..a2610860 --- /dev/null +++ b/pkg/images/imutil/src/imtile.h @@ -0,0 +1,55 @@ +# Header file for the IMTILE task. + +# Define the structure + +define LEN_IRSTRUCT 35 + +define IT_NCOLS Memi[$1] # x length of single subraster +define IT_NROWS Memi[$1+1] # y length of a single subrasters +define IT_NXOVERLAP Memi[$1+2] # x overlap between subrasters +define IT_NYOVERLAP Memi[$1+3] # y overlap between subrasters +define IT_NXSUB Memi[$1+4] # number of subrasters in x dimension +define IT_NYSUB Memi[$1+5] # number of subrasters in y dimension +define IT_NXRSUB Memi[$1+6] # x index of reference subraster +define IT_NYRSUB Memi[$1+7] # y index of reference subraster +define IT_XREF Memi[$1+8] # x offset of reference subraster +define IT_YREF Memi[$1+9] # y offset of reference subraster +define IT_CORNER Memi[$1+10] # starting corner for insertion +define IT_ORDER Memi[$1+11] # row or column insertion +define IT_RASTER Memi[$1+12] # raster order +define IT_OVAL Memr[P2R($1+13)] # undefined value + +define IT_IC1 Memi[$1+14] # input image lower column limit +define IT_IC2 Memi[$1+15] # input image upper column limit +define IT_IL1 Memi[$1+16] # input image lower line limit +define IT_IL2 Memi[$1+17] # input image upper line limit +define IT_OC1 Memi[$1+18] # output image lower column limit +define IT_OC2 Memi[$1+19] # output image upper column limit +define IT_OL1 Memi[$1+20] # output image lower line limit +define IT_OL2 Memi[$1+21] # output image upper line limit +define IT_DELTAX Memi[$1+22] # x shifts +define IT_DELTAY Memi[$1+23] # y shifts +define IT_DELTAI Memi[$1+24] # intensity shifts + +define IT_XRSHIFTS Memi[$1+25] # x row links +define IT_YRSHIFTS Memi[$1+26] # y row links +define IT_NRSHIFTS Memi[$1+27] # number of row links +define IT_XCSHIFTS Memi[$1+28] # x column links +define IT_YCSHIFTS Memi[$1+29] # y column links +define IT_NCSHIFTS Memi[$1+30] # number of column links + +# Define some useful constants + +define IT_LL 1 +define IT_LR 2 +define IT_UL 3 +define IT_UR 4 + +define IT_ROW 1 +define IT_COLUMN 2 + +define IT_COORDS 1 +define IT_SHIFTS 2 +define IT_FILE 3 + +define MAX_NRANGES 100 diff --git a/pkg/images/imutil/src/listpixels.x b/pkg/images/imutil/src/listpixels.x new file mode 100644 index 00000000..e4435c95 --- /dev/null +++ b/pkg/images/imutil/src/listpixels.x @@ -0,0 +1,216 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <mwset.h> + +# LISTPIXELS -- Convert image pixels into a text stream, i.e., into a list. +# Each pixel is printed on a separate line, preceded by its coordinates. +# The images or image sections may be of any dimension. + +procedure t_listpixels() + +bool verbose +char image[SZ_FNAME], wcs[SZ_FNAME] +double incoords[IM_MAXDIM], outcoords[IM_MAXDIM] +int i, j, npix, ndim, wcsndim, laxis1, fmtstat +int paxno[IM_MAXDIM], laxno[IM_MAXDIM] +long v[IM_MAXDIM], vcoords[IM_MAXDIM] +pointer im, line, imlist, mw, ct, fmtptrs[IM_MAXDIM] + +bool clgetb() +int imgnlr(), imgnld(), imgnlx(), imtgetim(), mw_stati(), clscan(), nscan() +pointer imtopenp(), immap(), mw_openim(), mw_sctran() + +begin + # Get the image list and the wcs. + imlist = imtopenp ("images") + call clgstr ("wcs", wcs, SZ_FNAME) + if (wcs[1] == EOS) + call strcpy ("logical", wcs, SZ_FNAME) + verbose = clgetb ("verbose") + + while (imtgetim (imlist, image, SZ_FNAME) != EOF) { + # Print optional banner string. + if (verbose) { + call printf ("\n#Image: %s Wcs: %s\n\n") + call pargstr (image) + call pargstr (wcs) + } + + # Open the input image. + im = immap (image, READ_ONLY, 0) + ndim = IM_NDIM(im) + npix = IM_LEN(im,1) + + # Get the wcs. + ifnoerr (mw = mw_openim (im)) { + # Set up the transformation. + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", wcs, 0) + wcsndim = mw_stati (mw, MW_NPHYSDIM) + + # Get the physical to logical axis map. + call mw_gaxmap (mw, paxno, laxno, wcsndim) + + # Set the default wcs. + call mw_ssytem (mw, wcs) + + } else { + # Print the error message from the above loop. + call erract (EA_WARN) + + # Set the transform to the identity transform. + mw = NULL + ct = NULL + wcsndim = ndim + + # Set the default physical to logical axis map. + do i = 1, wcsndim + paxno[i] = i + } + + # Initialize the v vectors. + call amovkl (long (1), v, IM_MAXDIM) + call amovkl (long (1), vcoords, IM_MAXDIM) + + # Initialize the coordinates. + laxis1 = 0 + do i = 1, wcsndim { + if (paxno[i] == 0) { + incoords[i] = 1 + } else if (paxno[i] == 1) { + laxis1 = i + incoords[i] = v[1] + } else { + incoords[i] = v[paxno[i]] + } + } + + # Check and correct for the no axis mapping case. + if (laxis1 == 0) { + laxis1 = 1 + do i = 1, wcsndim + paxno[i] = i + } + + # Get the logical to physical axis map for the format strings. + do i = 1, ndim { + laxno[i] = 0 + do j = 1, wcsndim { + if (paxno[j] != i) + next + laxno[i] = j + break + } + } + + # Set the format strings for the logical axes. + fmtstat = clscan ("formats") + do i = 1, ndim { + call malloc (fmtptrs[i], SZ_FNAME, TY_CHAR) + if (fmtstat != EOF) + call gargwrd (Memc[fmtptrs[i]], SZ_FNAME) + else + Memc[fmtptrs[i]] = EOS + if ((nscan() == i) && (Memc[fmtptrs[i]] != EOS)) + call strcat (" ", Memc[fmtptrs[i]], SZ_FNAME) + else if (laxno[i] == 0) + call strcpy ("%0.15g ", Memc[fmtptrs[i]], SZ_FNAME) + else if (mw == NULL || ct == NULL) + call strcpy ("%0.15g ", Memc[fmtptrs[i]], SZ_FNAME) + else iferr (call mw_gwattrs (mw, laxno[i], "format", + Memc[fmtptrs[i]], SZ_FNAME)) + call strcpy ("%0.15g ", Memc[fmtptrs[i]], SZ_FNAME) + else + call strcat (" ", Memc[fmtptrs[i]], SZ_FNAME) + } + + # Print the pixels. + switch (IM_PIXTYPE(im)) { + case TY_COMPLEX: + while (imgnlx (im, line, v) != EOF) { + do i = 1, npix { + incoords[laxis1] = i + if (ct == NULL) + call amovd (incoords, outcoords, wcsndim) + else + call mw_ctrand (ct, incoords, outcoords, wcsndim) + do j = 1, ndim { # X, Y, Z, etc. + call printf (Memc[fmtptrs[j]]) + if (laxno[j] == 0) + call pargd (double(vcoords[j])) + else + call pargd (outcoords[laxno[j]]) + } + call printf (" %z\n") # pixel value + call pargx (Memx[line+i-1]) + } + call amovl (v, vcoords, IM_MAXDIM) + do i = 1, wcsndim { + if (paxno[i] == 0) + next + incoords[i] = v[paxno[i]] + } + } + case TY_DOUBLE: + while (imgnld (im, line, v) != EOF) { + do i = 1, npix { + incoords[laxis1] = i + if (ct == NULL) + call amovd (incoords, outcoords, wcsndim) + else + call mw_ctrand (ct, incoords, outcoords, wcsndim) + do j = 1, ndim { # X, Y, Z, etc. + call printf (Memc[fmtptrs[j]]) + if (laxno[j] == 0) + call pargd (double(vcoords[j])) + else + call pargd (outcoords[laxno[j]]) + } + call printf (" %g\n") # pixel value + call pargd (Memd[line+i-1]) + } + call amovl (v, vcoords, IM_MAXDIM) + do i = 1, wcsndim { + if (paxno[i] == 0) + next + incoords[i] = v[paxno[i]] + } + } + default: + while (imgnlr (im, line, v) != EOF) { + do i = 1, npix { + incoords[laxis1] = i + if (ct == NULL) + call amovd (incoords, outcoords, wcsndim) + else + call mw_ctrand (ct, incoords, outcoords, wcsndim) + do j = 1, ndim { # X, Y, Z, etc. + call printf (Memc[fmtptrs[j]]) + if (laxno[j] == 0) + call pargd (double(vcoords[j])) + else + call pargd (outcoords[laxno[j]]) + } + call printf (" %g\n") # pixel value + call pargr (Memr[line+i-1]) + } + call amovl (v, vcoords, IM_MAXDIM) + do i = 1, wcsndim { + if (paxno[i] == 0) + next + incoords[i] = v[paxno[i]] + } + } + } + + do i = 1, ndim + call mfree (fmtptrs[i], TY_CHAR) + if (mw != NULL) + call mw_close (mw) + call imunmap (im) + } + + call imtclose (imlist) +end diff --git a/pkg/images/imutil/src/minmax.x b/pkg/images/imutil/src/minmax.x new file mode 100644 index 00000000..c3dcbfff --- /dev/null +++ b/pkg/images/imutil/src/minmax.x @@ -0,0 +1,313 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IM_VMINMAX -- Compute the minimum and maximum pixel values of an image. +# Works for images of any dimensionality, size, or datatype, although +# the min and max values can currently only be stored in the image header +# as real values. + +procedure im_vminmax (im, min_value, max_value, imin_value, imax_value, + vmin, vmax) + +pointer im # image descriptor +double min_value # minimum pixel value in image (real, out) +double max_value # maximum pixel value in image (real, out) +double imin_value # minimum pixel value in image (imag, out) +double imax_value # maximum pixel value in image (imag, out) +long vmin[ARB], vmax[ARB] # v vectors + +bool first_line +int colmin, colmax +complex xmin_value, xmax_value, minval_x, maxval_x +long v[IM_MAXDIM], ovmin[IM_MAXDIM], ovmax[IM_MAXDIM] +short minval_s, maxval_s +long minval_l, maxval_l +pointer buf +real minval_r, maxval_r +double minval_d, maxval_d +int imgnls(), imgnll(), imgnlr(), imgnld(), imgnlx() + +begin + call amovkl (long(1), v, IM_MAXDIM) # start vector + call amovkl (long(1), ovmin, IM_MAXDIM) + call amovkl (long(1), ovmax, IM_MAXDIM) + call amovkl (long(1), vmin, IM_MAXDIM) + call amovkl (long(1), vmax, IM_MAXDIM) + + first_line = true + min_value = INDEFD + max_value = INDEFD + imin_value = INDEFD + imax_value = INDEFD + + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + while (imgnls (im, buf, v) != EOF) { + call valims (Mems[buf], IM_LEN(im,1), minval_s, maxval_s, + colmin, colmax) + if (first_line) { + min_value = minval_s + max_value = maxval_s + vmin[1] = colmin + vmax[1] = colmax + first_line = false + } else { + if (minval_s < min_value) { + min_value = minval_s + vmin[1] = colmin + call amovl (ovmin[2], vmin[2], IM_NDIM(im) - 1) + } + if (maxval_s > max_value) { + max_value = maxval_s + vmax[1] = colmax + call amovl (ovmax[2], vmax[2], IM_NDIM(im) - 1) + } + } + call amovl (v[2], ovmin[2], IM_NDIM(im) - 1) + call amovl (v[2], ovmax[2], IM_NDIM(im) - 1) + } + + case TY_USHORT, TY_INT, TY_LONG: + while (imgnll (im, buf, v) != EOF) { + call valiml (Meml[buf], IM_LEN(im,1), minval_l, maxval_l, + colmin, colmax) + if (first_line) { + min_value = minval_l + max_value = maxval_l + vmin[1] = colmin + vmax[1] = colmax + first_line = false + } else { + if (minval_l < min_value) { + min_value = minval_l + vmin[1] = colmin + call amovl (ovmin[2], vmin[2], IM_NDIM(im) - 1) + } + if (maxval_l > max_value) { + max_value = maxval_l + vmax[1] = colmax + call amovl (ovmax[2], vmax[2], IM_NDIM(im) - 1) + } + } + call amovl (v[2], ovmin[2], IM_NDIM(im) - 1) + call amovl (v[2], ovmax[2], IM_NDIM(im) - 1) + } + + case TY_REAL: + while (imgnlr (im, buf, v) != EOF) { + call valimr (Memr[buf], IM_LEN(im,1), minval_r, maxval_r, + colmin, colmax) + if (first_line) { + min_value = minval_r + max_value = maxval_r + vmin[1] = colmin + vmax[1] = colmax + first_line = false + } else { + if (minval_r < min_value) { + min_value = minval_r + vmin[1] = colmin + call amovl (ovmin[2], vmin[2], IM_NDIM(im) - 1) + } + if (maxval_r > max_value) { + max_value = maxval_r + vmax[1] = colmax + call amovl (ovmax[2], vmax[2], IM_NDIM(im) - 1) + } + } + call amovl (v[2], ovmin[2], IM_NDIM(im) - 1) + call amovl (v[2], ovmax[2], IM_NDIM(im) - 1) + } + + case TY_DOUBLE: + while (imgnld (im, buf, v) != EOF) { + call valimd (Memd[buf], IM_LEN(im,1), minval_d, maxval_d, + colmin, colmax) + if (first_line) { + min_value = minval_d + max_value = maxval_d + vmin[1] = colmin + vmax[1] = colmax + first_line = false + } else { + if (minval_d < min_value) { + min_value = minval_d + vmin[1] = colmin + call amovl (ovmin[2], vmin[2], IM_NDIM(im) - 1) + } + if (maxval_d > max_value) { + max_value = maxval_d + vmax[1] = colmax + call amovl (ovmax[2], vmax[2], IM_NDIM(im) - 1) + } + } + call amovl (v[2], ovmin[2], IM_NDIM(im) - 1) + call amovl (v[2], ovmax[2], IM_NDIM(im) - 1) + } + + case TY_COMPLEX: + while (imgnlx (im, buf, v) != EOF) { + call valimx (Memx[buf], IM_LEN(im,1), minval_x, maxval_x, + colmin, colmax) + if (first_line) { + xmin_value = minval_x + xmax_value = maxval_x + vmin[1] = colmin + vmax[1] = colmax + first_line = false + } else { + if (abs (minval_x) < abs (xmin_value)) { + xmin_value = minval_x + vmin[1] = colmin + call amovl (ovmin[2], vmin[2], IM_NDIM(im) - 1) + } + if (abs (maxval_x) > abs (xmax_value)) { + xmax_value = maxval_x + vmax[1] = colmax + call amovl (ovmax[2], vmax[2], IM_NDIM(im) - 1) + } + } + call amovl (v[2], ovmin[2], IM_NDIM(im) - 1) + call amovl (v[2], ovmax[2], IM_NDIM(im) - 1) + } + + min_value = real (xmin_value) + max_value = real (xmax_value) + imin_value = aimag (xmin_value) + imax_value = aimag (xmax_value) + + default: + call error (0, "Unknown pixel data type") + } +end + + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure valims (a, npix, minval_s, maxval_s, colmin, colmax) + +short a[ARB], minval_s, maxval_s, value +int colmin, colmax, npix, i + +begin + minval_s = a[1] + maxval_s = a[1] + colmin = 1 + colmax = 1 + + do i = 1, npix { + value = a[i] + if (value < minval_s) { + minval_s = value + colmin = i + } else if (value > maxval_s) { + maxval_s = value + colmax = i + } + } +end + + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure valiml (a, npix, minval_l, maxval_l, colmin, colmax) + +long a[ARB], minval_l, maxval_l, value +int colmin, colmax, npix, i + +begin + minval_l = a[1] + maxval_l = a[1] + colmin = 1 + colmax = 1 + + do i = 1, npix { + value = a[i] + if (value < minval_l) { + minval_l = value + colmin = i + } else if (value > maxval_l) { + maxval_l = value + colmax = i + } + } +end + + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure valimr (a, npix, minval_r, maxval_r, colmin, colmax) + +real a[ARB], minval_r, maxval_r, value +int colmin, colmax, npix, i + +begin + minval_r = a[1] + maxval_r = a[1] + colmin = 1 + colmax = 1 + + do i = 1, npix { + value = a[i] + if (value < minval_r) { + minval_r = value + colmin = i + } else if (value > maxval_r) { + maxval_r = value + colmax = i + } + } +end + + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure valimd (a, npix, minval_d, maxval_d, colmin, colmax) + +double a[ARB], minval_d, maxval_d, value +int colmin, colmax, npix, i + +begin + minval_d = a[1] + maxval_d = a[1] + colmin = 1 + colmax = 1 + + do i = 1, npix { + value = a[i] + if (value < minval_d) { + minval_d = value + colmin = i + } else if (value > maxval_d) { + maxval_d = value + colmax = i + } + } +end + + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure valimx (a, npix, minval_x, maxval_x, colmin, colmax) + +complex a[ARB], minval_x, maxval_x, value +int colmin, colmax, npix, i + +begin + minval_x = a[1] + maxval_x = a[1] + colmin = 1 + colmax = 1 + + do i = 1, npix { + value = a[i] + if (abs (value) < abs (minval_x)) { + minval_x = value + colmin = i + } else if (abs (value) > abs (maxval_x)) { + maxval_x = value + colmax = i + } + } +end diff --git a/pkg/images/imutil/src/mkpkg b/pkg/images/imutil/src/mkpkg new file mode 100644 index 00000000..7fdbfbb3 --- /dev/null +++ b/pkg/images/imutil/src/mkpkg @@ -0,0 +1,81 @@ +# Library for making the IMUTIL tasks + +$checkout libpkg.a ../../ +$update libpkg.a +$checkin libpkg.a ../../ +$exit + +generic: + $set GEN = "$$generic -k" + + $ifolder (imexpr.x, imexpr.gx) + $(GEN) imexpr.gx -o imexpr.x $endif + + $ifolder (generic/imfuncs.x, imfuncs.gx) + $(GEN) imfuncs.gx -o generic/imfuncs.x $endif + + $ifolder (generic/imjoin.x, imjoin.gx) + $(GEN) imjoin.gx -o generic/imjoin.x $endif + + $ifolder (generic/imrep.x, imrep.gx) + $(GEN) imrep.gx -o generic/imrep.x $endif + + $ifolder (generic/imsum.x, imsum.gx) + $(GEN) imsum.gx -o generic/imsum.x $endif + + $ifolder (generic/imaadd.x, imaadd.gx) + $(GEN) imaadd.gx -o generic/imaadd.x $endif + $ifolder (generic/imadiv.x, imadiv.gx) + $(GEN) imadiv.gx -o generic/imadiv.x $endif + $ifolder (generic/imamax.x, imamax.gx) + $(GEN) imamax.gx -o generic/imamax.x $endif + $ifolder (generic/imamin.x, imamin.gx) + $(GEN) imamin.gx -o generic/imamin.x $endif + $ifolder (generic/imamul.x, imamul.gx) + $(GEN) imamul.gx -o generic/imamul.x $endif + $ifolder (generic/imasub.x, imasub.gx) + $(GEN) imasub.gx -o generic/imasub.x $endif + $ifolder (generic/imanl.x, imanl.gx) + $(GEN) imanl.gx -o generic/imanl.x $endif + + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call generic $endif + + @generic + + getcmd.x <error.h> <ctotok.h> <lexnum.h> + gettok.x <error.h> <ctype.h> <fset.h> gettok.h <syserr.h> + hedit.x <error.h> <evexpr.h> <imset.h> <ctype.h> <lexnum.h> + imdelete.x <imhdr.h> <error.h> + imexpr.x <ctotok.h> <imhdr.h> <ctype.h> <mach.h> <imset.h>\ + <fset.h> <lexnum.h> <evvexpr.h> gettok.h + iegsym.x <ctotok.h> <imhdr.h> <ctype.h> <mach.h> <imset.h>\ + <fset.h> <lexnum.h> <evvexpr.h> gettok.h + imfunction.x <imhdr.h> + imgets.x <imhdr.h> <error.h> <ctype.h> + imheader.x <imhdr.h> <imio.h> <time.h> <ctype.h> <error.h>\ + <imset.h> + imhistogram.x <mach.h> <imhdr.h> <gset.h> + imminmax.x <imhdr.h> + listpixels.x <error.h> <imhdr.h> <mwset.h> + minmax.x <imhdr.h> + nhedit.x <ctype.h> <error.h> <evexpr.h> <imset.h> <lexnum.h> + t_imstat.x <mach.h> <imhdr.h> <imset.h> "imstat.h" + t_sections.x + hselect.x <error.h> <evexpr.h> <ctype.h> + t_imarith.x <imhdr.h> <error.h> <lexnum.h> + t_imaxes.x <imhdr.h> + t_chpix.x <error.h> <imhdr.h> <fset.h> + t_imcopy.x <imhdr.h> + t_imdivide.x <imhdr.h> + t_imjoin.x <syserr.h> <error.h> <imhdr.h> + t_imrename.x <imhdr.h> + t_imreplace.x <imhdr.h> + t_imslice.x <error.h> <imhdr.h> <ctype.h> <mwset.h> + t_imsum.x <imhdr.h> + t_imstack.x <imhdr.h> <mwset.h> + t_imtile.x <imhdr.h> <fset.h> "imtile.h" + t_minmax.x <error.h> <imhdr.h> <imset.h> + ; diff --git a/pkg/images/imutil/src/nhedit.x b/pkg/images/imutil/src/nhedit.x new file mode 100644 index 00000000..1e9300c1 --- /dev/null +++ b/pkg/images/imutil/src/nhedit.x @@ -0,0 +1,1101 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <evexpr.h> +include <imset.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 HRECLEN 80 + +define OP_EDIT 1 # hedit opcodes +define OP_INIT 2 +define OP_ADD 3 +define OP_DELETE 4 +define OP_DEFPAR 5 +define OP_RENAME 6 +define BEFORE 1 +define AFTER 2 + + +# NHEDIT -- Edit or view selected fields of an image header or headers. This +# editor performs a single edit operation upon a relation, e.g., upon a set +# of fields of a set of images. Templates and expressions may be used to +# automatically select the images and fields to be edited, and to compute +# the new value of each field. + +procedure t_nhedit() + +pointer fields # template listing fields to be processed +pointer valexpr # the value expression (if op=edit|add) + +bool noupdate, quit +int imlist, nfields, up, min_lenuserarea +pointer sp, field, comment, sections, im, ip, image, buf +pointer cmd, pkey +int operation, verify, show, update, fd, baf +int dp_oper, dp_update, dp_verify, dp_show + +pointer immap() +bool streq() +int imtopenp(), imtgetim(), getline(), nowhite() +int envfind(), ctoi(), open() + +begin + call smark (sp) + call salloc (buf, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (field, SZ_FNAME, TY_CHAR) + call salloc (fields, SZ_FNAME, TY_CHAR) + call salloc (pkey, SZ_FNAME, TY_CHAR) + call salloc (valexpr, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + call salloc (sections, SZ_FNAME, TY_CHAR) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Get the primary operands. + imlist = imtopenp ("images") + + # Determine type of operation to be performed (default is edit). + + # Do we have a command file instead of a command line? Allow either + # a null string or the string "NULL" to indicate we don't. + + call clgstr ("comfile", Memc[fields], SZ_LINE) + if (nowhite (Memc[fields], Memc[fields], SZ_LINE) == 0 || + streq (Memc[fields], "NULL")) { + call he_getpars (operation, fields, valexpr, Memc[comment], + Memc[pkey], baf, update, verify, show) + fd = 0 + } else { + call he_getpars (dp_oper, NULL, valexpr, Memc[comment], + Memc[pkey], baf, dp_update, dp_verify, dp_show) + fd = open(Memc[fields], READ_ONLY, TEXT_FILE) + } + + # Main processing loop. An image is processed in each pass through + # the loop. + + while (imtgetim (imlist, Memc[image], SZ_FNAME) != EOF) { + + # set the length of the user area + if (envfind ("min_lenuserarea", Memc[sections], SZ_FNAME) > 0) { + up = 1 + if (ctoi (Memc[sections], up, min_lenuserarea) <= 0) + min_lenuserarea = LEN_USERAREA + else + min_lenuserarea = max (LEN_USERAREA, min_lenuserarea) + } else + min_lenuserarea = LEN_USERAREA + + # Open the image. + iferr { + if (update == YES || fd != 0) + im = immap (Memc[image], READ_WRITE, min_lenuserarea) + else + im = immap (Memc[image], READ_ONLY, min_lenuserarea) + } then { + call erract (EA_WARN) + next + } + + if (fd != 0) { + # Open the command file and start processing each line. + # rewind file before proceeding + + call seek(fd, BOF) + while (getline(fd, Memc[cmd]) != EOF) { + for (ip=cmd; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[cmd] == '#' || Memc[ip] == '\n') + next + + call he_getcmdf (Memc[cmd], operation, Memc[fields], + Memc[valexpr], Memc[comment], Memc[pkey], baf, + update, verify, show) + + # Set the default parameters for the command file. + if (operation < 0) { + dp_oper = -operation + if (update != -1) + dp_update = update + if (verify != -1) + dp_verify = verify + if (show != -1) + dp_show = show + next + } + + # Set the parameters for the current command, the + # command parameters take precedence over the defaults. + call nh_setpar (operation, dp_oper, dp_update, + dp_verify, dp_show, update, verify, show) + + iferr (call nh_edit (im, Memc[image], operation, + Memc[fields], Memc[valexpr], Memc[comment], + Memc[pkey], baf, update, verify, show, nfields)) + call erract (EA_WARN) + + } + + } else + iferr (call nh_edit (im, Memc[image], operation, Memc[fields], + Memc[valexpr], Memc[comment], Memc[pkey], baf, update, + verify, show, nfields)) + call erract (EA_WARN) + + # Update the image header and unmap the image. + + noupdate = false + quit = false + + if (update == YES) { + if (nfields == 0 && fd == 0) + noupdate = true + else if (verify == YES) { + call eprintf ("update %s ? (yes): ") + call pargstr (Memc[image]) + call flush (STDERR) + + if (getline (STDIN, Memc[buf]) == EOF) + noupdate = true + else { + # Strip leading whitespace and trailing newline. + for (ip=buf; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == 'q') { + quit = true + noupdate = true + } else if (! (Memc[ip] == '\n' || Memc[ip] == 'y')) + noupdate = true + } + } + + if (noupdate) { + call imseti (im, IM_WHEADER, NO) + call imunmap (im) + } else { + call imunmap (im) + if (show == YES) { + call printf ("%s updated\n") + call pargstr (Memc[image]) + } + } + } else { + call imunmap (im) + } + + call flush (STDOUT) + if (quit) + break + } #end of while + + # Close command file + if (fd != 0) + call close(fd) + call imtclose (imlist) + call sfree (sp) +end + + +# NH_EDIT -- Edit the field in the image header. + +procedure nh_edit (im, image, operation, keyws, exprs, comment, pkey, baf, + update, verify, show, nfields) + +pointer im #I image descriptor +char image[ARB] # +int operation #I operation code +char keyws[ARB] # Memc[fields] +char exprs[ARB] # Memc[valexpr] +char comment[ARB] # Memc[comment] +char pkey[ARB] # +int baf +int update +int verify +int show +int nfields + +pointer sp, field +int imgnfn(), imofnlu() +int flist + +begin + + call smark(sp) + call salloc (field, SZ_FNAME, TY_CHAR) + + if (operation == OP_INIT || operation == OP_ADD) { + # Add a field to the image header. This cannot be done within + # the IMGNFN loop because template expansion on the existing + # fields of the image header would discard the new field name + # since it does not yet exist. + + nfields = 1 + call he_getopsetimage (im, image, keyws) + switch (operation) { + case OP_INIT: + call nh_initfield (im, image, keyws, exprs, comment, + pkey, baf, verify, show, update) + case OP_ADD: + call nh_addfield (im, image, keyws, exprs, comment, + pkey, baf, verify, show, update) + } + } else { + # Open list of fields to be processed. + flist = imofnlu (im, keyws) + nfields = 0 + while (imgnfn (flist, Memc[field], SZ_FNAME) != EOF) { + call he_getopsetimage (im, image, Memc[field]) + + switch (operation) { + case OP_EDIT: + call nh_editfield (im, image, Memc[field], + exprs, comment, verify, show, update) + case OP_RENAME: + call nh_renamefield (im, image, Memc[field], + exprs, verify, show, update) + case OP_DELETE: + call nh_deletefield (im, image, Memc[field], + exprs, verify, show, update) + } + nfields = nfields + 1 + } + + call imcfnl (flist) + } + call sfree(sp) +end + + +# NH_EDITFIELD -- Edit the value of the named field of the indicated image. +# The value expression is evaluated, interactively inspected if desired, +# and the resulting value put to the image. + +procedure nh_editfield (im, image, field, valexpr, comment, verify, + show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # value expression +char comment[ARB] # keyword comment +int verify # verify new value interactively +int show # print record of edit +int update # enable updating of the image + +int goahead, nl +pointer sp, ip, oldval, newval, defval, o, fcomm, ncomm + +bool streq() +pointer evexpr() +extern he_getop() +int getline(), imaccf(), strldxs(), locpr() +errchk evexpr, getline, imaccf, he_gval + +begin + call smark (sp) + call salloc (oldval, SZ_LINE, TY_CHAR) + call salloc (newval, SZ_LINE, TY_CHAR) + call salloc (defval, SZ_LINE, TY_CHAR) + call salloc (fcomm, HRECLEN, TY_CHAR) + call salloc (ncomm, HRECLEN, TY_CHAR) + + call strcpy (comment, Memc[ncomm], HRECLEN) + + # Verify that the named field exists before going any further. + if (field[1] != '$') + if (imaccf (im, field) == NO) { + call eprintf ("parameter %s,%s not found\n") + call pargstr (image) + call pargstr (field) + call sfree (sp) + return + } + + # Get the old value. + call he_gval (im, image, field, Memc[oldval], SZ_LINE) + + # Evaluate the expression. Encode the result operand as a string. + # If the expression is not parenthesized, assume that is is already + # a string literal. + + if (valexpr[1] == '(') { + o = evexpr (valexpr, locpr (he_getop), 0) + call he_encodeop (o, Memc[newval], SZ_LINE) + call xev_freeop (o) + call mfree (o, TY_STRUCT) + } else + call strcpy (valexpr, Memc[newval], SZ_LINE) + + call imgcom (im, field, Memc[fcomm]) + if (streq (Memc[newval], ".") && streq (comment, ".")) { + # Merely print the value of the field. + + if (Memc[fcomm] == EOS) { + call printf ("%s,%s = %s\n") + call pargstr (image) + call pargstr (field) + call he_pargstr (Memc[oldval]) + } else { + call strcpy (Memc[oldval], Memc[newval], SZ_LINE) + call printf ("%s,%s = %s / %s\n") + call pargstr (image) + call pargstr (field) + call he_pargstr (Memc[oldval]) + call pargstr(Memc[fcomm]) + } + + } else if (verify == YES) { + # Query for new value and edit the field. If the response is a + # blank line, use the default new value. If the response is "$" + # or EOF, do not change the value of the parameter. + + if (streq (Memc[newval], ".")) { + call strcpy (Memc[oldval], Memc[newval], SZ_LINE) + } + if (streq (comment, ".")) + call strcpy (Memc[fcomm], Memc[ncomm], SZ_LINE) + call strcpy (Memc[newval], Memc[defval], SZ_LINE) + call eprintf ("%s,%s (%s -> %s): ") + call pargstr (image) + call pargstr (field) + call nh_pargstrc (Memc[oldval], Memc[fcomm]) + call nh_pargstrc (Memc[defval], Memc[ncomm]) + call flush (STDERR) + + if (getline (STDIN, Memc[newval]) != EOF) { + # Do not skip leading whitespace; may be significant in a + # string literal. + + ip = newval + + # Do strip trailing newline since it is an artifact of getline. + nl = strldxs ("\n", Memc[ip]) + if (nl > 0) + Memc[ip+nl-1] = EOS + + # Decode user response. + if (Memc[ip] == '\\') { + ip = ip + 1 + goahead = YES + } else if (streq(Memc[ip],"n") || streq(Memc[ip],"no")) { + goahead = NO + } else if (streq(Memc[ip],"y") || streq(Memc[ip],"yes") || + Memc[ip] == EOS) { + call strcpy (Memc[defval], Memc[newval], SZ_LINE) + goahead = YES + } else { + if (ip > newval) + call strcpy (Memc[ip], Memc[newval], SZ_LINE) + goahead = YES + } + + # Edit field if so indicated. + if (goahead == YES && update == YES) + call nh_updatefield (im, image, field, Memc[oldval], + Memc[newval], Memc[fcomm], Memc[ncomm], show) + + call flush (STDOUT) + } + + } else { + if (streq (Memc[newval], ".")) { + call strcpy (Memc[oldval], Memc[newval], SZ_LINE) + } + if (streq (comment, ".")) + call strcpy (Memc[fcomm], Memc[ncomm], SZ_LINE) + if (update == YES) { + call nh_updatefield (im, image, field, Memc[oldval], + Memc[newval], Memc[fcomm], Memc[ncomm], show) + } + } + if (update == NO && show == YES) { + call printf ("%s,%s: %s -> %s\n") + call pargstr (image) + call pargstr (field) + call nh_pargstrc (Memc[oldval], Memc[fcomm]) + call nh_pargstrc (Memc[newval], Memc[ncomm]) + } + + call sfree (sp) +end + + +# NH_RENAMEFIELD -- Rename the named field of the indicated image. +# The value expression is evaluated, interactively inspected if desired, +# and the resulting value put to the image. + +procedure nh_renamefield (im, image, field, valexpr, verify, show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # value expression +int verify # verify new value interactively +int show # print record of edit +int update # enable updating of the image + +int goahead, nl +pointer sp, ip, oldval, newval, defval, o + +bool streq() +pointer evexpr() +extern he_getop() +int getline(), imaccf(), strldxs(), locpr() +errchk evexpr, getline, imaccf, he_gval + +begin + call smark (sp) + call salloc (oldval, SZ_LINE, TY_CHAR) + call salloc (newval, SZ_LINE, TY_CHAR) + call salloc (defval, SZ_LINE, TY_CHAR) + + # Verify that the named field exists before going any further. + if (field[1] != '$') + if (imaccf (im, field) == NO) { + call eprintf ("parameter %s,%s not found\n") + call pargstr (image) + call pargstr (field) + call sfree (sp) + return + } + + # Get the old value. + call he_gval (im, image, field, Memc[oldval], SZ_LINE) + + # Evaluate the expression. Encode the result operand as a string. + # If the expression is not parenthesized, assume that is is already + # a string literal. + + if (valexpr[1] == '(') { + o = evexpr (valexpr, locpr (he_getop), 0) + call he_encodeop (o, Memc[newval], SZ_LINE) + call xev_freeop (o) + call mfree (o, TY_STRUCT) + } else + call strcpy (valexpr, Memc[newval], SZ_LINE) + call strupr (Memc[newval]) + + if (verify == YES) { + # Query for new value and edit the field. If the response is a + # blank line, use the default new value. If the response is "$" + # or EOF, do not change the value of the parameter. + + call strcpy (field, Memc[oldval], SZ_LINE) + if (streq (Memc[newval], ".")) + call strcpy (Memc[oldval], Memc[newval], SZ_LINE) + call strcpy (Memc[newval], Memc[defval], SZ_LINE) + call eprintf ("%s,%s (%s -> %s): ") + call pargstr (image) + call pargstr (field) + call pargstr (field) + call pargstr (Memc[newval]) + call flush (STDERR) + + if (getline (STDIN, Memc[newval]) != EOF) { + # Do not skip leading whitespace; may be significant in a + # string literal. + + ip = newval + + # Do strip trailing newline since it is an artifact of getline. + nl = strldxs ("\n", Memc[ip]) + if (nl > 0) + Memc[ip+nl-1] = EOS + + # Decode user response. + if (Memc[ip] == '\\') { + ip = ip + 1 + goahead = YES + } else if (streq(Memc[ip],"n") || streq(Memc[ip],"no")) { + goahead = NO + } else if (streq(Memc[ip],"y") || streq(Memc[ip],"yes") || + Memc[ip] == EOS) { + call strcpy (Memc[defval], Memc[newval], SZ_LINE) + goahead = YES + } else { + if (ip > newval) + call strcpy (Memc[ip], Memc[newval], SZ_LINE) + goahead = YES + } + + # Edit field if so indicated. + if (goahead == YES && update == YES) + call nh_updatekey (im, image, field, Memc[newval], show) + + call flush (STDOUT) + } + + } else { + call strcpy (field, Memc[oldval], SZ_LINE) + if (update == YES) + call nh_updatekey (im, image, field, Memc[newval], show) + } + if (update == NO && show == YES) { + call printf ("%s,%s: %s -> %s\n") + call pargstr (image) + call pargstr (field) + call pargstr (field) + call pargstr (Memc[newval]) + } + + call sfree (sp) +end + + +# NH_INITFIELD -- Add a new field to the indicated image. If the field already +# existsdo not set its value. The value expression is evaluated and the +# resulting value used as the initial value in adding the field to the image. + +procedure nh_initfield (im, image, field, valexpr, comment, pkey, baf, + verify, show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # value expression +char comment[ARB] # keyword comment +char pkey[ARB] # +int baf +int verify # verify new value interactively +int show # print record of edit +int update # enable updating of the image + +bool numeric +int numlen, ip +pointer sp, newval, o +pointer evexpr() +int imaccf(), locpr(), strlen(), lexnum() +extern he_getop() +errchk imaccf, evexpr, imakbc, imastrc, imakic, imakrc + +begin + call smark (sp) + call salloc (newval, SZ_LINE, TY_CHAR) + + # If the named field already exists, this is really an edit operation + # rather than an add. Call editfield so that the usual verification + # can take place. + + if (imaccf (im, field) == YES) { + call eprintf ("parameter %s,%s already exists\n") + call pargstr (image) + call pargstr (field) + call sfree (sp) + return + } + + # If the expression is not parenthesized, assume that is is already + # a string literal. If the expression is a string check for a simple + # numeric field. + + ip = 1 + numeric = (lexnum (valexpr, ip, numlen) != LEX_NONNUM) + if (numeric) + numeric = (numlen == strlen (valexpr)) + + if (numeric || valexpr[1] == '(') + o = evexpr (valexpr, locpr(he_getop), 0) + else { + call malloc (o, LEN_OPERAND, TY_STRUCT) + call xev_initop (o, strlen(valexpr), TY_CHAR) + call strcpy (valexpr, O_VALC(o), ARB) + } + + # Add the field to the image (or update the value). The datatype of + # the expression value operand determines the datatype of the new + # parameter. + + if (update == YES) { + switch (O_TYPE(o)) { + case TY_BOOL: + if (pkey[1] != EOS && baf != 0) + call imakbci (im, field, O_VALB(o), comment, pkey, baf) + else + call imakbc (im, field, O_VALB(o), comment) + case TY_CHAR: + if (pkey[1] != EOS && baf != 0) + call imastrci (im, field, O_VALC(o), comment, pkey, baf) + else + call imastrc (im, field, O_VALC(o), comment) + case TY_INT: + if (pkey[1] != EOS && baf != 0) + call imakici (im, field, O_VALI(o), comment, pkey, baf) + else + call imakic (im, field, O_VALI(o), comment) + case TY_REAL: + if (pkey[1] != EOS && baf != 0) + call imakrci (im, field, O_VALR(o), comment, pkey, baf) + else + call imakrc (im, field, O_VALR(o), comment) + default: + call error (1, "unknown expression datatype") + } + } + + if (show == YES) { + call he_encodeop (o, Memc[newval], SZ_LINE) + call printf ("add %s,%s = %s / %s\n") + call pargstr (image) + call pargstr (field) + call he_pargstr (Memc[newval]) + call pargstr(comment) + } + + call xev_freeop (o) + call mfree (o, TY_STRUCT) + call sfree (sp) +end + + +# NH_ADDFIELD -- Add a new field to the indicated image. If the field already +# exists, merely set its value. The value expression is evaluated and the +# resulting value used as the initial value in adding the field to the image. + +procedure nh_addfield (im, image, field, valexpr, comment, pkey, baf, + verify, show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # value expression +char comment[ARB] # keyword comment +char pkey[ARB] # pivot keyword name +int baf # either BEFORE or AFTER value +int verify # verify new value interactively +int show # print record of edit +int update # enable updating of the image + +bool numeric +int numlen, ip +pointer sp, newval, o +pointer evexpr() +bool streq() +int imaccf(), locpr(), strlen(), lexnum() +extern he_getop() +errchk imaccf, evexpr, imakbc, imastrc, imakic, imakrc + +begin + call smark (sp) + call salloc (newval, SZ_LINE, TY_CHAR) + + # If the named field already exists, this is really an edit operation + # rather than an add. Call editfield so that the usual verification + # can take place. + if (!streq(field, "comment") && !streq(field, "history")) { + if (imaccf (im, field) == YES) { + call nh_editfield (im, image, field, valexpr, comment, + verify, show, update) + call sfree (sp) + return + } + } + + # If the expression is not parenthesized, assume that is is already + # a string literal. If the expression is a string check for a simple + # numeric field. + + ip = 1 + numeric = (lexnum (valexpr, ip, numlen) != LEX_NONNUM) + if (numeric) + numeric = (numlen == strlen (valexpr)) + + if (numeric || valexpr[1] == '(') + o = evexpr (valexpr, locpr(he_getop), 0) + else { + call malloc (o, LEN_OPERAND, TY_STRUCT) + call xev_initop (o, max(1,strlen(valexpr)), TY_CHAR) + call strcpy (valexpr, O_VALC(o), SZ_LINE) + } + + # Add the field to the image (or update the value). The datatype of + # the expression value operand determines the datatype of the new + # parameter. + if (update == YES) { + switch (O_TYPE(o)) { + case TY_BOOL: + if (pkey[1] != EOS && baf != 0) + call imakbci (im, field, O_VALB(o), comment, pkey, baf) + else + call imakbc (im, field, O_VALB(o), comment) + case TY_CHAR: + if (streq(field, "comment") || + streq(field, "history") || + streq(field, "add_textf") || + streq(field, "add_blank")) { + if (streq(field, "add_textf")) { + call imputextf (im, O_VALC(o), pkey, baf) + } else { + call imphis (im, field, O_VALC(o), pkey, baf) + } + } else if (pkey[1] != EOS && baf != 0) { + call imastrci (im, field, O_VALC(o), comment, pkey, baf) + } else { + call imastrc (im, field, O_VALC(o), comment) + } + case TY_INT: + if (pkey[1] != EOS && baf != 0) + call imakici (im, field, O_VALI(o), comment, pkey, baf) + else + call imakic (im, field, O_VALI(o), comment) + case TY_REAL: + if (pkey[1] != EOS && baf != 0) + call imakrci (im, field, O_VALR(o), comment, pkey, baf) + else + call imakrc (im, field, O_VALR(o), comment) + default: + call error (1, "unknown expression datatype") + } + } + + if (show == YES) { + call he_encodeop (o, Memc[newval], SZ_LINE) + call printf ("add %s,%s = %s / %s\n") + call pargstr (image) + call pargstr (field) + call he_pargstr (Memc[newval]) + call pargstr(comment) + } + + call xev_freeop (o) + call mfree (o, TY_STRUCT) + call sfree (sp) +end + + +# NH_DELETEFIELD -- Delete a field from the indicated image. If the field does +# not exist, print a warning message. + +procedure nh_deletefield (im, image, field, valexpr, verify, show, update) + +pointer im # image descriptor of image to be edited +char image[ARB] # name of image to be edited +char field[ARB] # name of field to be edited +char valexpr[ARB] # not used +int verify # verify deletion interactively +int show # print record of edit +int update # enable updating of the image + +pointer sp, ip, newval +int getline(), imaccf() + +begin + call smark (sp) + call salloc (newval, SZ_LINE, TY_CHAR) + + if (imaccf (im, field) == NO) { + call eprintf ("nonexistent field %s,%s\n") + call pargstr (image) + call pargstr (field) + call sfree (sp) + return + } + + if (verify == YES) { + # Delete pending verification. + + call eprintf ("delete %s,%s ? (yes): ") + call pargstr (image) + call pargstr (field) + call flush (STDERR) + + if (getline (STDIN, Memc[newval]) != EOF) { + # Strip leading whitespace and trailing newline. + for (ip=newval; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '\n' || Memc[ip] == 'y') { + call imdelf (im, field) + if (show == YES) { + call printf ("%s,%s deleted\n") + call pargstr (image) + call pargstr (field) + } + } + } + + } else { + # Delete without verification. + + if (update == YES) { + iferr (call imdelf (im, field)) + call erract (EA_WARN) + else if (show == YES) { + call printf ("%s,%s deleted\n") + call pargstr (image) + call pargstr (field) + } else if (show == YES) + call printf ("%s,%s deleted, no update\n") + call pargstr (image) + call pargstr (field) + } + } + + call sfree (sp) +end + + +# NH_UPDATEFIELD -- Update the value of an image header field. + +procedure nh_updatefield (im, image, field, oldval, newval, oldcomm, + newcomm, show) + +pointer im # image descriptor +char image[ARB] # image name +char field[ARB] # field name +char oldval[ARB] # old value, encoded as a string +char newval[ARB] # new value, encoded as a string +char oldcomm[ARB] # old keyword comment +char newcomm[ARB] # new keyword comment +int show # print record of update + +begin + iferr (call impstrc (im, field, newval, newcomm)) { + call eprintf ("cannot update %s,%s\n") + call pargstr (image) + call pargstr (field) + return + } + if (show == YES) { + call printf ("%s,%s: %s -> %s\n") + call pargstr (image) + call pargstr (field) + call nh_pargstrc (oldval, oldcomm) + call nh_pargstrc (newval, newcomm) + + } +end + + +# NH_UPDATEKEY -- Update the image header field. + +procedure nh_updatekey (im, image, field, newkey, show) + +pointer im # image descriptor +char image[ARB] # image name +char field[ARB] # field name +char newkey[ARB] # new key +int show # print record of update + +begin + iferr (call imrenf (im, field, newkey)) { + call eprintf ("cannot update %s,%s\n") + call pargstr (image) + call pargstr (field) + return + } + if (show == YES) { + call printf ("%s,%s: %s -> %s\n") + call pargstr (image) + call pargstr (field) + call pargstr (field) + call pargstr (newkey) + + } +end + + +# NH_CPSTR -- Copy a string to a header record with optional comment. + +procedure nh_cpstr (str, outbuf) + +char str[ARB] # string to be printed +char outbuf[ARB] # comment string to be printed + +int ip +bool quoteit +pointer sp, op, buf + +begin + + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + op = buf + Memc[op] = '"' + op = op + 1 + + # Copy string to scratch buffer, enclosed in quotes. Check for + # embedded whitespace. + + quoteit = false + for (ip=1; str[ip] != EOS; ip=ip+1) { + if (IS_WHITE(str[ip])) { # detect whitespace + quoteit = true + Memc[op] = str[ip] + } else if (str[ip] == '\n') { # prettyprint newlines + Memc[op] = '\\' + op = op + 1 + Memc[op] = 'n' + } else # normal characters + Memc[op] = str[ip] + + if (ip < SZ_LINE) + op = op + 1 + } + + # If whitespace was seen pass the quoted string, otherwise pass the + # original input string. + + if (quoteit) { + Memc[op] = '"' + op = op + 1 + Memc[op] = EOS + call strcpy (Memc[buf], outbuf, SZ_LINE) + } else + call strcpy (str, outbuf, SZ_LINE) + + call sfree (sp) +end + + +# NH_PARGSTRC -- Pass a string to a printf statement plus the comment string. + procedure nh_pargstrc (str, comment) + +char str[ARB] # string to be printed +char comment[ARB] # comment string to be printed + +pointer sp, buf + +begin + + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + call nh_cpstr (str, Memc[buf]) + + if (comment[1] != EOS) { + call strcat (" / ", Memc[buf], SZ_LINE) + call strcat (comment, Memc[buf], SZ_LINE) + } + + call pargstr (Memc[buf]) + + call sfree (sp) +end + + +# HE_GETPARS -- get the cl parameters for this task + +procedure he_getpars (operation, fields, valexpr, comment, + pivot, baf, update, verify, show) + +int operation +pointer fields # template listing fields to be processed +pointer valexpr # the value expression (if op=edit|add) +char comment[ARB] +char pivot[ARB] +int baf +int update +int verify +int show +bool clgetb(), streq() + +pointer ip +int btoi() + +begin + # Set switches. + operation = OP_EDIT + if (clgetb ("add")) + operation = OP_ADD + else if (clgetb ("addonly")) + operation = OP_INIT + else if (clgetb ("delete")) + operation = OP_DELETE + else if (clgetb ("rename")) + operation = OP_RENAME + + # If fields is NULL then this will be done in a command file. + if (fields != NULL) { + + # Get list of fields to be edited, added, or deleted. + call clgstr ("fields", Memc[fields], SZ_LINE) + for (ip=fields; IS_WHITE (Memc[ip]); ip=ip+1) + ; + call strcpy (Memc[ip], Memc[fields], SZ_LINE) + + # Set value expression. + Memc[valexpr] = EOS + if (operation != OP_DELETE) { + call clgstr ("value", Memc[valexpr], SZ_LINE) + if (operation != OP_RENAME) + call clgstr ("comment", comment, SZ_LINE) + + # Justify value + for (ip=valexpr; IS_WHITE (Memc[ip]); ip=ip+1) + ; + call strcpy (Memc[ip], Memc[valexpr], SZ_LINE) + ip = valexpr + while (Memc[ip] != EOS) + ip = ip + 1 + while (ip > valexpr && IS_WHITE (Memc[ip-1])) + ip = ip - 1 + Memc[ip] = EOS + } + + # If only printing results ignore the RENAME flag. + if (operation == OP_RENAME && streq (Memc[valexpr], ".")) { + operation = OP_EDIT + call strcpy (".", comment, SZ_LINE) + } + + } else { + Memc[valexpr] = EOS + comment[1] = EOS + } + + + # Get switches. If the expression value is ".", meaning print value + # rather than edit, then we do not use the switches. + + if (operation == OP_EDIT && streq (Memc[valexpr], ".") && + streq (comment, ".")) { + update = NO + verify = NO + show = NO + } else { + update = btoi (clgetb ("update")) + verify = btoi (clgetb ("verify")) + show = btoi (clgetb ("show")) + call clgstr ("after", pivot, SZ_LINE) + if (pivot[1] != EOS) + baf = AFTER + if (pivot[1] == EOS) { + call clgstr ("before", pivot, SZ_LINE) + if (pivot[1] != EOS) + baf = BEFORE + } + } +end + + +# NH_SETPAR -- Set a parameter. + +procedure nh_setpar (operation, dp_oper, dp_update, dp_verify, dp_show, + update, verify, show) +int operation +int dp_oper +int dp_update +int dp_verify +int dp_show +int update +int verify +int show + +begin + # If the value is positive then the parameter has been set + # in the command line. + + if (operation == OP_DEFPAR) + operation = dp_oper + if (update == -1) + update = dp_update + if (verify == -1) + verify = dp_verify + if (show == -1) + show = dp_show +end diff --git a/pkg/images/imutil/src/t_chpix.x b/pkg/images/imutil/src/t_chpix.x new file mode 100644 index 00000000..13c35cc3 --- /dev/null +++ b/pkg/images/imutil/src/t_chpix.x @@ -0,0 +1,238 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <fset.h> + +# T_CHPIXTYPE -- Change the pixel type of a list of images from the specified +# old pixel type to the new pixel type. The input images to be converted can +# be slected by pixel type. Conversion from one pixel type to another is +# direct and may involve loss of precision and dynamic range. Mapping of +# floating point numbers to integer numbers is done by truncation. + + +define CHP_ALL 1 # All types +define CHP_USHORT 2 # Unsigned short integer +define CHP_SHORT 3 # Short integers +define CHP_INT 4 # Integers +define CHP_LONG 5 # Long integers +define CHP_REAL 6 # Reals +define CHP_DOUBLE 7 # Doubles +define CHP_COMPLEX 8 # Complex + +define CHP_TYSTR "|all|ushort|short|int|long|real|double|complex|" + +procedure t_chpixtype() + +pointer imtlist1 # Input image list +pointer imtlist2 # Output image list + +pointer image1 # Input image +pointer image2 # Output image +pointer imtemp # Temporary file + +int list1, list2, intype, outtype, verbose +pointer im1, im2, sp, instr, outstr, imstr +bool clgetb() +int imtopen(), imtgetim(), imtlen(), clgwrd(), chp_gettype(), btoi() +pointer immap() + +errchk xt_mkimtemp, immap, imunmap, xt_delimtemp, chp_pixtype + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate temporary space. + call smark (sp) + call salloc (imtlist1, SZ_FNAME, TY_CHAR) + call salloc (imtlist2, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call salloc (image2, SZ_FNAME, TY_CHAR) + call salloc (imtemp, SZ_FNAME, TY_CHAR) + call salloc (instr, SZ_LINE, TY_CHAR) + call salloc (outstr, SZ_LINE, TY_CHAR) + call salloc (imstr, SZ_LINE, TY_CHAR) + + # Get task parameters. + call clgstr ("input", Memc[imtlist1], SZ_FNAME) + call clgstr ("output", Memc[imtlist2], SZ_FNAME) + + # Get the input and output pixel types. + intype = clgwrd ("oldpixtype", Memc[instr], SZ_LINE, CHP_TYSTR) + outtype = clgwrd ("newpixtype", Memc[outstr], SZ_LINE, CHP_TYSTR) + verbose = btoi (clgetb ("verbose")) + + list1 = imtopen (Memc[imtlist1]) + list2 = imtopen (Memc[imtlist2]) + if (imtlen (list1) != imtlen (list2)) { + call imtclose (list1) + call imtclose (list2) + call error (0, "Number of input and output images not the same.") + } + + # Loop over the set of input and output images + while ((imtgetim (list1, Memc[image1], SZ_FNAME) != EOF) && + (imtgetim (list2, Memc[image2], SZ_FNAME) != EOF)) { + + iferr { + + # Open the input and output images. + call xt_mkimtemp (Memc[image1], Memc[image2], Memc[imtemp], + SZ_FNAME) + im1 = immap (Memc[image1], READ_ONLY, 0) + if (intype == CHP_ALL || IM_PIXTYPE(im1) == chp_gettype(intype)) + im2 = immap (Memc[image2], NEW_COPY, im1) + else + im2 = NULL + + # Change the pixel type. + call chp_enctype (IM_PIXTYPE(im1), Memc[imstr], SZ_LINE) + if (im2 == NULL) { + if (verbose == YES) { + call printf ("Cannot change Image: %s (%s) -> ") + call pargstr (Memc[image1]) + call pargstr (Memc[imstr]) + call printf ("Image: %s (%s)\n") + call pargstr (Memc[imtemp]) + call pargstr (Memc[outstr]) + } + } else { + if (verbose == YES) { + call printf ("Image: %s (%s) -> Image: %s (%s)\n") + call pargstr (Memc[image1]) + call pargstr (Memc[imstr]) + call pargstr (Memc[imtemp]) + call pargstr (Memc[outstr]) + } + call chp_pixtype (im1, im2, chp_gettype (outtype)) + } + + # Close up the input and output images. + call imunmap (im1) + if (im2 != NULL) { + call imunmap (im2) + call xt_delimtemp (Memc[image2], Memc[imtemp]) + } + + } then { + call eprintf ("Error converting %s (%s) -> (%s)\n") + call pargstr (Memc[image1]) + call pargstr (Memc[imstr]) + call pargstr (Memc[outstr]) + call erract (EA_WARN) + } + } + + call imtclose (list1) + call imtclose (list2) + + call sfree (sp) +end + + +# CHP_PIXTYPE -- Change pixel types using line sequential image i/o. + +procedure chp_pixtype (im1, im2, outtype) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image +int outtype # output pixel type + +int ncols +long v1[IM_MAXDIM], v2[IM_MAXDIM] +pointer buf1, buf2 +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx() +int impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() + +errchk imgnls, imgnli, imgnll, imgnlr, imgnld, imgnlx +errchk impnls, impnli, impnll, impnlr, impnld, impnlx + +begin + ncols = IM_LEN(im1, 1) + + IM_PIXTYPE(im2) = outtype + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + switch (outtype) { + case TY_USHORT: + while (impnll(im2,buf2,v2) != EOF && imgnll(im1,buf1,v1) != EOF) + call amovl (Meml[buf1], Meml[buf2], ncols) + case TY_SHORT: + while (impnls(im2,buf2,v2) != EOF && imgnls(im1,buf1,v1) != EOF) + call amovs (Mems[buf1], Mems[buf2], ncols) + case TY_INT: + while (impnli(im2,buf2,v2) != EOF && imgnli(im1,buf1,v1) != EOF) + call amovi (Memi[buf1], Memi[buf2], ncols) + case TY_LONG: + while (impnll(im2,buf2,v2) != EOF && imgnll(im1,buf1,v1) != EOF) + call amovl (Meml[buf1], Meml[buf2], ncols) + case TY_REAL: + while (impnlr(im2,buf2,v2) != EOF && imgnlr(im1,buf1,v1) != EOF) + call amovr (Memr[buf1], Memr[buf2], ncols) + case TY_DOUBLE: + while (impnld(im2,buf2,v2) != EOF && imgnld(im1,buf1,v1) != EOF) + call amovd (Memd[buf1], Memd[buf2], ncols) + case TY_COMPLEX: + while (impnlx(im2,buf2,v2) != EOF && imgnlx(im1,buf1,v1) != EOF) + call amovx (Memx[buf1], Memx[buf2], ncols) + } + + call imflush (im2) +end + + +# CHP_GETTYPE -- Get the the image pixel type. + +int procedure chp_gettype (intype) + +int intype # input pixel type + +begin + switch (intype) { + case CHP_USHORT: + return (TY_USHORT) + case CHP_SHORT: + return (TY_SHORT) + case CHP_INT: + return (TY_INT) + case CHP_LONG: + return (TY_LONG) + case CHP_REAL: + return (TY_REAL) + case CHP_DOUBLE: + return (TY_DOUBLE) + case CHP_COMPLEX: + return (TY_COMPLEX) + default: + return (ERR) + } +end + + +# CHP_ENCTYPE -- Encode the pixel type string. + +procedure chp_enctype (pixtype, str, maxch) + +int pixtype # pixel type +char str[ARB] # string for encoding pixel type +int maxch # maximum characters + +begin + switch (pixtype) { + case TY_USHORT: + call strcpy ("ushort", str, maxch) + case TY_SHORT: + call strcpy ("short", str, maxch) + case TY_INT: + call strcpy ("int", str, maxch) + case TY_LONG: + call strcpy ("long", str, maxch) + case TY_REAL: + call strcpy ("real", str, maxch) + case TY_DOUBLE: + call strcpy ("double", str, maxch) + case TY_COMPLEX: + call strcpy ("complex", str, maxch) + } +end diff --git a/pkg/images/imutil/src/t_imarith.x b/pkg/images/imutil/src/t_imarith.x new file mode 100644 index 00000000..6d5f6105 --- /dev/null +++ b/pkg/images/imutil/src/t_imarith.x @@ -0,0 +1,489 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> +include <lexnum.h> + +define ADD 1 # Opcodes. +define SUB 2 +define MUL 3 +define DIV 4 +define MIN 5 +define MAX 6 + +# T_IMARITH -- Simple image arithmetic. +# +# For each pixel in each image compute: +# +# operand1 op operand2 = result +# +# Do the operations as efficiently as possible. Allow operand1 or operand2 +# to be a constant. Allow resultant image to have the same name as an +# operand image. Allow lists for the operands and the results. +# Allow one of the operands to have extra dimensions but require that the +# common dimensions are of the same length. + +procedure t_imarith () + +int list1 # Operand1 list +int list2 # Operand2 list +int list3 # Result list +int op # Operator +bool verbose # Verbose option +bool noact # Noact option +double c1 # Constant for operand1 +double c2 # Constant for operand2 +double divzero # Zero divide replacement +int pixtype # Output pixel datatype +int calctype # Datatype for calculations + +int i, j, pixtype1, pixtype2 +short sc1, sc2, sdz +int hlist +double dval1, dval2 +pointer im1, im2, im3 +pointer sp, operand1, operand2, result, imtemp +pointer opstr, dtstr, field, title, hparams + +int imtopenp(), imtgetim(), imtlen(), imofnlu(), imgnfn() +double clgetd(), imgetd() +bool clgetb(), streq() +int clgwrd() +int gctod(), lexnum() +pointer immap() +errchk immap, imgetd, imputd + +begin + # Allocate memory for strings. + call smark (sp) + call salloc (operand1, SZ_FNAME, TY_CHAR) + call salloc (operand2, SZ_FNAME, TY_CHAR) + call salloc (result, SZ_FNAME, TY_CHAR) + call salloc (imtemp, SZ_FNAME, TY_CHAR) + call salloc (opstr, SZ_FNAME, TY_CHAR) + call salloc (dtstr, SZ_FNAME, TY_CHAR) + call salloc (field, SZ_FNAME, TY_CHAR) + call salloc (title, SZ_IMTITLE, TY_CHAR) + call salloc (hparams, SZ_LINE, TY_CHAR) + + # Get the operands and the operator. + list1 = imtopenp ("operand1") + op = clgwrd ("op", Memc[opstr], SZ_FNAME, ",+,-,*,/,min,max,") + list2 = imtopenp ("operand2") + list3 = imtopenp ("result") + + # Get the rest of the options. + call clgstr ("hparams", Memc[hparams], SZ_LINE) + verbose = clgetb ("verbose") + noact = clgetb ("noact") + if (op == DIV) + divzero = clgetd ("divzero") + + # Check the number of elements. + if (((imtlen (list1) != 1) && (imtlen (list1) != imtlen (list3))) || + ((imtlen (list2) != 1) && (imtlen (list2) != imtlen (list3)))) { + call imtclose (list1) + call imtclose (list2) + call imtclose (list3) + call error (1, "Wrong number of elements in the operand lists") + } + + # Do each operation. + while (imtgetim (list3, Memc[result], SZ_FNAME) != EOF) { + if (imtgetim (list1, Memc[imtemp], SZ_FNAME) != EOF) + call strcpy (Memc[imtemp], Memc[operand1], SZ_FNAME) + if (imtgetim (list2, Memc[imtemp], SZ_FNAME) != EOF) + call strcpy (Memc[imtemp], Memc[operand2], SZ_FNAME) + + # Image sections in the output are not allowed. + call imgsection (Memc[result], Memc[field], SZ_FNAME) + if (Memc[field] != EOS) { + call eprintf ( + "imarith: image sections in the output are not allowed (%s)\n") + call pargstr (Memc[result]) + next + } + + # To allow purely numeric file names first test if the operand + # is a file. If it is not then attempt to interpret the operand + # as a numerical constant. Otherwise it is an error. + iferr { + im1 = immap (Memc[operand1], READ_ONLY, 0) + pixtype1 = IM_PIXTYPE(im1) + } then { + i = 1 + j = gctod (Memc[operand1], i, c1) + if ((Memc[operand1+i-1]!=EOS) && (Memc[operand1+i-1]!=' ')) { + call eprintf ("%s is not an image or a number\n") + call pargstr (Memc[operand1]) + next + } + + i = 1 + pixtype1 = lexnum (Memc[operand1], i, j) + switch (pixtype1) { + case LEX_REAL: + pixtype1 = TY_REAL + default: + pixtype1 = TY_SHORT + } + im1 = NULL + } + + iferr { + im2 = immap (Memc[operand2], READ_ONLY, 0) + pixtype2 = IM_PIXTYPE(im2) + } then { + i = 1 + j = gctod (Memc[operand2], i, c2) + if ((Memc[operand2+i-1]!=EOS) && (Memc[operand2+i-1]!=' ')) { + call eprintf ("%s is not an image or a number\n") + call pargstr (Memc[operand2]) + if (im1 != NULL) + call imunmap (im1) + next + } + + i = 1 + pixtype2 = lexnum (Memc[operand2], i, j) + switch (pixtype2) { + case LEX_REAL: + pixtype2 = TY_REAL + default: + pixtype2 = TY_SHORT + } + im2 = NULL + } + + # Determine the output pixel datatype and calculation datatype. + call ima_set (pixtype1, pixtype2, op, pixtype, calctype) + + # If verbose or noact print the operation. + if (verbose || noact) { + call printf ("IMARITH:\n Operation = %s\n") + call pargstr (Memc[opstr]) + call printf (" Operand1 = %s\n Operand2 = %s\n") + call pargstr (Memc[operand1]) + call pargstr (Memc[operand2]) + call printf (" Result = %s\n Result pixel type = %s\n") + call pargstr (Memc[result]) + call dtstring (pixtype, Memc[dtstr], SZ_FNAME) + call pargstr (Memc[dtstr]) + call printf (" Calculation type = %s\n") + call dtstring (calctype, Memc[dtstr], SZ_FNAME) + call pargstr (Memc[dtstr]) + if (op == DIV) { + call printf ( + " Replacement value for division by zero = %g\n") + call pargd (divzero) + } + } + + # Do the operation if the no act switch is not set. + if (!noact) { + # Check the two operands have the same dimension lengths + # over the same dimensions. + if ((im1 != NULL) && (im2 != NULL)) { + j = OK + do i = 1, min (IM_NDIM (im1), IM_NDIM (im2)) + if (IM_LEN (im1, i) != IM_LEN (im2, i)) + j = ERR + if (j == ERR) { + call imunmap (im1) + call imunmap (im2) + call eprintf ( + "Input images have different dimensions\n") + next + } + } + + # Create a temporary output image as a copy of one of the + # operand images (the one with the highest dimension). + # This allows the resultant image to have + # the same name as one of the operand images. + if ((im1 != NULL) && (im2 != NULL)) { + call xt_mkimtemp (Memc[operand1], Memc[result], + Memc[imtemp], SZ_FNAME) + if (streq (Memc[result], Memc[imtemp])) + call xt_mkimtemp (Memc[operand2], Memc[result], + Memc[imtemp], SZ_FNAME) + if (IM_NDIM(im1) >= IM_NDIM(im2)) + im3 = immap (Memc[result], NEW_COPY, im1) + else + im3 = immap (Memc[result], NEW_COPY, im2) + } else if (im1 != NULL) { + call xt_mkimtemp (Memc[operand1], Memc[result], + Memc[imtemp], SZ_FNAME) + im3 = immap (Memc[result], NEW_COPY, im1) + } else if (im2 != NULL) { + call xt_mkimtemp (Memc[operand2], Memc[result], + Memc[imtemp], SZ_FNAME) + im3 = immap (Memc[result], NEW_COPY, im2) + } else + call error (0, "No operand images") + + # Set the result image title and pixel datatype. + call clgstr ("title", Memc[title], SZ_IMTITLE) + if (Memc[title] != EOS) + call strcpy (Memc[title], IM_TITLE (im3), SZ_IMTITLE) + IM_PIXTYPE (im3) = pixtype + + # Call the appropriate procedure to do the arithmetic + # efficiently. + switch (calctype) { + case TY_SHORT: + sc1 = c1 + sc2 = c2 + switch (op) { + case ADD: + call ima_adds (im1, im2, im3, sc1, sc2) + case SUB: + call ima_subs (im1, im2, im3, sc1, sc2) + case MUL: + call ima_muls (im1, im2, im3, sc1, sc2) + case DIV: + sdz = divzero + call ima_divs (im1, im2, im3, sc1, sc2, sdz) + case MIN: + call ima_mins (im1, im2, im3, sc1, sc2) + case MAX: + call ima_maxs (im1, im2, im3, sc1, sc2) + } + case TY_INT: + switch (op) { + case ADD: + call ima_addi (im1, im2, im3, int (c1), int (c2)) + case SUB: + call ima_subi (im1, im2, im3, int (c1), int (c2)) + case MUL: + call ima_muli (im1, im2, im3, int (c1), int (c2)) + case DIV: + call ima_divi (im1, im2, im3, int (c1), int (c2), + int (divzero)) + case MIN: + call ima_mini (im1, im2, im3, int (c1), int (c2)) + case MAX: + call ima_maxi (im1, im2, im3, int (c1), int (c2)) + } + case TY_LONG: + switch (op) { + case ADD: + call ima_addl (im1, im2, im3, long (c1), long (c2)) + case SUB: + call ima_subl (im1, im2, im3, long (c1), long (c2)) + case MUL: + call ima_mull (im1, im2, im3, long (c1), long (c2)) + case DIV: + call ima_divl (im1, im2, im3, long (c1), long (c2), + long (divzero)) + case MIN: + call ima_minl (im1, im2, im3, long (c1), long (c2)) + case MAX: + call ima_maxl (im1, im2, im3, long (c1), long (c2)) + } + case TY_REAL: + switch (op) { + case ADD: + call ima_addr (im1, im2, im3, real (c1), real (c2)) + case SUB: + call ima_subr (im1, im2, im3, real (c1), real (c2)) + case MUL: + call ima_mulr (im1, im2, im3, real (c1), real (c2)) + case DIV: + call ima_divr (im1, im2, im3, real (c1), real (c2), + real (divzero)) + case MIN: + call ima_minr (im1, im2, im3, real (c1), real (c2)) + case MAX: + call ima_maxr (im1, im2, im3, real (c1), real (c2)) + } + case TY_DOUBLE: + switch (op) { + case ADD: + call ima_addd (im1, im2, im3, double(c1), double(c2)) + case SUB: + call ima_subd (im1, im2, im3, double(c1), double(c2)) + case MUL: + call ima_muld (im1, im2, im3, double(c1), double(c2)) + case DIV: + call ima_divd (im1, im2, im3, double(c1), double(c2), + double(divzero)) + case MIN: + call ima_mind (im1, im2, im3, double(c1), double(c2)) + case MAX: + call ima_maxd (im1, im2, im3, double(c1), double(c2)) + } + } + + # Do the header parameters. + iferr { + ifnoerr (dval1 = imgetd (im3, "CCDMEAN")) + call imdelf (im3, "CCDMEAN") + + hlist = imofnlu (im3, Memc[hparams]) + while (imgnfn (hlist, Memc[field], SZ_FNAME) != EOF) { + if (im1 != NULL) + dval1 = imgetd (im1, Memc[field]) + else + dval1 = c1 + if (im2 != NULL) + dval2 = imgetd (im2, Memc[field]) + else + dval2 = c2 + + switch (op) { + case ADD: + call imputd (im3, Memc[field], dval1 + dval2) + case SUB: + call imputd (im3, Memc[field], dval1 - dval2) + case MUL: + call imputd (im3, Memc[field], dval1 * dval2) + case DIV: + if (dval2 == 0.) { + call eprintf ( + "WARNING: Division by zero in header keyword (%s)\n") + call pargstr (Memc[field]) + } else + call imputd (im3, Memc[field], dval1 / dval2) + case MIN: + call imputd (im3, Memc[field], min (dval1, dval2)) + case MAX: + call imputd (im3, Memc[field], max (dval1, dval2)) + } + } + call imcfnl (hlist) + } then + call erract (EA_WARN) + } + + # Unmap images and release the temporary output image. + if (im1 != NULL) + call imunmap (im1) + if (im2 != NULL) + call imunmap (im2) + if (!noact) { + call imunmap (im3) + call xt_delimtemp (Memc[result], Memc[imtemp]) + } + } + + call imtclose (list1) + call imtclose (list2) + call imtclose (list3) + call sfree (sp) +end + + +# IMA_SET -- Determine the output image pixel type and the calculation +# datatype. The default pixel types are based on the highest arithmetic +# precendence of the input images or constants. Division requires +# a minimum of real. + +procedure ima_set (pixtype1, pixtype2, op, pixtype, calctype) + +int pixtype1 # Pixel datatype of operand 1 +int pixtype2 # Pixel datatype of operand 2 +int pixtype # Pixel datatype of resultant image +int op # Operation +int calctype # Pixel datatype for calculations + +char line[1] +int max_type + +begin + # Determine maximum precedence datatype. + switch (pixtype1) { + case TY_SHORT: + if (op == DIV) + max_type = TY_REAL + else if (pixtype2 == TY_USHORT) + max_type = TY_LONG + else + max_type = pixtype2 + case TY_USHORT: + if (op == DIV) + max_type = TY_REAL + else if ((pixtype2 == TY_SHORT) || (pixtype2 == TY_USHORT)) + max_type = TY_LONG + else + max_type = pixtype2 + case TY_INT: + if (op == DIV) + max_type = TY_REAL + else if ((pixtype2 == TY_SHORT) || (pixtype2 == TY_USHORT)) + max_type = pixtype1 + else + max_type = pixtype2 + case TY_LONG: + if (op == DIV) + max_type = TY_REAL + else if ((pixtype2 == TY_SHORT) || (pixtype2 == TY_USHORT) || + (pixtype2 == TY_INT)) + max_type = pixtype1 + else + max_type = pixtype2 + case TY_REAL: + if (pixtype2 == TY_DOUBLE) + max_type = pixtype2 + else + max_type = pixtype1 + case TY_DOUBLE: + max_type = pixtype1 + } + + # Set calculation datatype. + call clgstr ("calctype", line, 1) + switch (line[1]) { + case '1': + if (pixtype1 == TY_USHORT) + calctype = TY_LONG + else + calctype = pixtype1 + case '2': + if (pixtype2 == TY_USHORT) + calctype = TY_LONG + else + calctype = pixtype2 + case EOS: + calctype = max_type + case 's': + calctype = TY_SHORT + case 'u': + calctype = TY_LONG + case 'i': + calctype = TY_INT + case 'l': + calctype = TY_LONG + case 'r': + calctype = TY_REAL + case 'd': + calctype = TY_DOUBLE + default: + call error (6, "Unrecognized datatype") + } + + # Set output pixel datatype. + call clgstr ("pixtype", line, 1) + switch (line[1]) { + case '1': + pixtype = pixtype1 + case '2': + pixtype = pixtype2 + case EOS: + pixtype = calctype + case 's': + pixtype = TY_SHORT + case 'u': + pixtype = TY_USHORT + case 'i': + pixtype = TY_INT + case 'l': + pixtype = TY_LONG + case 'r': + pixtype = TY_REAL + case 'd': + pixtype = TY_DOUBLE + default: + call error (6, "Unrecognized dataype") + } +end diff --git a/pkg/images/imutil/src/t_imaxes.x b/pkg/images/imutil/src/t_imaxes.x new file mode 100644 index 00000000..86d32fbd --- /dev/null +++ b/pkg/images/imutil/src/t_imaxes.x @@ -0,0 +1,33 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +define SZ_PARAM 5 + + +# IMAXES -- Determine the number and lengths of the axes of an image. +# Called from CL scripts. This routine will go away when we get DBIO +# access from the CL. + +procedure t_imaxes() + +char imname[SZ_FNAME] +char param[SZ_PARAM] +int i +pointer im +pointer immap() + +begin + call clgstr ("image", imname, SZ_FNAME) + im = immap (imname, READ_ONLY, 0) + + call clputi ("ndim", IM_NDIM(im)) + + do i = 1, IM_MAXDIM { + call sprintf (param, SZ_PARAM, "len%d") + call pargi (i) + call clputl (param, IM_LEN(im,i)) + } + + call imunmap (im) +end diff --git a/pkg/images/imutil/src/t_imcopy.x b/pkg/images/imutil/src/t_imcopy.x new file mode 100644 index 00000000..b79f0d9d --- /dev/null +++ b/pkg/images/imutil/src/t_imcopy.x @@ -0,0 +1,82 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMCOPY -- Copy image(s) +# +# The input images are given by an image template list. The output +# is either a matching list of images or a directory. +# The number of input images may be either one or match the number of output +# images. Image sections are allowed in the input images and are ignored +# in the output images. If the input and output image names are the same +# then the copy is performed to a temporary file which then replaces the +# input image. + +procedure t_imcopy() + +char imtlist1[SZ_LINE] # Input image list +char imtlist2[SZ_LINE] # Output image list +bool verbose # Print operations? + +char image1[SZ_PATHNAME] # Input image name +char image2[SZ_PATHNAME] # Output image name +char dirname1[SZ_PATHNAME] # Directory name +char dirname2[SZ_PATHNAME] # Directory name + +int list1, list2, root_len + +int imtopen(), imtgetim(), imtlen() +int fnldir(), isdirectory() +bool clgetb() + +begin + # Get input and output image template lists. + + call clgstr ("input", imtlist1, SZ_LINE) + call clgstr ("output", imtlist2, SZ_LINE) + verbose = clgetb ("verbose") + + # Check if the output string is a directory. + + if (isdirectory (imtlist2, dirname2, SZ_PATHNAME) > 0) { + list1 = imtopen (imtlist1) + while (imtgetim (list1, image1, SZ_PATHNAME) != EOF) { + + # Strip the image section first because fnldir recognizes it + # as part of a directory. Place the input image name + # without a directory or image section in string dirname1. + + call get_root (image1, image2, SZ_PATHNAME) + root_len = fnldir (image2, dirname1, SZ_PATHNAME) + call strcpy (image2[root_len + 1], dirname1, SZ_PATHNAME) + + call strcpy (dirname2, image2, SZ_PATHNAME) + call strcat (dirname1, image2, SZ_PATHNAME) + call img_imcopy (image1, image2, verbose) + } + call imtclose (list1) + + } else { + # Expand the input and output image lists. + + list1 = imtopen (imtlist1) + list2 = imtopen (imtlist2) + + if (imtlen (list1) != imtlen (list2)) { + call imtclose (list1) + call imtclose (list2) + call error (0, "Number of input and output images not the same") + } + + # Do each set of input/output images. + + while ((imtgetim (list1, image1, SZ_PATHNAME) != EOF) && + (imtgetim (list2, image2, SZ_PATHNAME) != EOF)) { + + call img_imcopy (image1, image2, verbose) + } + + call imtclose (list1) + call imtclose (list2) + } +end diff --git a/pkg/images/imutil/src/t_imdivide.x b/pkg/images/imutil/src/t_imdivide.x new file mode 100644 index 00000000..510e49e5 --- /dev/null +++ b/pkg/images/imutil/src/t_imdivide.x @@ -0,0 +1,132 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# T_IMDIVIDE -- Image division with rescaling. + +# Options for rescaling. +define NORESC 1 # Do not scale resultant image +define MEAN 2 # Scale resultant mean to given value +define NUMER 3 # Scale resultant mean to mean of numerator + +procedure t_imdivide () + +char image1[SZ_FNAME] # Numerator image +char image2[SZ_FNAME] # Denominator image +char image3[SZ_FNAME] # Resultant image +char title[SZ_IMTITLE] # Resultant image title +int rescale # Option for rescaling +real constant # Replacement for zero divide +bool verbose # Verbose output? + +char str[SZ_LINE] +int i, npix, ntotal +real sum1, sum2, sum3, scale +long line1[IM_MAXDIM], line2[IM_MAXDIM], line3[IM_MAXDIM] +pointer im1, im2, im3, data1, data2, data3 + +int clgwrd(), imgnlr(), impnlr() +bool clgetb(), strne() +real clgetr(), asumr(), ima_efncr() +pointer immap() +extern ima_efncr + +common /imadcomr/ constant + +begin + # Access images and set parameters. + call clgstr ("numerator", image1, SZ_FNAME) + im1 = immap (image1, READ_ONLY, 0) + call clgstr ("denominator", image2, SZ_FNAME) + im2 = immap (image2, READ_ONLY, 0) + call clgstr ("resultant", image3, SZ_FNAME) + im3 = immap (image3, NEW_COPY, im1) + + if (IM_NDIM (im1) != IM_NDIM (im2)) + call error (0, "Input images have different dimensions") + do i = 1, IM_NDIM (im1) + if (IM_LEN (im1, i) != IM_LEN (im2, i)) + call error (0, "Input images have different sizes") + + call clgstr ("title", title, SZ_IMTITLE) + if (strne (title, "*")) + call strcpy (title, IM_TITLE(im3), SZ_IMTITLE) + IM_PIXTYPE(im3) = TY_REAL + + constant = clgetr ("constant") + verbose = clgetb ("verbose") + + # Initialize. + npix = IM_LEN(im1, 1) + ntotal = 0 + sum1 = 0. + sum2 = 0. + sum3 = 0. + call amovkl (long(1), line1, IM_MAXDIM) + call amovkl (long(1), line2, IM_MAXDIM) + call amovkl (long(1), line3, IM_MAXDIM) + + # Loop through the images doing the division. + # Accumulate the sums for mean values. + while (impnlr (im3, data3, line3) != EOF) { + i = imgnlr (im1, data1, line1) + i = imgnlr (im2, data2, line2) + call advzr (Memr[data1], Memr[data2], Memr[data3], npix, ima_efncr) + sum1 = sum1 + asumr (Memr[data1], npix) + sum2 = sum2 + asumr (Memr[data2], npix) + sum3 = sum3 + asumr (Memr[data3], npix) + ntotal = ntotal + npix + } + sum1 = sum1 / ntotal + sum2 = sum2 / ntotal + sum3 = sum3 / ntotal + + # Close the images. + call imunmap (im1) + call imunmap (im2) + call imunmap (im3) + + # Print image means if verbose. + if (verbose) { + call printf ("Task imdivide:\n") + call printf (" %s: Mean = %g\n") + call pargstr (image1) + call pargr (sum1) + call printf (" %s: Mean = %g\n") + call pargstr (image2) + call pargr (sum2) + call printf (" %s: Mean = %g\n") + call pargstr (image3) + call pargr (sum3) + } + + # Determine resultant image rescaling. + rescale = clgwrd ("rescale", str, SZ_LINE, ",norescale,mean,numerator,") + switch (rescale) { + case NORESC: + return + case MEAN: + scale = clgetr ("mean") / sum3 + case NUMER: + scale = sum1 / sum3 + } + + if(verbose) { + call printf (" %s: Scale = %g\n") + call pargstr (image3) + call pargr (scale) + } + + # Open image read_write and initialize line counters. + im1 = immap (image3, READ_WRITE, 0) + call amovkl (long(1), line1, IM_MAXDIM) + call amovkl (long(1), line2, IM_MAXDIM) + + # Loop through the image rescaling the image lines. + while (imgnlr (im1, data1, line1) != EOF) { + i = impnlr (im1, data2, line2) + call amulkr (Memr[data1], scale, Memr[data2], npix) + } + + call imunmap (im1) +end diff --git a/pkg/images/imutil/src/t_imjoin.x b/pkg/images/imutil/src/t_imjoin.x new file mode 100644 index 00000000..810c0a2d --- /dev/null +++ b/pkg/images/imutil/src/t_imjoin.x @@ -0,0 +1,272 @@ +include <imhdr.h> +include <error.h> +include <syserr.h> + +define DEFBUFSIZE 65536 # default IMIO buffer size +define FUDGE 0.8 # fudge factor + + +# T_IMJOIN -- Produce a single output image from a list of input images +# by joining the images in the input image list along a single dimension. +# The set of input images need have the same number of dimensions and +# elements per dimension ONLY along the axes not being joined. +# The output pixel type will be converted to the highest precedence pixel +# type if not all the images do not have the same pixel type. + +procedure t_imjoin() + +int i, j, joindim, list, nimages, inpixtype, ndim, nelems[IM_MAXDIM] +int bufsize, maxsize, memory, oldsize, outpixtype, verbose +pointer sp, in, out, im, im1, input, output + +bool clgetb() +#char clgetc() +int imtopenp(), imtlen(), imtgetim(), clgeti(), btoi() +int getdatatype(), ij_tymax(), sizeof(), begmem(), errcode() +pointer immap() +errchk immap + +define retry_ 99 + +begin + # Allocate working space. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + + # Get the parameters. Note that clgetc no longer accepts a blank + # string as input so clgstr is used to fetch the pixtype parameter + # and input is used as the temporary holding variable. + list = imtopenp ("input") + call clgstr ("output", Memc[output], SZ_FNAME) + joindim = clgeti ("join_dimension") + #outpixtype = getdatatype (clgetc ("pixtype")) + call clgstr ("pixtype", Memc[input], SZ_FNAME) + outpixtype = getdatatype (Memc[input]) + verbose = btoi (clgetb ("verbose")) + + # Check to make sure that the input image list is not empty. + nimages = imtlen (list) + if (nimages == 0) { + call imtclose (list) + call sfree (sp) + call error (0, "The input image list is empty") + } else + call salloc (in, nimages, TY_POINTER) + + # Check the the join dimension is not too large. + if (joindim > IM_MAXDIM) + call error (0, + "The join dimension cannot be greater then the current IM_MAXDIM") + + bufsize = 0 + +retry_ + + # Map the input images. + nimages = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + nimages = nimages + 1 + Memi[in+nimages-1] = immap (Memc[input], READ_ONLY, 0) + } + + # Determine the dimensionality, size, and pixel type of the output + # image. Force the output image to have the same number of dimensions + # as the input images, with the following check even though the + # remainder of the code permits stacking the images into a higher + # dimension. + + im = Memi[in] + inpixtype = IM_PIXTYPE(im) + if (joindim > IM_NDIM(im)) { + call eprintf ( + "ERROR: For image %s ndim is %d max join dimension is %d\n") + call pargstr (IM_HDRFILE(im)) + call pargi (IM_NDIM(im)) + call pargi (IM_NDIM(im)) + call error (0, "The user-specified join dimension is too large") + } + ndim = max (IM_NDIM(im), joindim) + do j = 1, ndim { + if (j <= IM_NDIM(im)) + nelems[j] = IM_LEN(im,j) + else + nelems[j] = 1 + } + + # Make sure that all the input images have the same dimensionality, + # and that the length of each dimension is the same for all dimensions + # but the one being joined. + + do i = 2, nimages { + im1 = Memi[in+i-1] + if (IM_NDIM(im1) != IM_NDIM(im)) + call error (0, "The input images have different dimensions") + ndim = max (ndim, IM_NDIM(im1)) + do j = 1, ndim { + if (j > IM_NDIM(im1)) + nelems[j] = nelems[j] + 1 + else if (j == joindim) + nelems[j] = nelems[j] + IM_LEN(im1,j) + else if (IM_LEN(im1,j) != nelems[j]) + call error (0, + "The input images have unequal sizes in the non-join dimension") + } + inpixtype = ij_tymax (inpixtype, IM_PIXTYPE(im1)) + } + + # Open the output image and set its pixel data type, number of + # dimensions, and length of each of the dimensions. + + out = immap (Memc[output], NEW_COPY, Memi[in]) + if (outpixtype == ERR || outpixtype == TY_BOOL) + IM_PIXTYPE(out) = inpixtype + else + IM_PIXTYPE(out) = outpixtype + IM_NDIM(out) = ndim + do j = 1, ndim + IM_LEN(out,j) = nelems[j] + + if (bufsize == 0) { + + # Set initial IMIO buffer size based on the number of images + # and maximum amount of working memory available. The buffer + # size may be adjusted later if the task runs out of memory. + # The FUDGE factor is used to allow for the size of the + # program, memory allocator inefficiencies, and any other + # memory requirements besides IMIO. + + bufsize = 1 + do i = 1, IM_NDIM(out) + bufsize = bufsize * IM_LEN(out,i) + bufsize = bufsize * sizeof (inpixtype) + bufsize = min (bufsize, DEFBUFSIZE) + memory = begmem ((nimages + 1) * bufsize, oldsize, maxsize) + memory = min (memory, int (FUDGE * maxsize)) + bufsize = memory / (nimages + 1) + } + + # Join the images along the join dimension. If an out of memory error + # occurs close all images and files, divide the IMIO buffer size in + # half and try again. + + iferr { + switch (inpixtype) { + case TY_SHORT: + call imjoins (Memi[in], nimages, out, joindim, outpixtype) + case TY_INT: + call imjoini (Memi[in], nimages, out, joindim, outpixtype) + case TY_USHORT, TY_LONG: + call imjoinl (Memi[in], nimages, out, joindim, outpixtype) + case TY_REAL: + call imjoinr (Memi[in], nimages, out, joindim, outpixtype) + case TY_DOUBLE: + call imjoind (Memi[in], nimages, out, joindim, outpixtype) + case TY_COMPLEX: + call imjoinx (Memi[in], nimages, out, joindim, outpixtype) + } + } then { + switch (errcode()) { + case SYS_MFULL: + do j = 1, nimages + call imunmap (Memi[in+j-1]) + call imunmap (out) + call imdelete (Memc[output]) + call imtrew (list) + bufsize = bufsize / 2 + goto retry_ + default: + call erract (EA_ERROR) + } + } + + if (verbose == YES) + call ij_verbose (Memi[in], nimages, out, joindim) + + # Unmap all the images. + call imunmap (out) + do i = 1, nimages + call imunmap (Memi[in+i-1]) + + # Restore memory. + call sfree (sp) + call fixmem (oldsize) +end + + +define MAX_NTYPES 8 +define MAX_NPIXTYPES 7 + +# IJ_TYMAX -- Return the data type of highest precedence. + +int procedure ij_tymax (type1, type2) + +int type1, type2 # Input data types + +int i, j, order[MAX_NTYPES] +data order/TY_SHORT,TY_USHORT,TY_INT,TY_LONG,TY_REAL,TY_DOUBLE,TY_COMPLEX, + TY_REAL/ +begin + for (i=1; (i<=MAX_NPIXTYPES) && (type1!=order[i]); i=i+1) + ; + for (j=1; (j<=MAX_NPIXTYPES) && (type2!=order[j]); j=j+1) + ; + return (order[max(i,j)]) +end + + +# IJ_VERBOSE -- Print messages about the actions taken by IMJOIN. + +procedure ij_verbose (imptrs, nimages, outptr, joindim) + +pointer imptrs[ARB] # array of input image pointers +int nimages # the number of input images +pointer outptr # the output image pointer +int joindim # the join dimension + +int i, j, nindim, noutdim +long offset + +begin + noutdim = IM_NDIM(outptr) + offset = 1 + + do i = 1, nimages { + + nindim = IM_NDIM(imptrs[i]) + call printf ("Join: %s size: ") + call pargstr (IM_HDRFILE(imptrs[i])) + do j = 1, nindim { + if (j == nindim) + call printf ("%d -> ") + else + call printf ("%d X ") + call pargl (IM_LEN(imptrs[i],j)) + } + + call printf ("%s[") + call pargstr (IM_HDRFILE(outptr)) + do j = 1, noutdim { + if (j > nindim) { + call printf ("%d:%d") + call pargi (i) + call pargi (i) + } else if (j == joindim) { + call printf ("%d:%d") + call pargl (offset) + call pargl (offset + IM_LEN(imptrs[i],j)-1) + offset = offset + IM_LEN(imptrs[i],j) + } else { + call printf ("1:%d") + call pargl (IM_LEN(outptr,j)) + } + if (j != noutdim) + call printf (",") + else + call printf ("]") + } + + call printf ("\n") + + } +end diff --git a/pkg/images/imutil/src/t_imrename.x b/pkg/images/imutil/src/t_imrename.x new file mode 100644 index 00000000..25562044 --- /dev/null +++ b/pkg/images/imutil/src/t_imrename.x @@ -0,0 +1,100 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMRENAME -- Rename an image or list of images, or move a image or images +# to a new directory. Pixel files are moved to the current IMDIR. Moving +# an image to the same directory will move the pixel file if IMDIR has been +# changed since the image was created. + +procedure t_imrename() + +pointer sp, old_list, new_list +pointer old_name, new_name, old_dir, new_dir +bool verbose + +int list1, list2, root_len +int imtopen(), imtgetim(), imtlen() +int fnldir(), isdirectory() +bool clgetb() + +begin + call smark (sp) + call salloc (old_list, SZ_LINE, TY_CHAR) + call salloc (new_list, SZ_LINE, TY_CHAR) + call salloc (old_name, SZ_PATHNAME, TY_CHAR) + call salloc (new_name, SZ_PATHNAME, TY_CHAR) + call salloc (new_dir, SZ_PATHNAME, TY_CHAR) + call salloc (old_dir, SZ_PATHNAME, TY_CHAR) + + # Get input and output image template lists. + call clgstr ("oldnames", Memc[old_list], SZ_LINE) + call clgstr ("newnames", Memc[new_list], SZ_LINE) + verbose = clgetb ("verbose") + + # Check if the output string is a directory. + + if (isdirectory (Memc[new_list], Memc[new_dir], SZ_PATHNAME) > 0) { + list1 = imtopen (Memc[old_list]) + while (imtgetim (list1, Memc[old_name], SZ_PATHNAME) != EOF) { + + # Strip the image section first because fnldir recognizes it + # as part of a directory. Place the input image name + # without a directory or image section in string Memc[old_dir]. + + call get_root (Memc[old_name], Memc[new_name], SZ_PATHNAME) + root_len = fnldir (Memc[new_name], Memc[old_dir], SZ_PATHNAME) + call strcpy (Memc[new_name+root_len], Memc[old_dir],SZ_PATHNAME) + + call strcpy (Memc[new_dir], Memc[new_name], SZ_PATHNAME) + call strcat (Memc[old_dir], Memc[new_name], SZ_PATHNAME) + call img_rename (Memc[old_name], Memc[new_name], verbose) + } + call imtclose (list1) + + } else { + # Expand the input and output image lists. + list1 = imtopen (Memc[old_list]) + list2 = imtopen (Memc[new_list]) + + if (imtlen (list1) != imtlen (list2)) { + call imtclose (list1) + call imtclose (list2) + call error (1, "Different number of old and new image names") + } + + # Do each set of input/output images. + while ((imtgetim (list1, Memc[old_name], SZ_PATHNAME) != EOF) && + (imtgetim (list2, Memc[new_name], SZ_PATHNAME) != EOF)) { + + call img_rename (Memc[old_name], Memc[new_name], verbose) + } + + call imtclose (list1) + call imtclose (list2) + } + + call sfree (sp) +end + + +# IMG_RENAME -- Rename an image, optionally printing a message to the STDOUT. + +procedure img_rename (old_name, new_name, verbose) + +char old_name[ARB] #I old image name +char new_name[ARB] #I new image name +bool verbose #I print message? + +begin + iferr (call imrename (old_name, new_name)) { + call eprintf ("Warning: cannot rename `%s' -> `%s'\n") + call pargstr (old_name) + call pargstr (new_name) + } else if (verbose) { + call printf ("`%s' -> `%s'\n") + call pargstr (old_name) + call pargstr (new_name) + call flush (STDOUT) + } +end diff --git a/pkg/images/imutil/src/t_imreplace.x b/pkg/images/imutil/src/t_imreplace.x new file mode 100644 index 00000000..2b8750ac --- /dev/null +++ b/pkg/images/imutil/src/t_imreplace.x @@ -0,0 +1,83 @@ +include <imhdr.h> + +# T_IMREP -- Replace pixels in a window with a constant. + +procedure t_imrep () + +char imtlist[SZ_LINE] # Images to be editted +real lower # Lower limit of window +real upper # Upper limit of window +real value # Replacement value +real radius # Radius +real img # Imaginary part for complex + +int list +char image[SZ_FNAME] +pointer im + +int imtopen(), imtgetim() +real clgetr() +pointer immap() + +begin + # Get image template list. + + call clgstr ("images", imtlist, SZ_LINE) + list = imtopen (imtlist) + + # Get the parameters. + + value = clgetr ("value") + img = clgetr ("imaginary") + lower = clgetr ("lower") + upper = clgetr ("upper") + radius = max (0., clgetr ("radius")) + + # Replace the pixels in each image. Optimize IMIO. + + while (imtgetim (list, image, SZ_FNAME) != EOF) { + + im = immap (image, READ_WRITE, 0) + + if (radius < 1.) { + switch (IM_PIXTYPE (im)) { + case TY_SHORT: + call imreps (im, lower, upper, value, img) + case TY_INT: + call imrepi (im, lower, upper, value, img) + case TY_USHORT, TY_LONG: + call imrepl (im, lower, upper, value, img) + case TY_REAL: + call imrepr (im, lower, upper, value, img) + case TY_DOUBLE: + call imrepd (im, lower, upper, value, img) + case TY_COMPLEX: + call imrepx (im, lower, upper, value, img) + default: + call error (0, "Unsupported image pixel datatype") + } + + } else { + switch (IM_PIXTYPE (im)) { + case TY_SHORT: + call imrreps (im, lower, upper, radius, value, img) + case TY_INT: + call imrrepi (im, lower, upper, radius, value, img) + case TY_USHORT, TY_LONG: + call imrrepl (im, lower, upper, radius, value, img) + case TY_REAL: + call imrrepr (im, lower, upper, radius, value, img) + case TY_DOUBLE: + call imrrepd (im, lower, upper, radius, value, img) + case TY_COMPLEX: + call imrrepx (im, lower, upper, radius, value, img) + default: + call error (0, "Unsupported image pixel datatype") + } + } + + call imunmap (im) + } + + call imtclose (list) +end diff --git a/pkg/images/imutil/src/t_imslice.x b/pkg/images/imutil/src/t_imslice.x new file mode 100644 index 00000000..6942ec05 --- /dev/null +++ b/pkg/images/imutil/src/t_imslice.x @@ -0,0 +1,472 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <ctype.h> +include <mwset.h> + +# T_IMSLICE -- Slice an input image into a list of output images equal in +# length to the length of the dimension to be sliced. The remaining +# dimensions are unchanged. For a 1 dimensionsal image this task is a null +# operation. + +procedure t_imslice() + +pointer imtlist1 # Input image list +pointer imtlist2 # Output image list +pointer image1 # Input image +pointer image2 # Output image +int sdim # Dimension to be sliced +int verbose # Verbose mode + +pointer sp +int list1, list2 + +bool clgetb() +int imtopen(), imtgetim(), imtlen(), btoi(), clgeti() +errchk sl_slice + +begin + call smark (sp) + call salloc (imtlist1, SZ_FNAME, TY_CHAR) + call salloc (imtlist2, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call salloc (image2, SZ_FNAME, TY_CHAR) + + # Get task parameters. + call clgstr ("input", Memc[imtlist1], SZ_FNAME) + call clgstr ("output", Memc[imtlist2], SZ_FNAME) + sdim = clgeti ("slice_dimension") + verbose = btoi (clgetb ("verbose")) + + list1 = imtopen (Memc[imtlist1]) + list2 = imtopen (Memc[imtlist2]) + if (imtlen (list1) != imtlen (list2)) { + call imtclose (list1) + call imtclose (list2) + call error (0, "Number of input and output images not the same.") + } + + # Loop over the set of input and output images + while ((imtgetim (list1, Memc[image1], SZ_FNAME) != EOF) && + (imtgetim (list2, Memc[image2], SZ_FNAME) != EOF)) + call sl_imslice (Memc[image1], Memc[image2], sdim, verbose) + + call imtclose (list1) + call imtclose (list2) + + call sfree (sp) +end + + +# SL_IMSLICE -- Procedure to slice an n-dimensional image into a set +# of images with one fewer dimensions. A number is appendend to the +# output image name indicating which element of the n-th dimension the +# new image originated from. + +procedure sl_imslice (image1, image2, sdim, verbose) + +char image1[ARB] # input image +char image2[ARB] # output image +int sdim # slice dimension +int verbose # verbose mode + +int i, j, ndim, fdim, ncols, nlout, nimout, pdim +int axno[IM_MAXDIM], axval[IM_MAXDIM] +pointer sp, inname, outname, outsect, im1, im2, buf1, buf2, vim1, vim2 +pointer mw, vs, ve +real shifts[IM_MAXDIM] + +pointer immap(), mw_openim() +int mw_stati() +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx() +int imggss(), imggsi(), imggsl(), imggsr(), imggsd(), imggsx() +int impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() +bool envgetb() + +errchk imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx() +errchk imggss(), imggsi(), imggsl(), imggsr(), imggsd(), imggsx() +errchk impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() + +begin + iferr (im1 = immap (image1, READ_ONLY, 0)) { + call erract (EA_WARN) + return + } + + ndim = IM_NDIM(im1) + + # Check that sdim is in range. + if (sdim > ndim) { + call printf ("Image %s has fewer than %d dimensions.\n") + call pargstr (image1) + call pargi (sdim) + call imunmap (im1) + return + } + + # Cannot slice 1D images. + if (ndim == 1) { + call printf ("Image %s is 1 dimensional.\n") + call pargstr (image1) + call imunmap (im1) + return + } + + # Cannot slice an image which is degnerate in slice dimension. + #if (IM_LEN(im1,sdim) == 1) { + #call printf ("Image %s is degenerate in the %d dimension.\n") + #call pargstr (image1) + #call pargi (sdim) + #call imunmap (im1) + #return + #} + + call smark (sp) + call salloc (inname, SZ_LINE, TY_CHAR) + call salloc (outname, SZ_FNAME, TY_CHAR) + call salloc (outsect, SZ_LINE, TY_CHAR) + + call salloc (vs, IM_MAXDIM, TY_LONG) + call salloc (ve, IM_MAXDIM, TY_LONG) + call salloc (vim1, IM_MAXDIM, TY_LONG) + call salloc (vim2, IM_MAXDIM, TY_LONG) + + # Compute the number of output images. and the number of columns + nimout = IM_LEN(im1, sdim) + + # Compute the number of lines and columns in the output image. + if (sdim == 1) { + fdim = 2 + ncols = IM_LEN(im1,2) + } else { + fdim = 1 + ncols = IM_LEN(im1,1) + } + nlout = 1 + do i = 1, sdim - 1 + nlout = nlout * IM_LEN(im1,i) + do i = sdim + 1, ndim + nlout = nlout * IM_LEN(im1,i) + nlout = nlout / ncols + + call amovkl (long(1), Meml[vim1], IM_MAXDIM) + do i = 1, nimout { + + # Construct the output image name. + call sprintf (Memc[outname], SZ_FNAME, "%s%03d") + call pargstr (image2) + call pargi (i) + + # Open the output image. + iferr (im2 = immap (Memc[outname], NEW_COPY, im1)) { + call erract (EA_WARN) + call imunmap (im1) + call sfree (sp) + return + } else { + IM_NDIM(im2) = ndim - 1 + do j = 1, sdim - 1 + IM_LEN(im2,j) = IM_LEN(im1,j) + do j = sdim + 1, IM_NDIM(im1) + IM_LEN(im2,j-1) = IM_LEN(im1,j) + } + + # Print messages on the screen. + if (verbose == YES) { + call sl_einsection (im1, i, sdim, Memc[inname], SZ_LINE) + call sl_esection (im2, Memc[outsect], SZ_LINE) + call printf ("Copied image %s %s -> %s %s\n") + call pargstr (image1) + call pargstr (Memc[inname]) + call pargstr (Memc[outname]) + call pargstr (Memc[outsect]) + call flush (STDOUT) + } + + # Initialize the v vectors for each new image. + if (sdim != ndim) { + do j = 1, ndim { + if (j == sdim) { + Meml[vs+j-1] = i + Meml[ve+j-1] = i + } else if (j == fdim) { + Meml[vs+j-1] = 1 + Meml[ve+j-1] = IM_LEN(im1,j) + } else { + Meml[vs+j-1] = 1 + Meml[ve+j-1] = 1 + } + } + } + + # Loop over the appropriate range of lines. + call amovkl (long(1), Meml[vim2], IM_MAXDIM) + switch (IM_PIXTYPE(im1)) { + case TY_SHORT: + if (sdim == ndim) { + do j = 1, nlout { + if (impnls (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + if (imgnls (im1, buf1, Meml[vim1]) == EOF) + call error (0, "Error reading input image.") + call amovs (Mems[buf1], Mems[buf2], ncols) + } + } else { + do j = 1, nlout { + if (impnls (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + buf1 = imggss (im1, Meml[vs], Meml[ve], IM_NDIM(im1)) + if (buf1 == EOF) + call error (0, "Error reading input image.") + call amovs (Mems[buf1], Mems[buf2], ncols) + call sl_loop (Meml[vs], Meml[ve], IM_LEN(im1,1), fdim, + sdim, ndim) + } + } + case TY_USHORT, TY_INT: + if (sdim == ndim) { + do j = 1, nlout { + if (impnli (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + if (imgnli (im1, buf1, Meml[vim1]) == EOF) + call error (0, "Error reading input image.") + call amovi (Memi[buf1], Memi[buf2], ncols) + } + } else { + do j = 1, nlout { + if (impnli (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + buf1= imggsi (im1, Meml[vs], Meml[ve], IM_NDIM(im1)) + if (buf1 == EOF) + call error (0, "Error reading input image.") + call amovi (Memi[buf1], Memi[buf2], ncols) + call sl_loop (Meml[vs], Meml[ve], IM_LEN(im1,1), fdim, + sdim, ndim) + } + } + case TY_LONG: + if (sdim == ndim) { + do j = 1, nlout { + if (impnll (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + if (imgnll (im1, buf1, Meml[vim1]) == EOF) + call error (0, "Error reading input image.") + call amovl (Meml[buf1], Meml[buf2], ncols) + } + } else { + do j = 1, nlout { + if (impnll (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + buf1 = imggsl (im1, Meml[vs], Meml[ve], IM_NDIM(im1)) + if (buf1 == EOF) + call error (0, "Error reading input image.") + call amovl (Meml[buf1], Meml[buf2], ncols) + call sl_loop (Meml[vs], Meml[ve], IM_LEN(im1,1), fdim, + sdim, ndim) + } + } + case TY_REAL: + if (sdim == ndim) { + do j = 1, nlout { + if (impnlr (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + if (imgnlr (im1, buf1, Meml[vim1]) == EOF) + call error (0, "Error reading input image.") + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } else { + do j = 1, nlout { + if (impnlr (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + buf1 = imggsr (im1, Meml[vs], Meml[ve], IM_NDIM(im1)) + if (buf1 == EOF) + call error (0, "Error reading input image.") + call amovr (Memr[buf1], Memr[buf2], ncols) + call sl_loop (Meml[vs], Meml[ve], IM_LEN(im1,1), + fdim, sdim, ndim) + } + } + case TY_DOUBLE: + if (sdim == ndim) { + do j = 1, nlout { + if (impnld (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + if (imgnld (im1, buf1, Meml[vim1]) == EOF) + call error (0, "Error reading input image.") + call amovd (Memd[buf1], Memd[buf2], ncols) + } + } else { + do j = 1, nlout { + if (impnld (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + buf1 = imggsd (im1, Meml[vs], Meml[ve], IM_NDIM(im1)) + if (buf1 == EOF) + call error (0, "Error reading input image.") + call amovd (Memd[buf1], Memd[buf2], ncols) + call sl_loop (Meml[vs], Meml[ve], IM_LEN(im1,1), fdim, + sdim, ndim) + } + } + case TY_COMPLEX: + if (sdim == ndim) { + do j = 1, nlout { + if (impnlx (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + if (imgnlx (im1, buf1, Meml[vim1]) == EOF) + call error (0, "Error reading input image.") + call amovx (Memx[buf1], Memx[buf2], ncols) + } + } else { + do j = 1, nlout { + if (impnlx (im2, buf2, Meml[vim2]) == EOF) + call error (0, "Error writing output image.") + buf1 = imggsx (im1, Meml[vs], Meml[ve], IM_NDIM(im1)) + if (buf1 == EOF) + call error (0, "Error reading input image.") + call amovx (Memx[buf1], Memx[buf2], ncols) + call sl_loop (Meml[vs], Meml[ve], IM_LEN(im1,1), fdim, + sdim, ndim) + } + } + } + + # Update the wcs. + if (! envgetb ("nowcs")) { + + # Open and shift the wcs. + mw = mw_openim (im1) + call aclrr (shifts, ndim) + shifts[sdim] = -(i - 1) + call mw_shift (mw, shifts, (2 ** ndim - 1)) + + # Get and reset the axis map. + pdim = mw_stati (mw, MW_NPHYSDIM) + call mw_gaxmap (mw, axno, axval, pdim) + do j = 1, pdim { + if (axno[j] < sdim) { + next + } else if (axno[j] > sdim) { + axno[j] = axno[j] - 1 + } else { + axno[j] = 0 + axval[j] = i - 1 + } + } + call mw_saxmap (mw, axno, axval, pdim) + + call mw_savim (mw, im2) + call mw_close (mw) + } + + call imunmap (im2) + } + + + call imunmap (im1) + call sfree (sp) +end + + +# SL_LOOP -- Increment the vector V from VS to VE (nested do loops cannot +# be used because of the variable number of dimensions). + +procedure sl_loop (vs, ve, ldim, fdim, sdim, ndim) + +long vs[ndim] # vector of starting points +long ve[ndim] # vector of ending points +long ldim[ndim] # vector of dimension lengths +int fdim # first dimension +int sdim # slice dimension +int ndim # number of dimensions + +int dim + +begin + for (dim = fdim+1; dim <= ndim; dim = dim + 1) { + if (dim == sdim) + next + vs[dim] = vs[dim] + 1 + ve[dim] = vs[dim] + if (vs[dim] - ldim[dim] == 1) { + if (dim < ndim) { + vs[dim] = 1 + ve[dim] = 1 + } else + break + } else + break + } +end + + +# SL_EINSECTION -- Encode the dimensions of an image where the element of +# the slice dimension is fixed in section notation. + +procedure sl_einsection (im, el, sdim, section, maxch) + +pointer im # pointer to the image +int el # element of last dimension +int sdim # slice dimension +char section[ARB] # output section +int maxch # maximum number of characters in output section + +int i, op +int ltoc(), gstrcat() + +begin + op = 1 + section[1] = '[' + op = op + 1 + + # Encode dimensions up to the slice dimension. + for (i = 1; i <= sdim - 1 && op <= maxch; i = i + 1) { + op = op + ltoc (long(1), section[op], maxch) + op = op + gstrcat (":", section[op], maxch) + op = op + ltoc (IM_LEN(im,i), section[op], maxch) + op = op + gstrcat (",", section[op], maxch) + } + + # Encode the slice dimension. + op = op + ltoc (el, section[op], maxch) + op = op + gstrcat (",", section[op], maxch) + + # Encode dimensions above the slice dimension. + for (i = sdim + 1; i <= IM_NDIM(im); i = i + 1) { + op = op + ltoc (long(1), section[op], maxch) + op = op + gstrcat (":", section[op], maxch) + op = op + ltoc (IM_LEN(im,i), section[op], maxch) + op = op + gstrcat (",", section[op], maxch) + } + + section[op-1] = ']' + section[op] = EOS +end + + +# SL_ESECTION -- Encode the dimensions of an image in section notation. + +procedure sl_esection (im, section, maxch) + +pointer im # pointer to the image +char section[ARB] # output section +int maxch # maximum number of characters in output section + +int i, op +int ltoc(), gstrcat() + +begin + op = 1 + section[1] = '[' + op = op + 1 + + for (i = 1; i <= IM_NDIM(im); i = i + 1) { + op = op + ltoc (long(1), section[op], maxch) + op = op + gstrcat (":", section[op], maxch) + op = op + ltoc (IM_LEN(im,i), section[op], maxch) + op = op + gstrcat (",", section[op], maxch) + } + + section[op-1] = ']' + section[op] = EOS +end diff --git a/pkg/images/imutil/src/t_imstack.x b/pkg/images/imutil/src/t_imstack.x new file mode 100644 index 00000000..20fc1ac7 --- /dev/null +++ b/pkg/images/imutil/src/t_imstack.x @@ -0,0 +1,300 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mwset.h> + +define NTYPES 7 + + +# T_IMSTACK -- Stack images into a single image of higher dimension. + +procedure t_imstack () + +int i, j, npix, list, pdim, lmax, lindex +int axno[IM_MAXDIM], axval[IM_MAXDIM] +long line_in[IM_MAXDIM], line_out[IM_MAXDIM] +pointer sp, input, output, in, out, buf_in, buf_out, mwin, mwout + +bool envgetb() +int imtopenp(), imtgetim(), imtlen() +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx() +int impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() +int mw_stati() +pointer immap(), mw_open(), mw_openim() + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + + # Get the input images and the output image. + list = imtopenp ("images") + call clgstr ("output", Memc[output], SZ_FNAME) + + # Add each input image to the output image. + + i = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + + i = i + 1 + in = immap (Memc[input], READ_ONLY, 0) + + # For the first input image map the output image as a copy + # and increment the dimension. Set the output line counter. + + if (i == 1) { + out = immap (Memc[output], NEW_COPY, in) + call isk_new_image (out) + IM_NDIM(out) = IM_NDIM(out) + 1 + IM_LEN(out, IM_NDIM(out)) = imtlen (list) + npix = IM_LEN(out, 1) + call amovkl (long(1), line_out, IM_MAXDIM) + } + + # Check next input image for consistency with the output image. + if (IM_NDIM(in) != IM_NDIM(out) - 1) + call error (0, "Input images not consistent") + do j = 1, IM_NDIM(in) { + if (IM_LEN(in, j) != IM_LEN(out, j)) + call error (0, "Input images not consistent") + } + + # Copy the input lines from the image to the next lines of + # the output image. Switch on the output data type to optimize + # IMIO. + + call amovkl (long(1), line_in, IM_MAXDIM) + switch (IM_PIXTYPE (out)) { + case TY_SHORT: + while (imgnls (in, buf_in, line_in) != EOF) { + if (impnls (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovs (Mems[buf_in], Mems[buf_out], npix) + } + case TY_INT: + while (imgnli (in, buf_in, line_in) != EOF) { + if (impnli (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovi (Memi[buf_in], Memi[buf_out], npix) + } + case TY_USHORT, TY_LONG: + while (imgnll (in, buf_in, line_in) != EOF) { + if (impnll (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovl (Meml[buf_in], Meml[buf_out], npix) + } + case TY_REAL: + while (imgnlr (in, buf_in, line_in) != EOF) { + if (impnlr (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovr (Memr[buf_in], Memr[buf_out], npix) + } + case TY_DOUBLE: + while (imgnld (in, buf_in, line_in) != EOF) { + if (impnld (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovd (Memd[buf_in], Memd[buf_out], npix) + } + case TY_COMPLEX: + while (imgnlx (in, buf_in, line_in) != EOF) { + if (impnlx (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovx (Memx[buf_in], Memx[buf_out], npix) + } + default: + while (imgnlr (in, buf_in, line_in) != EOF) { + if (impnlr (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovr (Memr[buf_in], Memr[buf_out], npix) + } + } + + # Update the wcs. The output image will inherit the wcs of + # the first input image. The new axis will be assigned the + # identity transformation if wcsdim of the original image is + # less than the number of dimensions in the stacked image. + + if ((i == 1) && (! envgetb ("nowcs"))) { + mwin = mw_openim (in) + pdim = mw_stati (mwin, MW_NPHYSDIM) + call mw_gaxmap (mwin, axno, axval, pdim) + lmax = 0 + lindex = 0 + do j = 1, pdim { + if (axno[j] <= lmax) + next + lmax = axno[j] + lindex = j + } + if (lindex < pdim) { + axno[pdim] = lmax + 1 + axval[pdim] = 0 + call mw_saxmap (mwin, axno, axval, pdim) + call mw_saveim (mwin, out) + } else { + mwout = mw_open (NULL, pdim + 1) + call isk_wcs (mwin, mwout, IM_NDIM(out)) + call mw_saveim (mwout, out) + call mw_close (mwout) + } + call mw_close (mwin) + } + + call imunmap (in) + } + + # Finish up. + call imunmap (out) + call imtclose (list) + call sfree (sp) +end + + +# ISK_NEW_IMAGE -- Get a new image title and pixel type. +# +# The strings 'default' or '*' are recognized as defaulting to the original +# title or pixel datatype. + +procedure isk_new_image (im) + +pointer im # image descriptor + +pointer sp, lbuf +int i, type_codes[NTYPES] +bool strne() +int stridx() + +string types "suilrdx" +data type_codes /TY_SHORT,TY_USHORT,TY_INT,TY_LONG,TY_REAL,TY_DOUBLE, + TY_COMPLEX/ + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + call clgstr ("title", Memc[lbuf], SZ_LINE) + if (strne (Memc[lbuf], "default") && strne (Memc[lbuf], "*")) + call strcpy (Memc[lbuf], IM_TITLE(im), SZ_IMTITLE) + + call clgstr ("pixtype", Memc[lbuf], SZ_LINE) + if (strne (Memc[lbuf], "default") && strne (Memc[lbuf], "*")) { + i = stridx (Memc[lbuf], types) + if (i != 0) + IM_PIXTYPE(im) = type_codes[i] + } + + call sfree (sp) +end + + +# ISK_WCS -- Update the wcs of the stacked image. + +procedure isk_wcs (mwin, mwout, ndim) + +pointer mwin # input wcs descriptor +pointer mwout # output wcs descriptor +int ndim # the dimension of the output image + +int i, j, nin, nout, szatstr, axno[IM_MAXDIM], axval[IM_MAXDIM] +pointer sp, wcs, attribute, matin, matout, rin, rout, win, wout, atstr +int mw_stati(), itoc(), strlen() +errchk mw_newsystem() + +begin + # Get the sizes of the two wcs. + nin = mw_stati (mwin, MW_NPHYSDIM) + nout = mw_stati (mwout, MW_NPHYSDIM) + szatstr = SZ_LINE + + # Allocate space for the matrices and vectors. + call smark (sp) + call salloc (wcs, SZ_FNAME, TY_CHAR) + call salloc (matin, nin * nin, TY_DOUBLE) + call salloc (matout, nout * nout, TY_DOUBLE) + call salloc (rin, nin, TY_DOUBLE) + call salloc (rout, nout, TY_DOUBLE) + call salloc (win, nin, TY_DOUBLE) + call salloc (wout, nout, TY_DOUBLE) + call salloc (attribute, SZ_FNAME, TY_CHAR) + call malloc (atstr, szatstr, TY_CHAR) + + # Set the system name. + call mw_gsystem (mwin, Memc[wcs], SZ_FNAME) + iferr (call mw_newsystem (mwout, Memc[wcs], nout)) + call mw_ssystem (mwout, Memc[wcs]) + + # Set the lterm. + call mw_gltermd (mwin, Memd[matin], Memd[rin], nin) + call aclrd (Memd[rout], nout) + call amovd (Memd[rin], Memd[rout], nin) + call mw_mkidmd [Memd[matout], nout) + call isk_mcopy (Memd[matin], nin, Memd[matout], nout) + call mw_sltermd (mwout, Memd[matout], Memd[rout], nout) + + # Set the wterm. + call mw_gwtermd (mwin, Memd[rin], Memd[win], Memd[matin], nin) + call aclrd (Memd[rout], nout) + call amovd (Memd[rin], Memd[rout], nin) + call aclrd (Memd[wout], nout) + call amovd (Memd[win], Memd[wout], nin) + call mw_mkidmd [Memd[matout], nout) + call isk_mcopy (Memd[matin], nin, Memd[matout], nout) + call mw_swtermd (mwout, Memd[rout], Memd[wout], Memd[matout], nout) + + # Set the axis map. + call mw_gaxmap (mwin, axno, axval, nin) + do i = nin + 1, nout { + axno[i] = ndim + axval[i] = 0 + } + call mw_saxmap (mwout, axno, axval, nout) + + # Get the axis list and copy the old attribute list for each axis. + do i = 1, nin { + iferr (call mw_gwattrs (mwin, i, "wtype", Memc[atstr], szatstr)) + call strcpy ("linear", Memc[atstr], szatstr) + call mw_swtype (mwout, i, 1, Memc[atstr], "") + for (j = 1; ; j = j + 1) { + if (itoc (j, Memc[attribute], SZ_FNAME) <= 0) + Memc[attribute] = EOS + repeat { + iferr (call mw_gwattrs (mwin, i, Memc[attribute], + Memc[atstr], szatstr)) + Memc[atstr] = EOS + if (strlen (Memc[atstr]) < szatstr) + break + szatstr = szatstr + SZ_LINE + call realloc (atstr, szatstr, TY_CHAR) + } + if (Memc[atstr] == EOS) + break + call mw_swattrs (mwout, i, Memc[attribute], Memc[atstr]) + } + } + + # Set the default attributes for the new axes. + do i = nin + 1, nout + call mw_swtype (mwout, i, 1, "linear", "") + + call mfree (atstr, TY_CHAR) + call sfree (sp) +end + + +# ISK_MCOPY -- Copy a smaller 2d matrix into a larger one. + +procedure isk_mcopy (matin, nin, matout, nout) + +double matin[nin,nin] # the input matrix +int nin # size of the input matrix +double matout[nout,nout] # the input matrix +int nout # size of the output matrix + +int i,j + +begin + do i = 1, nin { + do j = 1, nin + matout[j,i] = matin[j,i] + } +end diff --git a/pkg/images/imutil/src/t_imstat.x b/pkg/images/imutil/src/t_imstat.x new file mode 100644 index 00000000..9641a83e --- /dev/null +++ b/pkg/images/imutil/src/t_imstat.x @@ -0,0 +1,1213 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imhdr.h> +include <imset.h> +include "imstat.h" + + +# T_IMSTATISTICS -- Compute and print the statistics of images. + +procedure t_imstatistics () + +real lower, upper, binwidth, lsigma, usigma, low, up, hwidth, hmin, hmax +pointer sp, fieldstr, fields, image, ist, v +pointer im, buf, hgm +int i, list, nclip, format, nfields, nbins, npix, cache, old_size + +real clgetr() +pointer immap() +int imtopenp(), btoi(), ist_fields(), imtgetim(), imgnlr(), ist_ihist() +int clgeti() +bool clgetb() +errchk immap() + +begin + call smark (sp) + call salloc (fieldstr, SZ_LINE, TY_CHAR) + call salloc (fields, IST_NFIELDS, TY_INT) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (v, IM_MAXDIM, TY_LONG) + + # Open the list of input images, the fields and the data value limits. + list = imtopenp ("images") + call clgstr ("fields", Memc[fieldstr], SZ_LINE) + lower = clgetr ("lower") + upper = clgetr ("upper") + nclip = clgeti ("nclip") + lsigma = clgetr ("lsigma") + usigma = clgetr ("usigma") + binwidth = clgetr ("binwidth") + format = btoi (clgetb ("format")) + cache = btoi (clgetb ("cache")) + + # Allocate space for statistics structure + call ist_allocate (ist) + + # Get the selected fields. + nfields = ist_fields (Memc[fieldstr], Memi[fields], IST_NFIELDS) + if (nfields <= 0) { + call imtclose (list) + call sfree (sp) + return + } + + # Set the processing switches + call ist_switches (ist, Memi[fields], nfields, nclip) + + # Print header banner. + if (format == YES) + call ist_pheader (Memi[fields], nfields) + + # Loop through the input images. + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + + # Open the image. + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call printf ("Error reading image %s ...\n") + call pargstr (Memc[image]) + next + } + + if (cache == YES) + call ist_cache1 (cache, im, old_size) + + # Accumulate the central moment statistics. + low = lower + up = upper + do i = 0, nclip { + + call ist_initialize (ist, low, up) + call amovkl (long(1), Meml[v], IM_MAXDIM) + + if (IST_SKURTOSIS(IST_SW(ist)) == YES) { + while (imgnlr (im, buf, Meml[v]) != EOF) + call ist_accumulate4 (ist, Memr[buf], + int (IM_LEN(im, 1)), low, up, + IST_SMINMAX(IST_SW(ist))) + } else if (IST_SSKEW(IST_SW(ist)) == YES) { + while (imgnlr (im, buf, Meml[v]) != EOF) + call ist_accumulate3 (ist, Memr[buf], + int (IM_LEN (im, 1)), low, up, + IST_SMINMAX(IST_SW(ist))) + } else if (IST_SSTDDEV(IST_SW(ist)) == YES || + IST_SMEDIAN(IST_SW(ist)) == YES || + IST_SMODE(IST_SW(ist)) == YES) { + while (imgnlr (im, buf, Meml[v]) != EOF) + call ist_accumulate2 (ist, Memr[buf], + int (IM_LEN(im,1)), low, up, + IST_SMINMAX(IST_SW(ist))) + } else if (IST_SMEAN(IST_SW(ist)) == YES) { + while (imgnlr (im, buf, Meml[v]) != EOF) + call ist_accumulate1 (ist, Memr[buf], + int (IM_LEN(im,1)), low, up, + IST_SMINMAX(IST_SW(ist))) + } else if (IST_SNPIX(IST_SW(ist)) == YES) { + while (imgnlr (im, buf, Meml[v]) != EOF) + call ist_accumulate0 (ist, Memr[buf], + int (IM_LEN(im,1)), low, up, + IST_SMINMAX(IST_SW(ist))) + } else if (IST_SMINMAX(IST_SW(ist)) == YES) { + while (imgnlr (im, buf, Meml[v]) != EOF) + call ist_accumulate0 (ist, Memr[buf], + int (IM_LEN(im,1)), low, up, YES) + } + + + # Compute the central moment statistics. + call ist_stats (ist) + + # Compute new limits and iterate. + if (i < nclip) { + if (IS_INDEFR(lsigma) || IS_INDEFR(IST_MEAN(ist)) || + IS_INDEFR(IST_STDDEV(ist))) + low = -MAX_REAL + else if (lsigma > 0.0) + low = IST_MEAN(ist) - lsigma * IST_STDDEV(ist) + else + low = -MAX_REAL + if (IS_INDEFR(usigma) || IS_INDEFR(IST_MEAN(ist)) || + IS_INDEFR(IST_STDDEV(ist))) + up = MAX_REAL + else if (usigma > 0.0) + up = IST_MEAN(ist) + usigma * IST_STDDEV(ist) + else + up = MAX_REAL + if (!IS_INDEFR(lower)) + low = max (low, lower) + if (!IS_INDEFR(upper)) + up = min (up, upper) + if (i > 0) { + if (IST_NPIX(ist) == npix) + break + } + npix = IST_NPIX(ist) + } + + } + + # Accumulate the histogram. + hgm = NULL + if ((IST_SMEDIAN(IST_SW(ist)) == YES || IST_SMODE(IST_SW(ist)) == + YES) && ist_ihist (ist, binwidth, hgm, nbins, hwidth, hmin, + hmax) == YES) { + call aclri (Memi[hgm], nbins) + call amovkl (long(1), Meml[v], IM_MAXDIM) + while (imgnlr (im, buf, Meml[v]) != EOF) + call ahgmr (Memr[buf], int(IM_LEN(im,1)), Memi[hgm], nbins, + hmin, hmax) + if (IST_SMEDIAN(IST_SW(ist)) == YES) + call ist_hmedian (ist, Memi[hgm], nbins, hwidth, hmin, + hmax) + if (IST_SMODE(IST_SW(ist)) == YES) + call ist_hmode (ist, Memi[hgm], nbins, hwidth, hmin, hmax) + } + if (hgm != NULL) + call mfree (hgm, TY_INT) + + # Print the statistics. + if (format == YES) + call ist_print (Memc[image], "", ist, Memi[fields], nfields) + else + call ist_fprint (Memc[image], "", ist, Memi[fields], nfields) + + call imunmap (im) + if (cache == YES) + call fixmem (old_size) + } + + call ist_free (ist) + call imtclose (list) + call sfree (sp) +end + + +# IST_ALLOCATE -- Allocate space for the statistics structure. + +procedure ist_allocate (ist) + +pointer ist #O the statistics descriptor + +begin + call calloc (ist, LEN_IMSTAT, TY_STRUCT) + call malloc (IST_SW(ist), LEN_NSWITCHES, TY_INT) +end + + +# IST_FREE -- Free the statistics structure. + +procedure ist_free (ist) + +pointer ist #O the statistics descriptor + +begin + call mfree (IST_SW(ist), TY_INT) + call mfree (ist, TY_STRUCT) +end + + +# IST_FIELDS -- Procedure to decode the fields string into a list of the +# fields to be computed and printed. + +int procedure ist_fields (fieldstr, fields, max_nfields) + +char fieldstr[ARB] #I string containing the list of fields +int fields[ARB] #O fields array +int max_nfields #I maximum number of fields + +int nfields, flist, field +pointer sp, fname +int fntopnb(), fntgfnb(), strdic() + +begin + nfields = 0 + + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + flist = fntopnb (fieldstr, NO) + while (fntgfnb (flist, Memc[fname], SZ_FNAME) != EOF && + (nfields < max_nfields)) { + field = strdic (Memc[fname], Memc[fname], SZ_FNAME, IST_FIELDS) + if (field == 0) + next + nfields = nfields + 1 + fields[nfields] = field + } + call fntclsb (flist) + + call sfree (sp) + + return (nfields) +end + + +# IST_SWITCHES -- Set the processing switches. + +procedure ist_switches (ist, fields, nfields, nclip) + +pointer ist #I the statistics pointer +int fields[ARB] #I fields array +int nfields #I maximum number of fields +int nclip #I the number of clipping iterations + +pointer sw +int ist_isfield() + +begin + # Initialize. + sw = IST_SW(ist) + call amovki (NO, Memi[sw], LEN_NSWITCHES) + + # Set the computation switches. + IST_SNPIX(sw) = ist_isfield (IST_FNPIX, fields, nfields) + IST_SMEAN(sw) = ist_isfield (IST_FMEAN, fields, nfields) + IST_SMEDIAN(sw) = ist_isfield (IST_FMEDIAN, fields, nfields) + IST_SMODE(sw) = ist_isfield (IST_FMODE, fields, nfields) + if (nclip > 0) + IST_SSTDDEV(sw) = YES + else + IST_SSTDDEV(sw) = ist_isfield (IST_FSTDDEV, fields, nfields) + IST_SSKEW(sw) = ist_isfield (IST_FSKEW, fields, nfields) + IST_SKURTOSIS(sw) = ist_isfield (IST_FKURTOSIS, fields, nfields) + + # Adjust the computation switches. + if (ist_isfield (IST_FMIN, fields, nfields) == YES) + IST_SMINMAX(sw) = YES + else if (ist_isfield (IST_FMAX, fields, nfields) == YES) + IST_SMINMAX(sw) = YES + else if (IST_SMEDIAN(sw) == YES || IST_SMODE(sw) == YES) + IST_SMINMAX(sw) = YES + else + IST_SMINMAX(sw) = NO +end + + +# IST_PHEADER -- Print the banner fields. + +procedure ist_pheader (fields, nfields) + +int fields[ARB] # fields to be printed +int nfields # number of fields + +int i + +begin + call printf ("#") + do i = 1, nfields { + switch (fields[i]) { + case IST_FIMAGE: + call printf (IST_FSTRING) + call pargstr (IST_KIMAGE) + case IST_FNPIX: + call printf (IST_FCOLUMN) + call pargstr (IST_KNPIX) + case IST_FMIN: + call printf (IST_FCOLUMN) + call pargstr (IST_KMIN) + case IST_FMAX: + call printf (IST_FCOLUMN) + call pargstr (IST_KMAX) + case IST_FMEAN: + call printf (IST_FCOLUMN) + call pargstr (IST_KMEAN) + case IST_FMEDIAN: + call printf (IST_FCOLUMN) + call pargstr (IST_KMEDIAN) + case IST_FMODE: + call printf (IST_FCOLUMN) + call pargstr (IST_KMODE) + case IST_FSTDDEV: + call printf (IST_FCOLUMN) + call pargstr (IST_KSTDDEV) + case IST_FSKEW: + call printf (IST_FCOLUMN) + call pargstr (IST_KSKEW) + case IST_FKURTOSIS: + call printf (IST_FCOLUMN) + call pargstr (IST_KKURTOSIS) + } + } + + call printf ("\n") + call flush (STDOUT) +end + + +# IST_ISFIELD -- Procedure to determine whether a specified field is one +# of the selected fields or not. + +int procedure ist_isfield (field, fields, nfields) + +int field #I field to be tested +int fields[ARB] #I array of selected fields +int nfields #I number of fields + +int i, isfield + +begin + isfield = NO + do i = 1, nfields { + if (field != fields[i]) + next + isfield = YES + break + } + + return (isfield) +end + + +# IST_INITIALIZE -- Initialize the statistics computation. + +procedure ist_initialize (ist, lower, upper) + +pointer ist #I pointer to the statistics structure +real lower #I lower good data limit +real upper #I upper good data limit + +begin + if (IS_INDEFR(lower)) + IST_LO(ist) = -MAX_REAL + else + IST_LO(ist) = lower + if (IS_INDEFR(upper)) + IST_HI(ist) = MAX_REAL + else + IST_HI(ist) = upper + + IST_NPIX(ist) = 0 + IST_SUMX(ist) = 0.0d0 + IST_SUMX2(ist) = 0.0d0 + IST_SUMX3(ist) = 0.0d0 + IST_SUMX4(ist) = 0.0d0 + + IST_MIN(ist) = MAX_REAL + IST_MAX(ist) = -MAX_REAL + IST_MEAN(ist) = INDEFR + IST_MEDIAN(ist) = INDEFR + IST_MODE(ist) = INDEFR + IST_STDDEV(ist) = INDEFR + IST_SKEW(ist) = INDEFR + IST_KURTOSIS(ist) = INDEFR +end + + +# IST_ACCUMULATE4 -- Accumulate sums up to the fourth power of the data for +# data values between lower and upper. + +procedure ist_accumulate4 (ist, x, npts, lower, upper, minmax) + +pointer ist #I pointer to the statistics structure +real x[ARB] #I the data array +int npts #I the number of data points +real lower #I lower data boundary +real upper #I upper data boundary +int minmax #I compute the minimum and maximum ? + +double xx, xx2, sumx, sumx2, sumx3, sumx4 +real lo, hi, xmin, xmax +int i, npix + +begin + lo = IST_LO(ist) + hi = IST_HI(ist) + npix = IST_NPIX(ist) + sumx = 0.0 + sumx2 = 0.0 + sumx3 = 0.0 + sumx4 = 0.0 + xmin = IST_MIN(ist) + xmax = IST_MAX(ist) + + if (IS_INDEFR(lower) && IS_INDEFR(upper)) { + npix = npix + npts + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + xx2 = xx * xx + sumx = sumx + xx + sumx2 = sumx2 + xx2 + sumx3 = sumx3 + xx2 * xx + sumx4 = sumx4 + xx2 * xx2 + } + } else { + do i = 1, npts { + xx = x[i] + xx2 = xx * xx + sumx = sumx + xx + sumx2 = sumx2 + xx2 + sumx3 = sumx3 + xx2 * xx + sumx4 = sumx4 + xx2 * xx2 + } + } + } else { + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + npix = npix + 1 + xx2 = xx * xx + sumx = sumx + xx + sumx2 = sumx2 + xx2 + sumx3 = sumx3 + xx2 * xx + sumx4 = sumx4 + xx2 * xx2 + } + } else { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + npix = npix + 1 + xx2 = xx * xx + sumx = sumx + xx + sumx2 = sumx2 + xx2 + sumx3 = sumx3 + xx2 * xx + sumx4 = sumx4 + xx2 * xx2 + } + } + } + + IST_NPIX(ist) = npix + IST_SUMX(ist) = IST_SUMX(ist) + sumx + IST_SUMX2(ist) = IST_SUMX2(ist) + sumx2 + IST_SUMX3(ist) = IST_SUMX3(ist) + sumx3 + IST_SUMX4(ist) = IST_SUMX4(ist) + sumx4 + IST_MIN(ist) = xmin + IST_MAX(ist) = xmax +end + + +# IST_ACCUMULATE3 -- Accumulate sums up to the third power of the data for +# data values between lower and upper. + +procedure ist_accumulate3 (ist, x, npts, lower, upper, minmax) + +pointer ist #I pointer to the statistics structure +real x[ARB] #I the data array +int npts #I the number of data points +real lower #I lower data boundary +real upper #I upper data boundary +int minmax #I compute the minimum and maximum ? + +double xx, xx2, sumx, sumx2, sumx3 +real lo, hi, xmin, xmax +int i, npix + +begin + lo = IST_LO(ist) + hi = IST_HI(ist) + npix = IST_NPIX(ist) + sumx = 0.0 + sumx2 = 0.0 + sumx3 = 0.0 + xmin = IST_MIN(ist) + xmax = IST_MAX(ist) + + if (IS_INDEFR(lower) && IS_INDEFR(upper)) { + npix = npix + npts + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + xx2 = xx * xx + sumx = sumx + xx + sumx2 = sumx2 + xx2 + sumx3 = sumx3 + xx2 * xx + } + } else { + do i = 1, npts { + xx = x[i] + xx2 = xx * xx + sumx = sumx + xx + sumx2 = sumx2 + xx2 + sumx3 = sumx3 + xx2 * xx + } + } + } else { + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + npix = npix + 1 + xx2 = xx * xx + sumx = sumx + xx + sumx2 = sumx2 + xx2 + sumx3 = sumx3 + xx2 * xx + } + } else { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + npix = npix + 1 + xx2 = xx * xx + sumx = sumx + xx + sumx2 = sumx2 + xx2 + sumx3 = sumx3 + xx2 * xx + } + } + } + + IST_NPIX(ist) = npix + IST_SUMX(ist) = IST_SUMX(ist) + sumx + IST_SUMX2(ist) = IST_SUMX2(ist) + sumx2 + IST_SUMX3(ist) = IST_SUMX3(ist) + sumx3 + IST_MIN(ist) = xmin + IST_MAX(ist) = xmax +end + + +# IST_ACCUMULATE2 -- Accumulate sums up to the second power of the data for +# data values between lower and upper. + +procedure ist_accumulate2 (ist, x, npts, lower, upper, minmax) + +pointer ist #I pointer to the statistics structure +real x[ARB] #I the data array +int npts #I the number of data points +real lower #I lower data boundary +real upper #I upper data boundary +int minmax #I compute the minimum and maximum ? + +double xx, sumx, sumx2 +real lo, hi, xmin, xmax +int i, npix + +begin + lo = IST_LO(ist) + hi = IST_HI(ist) + npix = IST_NPIX(ist) + sumx = 0.0 + sumx2 = 0.0 + xmin = IST_MIN(ist) + xmax = IST_MAX(ist) + + if (IS_INDEFR(lower) && IS_INDEFR(upper)) { + npix = npix + npts + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + sumx = sumx + xx + sumx2 = sumx2 + xx * xx + } + } else { + do i = 1, npts { + xx = x[i] + sumx = sumx + xx + sumx2 = sumx2 + xx * xx + } + } + } else { + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + npix = npix + 1 + sumx = sumx + xx + sumx2 = sumx2 + xx * xx + } + } else { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + npix = npix + 1 + sumx = sumx + xx + sumx2 = sumx2 + xx * xx + } + } + } + + IST_NPIX(ist) = npix + IST_SUMX(ist) = IST_SUMX(ist) + sumx + IST_SUMX2(ist) = IST_SUMX2(ist) + sumx2 + IST_MIN(ist) = xmin + IST_MAX(ist) = xmax +end + + +# IST_ACCUMULATE1 -- Accumulate sums up to the first power of the data for +# data values between lower and upper. + +procedure ist_accumulate1 (ist, x, npts, lower, upper, minmax) + +pointer ist #I pointer to the statistics structure +real x[ARB] #I the data array +int npts #I the number of data points +real lower #I lower data boundary +real upper #I upper data boundary +int minmax #I compute the minimum and maximum ? + +double sumx +real lo, hi, xx, xmin, xmax +int i, npix + +begin + lo = IST_LO(ist) + hi = IST_HI(ist) + npix = IST_NPIX(ist) + sumx = 0.0 + xmin = IST_MIN(ist) + xmax = IST_MAX(ist) + + if (IS_INDEFR(lower) && IS_INDEFR(upper)) { + npix = npix + npts + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + sumx = sumx + xx + } + } else { + do i = 1, npts + sumx = sumx + x[i] + } + } else { + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + npix = npix + 1 + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + sumx = sumx + xx + } + } else { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + npix = npix + 1 + sumx = sumx + xx + } + } + } + + IST_NPIX(ist) = npix + IST_SUMX(ist) = IST_SUMX(ist) + sumx + IST_MIN(ist) = xmin + IST_MAX(ist) = xmax +end + + +# IST_ACCUMULATE0 -- Accumulate sums up to the 0th power of the data for +# data values between lower and upper. + +procedure ist_accumulate0 (ist, x, npts, lower, upper, minmax) + +pointer ist #I pointer to the statistics structure +real x[ARB] #I the data array +int npts #I the number of data points +real lower #I lower data boundary +real upper #I upper data boundary +int minmax #I compute the minimum and maximum ? + +int i, npix +real lo, hi, xx, xmin, xmax + +begin + lo = IST_LO(ist) + hi = IST_HI(ist) + npix = IST_NPIX(ist) + xmin = IST_MIN(ist) + xmax = IST_MAX(ist) + + if (IS_INDEFR(lower) && IS_INDEFR(upper)) { + npix = npix + npts + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + } + } + } else { + if (minmax == YES) { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + npix = npix + 1 + if (xx < xmin) + xmin = xx + if (xx > xmax) + xmax = xx + } + } else { + do i = 1, npts { + xx = x[i] + if (xx < lo || xx > hi) + next + npix = npix + 1 + } + } + } + + IST_NPIX(ist) = npix + IST_MIN(ist) = xmin + IST_MAX(ist) = xmax +end + + +# IST_STATS -- Procedure to compute the first four central moments of the +# distribution. + +procedure ist_stats (ist) + +pointer ist #I statistics structure + +double mean, var, stdev +pointer sw +bool fp_equalr() + +begin + sw = IST_SW(ist) + + # Compute the basic statistics regardless of the switches. + if (fp_equalr (IST_MIN(ist), MAX_REAL)) + IST_MIN(ist) = INDEFR + if (fp_equalr (IST_MAX(ist), -MAX_REAL)) + IST_MAX(ist) = INDEFR + if (IST_NPIX(ist) <= 0) + return + + mean = IST_SUMX(ist) / IST_NPIX(ist) + IST_MEAN(ist) = mean + if (IST_NPIX(ist) < 2) + return + + var = (IST_SUMX2(ist) - IST_SUMX(ist) * mean) / + (IST_NPIX(ist) - 1) + if (var <= 0.0) { + IST_STDDEV(ist) = 0.0 + return + } else { + stdev = sqrt (var) + IST_STDDEV(ist) = stdev + } + + # Compute higher order moments if the switches are set. + if (IST_SSKEW(sw)== YES) + IST_SKEW(ist) = (IST_SUMX3(ist) - 3.0d0 * IST_MEAN(ist) * + IST_SUMX2(ist) + 3.0d0 * mean * mean * + IST_SUMX(ist) - IST_NPIX(ist) * mean ** 3) / + IST_NPIX(ist) / stdev / stdev / stdev + + if (IST_SKURTOSIS(sw) == YES) + IST_KURTOSIS(ist) = (IST_SUMX4(ist) - 4.0d0 * mean * + IST_SUMX3(ist) + 6.0d0 * mean * mean * + IST_SUMX2(ist) - 4.0 * mean ** 3 * IST_SUMX(ist) + + IST_NPIX(ist) * mean ** 4) / IST_NPIX(ist) / + stdev / stdev / stdev / stdev - 3.0d0 +end + + + +# IST_IHIST -- Initilaize the histogram of the image pixels. + +int procedure ist_ihist (ist, binwidth, hgm, nbins, hwidth, hmin, hmax) + +pointer ist #I pointer to the statistics structure +real binwidth #I histogram bin width in sigma +pointer hgm #O pointer to the histogram +int nbins #O number of bins +real hwidth #O histogram resolution +real hmin #O minimum histogram value +real hmax #O maximum histogram value + +begin + nbins = 0 + if (binwidth <= 0.0) + return (NO) + + hwidth = binwidth * IST_STDDEV(ist) + if (hwidth <= 0.0) + return (NO) + + nbins = (IST_MAX(ist) - IST_MIN(ist)) / hwidth + 1 + if (nbins < 3) + return (NO) + + hmin = IST_MIN(ist) + hmax = IST_MAX(ist) + + call malloc (hgm, nbins, TY_INT) + + return (YES) +end + + +# IST_HMEDIAN -- Estimate the median from the histogram. + +procedure ist_hmedian (ist, hgm, nbins, hwidth, hmin, hmax) + +pointer ist #I pointer to the statistics structure +int hgm[ARB] #I histogram of the pixels +int nbins #I number of bins in the histogram +real hwidth #I resolution of the histogram +real hmin #I minimum histogram value +real hmax #I maximum histogram value + +real h1, hdiff, hnorm +pointer sp, ihgm +int i, lo, hi + +bool fp_equalr() + +begin + call smark (sp) + call salloc (ihgm, nbins, TY_REAL) + + # Integrate the histogram and normalize. + Memr[ihgm] = hgm[1] + do i = 2, nbins + Memr[ihgm+i-1] = hgm[i] + Memr[ihgm+i-2] + hnorm = Memr[ihgm+nbins-1] + call adivkr (Memr[ihgm], hnorm, Memr[ihgm], nbins) + + # Initialize the low and high bin numbers. + lo = 0 + hi = 1 + + # Search for the point which divides the integral in half. + do i = 1, nbins { + if (Memr[ihgm+i-1] > 0.5) + break + lo = i + } + hi = lo + 1 + + # Approximate the median. + h1 = hmin + lo * hwidth + if (lo == 0) + hdiff = Memr[ihgm+hi-1] + else + hdiff = Memr[ihgm+hi-1] - Memr[ihgm+lo-1] + if (fp_equalr (hdiff, 0.0)) + IST_MEDIAN(ist) = h1 + else if (lo == 0) + IST_MEDIAN(ist) = h1 + 0.5 / hdiff * hwidth + else + IST_MEDIAN(ist) = h1 + (0.5 - Memr[ihgm+lo-1]) / hdiff * hwidth + + call sfree (sp) +end + + +# IST_HMODE -- Procedure to compute the mode. + +procedure ist_hmode (ist, hgm, nbins, hwidth, hmin, hmax) + +pointer ist #I pointer to the statistics strucuture +int hgm[ARB] #I histogram of the pixels +int nbins #I number of bins in the histogram +real hwidth #I resolution of the histogram +real hmin #I minimum histogram value +real hmax #I maximum histogram value + +int i, bpeak +real hpeak, dh1, dh2, denom +bool fp_equalr() + +begin + # If there is a single bin return the midpoint of that bin. + if (nbins == 1) { + IST_MODE(ist) = hmin + 0.5 * hwidth + return + } + + # If there are two bins return the midpoint of the greater bin. + if (nbins == 2) { + if (hgm[1] > hgm[2]) + IST_MODE(ist) = hmin + 0.5 * hwidth + else if (hgm[2] > hgm[1]) + IST_MODE(ist) = hmin + 1.5 * hwidth + else + IST_MODE(ist) = hmin + hwidth + return + } + + # Find the bin containing the histogram maximum. + hpeak = hgm[1] + bpeak = 1 + do i = 2, nbins { + if (hgm[i] > hpeak) { + hpeak = hgm[i] + bpeak = i + } + } + + # If the maximum is in the first bin return the midpoint of the bin. + if (bpeak == 1) { + IST_MODE(ist) = hmin + 0.5 * hwidth + return + } + + # If the maximum is in the last bin return the midpoint of the bin. + if (bpeak == nbins) { + IST_MODE(ist) = hmin + (nbins - 0.5) * hwidth + return + } + + # Compute the lower limit of bpeak. + bpeak = bpeak - 1 + + # Do a parabolic interpolation to find the peak. + dh1 = hgm[bpeak+1] - hgm[bpeak] + dh2 = hgm[bpeak+1] - hgm[bpeak+2] + denom = dh1 + dh2 + if (fp_equalr (denom, 0.0)) { + IST_MODE(ist) = hmin + (bpeak + 0.5) * hwidth + } else { + IST_MODE(ist) = bpeak + 1 + 0.5 * (dh1 - dh2) / denom + IST_MODE(ist) = hmin + (IST_MODE(ist) - 0.5) * hwidth + } + + #dh1 = hgm[bpeak] * (hmin + (bpeak - 0.5) * hwidth) + + #hgm[bpeak+1] * (hmin + (bpeak + 0.5) * hwidth) + + #hgm[bpeak+2] * (hmin + (bpeak + 1.5) * hwidth) + #dh2 = hgm[bpeak] + hgm[bpeak+1] + hgm[bpeak+2] +end + + +# IST_PRINT -- Print the fields using builtin format strings. + +procedure ist_print (image, mask, ist, fields, nfields) + +char image[ARB] #I image name +char mask[ARB] #I mask name +pointer ist #I pointer to the statistics structure +int fields[ARB] #I fields to be printed +int nfields #I number of fields + +int i + +begin + call printf (" ") + do i = 1, nfields { + switch (fields[i]) { + case IST_FIMAGE: + call printf (IST_FSTRING) + call pargstr (image) + case IST_FNPIX: + call printf (IST_FINTEGER) + call pargi (IST_NPIX(ist)) + case IST_FMIN: + call printf (IST_FREAL) + call pargr (IST_MIN(ist)) + case IST_FMAX: + call printf (IST_FREAL) + call pargr (IST_MAX(ist)) + case IST_FMEAN: + call printf (IST_FREAL) + call pargr (IST_MEAN(ist)) + case IST_FMEDIAN: + call printf (IST_FREAL) + call pargr (IST_MEDIAN(ist)) + case IST_FMODE: + call printf (IST_FREAL) + call pargr (IST_MODE(ist)) + case IST_FSTDDEV: + call printf (IST_FREAL) + call pargr (IST_STDDEV(ist)) + case IST_FSKEW: + call printf (IST_FREAL) + call pargr (IST_SKEW(ist)) + case IST_FKURTOSIS: + call printf (IST_FREAL) + call pargr (IST_KURTOSIS(ist)) + } + } + + call printf ("\n") + call flush (STDOUT) +end + + +# IST_FPRINT -- Print the fields using a free format. + +procedure ist_fprint (image, mask, ist, fields, nfields) + +char image[ARB] #I image name +char mask[ARB] #I mask name +pointer ist #I pointer to the statistics structure +int fields[ARB] #I fields to be printed +int nfields #I number of fields + +int i + +begin + do i = 1, nfields { + switch (fields[i]) { + case IST_FIMAGE: + call printf ("%s") + call pargstr (image) + case IST_FNPIX: + call printf ("%d") + call pargi (IST_NPIX(ist)) + case IST_FMIN: + call printf ("%g") + call pargr (IST_MIN(ist)) + case IST_FMAX: + call printf ("%g") + call pargr (IST_MAX(ist)) + case IST_FMEAN: + call printf ("%g") + call pargr (IST_MEAN(ist)) + case IST_FMEDIAN: + call printf ("%g") + call pargr (IST_MEDIAN(ist)) + case IST_FMODE: + call printf ("%g") + call pargr (IST_MODE(ist)) + case IST_FSTDDEV: + call printf ("%g") + call pargr (IST_STDDEV(ist)) + case IST_FSKEW: + call printf ("%g") + call pargr (IST_SKEW(ist)) + case IST_FKURTOSIS: + call printf ("%g") + call pargr (IST_KURTOSIS(ist)) + } + if (i < nfields) + call printf (" ") + } + + call printf ("\n") + call flush (STDOUT) +end + + +define MEMFUDGE 1.05 + +# IST_CACHE1 -- Cache 1 image in memory using the image i/o buffer sizes. + +procedure ist_cache1 (cache, im, old_size) + +int cache #I cache the image pixels in the imio buffer +pointer im #I the image descriptor +int old_size #O the old working set size + +int i, req_size, buf_size +int sizeof(), ist_memstat() + +begin + req_size = MEMFUDGE * IM_LEN(im,1) * sizeof (IM_PIXTYPE(im)) + do i = 2, IM_NDIM(im) + req_size = req_size * IM_LEN(im,i) + if (ist_memstat (cache, req_size, old_size) == YES) + call ist_pcache (im, INDEFI, buf_size) +end + + +# IST_MEMSTAT -- Figure out if there is enough memory to cache the image +# pixels. If it is necessary to request more memory and the memory is +# avalilable return YES otherwise return NO. + +int procedure ist_memstat (cache, req_size, old_size) + +int cache #I cache memory ? +int req_size #I the requested working set size in chars +int old_size #O the original working set size in chars + +int cur_size, max_size +int begmem() + +begin + # Find the default working set size. + cur_size = begmem (0, old_size, max_size) + + # If cacheing is disabled return NO regardless of the working set size. + if (cache == NO) + return (NO) + + # If the requested working set size is less than the current working + # set size return YES. + if (req_size <= cur_size) + return (YES) + + # Reset the current working set size. + cur_size = begmem (req_size, old_size, max_size) + if (req_size <= cur_size) { + return (YES) + } else { + return (NO) + } +end + + +# IST_PCACHE -- Cache the image pixels im memory by resetting the default image +# buffer size. If req_size is INDEF the size of the image is used to determine +# the size of the image i/o buffers. + +procedure ist_pcache (im, req_size, buf_size) + +pointer im #I the input image point +int req_size #I the requested working set size in chars +int buf_size #O the new image buffer size + +int i, def_size, new_imbufsize +int sizeof(), imstati() + +begin + # Find the default buffer size. + def_size = imstati (im, IM_BUFSIZE) + + # Compute the new required image i/o buffer size in chars. + if (IS_INDEFI(req_size)) { + new_imbufsize = IM_LEN(im,1) * sizeof (IM_PIXTYPE(im)) + do i = 2, IM_NDIM(im) + new_imbufsize = new_imbufsize * IM_LEN(im,i) + } else { + new_imbufsize = req_size + } + + # If the default image i/o buffer size is already bigger than + # the requested size do nothing. + if (def_size >= new_imbufsize) { + buf_size = def_size + return + } + + # Reset the image i/o buffer. + call imseti (im, IM_BUFSIZE, new_imbufsize) + call imseti (im, IM_BUFFRAC, 0) + buf_size = new_imbufsize +end + diff --git a/pkg/images/imutil/src/t_imsum.x b/pkg/images/imutil/src/t_imsum.x new file mode 100644 index 00000000..6e4d0c61 --- /dev/null +++ b/pkg/images/imutil/src/t_imsum.x @@ -0,0 +1,320 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IMSUM -- Sum or average images with optional high and low pixel rejection. + +procedure t_imsum () + +int list # Input image list +pointer image # Output image +pointer hparams # Header parameter list +pointer option # Output option +int pixtype # Output pixel datatype +int calctype # Internal calculation type +real low_reject # Number or frac of low pix to reject +real high_reject # Number or frac of high pix to reject + +int i, nimages, nlow, nhigh +pointer sp, str, im_in, im_out + +bool clgetb(), streq() +real clgetr() +int imtopenp(), imtlen(), imtgetim(), clgwrd() +pointer immap() + +errchk imsum_set, immap, imunmap + +begin + # Get the input image list. Check that there is at least 1 image. + list = imtopenp ("input") + nimages = imtlen (list) + if (nimages < 1) { + call imtclose (list) + call error (0, "No input images in list") + } + + # Allocate strings and get the parameters. + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (hparams, SZ_LINE, TY_CHAR) + call salloc (option, SZ_LINE, TY_CHAR) + + i = clgwrd ("option", Memc[option], SZ_LINE, "|sum|average|median|") + if (streq (Memc[option], "median")) { + nlow = nimages / 2 + nhigh = nimages - nlow - 1 + } else { + # If the rejection value is less than 1 then it is a fraction of the + # input images otherwise it is the number of pixels to be rejected. + low_reject = clgetr ("low_reject") + high_reject = clgetr ("high_reject") + + if (low_reject < 1.) + nlow = low_reject * nimages + else + nlow = low_reject + + if (high_reject < 1.) + nhigh = high_reject * nimages + else + nhigh = high_reject + + if (nlow + nhigh >= nimages) { + call sfree (sp) + call imtclose (list) + call error (0, "Number of pixels rejected >= number of images") + } + } + call clgstr ("hparams", Memc[hparams], SZ_LINE) + + # Map the output image and set the title and pixel type. + # Check all images have the same number and length of dimensions. + + call imsum_set (list, pixtype, calctype) + + i = imtgetim (list, Memc[image], SZ_FNAME) + im_in = immap (Memc[image], READ_ONLY, 0) + call clgstr ("output", Memc[image], SZ_FNAME) + im_out = immap (Memc[image], NEW_COPY, im_in) + call new_title ("title", im_out) + IM_PIXTYPE (im_out) = pixtype + + call imtrew (list) + + # Print verbose info. + if (clgetb ("verbose")) { + call salloc (str, SZ_LINE, TY_CHAR) + call printf ("IMSUM:\n") + call printf (" Input images:\n") + while (imtgetim (list, Memc[str], SZ_LINE) != EOF) { + call printf (" %s\n") + call pargstr (Memc[str]) + } + call imtrew (list) + call printf (" Output image: %s\n") + call pargstr (Memc[image]) + call printf (" Header parameters: %s\n") + call pargstr (Memc[hparams]) + call printf (" Output pixel datatype: %s\n") + call dtstring (pixtype, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call printf (" Calculation type: %s\n") + call dtstring (calctype, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call printf (" Option: %s\n") + call pargstr (Memc[option]) + call printf (" Low rejection: %d\n High rejection: %d\n") + call pargi (nlow) + call pargi (nhigh) + call flush (STDOUT) + } + + # Do the image average. Switch on the calculation type. + switch (calctype) { + case TY_SHORT: + call imsums (list, Memc[image], im_out, nlow, nhigh, Memc[option]) + case TY_INT: + call imsumi (list, Memc[image], im_out, nlow, nhigh, Memc[option]) + case TY_LONG: + call imsuml (list, Memc[image], im_out, nlow, nhigh, Memc[option]) + case TY_REAL: + call imsumr (list, Memc[image], im_out, nlow, nhigh, Memc[option]) + case TY_DOUBLE: + call imsumd (list, Memc[image], im_out, nlow, nhigh, Memc[option]) + default: + call imsumr (list, Memc[image], im_out, nlow, nhigh, Memc[option]) + } + call imunmap (im_out) + call imunmap (im_in) + + # Set the header parameters. + call imtrew (list) + call imsum_hparam (list, Memc[image], Memc[hparams], Memc[option]) + + call imtclose (list) + call sfree (sp) +end + +# IMSUM_SET -- Determine the output image pixel type and the calculation +# datatype. The default pixel types are based on the highest arithmetic +# precendence of the input images. + +define NTYPES 5 + +procedure imsum_set (list, pixtype, calctype) + +int list # List of input images +int pixtype # Pixel datatype of output image +int calctype # Pixel datatype for calculations + +int i, j, nimages, max_type +pointer sp, str, im1, im2 + +int imtgetim(), imtlen() +bool xt_imleneq() +pointer immap() +errchk immap, imunmap + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Determine maximum precedence datatype. + # Also check that the images are the same dimension and size. + + nimages = imtlen (list) + j = imtgetim (list, Memc[str], SZ_LINE) + im1 = immap (Memc[str], READ_ONLY, 0) + max_type = IM_PIXTYPE (im1) + + do i = 2, nimages { + j = imtgetim (list, Memc[str], SZ_LINE) + im2 = immap (Memc[str], READ_ONLY, 0) + + if ((IM_NDIM(im1) != IM_NDIM(im2)) || !xt_imleneq (im1, im2)) { + call imunmap (im1) + call imunmap (im2) + call error (0, "Images have different dimensions or sizes") + } + + switch (IM_PIXTYPE (im2)) { + case TY_SHORT: + if (max_type == TY_USHORT) + max_type = TY_INT + case TY_USHORT: + if (max_type == TY_SHORT) + max_type = TY_INT + case TY_INT: + if (max_type == TY_USHORT || max_type == TY_SHORT) + max_type = IM_PIXTYPE (im2) + case TY_LONG: + if (max_type == TY_USHORT || max_type == TY_SHORT || + max_type == TY_INT) + max_type = IM_PIXTYPE (im2) + case TY_REAL: + if (max_type != TY_DOUBLE) + max_type = IM_PIXTYPE (im2) + case TY_DOUBLE: + max_type = IM_PIXTYPE (im2) + default: + } + call imunmap (im2) + } + + call imunmap (im1) + call imtrew (list) + + # Set calculation datatype. + call clgstr ("calctype", Memc[str], SZ_LINE) + switch (Memc[str]) { + case EOS: + calctype = max_type + case 's': + calctype = TY_SHORT + case 'i': + calctype = TY_INT + case 'l': + calctype = TY_LONG + case 'r': + calctype = TY_REAL + case 'd': + calctype = TY_DOUBLE + default: + call error (0, "Unrecognized datatype") + } + + # Set output pixel datatype. + call clgstr ("pixtype", Memc[str], SZ_LINE) + switch (Memc[str]) { + case EOS: + pixtype = calctype + case 'u': + pixtype = TY_USHORT + case 's': + pixtype = TY_SHORT + case 'i': + pixtype = TY_INT + case 'l': + pixtype = TY_LONG + case 'r': + pixtype = TY_REAL + case 'd': + pixtype = TY_DOUBLE + default: + call error (0, "Unrecognized datatype") + } + + call sfree (sp) +end + +# IMSUM_HPARM -- Arithmetic on image header parameters. +# +# This program is limited by a lack of a rewind procedure for the image +# header fields list. Thus, a static array of field names is used +# to require only one pass through the list and the images. + +define NFIELDS 10 # Maximum number of fields allowed. + +procedure imsum_hparam (list, output, hparams, option) + +int list # List of input images. +char output[ARB] # Output image +char hparams[ARB] # List of header parameters +char option[ARB] # Sum option + +int i, nfields, flist +pointer sp, field, dvals, image, in, out + +int imofnlu(), imgnfn(), imtgetim(), imtlen() +bool strne(), streq() +double imgetd() +pointer immap() + +errchk immap, imofnlu, imgetd, imputd, imunmap + +begin + # Return if median. + if (strne (option, "average") && strne (option, "sum")) + return + + # Allocate memory. + call smark (sp) + call salloc (field, NFIELDS*SZ_FNAME, TY_CHAR) + call salloc (dvals, NFIELDS, TY_DOUBLE) + call salloc (image, SZ_FNAME, TY_CHAR) + + # Map the fields. + out = immap (output, READ_WRITE, 0) + flist = imofnlu (out, hparams) + i = 0 + while ((i < NFIELDS) && + (imgnfn (flist, Memc[field+i*SZ_FNAME], SZ_FNAME) != EOF)) + i = i + 1 + call imcfnl (flist) + + # Accumulate values from each image. + + nfields = i + call aclrd (Memd[dvals], nfields) + + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + in = immap (Memc[image], READ_ONLY, 0) + do i = 1, nfields + Memd[dvals+i-1] = Memd[dvals+i-1] + + imgetd (in, Memc[field+(i-1)*SZ_FNAME]) + call imunmap (in) + } + + # Output the sums or average. + if (streq (option, "average")) { + i = imtlen (list) + call adivkd (Memd[dvals], double (i), Memd[dvals], nfields) + } + + do i = 1, nfields + call imputd (out, Memc[field+(i-1)*SZ_FNAME], Memd[dvals+i-1]) + + call imunmap (out) + call sfree (sp) +end diff --git a/pkg/images/imutil/src/t_imtile.x b/pkg/images/imutil/src/t_imtile.x new file mode 100644 index 00000000..92f5cce0 --- /dev/null +++ b/pkg/images/imutil/src/t_imtile.x @@ -0,0 +1,619 @@ +include <imhdr.h> +include <fset.h> +include "imtile.h" + + +# T_IMTILE -- Combine a list of same-size subrasters into a single large +# mosaiced image. + +procedure t_imtile () + +int nimages, nmissing, subtract, verbose +pointer it, sp, outimage, trimsection, medsection, nullinput, ranges +pointer str, index, c1, c2, l1, l2, isnull, median, imlist, outim + +bool clgetb() +char clgetc() +int btoi(), clgwrd(), imtlen(), clgeti(), decode_ranges(), it_get_imtype() +pointer imtopenp(), it_setim() +real clgetr() + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + call malloc (it, LEN_IRSTRUCT, TY_STRUCT) + + # Allocate temporary working space. + call smark (sp) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (trimsection, SZ_FNAME, TY_CHAR) + call salloc (medsection, SZ_FNAME, TY_CHAR) + call salloc (nullinput, SZ_FNAME, TY_CHAR) + call salloc (ranges, 3 * MAX_NRANGES + 1, TY_INT) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Get the input image list and the output image name. + imlist = imtopenp ("input") + call clgstr ("output", Memc[outimage], SZ_FNAME) + call clgstr ("trim_section", Memc[trimsection], SZ_FNAME) + call clgstr ("missing_input", Memc[nullinput], SZ_FNAME) + call clgstr ("median_section", Memc[medsection], SZ_FNAME) + if (Memc[medsection] == EOS) + subtract = NO + else + subtract = btoi (clgetb ("subtract")) + verbose = btoi (clgetb ("verbose")) + + # Get the mosaicing parameters. + IT_NXSUB(it) = clgeti ("nctile") + IT_NYSUB(it) = clgeti ("nltile") + IT_CORNER(it) = clgwrd ("start_tile", Memc[str], SZ_FNAME, + ",ll,lr,ul,ur,") + if (clgetb ("row_order")) + IT_ORDER(it) = IT_ROW + else + IT_ORDER(it) = IT_COLUMN + IT_RASTER(it) = btoi (clgetb ("raster_order")) + IT_NXOVERLAP(it) = clgeti ("ncoverlap") + IT_NYOVERLAP(it) = clgeti ("nloverlap") + IT_OVAL(it) = clgetr ("ovalue") + + # Check that the number of observed and missing images matches + # the number of specified subrasters. + if (Memc[nullinput] == EOS) { + nmissing = 0 + Memi[ranges] = 0 + Memi[ranges+1] = 0 + Memi[ranges+2] = 1 + Memi[ranges+3] = NULL + } else { + if (decode_ranges (Memc[nullinput], Memi[ranges], MAX_NRANGES, + nmissing) == ERR) + call error (0, "Error decoding list of unobserved rasters.") + } + nimages = imtlen (imlist) + nmissing + if (nimages != (IT_NXSUB(it) * IT_NYSUB(it))) + call error (0, + "The number of input images is not equal to nxsub * nysub.") + + # Compute the output image characteristics and open the output image. + outim = it_setim (it, imlist, Memc[trimsection], Memc[outimage], + clgeti ("ncols"), clgeti ("nlines"), it_get_imtype (clgetc ( + "opixtype"))) + + # Allocate space for and setup the section descriptors. + call salloc (index, nimages, TY_INT) + call salloc (c1, nimages, TY_INT) + call salloc (c2, nimages, TY_INT) + call salloc (l1, nimages, TY_INT) + call salloc (l2, nimages, TY_INT) + call salloc (isnull, nimages, TY_INT) + call salloc (median, nimages, TY_REAL) + + call it_setup (it, imlist, Memi[ranges], Memc[trimsection], + Memc[medsection], outim, Memi[index], Memi[c1], Memi[c2], + Memi[l1], Memi[l2], Memi[isnull], Memr[median]) + + # Make the output image. + call it_mkmosaic (imlist, Memc[trimsection], outim, Memi[index], + Memi[c1], Memi[c2], Memi[l1], Memi[l2], Memi[isnull], + Memr[median], IT_NXSUB(it), IT_NYSUB(it), IT_OVAL(it), subtract) + + # Printe the results. + if (verbose == YES) { + call it_show (imlist, Memc[trimsection], Memc[outimage], + Memi[index], Memi[c1], Memi[c2], Memi[l1], Memi[l2], + Memi[isnull], Memr[median], IT_NXSUB(it)*IT_NYSUB(it), subtract) + } + + # Close up files and free space. + call imunmap (outim) + call clpcls (imlist) + call sfree (sp) + call mfree (it, TY_STRUCT) +end + + +define NTYPES 7 + +# IT_GET_IMTYPE -- Procedure to get the image type. + +int procedure it_get_imtype (c) + +char c # character denoting the image type + +int i, typecodes[NTYPES] +int stridx() +string types "usilrdx" +data typecodes /TY_USHORT, TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE, + TY_COMPLEX/ + +begin + i = stridx (c, types) + if (i == 0) + return (ERR) + else + return (typecodes[i]) +end + + +# IT_SETUP -- Setup the data base parameters for the images. + +procedure it_setup (it, imlist, ranges, trimsection, medsection, outim, + index, c1, c2, l1, l2, isnull, median) + +pointer it # pointer to the imtil structure +pointer imlist # pointer to the list of input images +int ranges[ARB] # list of missing subrasters +char trimsection[ARB] # input image section for output +char medsection[ARB] # input image section for median computation +pointer outim # pointer to the output image +int index[ARB] # index array +int c1[ARB] # array of beginning column limits +int c2[ARB] # array of ending column limits +int l1[ARB] # array of beginning line limits +int l2[ARB] # array of ending line limits +int isnull[ARB] # output input image order number +real median[ARB] # output median of input image + +int i, j, k, nimrows, nimcols, imcount, next_null +pointer sp, imname, im, buf +int get_next_number(), imtgetim() +pointer immap(), imgs2r() +real amedr() + +begin + nimcols = IM_LEN(outim,1) + nimrows = IM_LEN(outim,2) + + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + imcount = 1 + next_null = 0 + if (get_next_number (ranges, next_null) == EOF) + next_null = IT_NXSUB(it) * IT_NYSUB(it) + 1 + + # Loop over the input images. + do i = 1, IT_NXSUB(it) * IT_NYSUB(it) { + + # Set the indices array. + call it_indices (i, j, k, IT_NXSUB(it), IT_NYSUB(it), + IT_CORNER(it), IT_RASTER(it), IT_ORDER(it)) + index[i] = i + c1[i] = max (1, min (1 + (j - 1) * (IT_NCOLS(it) - + IT_NXOVERLAP(it)), nimcols)) + c2[i] = min (nimcols, max (1, c1[i] + IT_NCOLS(it) - 1)) + l1[i] = max (1, min (1 + (k - 1) * (IT_NROWS(it) - + IT_NYOVERLAP(it)), nimrows)) + l2[i] = min (nimrows, max (1, l1[i] + IT_NROWS(it) - 1)) + + # Set the index of each image in the image template + # and compute the median of the subraster. + if (i < next_null) { + isnull[i] = imcount + if (medsection[1] != EOS) { + if (imtgetim (imlist, Memc[imname], SZ_FNAME) == EOF) + call error (0, "Error reading input image list.") + call strcat (medsection, Memc[imname], SZ_FNAME) + im = immap (Memc[imname], READ_ONLY, TY_CHAR) + buf = imgs2r (im, 1, int (IM_LEN(im,1)), 1, int (IM_LEN(im, + 2))) + median[i] = amedr (Memr[buf], int (IM_LEN(im,1)) * + int (IM_LEN(im,2))) + call imunmap (im) + } else + median[i] = INDEFR + imcount = imcount + 1 + } else { + isnull[i] = 0 + if (medsection[1] == EOS) + median[i] = INDEFR + else + median[i] = IT_OVAL(it) + if (get_next_number (ranges, next_null) == EOF) + next_null = IT_NXSUB(it) * IT_NYSUB(it) + 1 + } + + } + + call imtrew (imlist) + call sfree (sp) +end + + +# IT_SETIM -- Procedure to set up the output image characteristics. + +pointer procedure it_setim (it, list, trimsection, outimage, nimcols, nimrows, + opixtype) + +pointer it # pointer to the imtile structure +pointer list # pointer to list of input images +char trimsection[ARB]# input image section +char outimage[ARB] # name of the output image +int nimcols # number of output image columns +int nimrows # number of output image rows +int opixtype # output image pixel type + +int ijunk, nc, nr +pointer sp, imname, im, outim +int imtgetim() +pointer immap() + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + # Get the size of the first subraster. + if (imtgetim (list, Memc[imname], SZ_FNAME) != EOF) { + call strcat (trimsection, Memc[imname], SZ_FNAME) + im = immap (Memc[imname], READ_ONLY, 0) + IT_NCOLS(it) = IM_LEN(im,1) + IT_NROWS(it) = IM_LEN(im,2) + call imunmap (im) + call imtrew (list) + } else + call error (0, "Error reading first input image.\n") + + # Compute the size of the output image. + ijunk = IT_NXSUB(it) * IT_NCOLS(it) - (IT_NXSUB(it) - 1) * + IT_NXOVERLAP(it) + if (IS_INDEFI(nimcols)) + nc = ijunk + else + nc = max (nimcols, ijunk) + ijunk = IT_NYSUB(it) * IT_NROWS(it) - (IT_NYSUB(it) - 1) * + IT_NYOVERLAP(it) + if (IS_INDEFI(ijunk)) + nr = ijunk + else + nr = max (nimrows, ijunk) + + # Set the output pixel type. + if (opixtype == ERR) + opixtype = TY_REAL + + # Open output image and set the parameters. + outim = immap (outimage, NEW_IMAGE, 0) + IM_NDIM(outim) = 2 + IM_LEN(outim,1) = nc + IM_LEN(outim,2) = nr + IM_PIXTYPE(outim) = opixtype + + call sfree (sp) + + return (outim) +end + + +# IT_MKMOSAIC -- Procedure to make the mosaiced image. + +procedure it_mkmosaic (imlist, trimsection, outim, index, c1, c2, l1, l2, + isnull, median, nxsub, nysub, oval, subtract) + +pointer imlist # pointer to input image list +char trimsection[ARB]# input image section +pointer outim # pointer to the output image +int index[ARB] # index array for sorting the images +int c1[ARB] # array of column beginnings +int c2[ARB] # array of column endings +int l1[ARB] # array of line beginnings +int l2[ARB] # array of line endings +int isnull[ARB] # index of input image in the template +real median[ARB] # array of input image median values +int nxsub # number of subrasters per output image column +int nysub # number of subrasters per output image row +real oval # pixel value of undefined output image regions +int subtract # subtract the median off each subraster + +int i, j, noutcols, noutlines, olineptr, ll1, ll2 +pointer sp, inimage, imptrs, buf +int imtrgetim() +pointer immap(), impl2r() + +begin + # Allocate temporary space. + call smark (sp) + call salloc (imptrs, nxsub, TY_POINTER) + call salloc (inimage, SZ_FNAME, TY_CHAR) + + # Sort the subrasters on the yindex. + do i = 1, nxsub * nysub + index[i] = i + call rg_qsorti (l1, index, index, nxsub * nysub) + + noutcols = IM_LEN(outim,1) + noutlines = IM_LEN(outim,2) + + # Loop over the input images. + olineptr = 1 + do i = 1, nxsub * nysub, nxsub { + + # Compute the line and column limits. + ll1 = l1[index[i]] + ll2 = l2[index[i]] + + # Open the nxsub input images. + do j = i, i + nxsub - 1 { + if (isnull[index[j]] <= 0) { + Memc[inimage] = EOS + Memi[imptrs+j-i] = NULL + } else { + if (imtrgetim (imlist, isnull[index[j]], Memc[inimage], + SZ_FNAME) == EOF) + Memi[imptrs+j-i] = NULL + else { + call strcat (trimsection, Memc[inimage], SZ_FNAME) + Memi[imptrs+j-i] = immap (Memc[inimage], READ_ONLY, 0) + } + } + } + + # Write out the undefined lines. + while (olineptr < ll1) { + buf = impl2r (outim, olineptr) + call amovkr (oval, Memr[buf], noutcols) + olineptr = olineptr + 1 + } + + # Write the output lines. + call it_mklines (Memi[imptrs], outim, index, c1, c2, ll1, ll2, + median, i, nxsub, oval, subtract) + olineptr = ll2 + 1 + + # Close up the images. + # Open the nxsub input images. + do j = i, i + nxsub - 1 { + if (Memi[imptrs+j-i] != NULL) + call imunmap (Memi[imptrs+j-i]) + } + + } + + # Write out the remaining undefined lines. + while (olineptr < noutlines) { + buf = impl2r (outim, olineptr) + call amovkr (oval, Memr[buf], noutcols) + olineptr = olineptr + 1 + } + + call sfree (sp) +end + + +# IT_MKLINES -- Construct and output image lines. + +procedure it_mklines (imptrs, outim, index, c1, c2, l1, l2, meds, init, nsub, + oval, subtract) + +pointer imptrs[ARB] # array of input image pointers +pointer outim # output imnage pointer +int index[ARB] # array of indices +int c1[ARB] # array of beginning columns +int c2[ARB] # array of ending columns +int l1 # beginning line +int l2 # ending line +real meds[ARB] # array of median values +int init # first index +int nsub # number of subrasters +real oval # output value +int subtract # subtract the median value + +int i, j, jj, noutcols +pointer obuf, ibuf +pointer impl2r(), imgl2r() + +begin + noutcols = IM_LEN(outim, 1) + do i = l1, l2 { + obuf = impl2r (outim, i) + call amovkr (oval, Memr[obuf], noutcols) + do j = 1, nsub { + jj = index[j+init-1] + if (imptrs[j] != NULL) { + ibuf = imgl2r (imptrs[j], i - l1 + 1) + if (subtract == YES) + call asubkr (Memr[ibuf], meds[jj], Memr[obuf+c1[jj]-1], + c2[jj] - c1[jj] + 1) + else + call amovr (Memr[ibuf], Memr[obuf+c1[jj]-1], c2[jj] - + c1[jj] + 1) + } + } + } +end + + +# IT_INDICES -- Given the number in the list for a missing subraster and +# information about how the subrasters were written return the i and j +# indices of the specified subrasters. + +procedure it_indices (num, i, j, nxsub, nysub, corner, raster, order) + +int num # number of the subraster +int i,j # indices of the subraster +int nxsub,nysub # number of subrasters in x and y +int corner # starting corner +int raster # raster order +int order # column or row order + +begin + switch (corner) { + case IT_LL: + if (order == IT_ROW) { + if (mod (num, nxsub) == 0) { + j = num / nxsub + if (raster == YES && mod (j,2) == 0) + i = 1 + else + i = nxsub + } else { + j = num / nxsub + 1 + if (raster == YES && mod (j,2) == 0) + i = nxsub - mod (num, nxsub) + 1 + else + i = mod (num, nxsub) + } + } else if (order == IT_COLUMN) { + if (mod (num, nysub) == 0) { + i = num / nysub + if (raster == YES && mod (i,2) == 0) + j = 1 + else + j = nysub + } else { + i = num / nysub + 1 + if (raster == YES && mod (i,2) == 0) + j = nysub - mod (num, nysub) + 1 + else + j = mod (num, nysub) + } + } + case IT_LR: + if (order == IT_ROW) { + if (mod (num, nxsub) == 0) { + j = num / nxsub + if (raster == YES && mod (j,2) == 0) + i = nxsub + else + i = 1 + } else { + j = num / nxsub + 1 + if (raster == YES && mod (j,2) == 0) + i = mod (num, nxsub) + else + i = nxsub - mod (num, nxsub) + 1 + } + } else if (order == IT_COLUMN) { + if (mod (num, nysub) == 0) { + i = nxsub - num / nysub + 1 + if (raster == YES && mod (i,2) != 0) + j = 1 + else + j = nysub + } else { + i = nxsub - num / nysub + if (raster == YES && mod (i,2) != 0) + j = nysub - mod (num, nysub) + 1 + else + j = mod (num, nysub) + } + } + case IT_UL: + if (order == IT_ROW) { + if (mod (num, nxsub) == 0) { + j = nysub - num / nxsub + 1 + if (raster == YES && mod (j,2) != 0) + i = 1 + else + i = nxsub + } else { + j = nysub - num / nxsub + if (raster == YES && mod (j,2) != 0) + i = nxsub - mod (num, nxsub) + 1 + else + i = mod (num, nxsub) + } + } else if (order == IT_COLUMN) { + if (mod (num, nysub) == 0) { + i = num / nysub + if (raster == YES && mod (i,2) == 0) + j = nysub + else + j = 1 + } else { + i = num / nysub + 1 + if (raster == YES && mod (i,2) == 0) + j = mod (num, nysub) + else + j = nysub - mod (num, nysub) + 1 + } + } + case IT_UR: + if (order == IT_ROW) { + if (mod (num, nxsub) == 0) { + j = nysub - num / nxsub + 1 + if (raster == YES && mod (j,2) != 0) + i = nxsub + else + i = 1 + } else { + j = nysub - num / nxsub + if (raster == YES && mod (j,2) != 0) + i = mod (num, nxsub) + else + i = nxsub - mod (num, nxsub) + 1 + } + } else if (order == IT_COLUMN) { + if (mod (num, nysub) == 0) { + i = nxsub - num / nysub + 1 + if (raster == YES && mod (i,2) != 0) + j = nysub + else + j = 1 + } else { + i = nxsub - num / nysub + if (raster == YES && mod (i,2) != 0) + j = mod (num, nysub) + else + j = nysub - mod (num, nysub) + 1 + } + } + } +end + + +# IT_SHOW -- List the results. + +procedure it_show (imlist, trimsection, outimage, index, c1, c2, l1, + l2, isnull, median, nsub, subtract) + +int imlist # input image list +char trimsection[ARB]# trim section of input image +char outimage[ARB] # output image +int index[ARB] # array of sorted indices (not used at present) +int c1[ARB] # array of beginning column limits +int c2[ARB] # array of ending column limits +int l1[ARB] # array of beginning line limits +int l2[ARB] # array of ending line limits +int isnull[ARB] # image name index +real median[ARB] # array of medians +int nsub # number of subrasters +int subtract # subtract the median from the subraster + +int i +pointer sp, imname +int imtrgetim() + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + do i = 1, nsub { + + if (isnull[i] <= 0) + call strcpy ("nullimage", Memc[imname], SZ_FNAME) + else if (imtrgetim (imlist, isnull[i], Memc[imname], + SZ_FNAME) != EOF) + call strcat (trimsection, Memc[imname], SZ_FNAME) + else + Memc[imname] = EOS + + call printf ("imcopy %s %s[%d:%d,%d:%d] %g %g\n") + call pargstr (Memc[imname]) + call pargstr (outimage) + call pargi (c1[i]) + call pargi (c2[i]) + call pargi (l1[i]) + call pargi (l2[i]) + call pargr (median[i]) + if (subtract == YES) + call pargr (-median[i]) + else + call pargr (0.0) + } + + call sfree (sp) +end + + + diff --git a/pkg/images/imutil/src/t_minmax.x b/pkg/images/imutil/src/t_minmax.x new file mode 100644 index 00000000..03dff18c --- /dev/null +++ b/pkg/images/imutil/src/t_minmax.x @@ -0,0 +1,192 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <imset.h> + +# MINMAX -- Update the minimum and maximum pixel values of an image. This is +# done only if the values are absent or invalid, unless the force flag is set. +# The header values are not updated when computing the min/max of an image +# section unless the force flag is set. The values are printed on the standard +# output as they are computed, if the verbose option is selected. + +procedure t_minmax() + +pointer images # image name template +bool force # force recomputation of values +bool update # update values in image header +bool verbose # print values as they are computed + +bool section +int list, pixtype +long vmin[IM_MAXDIM], vmax[IM_MAXDIM] +pointer im, sp, pixmin, pixmax, imname, imsect +double minval, maxval, iminval, imaxval + +bool clgetb() +long clktime() +int imtopen(), imtgetim() +pointer immap() +define tryagain_ 91 + +begin + call smark (sp) + call salloc (images, SZ_LINE, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (imsect, SZ_FNAME, TY_CHAR) + call salloc (pixmin, SZ_FNAME, TY_CHAR) + call salloc (pixmax, SZ_FNAME, TY_CHAR) + + # Get list of input images. + + call clgstr ("images", Memc[images], SZ_LINE) + list = imtopen (Memc[images]) + + # Get switches. + + force = clgetb ("force") + update = clgetb ("update") + verbose = clgetb ("verbose") + + # Process each image in the list. + + while (imtgetim (list, Memc[imname], SZ_FNAME) != EOF) { + call imgsection (Memc[imname], Memc[imsect], SZ_FNAME) + section = (Memc[imsect] != EOS) + + call strcpy ("", Memc[pixmin], SZ_FNAME) + call strcpy ("", Memc[pixmax], SZ_FNAME) + + if (update) { + + iferr (im = immap (Memc[imname], READ_WRITE, 0)) + goto tryagain_ + + pixtype = IM_PIXTYPE(im) + if (force || (IM_LIMTIME(im) < IM_MTIME(im))) { + if (IM_NDIM(im) > 0) { + call im_vminmax (im, minval, maxval, iminval, imaxval, + vmin, vmax) + call mkoutstr (vmin, IM_NDIM(im), Memc[pixmin], + SZ_FNAME) + call mkoutstr (vmax, IM_NDIM(im), Memc[pixmax], + SZ_FNAME) + } else { + minval = INDEFD + maxval = INDEFD + Memc[pixmin] = EOS + Memc[pixmax] = EOS + } + if (! section) { + if (IS_INDEFD(minval)) + IM_MIN(im) = INDEFR + else + IM_MIN(im) = minval + if (IS_INDEFD(maxval)) + IM_MAX(im) = INDEFR + else + IM_MAX(im) = maxval + IM_LIMTIME(im) = clktime (long(0)) + call imseti (im, IM_WHEADER, YES) + } + } else { + minval = IM_MIN(im) + maxval = IM_MAX(im) + } + + call imunmap (im) + + } else { +tryagain_ iferr (im = immap (Memc[imname], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } else { + pixtype = IM_PIXTYPE(im) + if (force || IM_LIMTIME(im) < IM_MTIME(im)) { + if (IM_NDIM(im) > 0) { + call im_vminmax (im, minval, maxval, iminval, + imaxval, vmin, vmax) + call mkoutstr (vmin, IM_NDIM(im), Memc[pixmin], + SZ_FNAME) + call mkoutstr (vmax, IM_NDIM(im), Memc[pixmax], + SZ_FNAME) + } else { + minval = INDEFD + maxval = INDEFD + Memc[pixmin] = EOS + Memc[pixmax] = EOS + } + } else { + minval = IM_MIN(im) + maxval = IM_MAX(im) + } + call imunmap (im) + } + } + + # Make the section strings. + + if (verbose) { + if (pixtype == TY_COMPLEX) { + call printf (" %s %s %z %s %z\n") + call pargstr (Memc[imname]) + call pargstr (Memc[pixmin]) + call pargx (complex (minval, iminval)) + call pargstr (Memc[pixmax]) + call pargx (complex (maxval, imaxval)) + call flush (STDOUT) + } else { + call printf (" %s %s %g %s %g\n") + call pargstr (Memc[imname]) + call pargstr (Memc[pixmin]) + call pargd (minval) + call pargstr (Memc[pixmax]) + call pargd (maxval) + call flush (STDOUT) + } + } + } + + # Return the computed values of the last image examined as CL + # parameters. + + call clputd ("minval", minval) + call clputd ("maxval", maxval) + call clputd ("iminval", iminval) + call clputd ("imaxval", imaxval) + call clpstr ("minpix", Memc[pixmin]) + call clpstr ("maxpix", Memc[pixmax]) + + call sfree (sp) +end + + +# MKOUTSTR -- Encode the output string. + +procedure mkoutstr (v, ndim, outstr, maxch) + +long v[ARB] # imio v vector +int ndim # number of dimensions +char outstr[ARB] # output string +int maxch # maximum length of string + +int i, ip, nchars +int ltoc() + +begin + # Encode opening brackett. + outstr[1] = '[' + + # Encode v vector values. + ip = 2 + do i = 1, ndim { + nchars = ltoc (v[i], outstr[ip], maxch) + ip = ip + nchars + outstr[ip] = ',' + ip = ip + 1 + } + + # Encode closing bracketts and EOS. + outstr[ip-1] = ']' + outstr[ip] = EOS +end diff --git a/pkg/images/imutil/src/t_sections.x b/pkg/images/imutil/src/t_sections.x new file mode 100644 index 00000000..560e2a2f --- /dev/null +++ b/pkg/images/imutil/src/t_sections.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# SECTIONS -- Expand a image template into a list of images on the +# standard output and record the number of sections in a parameter. + +procedure t_sections() + +char images[SZ_LINE] # Image template +char image[SZ_FNAME] +char str[SZ_LINE] +int option, list +int clgwrd(), imtopen(), imtgetim(), imtlen() + +begin + call clgstr ("images", images, SZ_LINE) + option = clgwrd ("option", str, SZ_LINE, + ",nolist,fullname,root,section,") + list = imtopen (images) + + call clputi ("nimages", imtlen (list)) + + while (imtgetim (list, image, SZ_FNAME) != EOF) { + switch (option) { + case 2: + call printf ("%s\n") + call pargstr (image) + case 3: + call get_root (image, str, SZ_LINE) + call printf ("%s\n") + call pargstr (str) + case 4: + call get_section (image, str, SZ_LINE) + call printf ("%s\n") + call pargstr (str) + } + } + + call imtclose (list) +end |