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/proto | |
| download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz | |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'pkg/proto')
195 files changed, 33292 insertions, 0 deletions
diff --git a/pkg/proto/README b/pkg/proto/README new file mode 100644 index 00000000..3322c859 --- /dev/null +++ b/pkg/proto/README @@ -0,0 +1,12 @@ +The PROTO package provides a place in the system where users can put their +programs for others to conveniently use, without modifying the IRAF system +itself (see also LOCAL). A program or package must meet a strict set of +standards to be installed in the IRAF system as a fully supported program; +PROTO provides a way for users to get software into the system without having +to meet the mainline IRAF standards. Programs or packages installed in PROTO +are automatically candidates for eventual migration into the main system. +Tasks installed in PROTO are generally expected to go away after a while. + +Only portable IRAF software should be installed in the PROTO package. +Nonportable programs should be placed in LOCAL and will not be exported with +the system. diff --git a/pkg/proto/Revisions b/pkg/proto/Revisions new file mode 100644 index 00000000..c474fe6d --- /dev/null +++ b/pkg/proto/Revisions @@ -0,0 +1,926 @@ +.help revisions Jun88 proto +.nf + +t_mkglbhdr.x + +mkglbhdr.par + +doc/mkglbhdr.hlp + +x_proto.x +mkpkg +proto.cl +proto.hd +proto.men + A new task that creates a global, dataless image header from keywords + which are in common in an input image list and an optional reference + image. (2/6/09, Valdes) + +masks$t_mimstat.x + The clipping calculation was resetting the user supplied pixel limits. + Instead, any clipping limits need to remain bounded by the user + limits. + (7/15/08, Valdes) + +masks/t_mimstat.x + When creating an output mask the final mp_invert step doesn't work. I'm + not sure if this ever worked right with the PIX_NOT(PIX_SRC) raster op. + Replaced this routine with yt_pminvert. (3/14/08, Valdes) + +masks/t_mimstat.x +doc/mimstat.hlp + The "pmmatch" facility now allows the masks to be matched in physical + and world coordinate systems. (2/4/08, Valdes) + +t_bscale.x + Fixed a type declaration problem (1/21/08, MJF) + +t_fixpix.x + Changed from using xt_pmmap to yt_pmmap thus supporting world + coordinate pixel mask matching. (1/16/08, Valdes) + +maskexpr/t_mskexpr.x + If both a reference image and a reference mask are specified the + reference mask will be matched to reference image using the features + of yt_mappm (see xtools$fixpix/ytpmmap.x). The default is to match + in "logical" which basically trims or pads the mask. The power of + this is that the user may set the environment variable "pmmatch" to + one of "physical", "world", or "offset". The physical option is useful + for taking trims, subsections, or other linear changes into account. + The world option is useful for matching masks generated from transformed + images. One application of this task is now to create the matched + mask as a file from the internal matching operation by using the + simple expression "m". + (1/10/08, Valdes) + +===== +V2.14 +===== + +t_imext.x + Removed supporting procedures which are now in the xtools library + in the file xtextns. + (3/20/07, Valdes) + +===== +V2.13 +===== + +======== +V2.12.2a +======== + +maskexpr/t_mskregions.x + The code to inherit the size of the reference image was incorrect + and is now fixed. (7/8/04, Valdes) + +interp.x + Removed the limit on the size of the table. The table is initially + allocated to 4096 pairs, and dynamically reallocated in 4096 chunks + as needed. (5/6/04, MJF) + +======= +V2.12.2 +======= + +maskexpr/peregfuncs.x + Fixed a size decl error in a salloc call in pe_lines() (9/29/03, MJF) + +maskexpr/meregfuncs.x + Fixed an type declaration/usage error for me_is_in_range() (9/29/03, MJF) + +ringavg.cl + Included help page in script in order to document for adass.iraf.sources. + (1/7/03, Valdes) + +ringavg.cl + +doc/ringavg.hlp + +proto.cl +proto.men +proto.hd + Added a script task to compute pixel averages in concentric rings. + (11/25/02, Valdes) + +doc/fixpix.hlp + Added an example for using a text file on a 1D image. + (9/20/02, Valdes) + +======= +V2.12.1 +======= + +===== +V2.12 +===== + +maskexpr/peregfuncs.x + Fixed various min / max data type mismatch problems. (06/19/02, Davis) + +masks/t_mimstat.x +masks/rsstats.x + If nclip > 0 and the initial mean and standard deviation are INDEF (a very + unlikely occurence unless there is a mask) the ksigma limit computation in + the mimstatistics / rskysub task could overflow. This does not affect + released code. (05/01/02, Davis) + +maskexpr/gettok.x + Modified the fetch number token routine to decode decimal number with + negative exponents correctly. (01/23/02, Davis) + +t_suntoiraf.x + The read routine was being called as a subroutine instead of as a function. + (01/07/02, Davis) + +maskexpr/peregfuncs.x + Fixed a typo in the salloc call. (01/07/02, Davis) + +maskexpr/peregfuncs.x + Removed argument from the pe_polygon function that was no longer necessary + and was being used incorrectly. + (12/14/01, Davis) + +masks/mstcache.x +masks/rsscache.x + Added a call setting IM_BUFFRAC to 0 to the memory caching code in the + mimstatistics and rskysub tasks in order to force the imio buffer to be + the size of the input image. + (12/10/01, Davis) + +proto.cl +proto.men +proto.hd +x_proto.x +mskexpr.par +mskregions.par +doc/mskexpr.hlp +doc/mskregions.hlp +maskexpr/t_mskexpr.x +maskexpr/memkmask.x +maskexpr/t_mskregions.x +maskexpr/mesetreg.x +maskexpr/mesetexpr.x +maskexpr/meregmask.x +maskexpr/peregfuncs.x +maskexpr/megeom.x +maskexpr/meregfuncs.x +maskexpr/mskexpand.x +maskexpr/gettok.x +maskexpr/gettok.h + Installed the mskexpr and mskregions tasks in the proto package. + (12/06/01, Davis) + +t_suntoiraf.x +t_binfil.x +t_hfix.x +t_joinlines.x +doc/irafil.hlp + Fixed various extra/missing argument, function declaration, and + subroutine/function mismatchs. Also fixed an irafil task help page + formatting problem. (9/19/01, Davis) + +rskysub.par +doc/rskysub.hlp +masks/rskysub.h +masks/t_rskysub.x +masks/rsstats.x +masks/rsmean.x +masks/rsmmean.x +masks/rscache.x +masks/rsfnames.x +masks/rsreject.x + Installed the new running mean or median sky subtraction task rskysub + in the proto package. (9/18/01, Davis) + +mimstatistics.par +doc/mimstat.hlp +masks/mimstat.h +masks/t_mimstat.x +masks/mstcache.x +masks/mimstat.x +masks/mptools.x + Installed the new statistics through a mask task mimstatistics in the + proto package. (09/17/01, Davis) + +t_imext.x + The change to use a temp file was not done right. (1/9/01, Valdes) + +t_fixpix.x + Change to call xt_pmunmap to insure pixel masks memory is released. + (12/13/00, Valdes) + +t_imext.x + Added logic to recognize an input specifications which has an explict + extension as a single image. Previously an infinite loop would + result. (9/26/00, Valdes) + +t_imext.x + Instead of expanding into a string buffer the task now uses a temp + file. (9/18/00, Valdes) + +fields.x + Added two close statements and a missing sfree statement to the fields + task to avoid a too many open files error when processing a long list + of files. (5/19/00, Davis) + +===== +V2.11.3 +===== + +t_bscale.x + The imio input and output pointers for type double and complex images + were declared as type double and complex instead of integer causing + a hangup on sun systems. (12/11/99, Davis) + +===== +V2.11.2 +===== + +mkpkg + Added missing file dependencies to the mkpkg file. (9/22/99, Davis) + +===== +V2.11.2 +===== + +t_imext.x +doc/imextensions.hlp + 1. Image template expansion is used intead of file template expansion. + 2. Image sections may now be in the input names. + (12/1/97, Valdes) + +===== +V2.11 +===== + +t_imext.x + Included a private copy of the ranges package to allow having zero + be a legal value. (8/22/97, Valdes) + +t_imext.x + +imextensions.par + +doc/imextensions.hlp + +x_proto.x +mkpkg +proto.cl +proto.men +proto.hd + Installed new task for making lists of image extensions. + (8/15/97, Valdes) + +========= +V2.11BETA +========= + +proto$ + The tasks imalign, imcentroid, imfunction, imreplace, wcsedit, and + wcsreset have been moved to the images package. Imalign and imcentroid + are in immatch, imfunction and imreplace are in imutil, and wcsedit + and wcsreset are in imcoords. (3/31, Valdes) + +proto$t_wcsedit.x + The off-diagonal elements of the LTM matrix were being incorrectly edited + although correctly listed by the wcsedit task, in the sense that editing + ltm[2,1] was actually editing ltm[1,2]. On the other hand the off-diagonal + elements of th CD matrxi were being correctly edited, but incorrectly + displayed. (1/20/97, Valdes) + +proto$t_fixpix.x +proto$fixpix.par +proto$doc/fixpix.hlp +proto$mkpkg + Improved final version of new FIXPIX. This uses the routines in + xtools$fixpix. (12/11/96, Valdes) + +proto$fields.par +proto$doc/fields.hlp + Changed the default lines in FIELDS to an open upper limit. + (8/22/96, Valdes) + +proto$t_fixpix.x +proto$fpfixpix.gx +proto$fixpix.par +proto$text2mask.par + +proto$t_text2mask.x + +proto$t_mask2text.x + +proto$doc/fixpix.hlp +proto$doc/text2mask.hlp + +proto$mkpkg +proto$x_proto.x +proto$proto.cl +proto$proto.hd +proto$proto.men + Replace the old version of FIXPIX by a new version that works with + mask images. Two new tasks have been added TEXT2MASK and MASK2TEXT that + convert from the old text file description to mask images and back. + The MASK2TEXT task is hidden to discourage continued use of the text + file description. + (6/14/96, Valdes) + +proto$generic/ + +proto$imfunc.x -> generic/ +proto$imrep.x -> generic/ + Added a generic directory for generic files. The imfunc.x + and imrep.x are now in this directory. (6/14/96, Valdes) + +proto$t_wcsreset.x + Added an error check to the mw_openim command so wcsreset can erase + the world coordinate systems of images with wcss that it cannot + read correctly. (1/8/95, Davis) + +proto$t_imcntr.x + Modified the format of the output to ensure a space between the x: and + y: and the x and y coordinate and increased the precision of the output + from %7.3f to %8.3f. (22/4/94, Davis) + +proto$t_bscale.x + Added a call to flush after the status printout so that the output will + appear after each images is processed. (29/11/93, Davis) + +proto$t_imcntr.x + Modified to imcntr task to use image templates instead of file templates. + (10/27/92, Davis) + +proto$t_imcntr.x + Added an error check for constant data. (10/26/92, Davis) + +proto$doc/suntoiraf.hlp + Replaced the help page with an updated one. (4/30/92, Davis) + +proto$wcsedit + Added the new task WCSEDIT to the PROTO package. (4/22/92, Davis) + +proto$wcsreset + Added the new task WCSRESET to the PROTO package. (4/21/92, Davis) + +proto$intrp.f + Updated to be the same as in the ONEDSPEC package so that the entry + statements are removed. (2/10/92, Valdes) + +proto$ +proto$suntoiraf + The LOCAL package task SUNTOIRAF was added to PROTO. (1/31/92, Davis) + +proto$hfix + The new task HFIX was added to the PROTO package. (1/24/92, Valdes) + +proto$* + 1. New PROTO package created from the NOAO.PROTO package. + + 2. The IMEDIT, IMEXAMINE, and TVMARK tasks in NOAO.PROTO have been moved + to the IMAGES.TV package. + + 3. The IMTITLE, MKHISTOGRAM, and RADPLT tasks in NOAO.PROTO have been moved + to the OBSOLETE package. They are superseded by the HEDIT, PHISTOGRAM, and + PRADPROF tasks respectively. + + 4. The BINPAIRS, IRALIGN, IRMATCH1D, IRMATCH2D, IRMOSAIC, NDPREP, and + SLITPIC tasks have been moved to the new version of NOAO.PROTO called + NPROTO. + + 5. The JOIN task has been renamed JOINLINES. + + (1/23/92, Valdes, Davis) + + +==== +Package regorganization +==== + +noao$proto +proto$imexamine/ievimexam.x + Corrected an error in the column limits computation in the routine + ie_get_vector that caused occasional glitches in vectors plotted + using the 'v' key. This bug may also explain occasional unrepeatable + bus errors which occurred after using the 'v' key. (12/11/91, Davis) + +proto$imedit/epcolon.x + Two calls to pargr changed to pargi. (11/13/91, Valdes) + +proto$tvmark/t_tvmark.x +proto$tvmark/mkcolon.x + Removed extra argument to mk_sets() calls. (11/13/91, Davis) + +proto$tvmark/mkppars.x + Changed two clputi calls to clputb calls. (11/13/91, Davis) + + +proto$t_fixpix.x +proto$doc/t_fixpix.x + Made the order of lower/upper columns/lines unimportant by internally + transposing the endpoints if not in increasing order. (10/31/91, Valdes) + +proto$imfuncs.gx +proto$imfuncs.x + The reference to the E macro in math.h was replaced with a reference to + the new macro BASE_E. + (9/17/91 LED) + +proto$jimexam.par +proto$proto.cl +proto$mkpkg +proto$imexamine/iejimexam.x +proto$imexamine/iecolon.x +proto$imexamine/t_imexam.x +proto$imexamine/iegcur.x +proto$imexamine/mkpkg +proto$doc/imexamine.hlp +noao$lib/scr/imexamine.key + Added new options for fitting 1D gaussians to lines and columns. + (9/2/91, Valdes) + +proto$imfunction.par +proto$imfunction.x +proto$imfuncs.gx +proto$imfuncs.x +proto$doc/imfunction.hlp + A new version of the imfunction task was installed. This new version + supports many more functions as well the double precision images. + (8/29/91 LED) + +proto$bscale.par +proto$t_bscale.x +proto$mkpkg +proto$doc/bscale.hlp + Installed a new version of the bscale task. The new task takes a list + of input images and produces a list of output images like most other + images tasks. The input images are overwritten if the output list equals + the input list, and the noact parameter was removed since it is no longer + required. Two new parameters upper and lower can be used to remove + outliers from the statistics computation. The logfile parameter was + removed and replaced with the verbose parameter. Finally the code was + modified to only use the step parameter for sampling along a particular + axis, if no reference is made to that axis in the section parameter. + (8/26/91 LED) + +proto$fixline.gx + The call to awsud had an argument type mismatch. (8/13/91, Valdes & Jacoby) + +proto$imexamine/iemw.x + +proto$imexamine/iecimexam.x +proto$imexamine/iecolon.x +proto$imexamine/iegimage.x +proto$imexamine/ielimexam.x +proto$imexamine/iepos.x +proto$imexamine/ierimexam.x +proto$imexamine/imexam.h +proto$imexamine/mkpkg +proto$imexamine/t_imexam.x +proto$imexamine.par +proto$doc/imexamine.hlp + Modified IMEXAMINE to use WCS information in axis labels and coordinate + readback. (8/13/91, Valdes) + +proto$tvmark/mkonemark.x + Moved the two salloc routines to the top of the mk_onemark routine + where they cannot be called more than once. + (7/22/91, Davis) + +proto$tvmark.par + Modified the description of the pointsize parameter. + (7/17/91, Davis) + +proto$imfit1d.par,linefit.par + Removed these defunct .par files from the PROTO package. + (10/25/90, Davis) + +proto$t_imreplace.x + Added support for pixel type USHORT to the IMREPLACE task. + (10/25/90, Davis) + +proto$imexamine/iesimexam.x + Add code for checking and warning if data is all constant, all above the + specified ceiling, or all below the specified floor when making surface + plots. (10/3/90, Valdes) + +proto$imedit/epmask.x + Added some protective changes so that if a radius of zero with a circular + aperture is used then round off will be less likely to cause missing + the pixel. (9/23/90, Valdes) + +proto$tvmark/tvmark.key +proto$tvmark/mkmark.x +proto$tvmark/doc/tvmark.hlp + At user request changed the 'd' keystroke command which marks an object + with a dot to the '.' and the 'u' keystroke command which deletes a + point to 'd'. (9/14/90 Davis) + +proto$mkpkg +proto$proto.cl +proto$proto.hd +proto$proto.men +proto$x_proto.x +proto$toonedspec.x - +proto$toonedspec.par - +proto$doc/toonedspec.hlp - + Removed TOONEDSPEC. It's replacement is ONEDSPEC.SCOPY. (8/23/90, Valdes) + +==== +V2.9 +==== + +noao$proto + Davis, June 20, 1990 + The prototype tasks IMSLICE and IMSTACK were removed from the PROTO + package. Their functionality is duplicated by tasks of the same + name in the IMAGES package. + +noao$proto/imedit/epgcur.x + Valdes, June 6, 1990 + The fixpix format input was selecting interpolation across the longer + dimension instead of the shorter. This meant that complete columns + or lines did not work at all. + +noao$proto/t_fixpix.x + Davis, May 29, 1990 + Modified fixpix so that it would work on unsigned short images. + +==== +V2.8 +==== + +noao$proto/ + Davis, April 6, 1990 + Two new tasks IMALIGN and IMCENTROID written by Rob Seaman were added + to the proto package. IMCENTROID computes a set of relative shifts + required to register a set of images. IMALIGN both computes the + shifts and aligns the images. + +noao$proto/imexamine/t_imexam.x + Valdes, Mar 29, 1990 + Even when use_display=no the task was trying to check the image display + for the name. This was fixed by adding a check for this flag in the + relevant if statement. + +noao$proto/imexamine/ievimexam.x + Valdes, Mar 22, 1990 + The pset was being closed without indicating this in the data structure. + The clcpset statement was removed. + +noao$proto/imedit/epgcur.x + Valdes, Mar 15, 1990 + The EOF condition was being screwed up for two keystroke commands leading + to a possible infinite loop when using a cursor file input. The fix + is to change the "nitems=nitems+clgcur" incrementing to simply + "nitems=clgcur". + +noao$proto/imedit/epbackground.x +noao$proto/imedit/epgcur.x + Valdes, Mar 9, 1990 + 1. The surfit pointer was incorrectly declared as real in ep_bg causing the + 'b' key to do nothing. This appears to be SPARC dependent. + 2. Fixed some more problems with cursor strings having missing coordinates + causing floating overflow errors. + +noao$proto/iralign.par,ir/t_iralign.x + Davis, Feb 27, 1990 + Changed the iralign parameter align to alignment for consistency with + the other tasks. + +noao$proto/imexamine/iecolon.x + Valdes, Feb 16, 1990 + Fixed a mistake in the the datatype of a parg call. + +noao$proto/ir/ + Davis, Feb 16, 1990 + Added a feature to the iralign code that permits the user to rerun + the iralign, irmatch1d, and irmatch2d using the first runs output + as input. This permits the user to fine tune the intensity adjustments + and shifts. + +noao$proto/proto.cl +noao$proto/proto.men +noao$proto/mkpkg +noao$proto/x_proto.x +noao$proto/t_join.x + +noao$proto/join.par + +noao$proto/join.cl - +noao$proto/doc/join.hlp + Valdes, Feb 13, 1990 + Added compiled version of the join task and updated the documentation. + Note that the parameters are now different. + +noao$proto/imedit.par +noao$proto/imedit/epcolon.x +noao$proto/imedit/epmask.x + Valdes, Jan 17, 1990 + 1. Fixed typo in prompt string for y background order. + 2. Wrong datatype in clput for order parameters resulting in setting + the user parameter file value to 0. + 3. Bug fix in epmask. The following is the correct line: + line 130: call amovi (Memi[line], Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + +noao$proto/imedit/epdisplay.x + Valdes, Jan 7, 1990 + Added initialization to the zoom state. Without the intialization + starting IMEDIT without display and then turning display on followed by + a 'r' would cause an error (very obscure but found in a demo). + +noao$proto/tvmark/t_tvmark.x +noao$proto/tvmark/mkmark.x +noao$proto/tvmark/tvmark.key +noao$proto/doc/tvmark.hlp + Valdes, Jan 4, 1990 + Added filled rectangle command 'f'. + +noao$proto/tvmark/t_tvmark.x +noao$proto/tvmark/mktools.x +noao$proto/tvmark/mkshow.x +noao$proto/tvmark/mkcolon.x +noao$proto/tvmark/mkfind.x +noao$proto/tvmark/mkremove.x + Davis, Dec 12, 1989 + 1. Tvmark has been modified to permit deletion as well as addition of + objects to the coordinate file. Objects to be deleted are marked + with the cursor and must be within a given tolerance of an + object in the coordinate list to be deleted. + 2. The help screen no longer comes up in the text window when the task + is invoked for the sake of uniformity with all other IRAF tasks. + 3. The coordinate file is opened read_only in batch mode. In interactive + mode a warning message is issued if the user tries to append or delete + objects from a file which does not have write permission and no action + is taken. + +noao$proto/imexamine/t_imexam.x +noao$proto/imexamine/iegimage.x + Valdes, Nov 30, 1989 + The default display frame when not using an input list was changed from + 0 to 1. + +noao$proto/ir/ + Davis, Nov 28, 1989 + New versions of the proto tasks IRMOSAIC, IRALIGN, IRMATCH1D and + IRMATCH2D have been installed in the PROTO package. The routine + have been modularised and now share code in preparation for a + future database approach to the registration problem. The image i/o + has been optimized so that all the tasks, but IRMOSAIC in particular, + will run much faster. A bug in the alignment code in which errors of + alignment of up to 0.5 pixels can occur has been fixed. + There is now an option to trim each section before insertion into + the output image. Finally the actions taken by the task can optionally + be printed on the terminal. + +noao$proto/imeidt/epgcur.x + Valdes, Oct 30, 1989 + 1. There was no check against INDEF cursor coordinates. Such coordinates + will occur when reading a previous logfile output and cursor input + where the shorthand ":command" is used. The actual error occured when + attempting to add 0.5 to INDEF. + +noao$proto/imedit/epstatistics.x +noao$proto/imedit/epmove.x +noao$proto/imedit/epgsfit.x +noao$proto/imedit/epnoise.x +noao$proto/imedit/epbackground.x +noao$proto/imedit/t_imedit.x + Valdes, Aug 17, 1989 + 1. Added errchk to main cursor loop to try and prevent loss of the + user's changes if an error occurs. + 2. If no background points are found an error message is now printed + instead of aborting. + +noao$proto/tvmark/mkbmark.x + Davis, Aug 4, 1989 + Modified tvmark so that drawing to the frame buffer is more efficient + in batch mode. This involved removing a number of imflush calls + which were unnecessarily flushing the output buffer to disk and + recoding the basic routines which draw concentric circles and rectangles. + +noao$proto/imreplace.par + Valdes, July 20, 1989 + Changed mode of imaginary component value to hidden. + +=========== +Version 2.8 +=========== + +noao$proto/imexamine/* + +noao$proto/imexamine.par + +noao$proto/?imexam.par + +noao$proto/doc/imexamine.hlp + +noao$proto/proto.cl +noao$proto/proto.men +noao$proto/proto.hd +noao$proto/x_proto.x +noao$proto/mkpkg +noao$lib/scr/imexamine.key + Valdes, June 13, 1989 + New task IMEXAMINE added to the proto package. + +noao$proto/tvmark/ + Davis, June 6, 1989 + Fixed a bug in tvmark wherein circles were not being drawn if they + were partially off the image in the x dimension. + +noao$proto/tvmark/ + Davis, June1, 1989 + A labeling capability has been added to tvmark. If the label parameter + is turned on tvmark will label objects with the string in the third + column of the coordinate file. + +noao$proto/tvmark/ + Davis, May 25, 1989 + The problem reported by phil wherein TVMARK would go into an infinite + loop if it encountered a blank line has been fixed. + +noao$proto/t_imreplace.x +noao$proto/imrep.gx +noao$proto/imreplace.par +noao$proto/doc/imreplace.hlp + Valdes, May 23, 1989 + Complex images are supported with the thresholds being the magnitude + of the complex values and the replacement value specified as real + and imaginary. + +noao$proto/tvmark + Davis, May 22, 1989 + The new task TVMARK was added to the proto package. + +noao$proto/imedit/ + Davis, May 22, 1989 + The new task IMEDIT was added to the proto package. + +noao$proto/t_binfil.x + Rooke, Apr 28, 1989 + After allocating temporary storage for header bytes in IRAFIL, the code + was then reading those bytes instead into pixel storage, resulting in + a segmentation violation if header > row of pixels (found by Jim + Klavetter). + +noao$proto/epix/epgdata.x + Valdes, Mar 20, 1989 + Limit checking on the requested data region was wrong. User would get + out of bounds message if the line desired was greater than the number + of columns. + +noao$proto/t_bscale.x + Davis, Feb 7, 1989 + Fixed a memory corruption error in bscale. If a user specified a section + using the section parameter, the task was overflowing the data array + by trying to read beyond the boundary of the section. + + Fixed a floating divide by zero problem in the computation of + step sizes when a specified section was only one pixel + wide in a given dimension. + +noao$proto/ + Davis, Jan 26, 1989 + A "pixel out of bounds" error was fixed in the task IRMATCH2D. This + would occur if nxsub != nysub and for certain combination of corner + and order. This bug has been fixed. + +noao$proto/ + Davis, Nov 8, 1988 + The two prototype image intensity matching tasks IRMATCH1D and IRMATCH2D + have been added to the proto package. See the help pages for further + details. + +noao$proto/t_irmosaic.x + Davis, Jul 23, 1988 + The number of columns and rows between adjacent subrasters in the output + image produced by IRMOSAIC was incorrect if nxoverlap or nyoverlap were + less than -1. + +noao$proto/t_imslice.x + Davis, Jul 8, 1988 + A new task imslice has been added to the proto package. IMSLICE reduces + an n-dimensional image to a list of (n-1)-dimensional images. + +noao$proto/mkpkg +noao$proto/imfunction.x +noao$proto/imfuncs.gx + +noao$proto/imdex.gx - +noao$proto/imlog.gx - +noao$proto/imsqr.gx - + Valdes, Apr 8, 1988 + Added the absolute value function. Combined the different functions + into one procedure. + +noao$proto/t_mkhistogram.x + Davis, Feb 5, 1988 + A new task mkhistogram has been added to the proto package. Mkhistogram + will task a stream of data and list or plot the histogram of the data. + +noao$proto/t_irmosaic.x + Davis, Feb 3, 1988 + 1. A new parameter "subtract" has been added to the IRMOSAIC task. If + the "median" parameter is yes then IRMOSAIC will subtract the median + from each subraster before adding it to the output image mosaic. + +noao$proto + Davis, Dec 8, 1987 + 1. Two new tasks IRMOSAIC and IRALIGN have been added to the PROTO + package. IRMOSAIC takes an ordered list of input images and places them + on a grid in an output image. Options exist to order the input list + by row, column or in a raster pattern starting at any of the four + corners of the output image. Adjacent subrasters may be overlapped or + separated by a specified number of columns and rows. Positions of objects + which occur in adjacent subrasters can be marked using for example + the sun imtool facility and centered using the APPHOT center routine. + IRALIGN takes the mosaiced image and the coordinate list and produces an + output image where all the individual subrasters have been aligned with + respect to some reference subraster. These two tasks are most useful for + images which already lie approximately on a grid. + +noao$proto/t_bscale.x + +noao$proto/bscale.par + +noao$proto/doc/bscale.hlp + + Valdes, October 7, 1988 + A new task to compute to scale images by a zero point and scale factor + has been added. The zero point and scale factor can be chosen as the + mean, median, or mode of the images. + +noao$proto/doc/replicate.hlp - + Valdes, June 4, 1987 + 1. Deleted this obsolete file. + +noao$proto/toonedspec.x +noao$proto/doc/toonedspec.hlp + Valdes, April 27, 1987 + 1. The output spectra are now of type real regardless of the input + pixel type. This change was made to avoid fix point exceptions + on AOS/VS IRAF when summing enough lines to overflow the input + pixel type. On the other IRAF systems integer overflows only cause + erroneous output but no error. + +noao$proto/fixline.gx + Valdes, April 27, 1987 + 1. The interpolation weights when interpolating across lines were + being truncated and producing approximately correct values + but not correct interpolation. The weights are now not truncated. + +noao$proto/join.cl + Hammond, March 10, 1987 + 1. Added script task JOIN, which joins two lists line by line. + +noao$proto/t_imstack.x + Valdes, March 3, 1987 + 1. The input images being stacked were not being closed after they + were added to the output image. + +noao$proto/imrep.gx + Valdes, February 5, 1987 + 1. There was a problem in AOS iraf because of an attempt to convert + a real INDEF to a short value. The routine was modified to attempt + the conversion only if the value is not INDEF. + +noao$proto/t_imstack.x +noao$proto/doc/imstack.hlp + Valdes, October 8, 1986 + 1. Modified IMSTACK to use image templates instead of file templates. + All image tasks should use the image template package for consistency. + 2. Modified the help page. One of the examples was incorrect. + +noao$proto/imfunction.x + Valdes, October 8, 1986 + 1. Doug Tody added the square root function. I don't know the + details of the revision. + +noao$proto/imfunction.x +noao$proto/imfunction.par +noao$proto/imlog.gx +noao$proto/imdex.gx + +noao$proto/funcs.x - +noao$proto/doc/imfunction.hlp + Valdes, September 9, 1986 + 1. Added the "dex" function which is the inverse of the existing "log" + function. + 2. The help page was revised. + +proto$toonedspec: Valdes, June 16, 1986 + 1. Added new task TOONEDSPEC to convert columns or lines of 2D + spectra to 1D spectra. A manual page was also added. This + is a prototype. The task or it's function will eventually + move to the TWODSPEC package. + +====================== +Package reorganization +====================== + +local$dsttoiraf: Valdes, April 7, 1986 + 1. The task resides now on NOAO/VMS SKD:[LOCAL.DAOP] + +local$t_imstack.x: Valdes, April 6, 1986 +local$doc/imstack.hlp: Valdes, April 6, 1986 + 1. Removed warning message about mixed datatypes in IMSTACK. + 2. Updated help page for IMSTACK. + +local$dsttoiraf: Valdes, April 3, 1986 + 1. Added NOAO foreign task to convert DST (DAO) format images to + IRAF images. This task is only available on the NOAO/VMS cluster. + Attempting to run this on any other system will fail. + +local$irafil: Valdes, April 3, 1986 + 1. George Jacoby added the task IRAFIL to convert integer byte + pixel data to an IRAF image. It is an attempt to have a general + dataio conversion for foreign format images. + +=========== +Release 2.2 +=========== + +From Valdes Jan. 24, 1986: + +1. Removed NOTES tasks which was not useful. +------ +August 6, 1985: + +1. Imfunction modified to produce only real datatype output images. +2. Revisions script added. +.endhelp diff --git a/pkg/proto/binfil.par b/pkg/proto/binfil.par new file mode 100644 index 00000000..c5976e0b --- /dev/null +++ b/pkg/proto/binfil.par @@ -0,0 +1,3 @@ +input,s,a,,,,Input image names +scale_fact,r,h,1.0,,,Scaling multiplier +header,b,h,no,,,Include a header field diff --git a/pkg/proto/bscale.par b/pkg/proto/bscale.par new file mode 100644 index 00000000..a3b25d30 --- /dev/null +++ b/pkg/proto/bscale.par @@ -0,0 +1,9 @@ +input,s,a,,,,Input images +output,s,a,,,,Output images +bzero,s,h,"0.",,,Zero point (mean|median|mode or value) +bscale,s,h,"1.",,,Scale factor (mean|median|mode or value) +section,s,h,"",,,Image section for calculating statistics +step,i,h,10,1,,Default sampling step for calculating statistics +lower,r,h,INDEF,,,Lower limit for calculating statistics +upper,r,h,INDEF,,,Upper limit for calculating statistics +verbose,b,h,yes,,,Verbose mode ? diff --git a/pkg/proto/color/README b/pkg/proto/color/README new file mode 100644 index 00000000..bdb8ad90 --- /dev/null +++ b/pkg/proto/color/README @@ -0,0 +1,87 @@ + IRAF Tools for Color Image Display + +A prototype IRAF color image display package, COLOR, is now available. +Currently this package provides conversion of 3 bandpass IRAF images to a +Sun 24-bit RGB rasterfile format, a 24-bit to 8-bit compression algorithm +and Floyd-Steinberg dithering, and an RGB 8-bit pixel dithering algorithm. +The Sun rasterfiles are displayed using non-IRAF tools and the others use +only IRAF images and SAOimage or IMTOOL. These tasks are usable with the +currently common 8-bit color workstations and are provided for those users +which don't have more capable hardware such as 24-bit workstations, IIS +displays, and 24-bit addon cards. Addtional functionality will be added to +the COLOR package in time. + +The task RGBSUN takes three input IRAF images and produces a 24-bit Sun +rasterfile. Though this file type was developed by Sun Microsystems it is +a relatively simple format which may useful on other machines having +software designed to use it. The color image may be displayed with a variety +of non-IRAF tools such as XV (a very powerful and generic viewer for +X-window systems), XLOADIMAGE (another X-window display tool), SCREENLOAD +(a simple displayer on Sun computers), and SNAPSHOT (an Open-Look tool). +Also some color printers can be used with this format such as a Shinko +color printer. + +The recommended display tool is XV which provides a great deal of +capability in adjusting the color map and size. This program compress the +24-bit colors to 8-bits on an 8-bit workstation using color dithering +techniques (there is a choice of a slow and fast method). This program +also provides the capability to write the picture out to other formats and +one may also use screen capture tools such as XWD or SNAPSHOT +to extract and possibly print the picture. + +For hardcopy there is always the option of photographing the workstation +screen. Different sites may also have color printers which accept +the rasterfile directly or some other form of capture from the screen. +At NOAO there is a Shinko color printer which may be used directly with +the rasterfile to make moderate quality color prints and slides. + +The task RGBTO8 takes three input IRAF images, maps them to 8-bits each, +compresses the 24-bit RGB colors to 8-bits using the Heckbert Median +Cut Algorithm, and applies a Floyd-Steinberg dither to the output +8-bit IRAF image. The task also outputs a color map suitable for use +with (V1.07) SAOimage and IMTOOL. Basically this does the same thing +as the X tools except in an IRAF task which produces and IRAF image and +separate color map. This approach, thus, only requires this package +and the standard IRAF display server and only uses IRAF images. + +The pixel dithering techique takes three input IRAF images and makes a +special output image in which each pixel in the input images is expanded +into nine pixels in the output image with a specified pattern such as +the default of + + brg + r + g + b = gbr + rgb + +where r is the red image pixel, g is the green image pixel, and b is the +blue image pixel. + +The pixel intensities are linearly mapped from a specified input range to +one of three sets of 85 levels. The red pixels map to the values 0 to 84, +the green pixels to the range 85 to 169, and the blue pixels to the range +170 to 254. The display server then uses a special 8-bit look up table +that maps each set of 85 levels in each pure color from off to the maximum +intensity. The displayed image counts on the nearby grouping of pure +colors to blend in the detector, such as the eye, to give a color composite +effect. + +This is essentially the same technique used in some kinds of color printing +and CRT monitors where each resolution element has three color phosphors +and three guns to excite them. The pixel dithering is also related to +black and white half-toning. As with any of these, if the image is +magnified or viewed with enough resolution (by looking very closely at the +display) the individual color elements can be distinguished. However, when +viewed normally without magnification the effect is reasonably good. + +The advantages of the last two techniques for IRAF users are that the +currently common 8-bit color workstation displays, the standard IRAF +display servers SAOimage and IMTOOL, and the standard IRAF image formats +are all that is required. The pixel dither technique has the advantage of +using a palette of colors which is wider than attempting to compress the +three images into a single 8-bit word (color compression) and the method is +more intuitive than the 24-bit to 8-bit compress and dithering used in XV +RGBTO8. The disadvantages of the pixel dithering are the loss of +resolution, the decrease in overall brightness (since at most only one +color is at maximum at each resolution element), and the special nature of +the composite image (which, however, is an IRAF image rather than one of +the many other color picture formats). diff --git a/pkg/proto/color/Revisions b/pkg/proto/color/Revisions new file mode 100644 index 00000000..1a5b2819 --- /dev/null +++ b/pkg/proto/color/Revisions @@ -0,0 +1,81 @@ +.help revisions Aug92 color +.nf + +src/rgb8bit.par - + Delete unused file. (10/24/11) + +================================= +Archive 3/14/96: Fourth release +================================= + +src/t_rgbto8.x + Removed an extra argument in a call to xv_getline. (10/30/94, Valdes) + +src/t_rgbto8.x +src/rgbto8.par +doc/rgbto8.hlp +doc/color.hlp + A new color map output type was added for XIMTOOL and the documentation + was updated. (5/23/94, Valdes) + +================================= +Archive 3/8/93: Third release +================================= + +src/t_rgbto8.x + The converting the colormap to SAO output format failed on VMS. A + type coercion from short to int was added in the parg statements. + (10/29/92, Valdes) + +================================ +Archive 10/12/92: Second release +================================ +src/t_rgbto8.x + +src/rgbto8.par + +src/mkpkg +src/rgb8bit.par +src/rgbdisplay.cl +src/rgbdisplay.par +src/rgbdither.par +src/rgbsun.par +src/t_rgbdither.x +src/t_rgbsun.x +src/x_color.x +src/mkpkg +color.cl +color.hd +color.men +color.par +doc/color.hlp +doc/rgbdisplay.hlp +doc/rgbdither.hlp +doc/rgbsun.hlp +doc/rgbto8.hlp + + 1. Added new task, RGBTO8, which implements a 24bit to 8bit algorithm + and Floyd-Steinberg dithering to produce an 8bit IRAF image and + a color map for use with SAOimage and IMTOOL. + 2. The names of the various tasks were changed. + +t_rgb8bit.x +t_sunrgb.x + Changed the way the log scaling is done to shift the user specified + range to the range 1 to 10 before taking the log and then shifting the + resultant range to required display range. This allows ranges that + include negative values. (8/28/92, Valdes) + +t_rgb8bit.x +mkrgb8bit.par +rgb8bit.par +mkrgb8bit.hlp +rgb8bit.hlp + Made the dither pattern be user defineable. (8/28/92, Valdes) + + +=============================== +Archive 8/26/92: First release +=============================== + +color$* + + Created first version of the color package with a Sun 24-bit RGB + rasterfile task and 8-bit pixel dithering tasks. (8/25/92, Valdes) +.endhelp diff --git a/pkg/proto/color/color.cl b/pkg/proto/color/color.cl new file mode 100644 index 00000000..0c7f5376 --- /dev/null +++ b/pkg/proto/color/color.cl @@ -0,0 +1,10 @@ +#{ COLOR -- Package for COLOR image display + +package color + +task rgbdither, + rgbsun, + rgbto8 = "color$src/x_color.e" +task rgbdisplay = "color$src/rgbdisplay.cl" + +clbye diff --git a/pkg/proto/color/color.hd b/pkg/proto/color/color.hd new file mode 100644 index 00000000..7bc9c987 --- /dev/null +++ b/pkg/proto/color/color.hd @@ -0,0 +1,13 @@ +# Help directory for the COLOR package + +$defdir = "color$" +$doc = "color$doc/" +$src = "color$src/" + +package hlp=doc$color.hlp +rgbdisplay hlp=doc$rgbdisplay.hlp, src=src$rgbdisplay.cl +rgbdither hlp=doc$rgbdither.hlp, src=src$t_rgbdither.x +rgbsun hlp=doc$rgbsun.hlp, src=src$t_rgbsun.x +rgbto8 hlp=doc$rgbto8.hlp, src=src$t_rgbto8.x + +revisions sys=Revisions diff --git a/pkg/proto/color/color.men b/pkg/proto/color/color.men new file mode 100644 index 00000000..e96f1a95 --- /dev/null +++ b/pkg/proto/color/color.men @@ -0,0 +1,8 @@ + rgbdisplay - Display an RGB image + rgbdither - Create an 8-bit RGB dithered image + rgbsun - Create a Sun 24-bit RGB rasterfile + rgbto8 - Create an 8-bit RGB image with special color map + + ADDITIONAL TOPICS + + package - Guide to color image display diff --git a/pkg/proto/color/color.par b/pkg/proto/color/color.par new file mode 100644 index 00000000..dcf9ef48 --- /dev/null +++ b/pkg/proto/color/color.par @@ -0,0 +1,3 @@ +# COLOR - Package parameters + +version,s,h,"COLOR V2.0: October 1992" diff --git a/pkg/proto/color/color.readme b/pkg/proto/color/color.readme new file mode 100644 index 00000000..6aa00236 --- /dev/null +++ b/pkg/proto/color/color.readme @@ -0,0 +1,139 @@ +A new color map output type was added for XIMTOOL and the documentation +was updated. + +================================= +Archive 3/8/93: Third release +================================= + +On VMS the sao lookup table was coming out incorrect due to datatype problems. + +================================= +Archive 10/12/92: Second release +================================= + +A new task, RGBTO8, was added which compresses 24-bit RGB data from IRAF +images to an 8-bit IRAF image and a outputs a color map suitable for display +with (V1.07) SAOimage or IMTOOL. Also the names of the other tasks from the +first release have been changes. The 3x3 pixel dithering task, now called +RGBDITHER, was modified to allow the user to specify a dither pattern. + +Note that to use the output from the new RGBTO8 with SAOimage you must +obtain a revised version of SAOimage (V1.07) which expands the size of +the color maps allowed from 30 to the full 200 used by the task. + +================================= +Archive 8/26/92: First release +================================= + + Installation Instructions for the COLOR Package + +A prototype IRAF color image display package, COLOR, is now available. +Currently this package provides conversion of 3 bandpass IRAF images to a +Sun 24-bit RGB rasterfile format, a 24-bit to 8-bit compression algorithm +and Floyd-Steinberg dithering, and an RGB 8-bit pixel dithering algorithm. +The Sun rasterfiles are displayed using non-IRAF tools and the others use +only IRAF images and SAOimage or IMTOOL. These tasks are usable with the +currently common 8-bit color workstations and are provided for those users +which don't have more capable hardware such as 24-bit workstations, IIS +displays, and 24-bit addon cards. Addtional functionality will be added to +the COLOR package in time. + +The installation instructions that follow assume that you have copied the +tar format COLOR archive onto your host machine. The method you use to +copy the file (or remotely access the tar file) is OS dependent and is not +discussed in this document. If you have any questions, please contact the +IRAF group at iraf$noao.edu, NOAO::IRAF (5355::IRAF) or call the IRAF +HOTLINE at 602-323-4160. + +[1] The package is distributed as a tar archive; IRAF is distributed + with a tar reader. The tar archive may be obtained by magnetic + tape or anonymous ftp. For magnetic tape go to step [2] and when + reading the tar archive simply mount the tape and use the tape + device name for the archive name in step [4]. To obtain the package + via ftp (assuming a UNIX computer): + + % ftp 192.31.165.1 + login: anonymous + password: [your email address] + ftp> cd iraf.old + ftp> get readme.color + ftp> binary + ftp> get color.tar.Z + ftp> quit + % uncompress color.tar + + The readme.color file contains these instructions. Special arrangements + can be made for sites that don't have access to internet but could copy + the uncompressed archive over SPAN. + +[2] Create a directory to contain the COLOR external package files. This + directory should be outside the IRAF directory tree and must be owned + by the IRAF account. In the following examples, this root directory is + named usr1:[color] (VMS) or /local/color/ (UNIX). Make the + appropriate file name substitutions for your site. + +[3] Log in as IRAF and edit the extern.pkg file in the hlib$ directory to + define the package to the CL. From the IRAF account, outside the CL, + you can move to this directory with the commands: + + $ set def irafhlib # VMS example + % cd $hlib # UNIX example + + Define the environment variable color to be the pathname to the + color root directory. The '$' character must be escaped in the VMS + pathname; UNIX pathnames must be terminated with a '/'. Edit + extern.pkg to include: + + reset color = usr\$1:[color] # VMS example + reset color = /local/color/ # UNIX example + task $color.pkg = color$color.cl + + Near the end of the hlib$extern.pkg file, update the definition of helpdb + so it includes the color help database, copying the syntax already used + in the string. Add this line before the line containing a closing quote: + + ,color$lib/helpdb.mip\ + + NOTE: In IRAF V2.8 the length of the helpdb string cannot exceede 160 + characters. A helpdb string longer than 160 characters will cause the + CL startup process to fail. + +[4] Log into the CL from the IRAF account and unpack the archive file. Change + directories to the COLOR root directory created above and use 'rtar': + + cl> cd color + cl> softools + cl> rtar -xrf <archive> where <archive> is the host name of the + archive file or the IRAF tape + device for tape distributions. + + On VMS systems, an error message will appear ("Copy 'bin.generic' to + './bin fails") which can be ignored. Also on VMS systems, the four + bin.'mach' directories created by rtar under [color.bin] can be + deleted. UNIX sites should leave the symbolic link 'bin' in the COLOR + root directory pointing to 'bin.generic' but can delete any of the + bin.`mach' directories that won't be used. The archive file can be + deleted once the package has been successfully installed. + +[5] When the archive has been unpacked, build the COLOR package executable. + The compilation and linking of the COLOR package is done using the + following command: + + cl> mkpkg -p color update >& color.spool & + + NOTE: On systems that concurrently support different architectures + (e.g., Suns, Convex), you must configure the system for the desired + architecture before issuing the above command. SUN/IRAF sites must + execute a pair of 'mkpkg' commands for each supported architecture type. + The Unix environment variable IRAFARCH must be set as well before + compiling. For example: + + # Assuming IRAFARCH is set to ffpa + cl> mkpkg -p color ffpa + cl> mkpkg -p color update >& color.ffpa & + cl> mkpkg -p color f68881 + # Now reset IRAFARCH to f68881 before continuing + cl> mkpkg -p color update >& color.f68881 & + + The spool file(s) should be reviewed upon completion to make sure there + were no errors. diff --git a/pkg/proto/color/doc/color.hlp b/pkg/proto/color/doc/color.hlp new file mode 100644 index 00000000..539e0dbc --- /dev/null +++ b/pkg/proto/color/doc/color.hlp @@ -0,0 +1,215 @@ +.help package Oct92 color +.ce +Guide to Making Color Composites from IRAF images + +INTRODUCTION + +This guide describes techniques for taking three monochrome IRAF images, a +"red" image, a "green" image, and a "blue" image and making color +composites. There are many techniques which depend on different hardware +and software. This guide currently discusses three methods for display on +an 8-bit color workstation, using Sun 24-bit RGB rasterfiles, creating a +special color map and image which samples the RGB color space, and pixel +dithering. The rasterfiles may be displayed or printed using a variety or +non-IRAF tools which are readily available and which can be used with 8-bit +workstations. The special color map and pixel dithering methods use only +IRAF images and the standard SAOimage/IMTOOL display servers to display on +8-bit color workstation. These techniques are intended to provide a +rudimentary color composite capability in absence of better hardware such +as IIS/IVAS devices or 24-bit workstations. + +For further information on the tasks described here see the approriate +help pages. + + +SUN 24-BIT RGB RASTERFILES + +The task \fBrgbsun\fR takes three input IRAF images and produces a 24-bit +Sun rasterfile. Though this file type was developed by Sun Microsystems +it is a relatively simple format which may useful on other machines having +software designed to use it. The color image may be display with a variety +of tools such as \fBxv\fR (a very powerful and generic viewer for X-window +systems), \fBxloadimage\fR (another X-window display tool), +\fBscreenload\fR (a simple displayer on Sun computers), and \fBsnapshot\fR +(an Open-Look tool). Also some color printers can be used with this format +such as a Shinko color printer. + +The recommended display tool is \fBxv\fR which provides a great deal of +capability in adjusting the color map and size. This program compresses the +24-bit colors to 8-bits on an 8-bit workstation using color dithering +techniques (there is a choice of a slow and fast method). This program +also provides the capability to write the picture out to other formats and +one may also use screen capture tools such as \fBxwd\fR or \fBsnapshot\fR +to extract and possibly print the picture. + +For hardcopy there is always the option of photographing the workstation +screen. Different sites may also have color printers which accept +the rasterfile directly or some other form of capture from the screen. +At NOAO there is a Shinko color printer which may be used directly with +the rasterfile to make moderate quality color prints and slides. + + +24-BIT to 8-BIT COLOR MAP COMPRESSION + +The task \fBrgbto8\fR produces an 8-bit color map which samples the full +range of RGB color values and an associated image with values indexing the +color map. The compression algorithm is called the Median Cut Algorithm +and the image is dithered with this color map using the Floyd-Steinberg +algorithm. The resulting image is a short image with 199 values. The +color map is output in either a format suitable for use with SAOimage or +with IMTOOL. This method is recommended over the pixel dithering method. + +The RGB values are input as three IRAF images. The images must each be +scaled to an 8 bit range. This is done by specifying a range of input +values to be mapped to the 8 bit range. In addition the range can be +mapped logarithmically to allow a greater dynamic range. + +The output image is displayed with \fBrgbdisplay\fR and SAOimage, IMTOOL, +or XIMTOOL. Note that this requires V1.07 of SAOimage. The color map +produced by the \fBrgbto8\fR for a particular image must also be loaded +into the display server manually. With IMTOOL use the setup panel and set +the file name in the user1 or user2 field and then select the appropriate +map. With SAOimage you select the "color" main menu function, and then the +"cmap" submenu function, and then the "read" button. Note that usually a +full pathname is required since the server is usually started from the +login directory. For XIMTOOL the "XImtool*cmapDir1" resource must be +set to the directory containing the color map and XIMTOOL must be +restarted to cause the directory to be searched for color map files. + +The display server must be setup in it's default contrast mapping (with +IMTOOL you can use the RESET option, with XIMTOOL the "normalize" option is +used, and with SAOimage you must restart) and the contrast mapping must not +be changed. There are no adjustments that can be made in IMTOOL or XIMTOOL +but with SAOimage you can adjust the colors using the "gamma" selections +and the mouse. + + +8-BIT PIXEL DITHERING + +1. Theory + +The pixel dithering technique takes the three input IRAF images and makes a +special output IRAF image in which each pixel in the input images is expanded +into nine pixels in the output image with a specified pattern such as +the default of + +.nf + brg + r + g + b = gbr + rgb +.fi + +where r is the red image pixel, g is the green image pixel, and b is the +blue image pixel. + +The pixel intensities are linearly mapped from a specified input range to +one of three sets of 85 levels. The red pixels map to the values 0 to 84, +the green pixels to the range 85 to 169, and the blue pixels to the range +170 to 254. The display server then uses a special 8-bit look up table +that maps each set of 85 levels in each pure color from off to the maximum +intensity. The displayed image counts on the nearby grouping of pure +colors to blend in the detector, such as the eye, to give a color composite +effect. + +This is essentially the same technique used in some kinds of color printing +and CRT monitors where each resolution element has three color phosphors +and three guns to excite them. The pixel dithering is also related to +black and white half-toning. As with any of these, if the image is +magnified or viewed with enough resolution (by looking very closely at the +display) the individual color elements can be distinguished. However, when +viewed normally without magnification the effect is reasonably good. + +8-BIT PIXEL DITHERING: Usage + +The composite image is created by the task \fBrgbdither\fR and displayed +with the task \fBrgbdisplay\fR. Unlike the \fBdisplay\fR task there is no +automated way to define the display ranges for the three images. These +must be specified explicitly with the image is created. The ranges may be +determined in a variety of ways such as by looking at the histograms, +\fBimhist\fR, the statistics of the image, \fBimstat\fR, or possibly the +display range produced by \fBdisplay\fR. Note, however, that often the +ranges used to stretch an individual image are not appropriate for color +balancing between the three images. + +Because each input pixel is expanded into nine pixels in the composite +image the composite image will have dimensions three times larger than +the input image. The \fIblkavg\fR parameter allows block averaging +the input images at the same time that the composite image is created. +If a value of 3, the default, is used then the final displayed image +will have dimensions nearly the same as the input images. This is often +satisfactory and one should try this first. + +If one wants to display images which have a large dyanmic range it +may be desirable to first take the logarithm of each image. This may +be done with the \fIlogmap\fR parameter. Other types of stretching may +be accomplished by modifying the individual images first, say with +\fRimfunction\fR. + +In addition to creating and loading the composite image within IRAF +it is also necessary to adjust the image display server. Either +SAOimage or IMTOOL may be used. SAOimage is prefered because +it is possible to make some adjustments in the color mapping while with +IMTOOL one must modify the composite image by varying the z1 and z2 +values for the three images. + +The display servers must be set so that there is no contrast stretching. +This is how the programs start initially but it may be difficult to return +to this state if you adjust the contrast with the right mouse button in +IMTOOL or the contrast adjustments in the (COLOR) menu of SAOimage. + +You must first determine where the special color maps are located. +Since the display servers are host programs they require host pathnames. +You can determine the host pathname from within IRAF using the command + +.nf + cl> path colorlib$saorgb.lut + puppis!/ursa/iraf/extern/color/lib/saorgb.lut + + or + + cl> path colorlib$imtoolrgb.lut + puppis!/ursa/iraf/extern/color/lib/imtoolrgb.lut +.fi + +You can either remember these names (without the node prefix) or +more simply copy the one you need to your IRAF home directory +(or any place else you like) with the command + +.nf + cl> copy colorlib$saorgb.lut home$ + + or + + cl> copy colorlib$imtoolrgb.lut home$ +.fi + +With SAOimage load the special look up table by entering the (COLOR) menu, +then the (CMAP) menu, and then pushing the (READ) button. When you are +prompted for the map enter the pathname for the file saorgb.lut. For +IMTOOL you need to call up the setup menu and set the pathname for the file +imtoolrgb.lut in either of the user look up tables and then select the +appropriate map. + +For IMTOOL that is all you can do. Beware, don't adjust the contrast (the +right mouse button) since this destroys the mapping between the composite +image values and the look up table. + +In SAOimage there are a couple of things you can do to make adjustments to +the display. Bring up the color editor by clicking on the color bar. Even +if you don't adjust the look up table this can be instructive. If you +select (GAMMA) in the (COLOR) menu you can then move the mouse with a +button down and vary the linearity of the color maps. This can be seen in +the color editor. You can also adjust the individual colors by clicking +the left (red), middle (green), or right (blue) buttons to either move the +shown points or add and move points in the middle. Note that the abrupt +discontinuity between the colors can cause sudden jumps in the color map if +one point is moved past the other but you can recover by bring the point +slowly back. If the map gets too messed up you can always reload the color +map. + +One might expect that making a hardcopy of the display would produce a +comparable quality image. This may be the case by photographing the CRT +screen. However, experiments with capturing the displayed image to a +rasterfile and printing it on a SHINKO color printer does not produce +useful hardcopy. +.endhelp diff --git a/pkg/proto/color/doc/rgbdisplay.hlp b/pkg/proto/color/doc/rgbdisplay.hlp new file mode 100644 index 00000000..f823d09a --- /dev/null +++ b/pkg/proto/color/doc/rgbdisplay.hlp @@ -0,0 +1,113 @@ +.help rgbdisplay Oct92 color +.ih +NAME +rgbdisplay -- display an RGB image +.ih +USAGE +rgbdisplay rgb +.ih +PARAMETERS +.ls rgb +Image name of the 8-bit RGB dithered composite image to be displayed. +.le +.ls frame = 1 +Image display frame. +.le +.ih +DESCRIPTION +\fBRgbdisplay\fR displays an 8-bit RGB color mapped or dithered image produced +by the tasks \fBrgbto8\fR or \fBrgbdither\fR. This task is a simple script +calling +the \fBdisplay\fR task with parameters fixed appropriately for the +images. The actual display command is: + +.nf + display rgb frame fill- ztrans=none +.fi + +where rgb and frame are the parameters of this task. + +In addition to loading the image with the \fBrgbdisplay\fR task +it is also necessary to adjust the image display server. Either +SAOimage or IMTOOL may be used. SAOimage is to be prefered because +it is possible to make some adjustments in the color mapping while with +IMTOOL one must modify the composite image by varying the z1 and z2 +values for the three images. + +Both display servers must be set so that there is no contrast stretching. +This is how both programs start initially but it may be difficult to return +to this state if you adjust the contrast with the right mouse button in +IMTOOL or the contrast adjustments in the (COLOR) menu of SAOimage. + +You must first determine where the special color maps are located. +For the images produced by \fBrgbto8\fR the color map will be in +the same directory as the image and have the same name with either +the extension ".sao" or ".imt" depending on the target display server. +Since the display servers are host programs they require host pathnames. + +For the images produced by \fBrgbdither\fR +you can determine the host pathname for the special color map +from within IRAF using the command + +.nf + cl> path colorlib$saorgb.lut + puppis!/ursa/iraf/extern/color/lib/saorgb.lut + + or + + cl> path colorlib$imtoolrgb.lut + puppis!/ursa/iraf/extern/color/lib/imtoolrgb.lut +.fi + +You can either remember these names (without the node prefix) or +more simply copy the one you need to your IRAF home directory +(or any place else you like) with the command + +.nf + cl> copy colorlib$saorgb.lut home$ + + or + + cl> copy colorlib$imtoolrgb.lut home$ +.fi + +With SAOimage load the appropriate color map look up table by entering the +(COLOR) menu, then the (CMAP) menu, and then pushing the (READ) button. +When you are prompted for the map enter the pathname for the file +saorgb.lut. For IMTOOL you need to call up the setup menu and set the +pathname for the file imtoolrgb.lut in either of the user look up tables +and then select the appropriate map. + +For IMTOOL that is all you can do. Beware, don't adjust the contrast (the +right mouse button) since this destroys the mapping between the composite +image values and the look up table. + +In SAOimage there are a couple of things you can do to make adjustments to +the display. If you select (GAMMA) in the (COLOR) menu you can then move +the mouse with a button down and vary the linearity of the color maps. +This may be used with either of the 8-bit algorithms. + +For the pixel dithered images you can also directly manipulate the color +map. Bring up the color editor by clicking on the color bar. Even if you +don't adjust the look up table this can be instructive. You can also +adjust the individual colors by clicking the left (red), middle (green), or +right (blue) buttons to either move the shown points or add and move points +in the middle. Note that the abrupt discontinuity between the colors can +cause sudden jumps in the color map if one point is moved past the other +but you can recover by bring the point slowly back. If the map gets too +messed up you can always reload the color map. +.ih +EXAMPLES +1. Display a dithered composite image. + +.nf + cl> rgbdisplay tucana!/d1/testdata/rgb/trifid8 + <Load the color map tucana!/d1/testdata/rgb/trifid8.sao or + <tucana!/d1/testdata/rgb/trifid8.imt. Because the display + <server is a host program you may need to copy the map + <first. +.fi +.ih +SEE ALSO +rgbto8, rgbdither, color.package +.endhelp diff --git a/pkg/proto/color/doc/rgbdither.hlp b/pkg/proto/color/doc/rgbdither.hlp new file mode 100644 index 00000000..1d22c94c --- /dev/null +++ b/pkg/proto/color/doc/rgbdither.hlp @@ -0,0 +1,91 @@ +.help rgbdither Oct92 color +.ih +NAME +rgbdither -- make an RGB composite image using 8-bit pixel dithering +.ih +USAGE +rgbdither red green blue rgb +.ih +PARAMETERS +.ls red, green, blue +Input image names for the red, green, and blue components. The images +must all be two dimensional and of the same size. +.le +.ls rgb +Output image name for the RGB dithered composite image. +.le +.ls rz1, rz2, gz1, gz2, bz1, bz2 +Range of values in the input images to be mapped to the minimum and maximum +intensity in each color. Image pixel values outside the range are mapped +to the nearest endpoint. The values correspond to the input image +intensities even when using logarithmic mapping. +.le +.ls blkavg = 3 +Block average factor for the input images. The input images may first be +block averaged before creating the output dithered composite image. Note +that the output image will be have dimensions three times larger than the +block averaged input images so a block average factor of three will produce +an image which is nearly the same size as the original input images. A +factor of 1 will use the pixel values without any averaging. +.le +.ls logmap = no +Use logarithmic intensity mapping? The logarithm of the input pixel +values, in the range given by the z1 and z2 parameters, is taken before +dividing the range into the 85 display levels. Logarithmic mapping allows +a greater dynamic range. +.le +.ls pattern = "rgbgbrbrg" +Dither pattern given as a list of characters specifying a 3x3 array +with the column element incrementing fastest. A character of r is +the red image, a character of g is the green image, and a character of +b is the blue image. Note that each image should occur three times. +.le +.ih +DESCRIPTION +\fBRgbdither\fR takes three input IRAF images and produces a special +composite IRAF image which may be displayed as an RGB color image using a +special color map. The input images are first block averaged by the +\fIblkavg\fR factor, pixel values outside the specified ranges are mapped +to the nearest endpoint, converted to logarithmic intensities if desired, +and the range mapped to 85 integer levels. The red image is mapped to the +values 0 to 84, the green image to the values 85 to 169, and the blue image +to the values 170 to 254. The corresponding pixels from the three images +are then replicated in the output image to form a specified 3x3 dither +pattern such as the default of + +.nf + brg + gbr + rgb +.fi + +where r is the red image pixel, g is the green image pixel, and b is the +blue image pixel. This produces a composite image which is three times +larger in each dimension than the block averaged input images. + +When the dithered 8-bit composite image is displayed using a color map that +shows values 0-84 as shades of red, 85-169 as shades of green, and 170-254 +as shades of blue the eye (or camera) will blend the individual pixels into +a RGB color image. See \fBrgbdisplay\fR and \fBcolor\fR for a description of +how to display the composite image. A better technique may be to use +\fBrgbto8\fR. +.ih +EXAMPLES +1. Three 2048x2048 images of the Trifid nebula are obtained in the B, V, +and R bandpasses. These images are properly registered. Examination of +the histograms leads to selecting the display ranges 1-500 in each band. +The large scale colors of the extended emission is of interest and so a +block averaging factor 6 will yield a final composite image of size +1023x1023 to be displayed. + +.nf + cl> rgbdither trifidr trifidv trifidb trifidrgb \ + >>> rz1=1 rz2=500 gz1=1 gz2=500 bz1=1 bz2=500 blk=6 +.fi +.ih +TIME REQUIREMENTS +Example 1 takes 2:20 minutes (33 seconds CPU) on a SparcStation 2. +.ih +SEE ALSO +rgbdisplay, rgbto8, rgbsun, color.package +.endhelp diff --git a/pkg/proto/color/doc/rgbsun.hlp b/pkg/proto/color/doc/rgbsun.hlp new file mode 100644 index 00000000..ee28b4bf --- /dev/null +++ b/pkg/proto/color/doc/rgbsun.hlp @@ -0,0 +1,92 @@ +.help rgbsun Oct92 color +.ih +NAME +rgbsun -- make a Sun 24-bit RGB rasterfile from three IRAF images +.ih +USAGE +rgbsun red green blue rgb +.ih +PARAMETERS +.ls red, green, blue +Input image names for the red, green, and blue components. The images +must all be two dimensional and of the same size. +.le +.ls rgb +Output file name for the Sun 24-bit RGB rasterfile. +.le +.ls rz1, rz2, gz1, gz2, bz1, bz2 +Range of values in the input images to be mapped to the minimum and maximum +intensity in each color. Image pixel values outside the range are mapped +to the nearest endpoint. The values correspond to the input image +intensities even when using logarithmic mapping. +.le +.ls logmap = no +Use logarithmic intensity mapping? The logarithm of the input pixel +values, in the range given by the z1 and z2 parameters, is taken before +dividing the range into the 85 display levels. Logarithmic mapping allows +a greater dynamic range. +.le +.ls swap = no +Swap rasterfile bytes on output? Used when rasterfiles are being written +to a computer with opposite byte-swapping from that of the home computer +(e.g. between VAX and Sun). +.le +.ih +DESCRIPTION +\fBRgbsun\fR takes three input IRAF images and produces a 24-bit Sun +rasterfile. Though this file type was developed by Sun Microcomputers it +is a relatively simple format which may useful on other machines have +software designed to use it. The color image may be display with a variety +of tools such as \fBxv\fR (a very powerful and generic, public domain +viewer for X-window systems), \fBxloadimage\fR (another X-window display +tool), \fBscreenload\fR (a simple displayer on Sun computers), and +\fBsnapshot\fR (a Open-Look tool). Also some color printers can be used +with this format such as a Shinko color printer. + +If one wants to display images which have a large dyanmic range it +may be desirable to first take the logarithm of each image. This may +be done with the \fIlogmap\fR parameter. Other types of stretching may +be accomplished by modifying the individual images first, say with +\fBimfunction\fR. + +If the output rasterfiles are being sent to a computer with opposite +byte-swapping characteristics, set \fIswap\fR = yes (e.g., when running +\fBrgbsun\fR on a VAX, with output to a Sun). + +The rasterfile format produced is quite simple. There is a header with 8 +integer values immediately followed by the data values. The header has the +following values of interest: + + Word 1: Magic numer = 1504078485 + Word 2: The number of columns + Word 3: The number of lines + Word 4: The number of bits per pixel = 24 + +The data consists of triplets of 8-bit data values in the order blue, +green, and red. The triplet pixels are ordered by varying the column +elements first and then the line elements. The sequence is continuous +except that each line is padded, if necessary, to maintain a multiple of 2 +bytes per line (with 3 bytes per pixel this means that images with an odd +number of columns will have an extra zero byte). +.ih +EXAMPLES +1. Three 2048x2048 images of the Trifid nebula are obtained in the B, V, +and R bandpasses. These images are properly registered. Examination of +the histograms leads to selecting the display ranges 1-500 in each band. +The image is then displayed on a workstation running an X-window system +using the \fBxv\fR utility. The file is also printed to a local +color printer interfaced as a Unix printer (the Shinko at NOAO). + +.nf + cl> rgbsun trifidr trifidv trifidb trifid.ras \ + >>> rz1=1 rz2=500 gz1=1 gz2=500 bz1=1 bz2=500 + cl> !xv -swap24 trifid.ras + cl> !lpr -Pclp trifd.ras +.fi +.ih +TIME REQUIREMENTS +Example 1 takes 2:20 minutes (33 seconds CPU) on a SparcStation 2. +.ih +SEE ALSO +rgbdither, rgbto8, color.package +.endhelp diff --git a/pkg/proto/color/doc/rgbto8.hlp b/pkg/proto/color/doc/rgbto8.hlp new file mode 100644 index 00000000..eea9a2d8 --- /dev/null +++ b/pkg/proto/color/doc/rgbto8.hlp @@ -0,0 +1,93 @@ +.help rgbto8 Oct92 color +.ih +NAME +rgbto8 -- make an RGB 8-bit image and associated color map +.ih +USAGE +rgbto8 red green blue rgb +.ih +PARAMETERS +.ls red, green, blue +Input image names for the red, green, and blue components. The images +must all be two dimensional and of the same size. +.le +.ls rgb +Output image name for the RGB 8-bit image. A color map with the same +image name but the extension ".sao" or ".imt" will also be created. +.le +.ls maptype = "saoimage" (saoimage|imtool|ximtool) +This parameter selects the type of color map file to be produced. The +choices are "saoimage" to produce a map for SAOimage, "imtool" to produce a +map for IMTOOL, and "ximtool" to produce a map for XIMTOOL. The filenames +are derived from the output image name with the extension ".sao", ".imt", +or ".xim". +.le +.ls rz1, rz2, gz1, gz2, bz1, bz2 +Range of values in the input images to be mapped to the minimum and maximum +intensity in each color. Image pixel values outside the range are mapped +to the nearest endpoint. The values correspond to the input image +intensities even when using logarithmic mapping. +.le +.ls logmap = no +Use logarithmic intensity mapping? The logarithm of the input pixel +values, in the range given by the z1 and z2 parameters, is taken before +dividing the range into the 85 display levels. Logarithmic mapping allows +a greater dynamic range. +.le +.ih +DESCRIPTION +\fBRgbto8\fR takes three input IRAF images and produces an 8-bit color map +which samples the full range of RGB color values and an associated image +with values indexing the color map. The compression algorithm is called +the Median Cut Algorithm and the image is dithered with this color map +using the Floyd-Steinberg algorithm. The resulting image is a short image +with 199 values. The color map is output in a format suitable for +use with SAOimage, IMTOOL or XIMTOOL. This method is recommended over the +pixel dithering method. + +The RGB values are input as three IRAF images. The images must each be +scaled to an 8 bit range. This is done by specifying a range of input +values to be mapped to the 8 bit range. In addition the range can be +mapped logarithmically to allow a greater dynamic range. + +The output image is displayed with \fBrgbdisplay\fR and SAOimage, IMTOOL, +or XIMTOOL. Note that this requires V1.07 of SAOimage. The color map +produced by the \fBrgbto8\fR for a particular image must also be loaded +into the display server manually. With IMTOOL use the setup panel and set +the file name in the user1 or user2 field and then select the appropriate +map. With SAOimage you select the "color" main menu function, and then the +"cmap" submenu function, and then the "read" button. Note that usually a +full pathname is required since the server is usually started from the +login directory. For XIMTOOL the "XImtool*cmapDir1" resource must be +set to the directory containing the color map and XIMTOOL must be +restarted to cause the directory to be searched for color map files. + +The display server must be setup in it's default contrast mapping (with +IMTOOL you can use the RESET option, with XIMTOOL the "normalize" option is +used, and with SAOimage you must restart) and the contrast mapping must not +be changed. There are no adjustments that can be made in IMTOOL or XIMTOOL +but with SAOimage you can adjust the colors using the "gamma" selections +and the mouse. +.ih +EXAMPLES +1. Three 2048x2048 images of the Trifid nebula are obtained in +the B, V, and R bandpasses. These images are properly registered. +Examination of the histograms leads to selecting the display ranges 1-500 +in each band. A half size image is created by subsampling using image +sections. + +.nf + cl> rgbto8 trifidr[*:2,*:2] trifidv[*:2,*:2] trifidb[*:2,*:2] \ + >>> trifid8 maptype=saoimage rz1=1 rz2=500 gz1=1 gz2=500 \ + >>> bz1=1 bz2=500 +.fi + +The file trifid8.sao will be created containing the color map for use +with the image trifid8. +.ih +TIME REQUIREMENTS +Example 1 takes 5 minutes on a SparcStation 2. +.ih +SEE ALSO +rgbdisplay, rgbdither, rgbsun, color.package +.endhelp diff --git a/pkg/proto/color/lib/helpdb.mip b/pkg/proto/color/lib/helpdb.mip Binary files differnew file mode 100644 index 00000000..cb36f99f --- /dev/null +++ b/pkg/proto/color/lib/helpdb.mip diff --git a/pkg/proto/color/lib/imtoolrgb.lut b/pkg/proto/color/lib/imtoolrgb.lut new file mode 100644 index 00000000..a2ed400e --- /dev/null +++ b/pkg/proto/color/lib/imtoolrgb.lut @@ -0,0 +1,256 @@ +0. 0. 0. +0.011904761904762 0. 0. +0.023809523809524 0. 0. +0.035714285714286 0. 0. +0.047619047619048 0. 0. +0.05952380952381 0. 0. +0.071428571428571 0. 0. +0.083333333333333 0. 0. +0.095238095238095 0. 0. +0.10714285714286 0. 0. +0.11904761904762 0. 0. +0.13095238095238 0. 0. +0.14285714285714 0. 0. +0.1547619047619 0. 0. +0.16666666666667 0. 0. +0.17857142857143 0. 0. +0.19047619047619 0. 0. +0.20238095238095 0. 0. +0.21428571428571 0. 0. +0.22619047619048 0. 0. +0.23809523809524 0. 0. +0.25 0. 0. +0.26190476190476 0. 0. +0.27380952380952 0. 0. +0.28571428571429 0. 0. +0.29761904761905 0. 0. +0.30952380952381 0. 0. +0.32142857142857 0. 0. +0.33333333333333 0. 0. +0.3452380952381 0. 0. +0.35714285714286 0. 0. +0.36904761904762 0. 0. +0.38095238095238 0. 0. +0.39285714285714 0. 0. +0.4047619047619 0. 0. +0.41666666666667 0. 0. +0.42857142857143 0. 0. +0.44047619047619 0. 0. +0.45238095238095 0. 0. +0.46428571428571 0. 0. +0.47619047619048 0. 0. +0.48809523809524 0. 0. +0.5 0. 0. +0.51190476190476 0. 0. +0.52380952380952 0. 0. +0.53571428571429 0. 0. +0.54761904761905 0. 0. +0.55952380952381 0. 0. +0.57142857142857 0. 0. +0.58333333333333 0. 0. +0.5952380952381 0. 0. +0.60714285714286 0. 0. +0.61904761904762 0. 0. +0.63095238095238 0. 0. +0.64285714285714 0. 0. +0.6547619047619 0. 0. +0.66666666666667 0. 0. +0.67857142857143 0. 0. +0.69047619047619 0. 0. +0.70238095238095 0. 0. +0.71428571428571 0. 0. +0.72619047619048 0. 0. +0.73809523809524 0. 0. +0.75 0. 0. +0.76190476190476 0. 0. +0.77380952380952 0. 0. +0.78571428571429 0. 0. +0.79761904761905 0. 0. +0.80952380952381 0. 0. +0.82142857142857 0. 0. +0.83333333333333 0. 0. +0.8452380952381 0. 0. +0.85714285714286 0. 0. +0.86904761904762 0. 0. +0.88095238095238 0. 0. +0.89285714285714 0. 0. +0.9047619047619 0. 0. +0.91666666666667 0. 0. +0.92857142857143 0. 0. +0.94047619047619 0. 0. +0.95238095238095 0. 0. +0.96428571428571 0. 0. +0.97619047619048 0. 0. +0.98809523809524 0. 0. +1. 0. 0. +0. 0. 0. +0. 0.011904761904762 0. +0. 0.023809523809524 0. +0. 0.035714285714286 0. +0. 0.047619047619048 0. +0. 0.05952380952381 0. +0. 0.071428571428571 0. +0. 0.083333333333333 0. +0. 0.095238095238095 0. +0. 0.10714285714286 0. +0. 0.11904761904762 0. +0. 0.13095238095238 0. +0. 0.14285714285714 0. +0. 0.1547619047619 0. +0. 0.16666666666667 0. +0. 0.17857142857143 0. +0. 0.19047619047619 0. +0. 0.20238095238095 0. +0. 0.21428571428571 0. +0. 0.22619047619048 0. +0. 0.23809523809524 0. +0. 0.25 0. +0. 0.26190476190476 0. +0. 0.27380952380952 0. +0. 0.28571428571429 0. +0. 0.29761904761905 0. +0. 0.30952380952381 0. +0. 0.32142857142857 0. +0. 0.33333333333333 0. +0. 0.3452380952381 0. +0. 0.35714285714286 0. +0. 0.36904761904762 0. +0. 0.38095238095238 0. +0. 0.39285714285714 0. +0. 0.4047619047619 0. +0. 0.41666666666667 0. +0. 0.42857142857143 0. +0. 0.44047619047619 0. +0. 0.45238095238095 0. +0. 0.46428571428571 0. +0. 0.47619047619048 0. +0. 0.48809523809524 0. +0. 0.5 0. +0. 0.51190476190476 0. +0. 0.52380952380952 0. +0. 0.53571428571429 0. +0. 0.54761904761905 0. +0. 0.55952380952381 0. +0. 0.57142857142857 0. +0. 0.58333333333333 0. +0. 0.5952380952381 0. +0. 0.60714285714286 0. +0. 0.61904761904762 0. +0. 0.63095238095238 0. +0. 0.64285714285714 0. +0. 0.6547619047619 0. +0. 0.66666666666667 0. +0. 0.67857142857143 0. +0. 0.69047619047619 0. +0. 0.70238095238095 0. +0. 0.71428571428571 0. +0. 0.72619047619048 0. +0. 0.73809523809524 0. +0. 0.75 0. +0. 0.76190476190476 0. +0. 0.77380952380952 0. +0. 0.78571428571429 0. +0. 0.79761904761905 0. +0. 0.80952380952381 0. +0. 0.82142857142857 0. +0. 0.83333333333333 0. +0. 0.8452380952381 0. +0. 0.85714285714286 0. +0. 0.86904761904762 0. +0. 0.88095238095238 0. +0. 0.89285714285714 0. +0. 0.9047619047619 0. +0. 0.91666666666667 0. +0. 0.92857142857143 0. +0. 0.94047619047619 0. +0. 0.95238095238095 0. +0. 0.96428571428571 0. +0. 0.97619047619048 0. +0. 0.98809523809524 0. +0. 1. 0. +0. 0. 0. +0. 0. 0.011904761904762 +0. 0. 0.023809523809524 +0. 0. 0.035714285714286 +0. 0. 0.047619047619048 +0. 0. 0.05952380952381 +0. 0. 0.071428571428571 +0. 0. 0.083333333333333 +0. 0. 0.095238095238095 +0. 0. 0.10714285714286 +0. 0. 0.11904761904762 +0. 0. 0.13095238095238 +0. 0. 0.14285714285714 +0. 0. 0.1547619047619 +0. 0. 0.16666666666667 +0. 0. 0.17857142857143 +0. 0. 0.19047619047619 +0. 0. 0.20238095238095 +0. 0. 0.21428571428571 +0. 0. 0.22619047619048 +0. 0. 0.23809523809524 +0. 0. 0.25 +0. 0. 0.26190476190476 +0. 0. 0.27380952380952 +0. 0. 0.28571428571429 +0. 0. 0.29761904761905 +0. 0. 0.30952380952381 +0. 0. 0.32142857142857 +0. 0. 0.33333333333333 +0. 0. 0.3452380952381 +0. 0. 0.35714285714286 +0. 0. 0.36904761904762 +0. 0. 0.38095238095238 +0. 0. 0.39285714285714 +0. 0. 0.4047619047619 +0. 0. 0.41666666666667 +0. 0. 0.42857142857143 +0. 0. 0.44047619047619 +0. 0. 0.45238095238095 +0. 0. 0.46428571428571 +0. 0. 0.47619047619048 +0. 0. 0.48809523809524 +0. 0. 0.5 +0. 0. 0.51190476190476 +0. 0. 0.52380952380952 +0. 0. 0.53571428571429 +0. 0. 0.54761904761905 +0. 0. 0.55952380952381 +0. 0. 0.57142857142857 +0. 0. 0.58333333333333 +0. 0. 0.5952380952381 +0. 0. 0.60714285714286 +0. 0. 0.61904761904762 +0. 0. 0.63095238095238 +0. 0. 0.64285714285714 +0. 0. 0.6547619047619 +0. 0. 0.66666666666667 +0. 0. 0.67857142857143 +0. 0. 0.69047619047619 +0. 0. 0.70238095238095 +0. 0. 0.71428571428571 +0. 0. 0.72619047619048 +0. 0. 0.73809523809524 +0. 0. 0.75 +0. 0. 0.76190476190476 +0. 0. 0.77380952380952 +0. 0. 0.78571428571429 +0. 0. 0.79761904761905 +0. 0. 0.80952380952381 +0. 0. 0.82142857142857 +0. 0. 0.83333333333333 +0. 0. 0.8452380952381 +0. 0. 0.85714285714286 +0. 0. 0.86904761904762 +0. 0. 0.88095238095238 +0. 0. 0.89285714285714 +0. 0. 0.9047619047619 +0. 0. 0.91666666666667 +0. 0. 0.92857142857143 +0. 0. 0.94047619047619 +0. 0. 0.95238095238095 +0. 0. 0.96428571428571 +0. 0. 0.97619047619048 +0. 0. 0.98809523809524 +0. 0. 1. +1. 1. 1. diff --git a/pkg/proto/color/lib/mkpkg.inc b/pkg/proto/color/lib/mkpkg.inc new file mode 100644 index 00000000..6e985377 --- /dev/null +++ b/pkg/proto/color/lib/mkpkg.inc @@ -0,0 +1,11 @@ +# Global MKPKG definitions for the COLOR package. + +$set XFLAGS = "$(XFLAGS) -p color" + +# Special file lists + +$ifeq (MACH, f68881) then + $include "color$lib/mkpkg.sf.SUN3" +$else $ifeq (MACH, ffpa) then + $include "color$lib/mkpkg.sf.SUN3" +$end diff --git a/pkg/proto/color/lib/mkpkg.sf.SUN3 b/pkg/proto/color/lib/mkpkg.sf.SUN3 new file mode 100644 index 00000000..3b0036b4 --- /dev/null +++ b/pkg/proto/color/lib/mkpkg.sf.SUN3 @@ -0,0 +1 @@ +# Mkpkg special file list for SUN/IRAF, Sun-3/OS-4. diff --git a/pkg/proto/color/lib/root.hd b/pkg/proto/color/lib/root.hd new file mode 100644 index 00000000..ee6ed283 --- /dev/null +++ b/pkg/proto/color/lib/root.hd @@ -0,0 +1,3 @@ +# Root help directory for the COLOR package. + +_color pkg = color$lib/rootcolor.hd diff --git a/pkg/proto/color/lib/rootcolor.hd b/pkg/proto/color/lib/rootcolor.hd new file mode 100644 index 00000000..08155b5f --- /dev/null +++ b/pkg/proto/color/lib/rootcolor.hd @@ -0,0 +1,7 @@ +# Root task entry for the COLOR package help tree. + +color men = color$color.men, + hlp = color$color.men, + sys = color$color.hlp, + pkg = color$color.hd, + src = color$color.cl diff --git a/pkg/proto/color/lib/saorgb.lut b/pkg/proto/color/lib/saorgb.lut new file mode 100644 index 00000000..46dfcd78 --- /dev/null +++ b/pkg/proto/color/lib/saorgb.lut @@ -0,0 +1,9 @@ +# SAOimage color table +# Thu Aug 20 14:59:34 1992 +PSEUDOCOLOR +RED: +(0.000,0.000)(0.333,1.000)(0.334,0.000)(1.000,0.000) +GREEN: +(0.000,0.000)(0.334,0.000)(0.666,1.000)(0.667,0.000)(1.000,0.000) +BLUE: +(0.000,0.000)(0.666,0.000)(1.000,1.000) diff --git a/pkg/proto/color/lib/strip.color b/pkg/proto/color/lib/strip.color new file mode 100644 index 00000000..6ee4d092 --- /dev/null +++ b/pkg/proto/color/lib/strip.color @@ -0,0 +1,9 @@ +# STRIP.COLOR -- Rmfiles command script, used to strip the COLOR directory +# of all files not required for ordinary runtime use of the system. + +color -allbut .hlp .hd .men .cl .par .key .dat .mip .lut + +# Sun/IRAF only. +# --------------- +-file bin.68881/OBJS.arc +-file bin.ffpa/OBJS.arc diff --git a/pkg/proto/color/lib/zzsetenv.def b/pkg/proto/color/lib/zzsetenv.def new file mode 100644 index 00000000..7696dba9 --- /dev/null +++ b/pkg/proto/color/lib/zzsetenv.def @@ -0,0 +1,7 @@ +# Global environment definitions for the COLOR package. + +set colorlib = "color$lib/" +set colorsrc = "color$src/" +set colorbin = "color$bin(arch)/" + +keep diff --git a/pkg/proto/color/mkpkg b/pkg/proto/color/mkpkg new file mode 100644 index 00000000..1b0fe94e --- /dev/null +++ b/pkg/proto/color/mkpkg @@ -0,0 +1,20 @@ +# MKPKG file for the COLOR Package + +$call update +$exit + +update: + $call update@src + + $ifeq (HOSTID, vms) $purge [...] $endif + ; + +relink: + $call relink@src + + $ifeq (HOSTID, vms) $purge [...] $endif + ; + +install: + $call install@src + ; diff --git a/pkg/proto/color/src/mkpkg b/pkg/proto/color/src/mkpkg new file mode 100644 index 00000000..c7ddd050 --- /dev/null +++ b/pkg/proto/color/src/mkpkg @@ -0,0 +1,29 @@ +# COLOR package + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $update libpkg.a + $call color + ; + +install: + $move xx_color.e bin$x_color.e + ; + +color: + $omake x_color.x + $link x_color.o libpkg.a -o xx_color.e + ; + +libpkg.a: + t_rgbdither.x <imhdr.h> + t_rgbsun.x <imhdr.h> <mach.h> + t_rgbto8.x <imhdr.h> + ; diff --git a/pkg/proto/color/src/rgbdisplay.cl b/pkg/proto/color/src/rgbdisplay.cl new file mode 100644 index 00000000..d459d1d0 --- /dev/null +++ b/pkg/proto/color/src/rgbdisplay.cl @@ -0,0 +1 @@ +display (rgb, frame=frame, fill=no, ztrans="none") diff --git a/pkg/proto/color/src/rgbdisplay.par b/pkg/proto/color/src/rgbdisplay.par new file mode 100644 index 00000000..a64674db --- /dev/null +++ b/pkg/proto/color/src/rgbdisplay.par @@ -0,0 +1,2 @@ +rgb,f,a,,,,RGB 8-bit composite image +frame,i,h,1,1,,Display frame diff --git a/pkg/proto/color/src/rgbdither.par b/pkg/proto/color/src/rgbdither.par new file mode 100644 index 00000000..66e3e4be --- /dev/null +++ b/pkg/proto/color/src/rgbdither.par @@ -0,0 +1,13 @@ +red,f,a,,,,Red image +green,f,a,,,,Green image +blue,f,a,,,,Blue image +rgb,f,a,,,,Output RGB image +rz1,r,h,0.,,,Red z1 +rz2,r,h,255.,,,Red z2 +gz1,r,h,0.,,,Green z1 +gz2,r,h,255.,,,Green z2 +bz1,r,h,0.,,,Blue z1 +bz2,r,h,255.,,,Blue z2 +blkavg,i,h,3,1,,Block average factor +logmap,b,h,no,,,Use logarithmic intensity mapping? +pattern,s,h,"rgbgbrbrg",,,"Dither pattern (3x3)" diff --git a/pkg/proto/color/src/rgbsun.par b/pkg/proto/color/src/rgbsun.par new file mode 100644 index 00000000..abcd93e0 --- /dev/null +++ b/pkg/proto/color/src/rgbsun.par @@ -0,0 +1,12 @@ +red,f,a,,,,Red image +green,f,a,,,,Green image +blue,f,a,,,,Blue image +rgb,f,a,,,,Output RGB image +rz1,r,h,0.,,,Red z1 +rz2,r,h,255.,,,Red z2 +gz1,r,h,0.,,,Green z1 +gz2,r,h,255.,,,Green z2 +bz1,r,h,0.,,,Blue z1 +bz2,r,h,255.,,,Blue z2 +logmap,b,h,no,,,Use logarithmic intensity mapping? +swap,b,h,no,,,"Swap bytes in output rasterfiles?" diff --git a/pkg/proto/color/src/rgbto8.par b/pkg/proto/color/src/rgbto8.par new file mode 100644 index 00000000..7d96183c --- /dev/null +++ b/pkg/proto/color/src/rgbto8.par @@ -0,0 +1,13 @@ +red,f,a,,,,Red image +green,f,a,,,,Green image +blue,f,a,,,,Blue image +rgb,f,a,,,,Output RGB image +maptype,s,h,"saoimage","saoimage|imtool|ximtool",,Color map type +ncolors,i,h,192,1,200,Number of colors (XIMTOOL only) +rz1,r,h,0.,,,Red z1 +rz2,r,h,255.,,,Red z2 +gz1,r,h,0.,,,Green z1 +gz2,r,h,255.,,,Green z2 +bz1,r,h,0.,,,Blue z1 +bz2,r,h,255.,,,Blue z2 +logmap,b,h,no,,,Use logarithmic intensity mapping? diff --git a/pkg/proto/color/src/t_rgbdither.x b/pkg/proto/color/src/t_rgbdither.x new file mode 100644 index 00000000..2689d443 --- /dev/null +++ b/pkg/proto/color/src/t_rgbdither.x @@ -0,0 +1,198 @@ +include <imhdr.h> + + +# T_RGBDITHER -- Make special RGB 8 bit dither image + +procedure t_rgbdither () + +pointer im[3] # Red, green, blue images +pointer rgb # Output image +real rz1, rz2 # Red display range +real gz1, gz2 # Green display range +real bz1, bz2 # Blue display range +int blk # Block average factor +bool logmap # Logartihmic intensity mapping? + +int i, j, k, l, nc, nl, ncblk, nlblk, dither[3,3] +real rdz, rz, rs, gdz, gz, gs, bdz, bz, bs, v +pointer buf[3], rgbbuf, ptr1, ptr2, ptr3 +pointer sp, fname +bool clgetb() +real clgetr() +int clgeti() +pointer immap(), imgl2r(), impl2s() + +data dither/1,2,3,2,3,1,3,1,2/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + # Open input RGB images + call clgstr ("red", Memc[fname], SZ_FNAME) + im[1] = immap (Memc[fname], READ_ONLY, 0) + call clgstr ("green", Memc[fname], SZ_FNAME) + im[2] = immap (Memc[fname], READ_ONLY, 0) + call clgstr ("blue", Memc[fname], SZ_FNAME) + im[3] = immap (Memc[fname], READ_ONLY, 0) + + # Get other parameters + rz1 = clgetr ("rz1") + rz2 = clgetr ("rz2") + gz1 = clgetr ("gz1") + gz2 = clgetr ("gz2") + bz1 = clgetr ("bz1") + bz2 = clgetr ("bz2") + blk = clgeti ("blkavg") + logmap = clgetb ("logmap") + call clgstr ("pattern", Memc[fname], SZ_FNAME) + + # Parse the dither pattern + ptr1 = fname + do j = 1, 3 { + do i = 1, 3 { + if (Memc[ptr1] == 'r') + dither[i,j] = 1 + else if (Memc[ptr1] == 'g') + dither[i,j] = 2 + else if (Memc[ptr1] == 'b') + dither[i,j] = 3 + else + call error (1, "Error reading dither pattern") + ptr1 = ptr1 + 1 + } + } + + # Check dimensions + i = IM_NDIM(im[1]) + nc = IM_LEN(im[1],1) + nl = IM_LEN(im[1],2) + ncblk = nc / blk + nlblk = nl / blk + if (i != 2 || i != IM_NDIM(im[2]) || i != IM_NDIM(im[3])) + call error (1, "All images must be two dimensional") + if (nc != IM_LEN(im[2],1) || nc != IM_LEN(im[3],1)) + call error (1, "All images must be the same size") + if (nl != IM_LEN(im[2],2) || nl != IM_LEN(im[3],2)) + call error (1, "All images must be the same size") + + # Open and initialize the output image + call clgstr ("rgb", Memc[fname], SZ_FNAME) + rgb = immap (Memc[fname], NEW_COPY, im[1]) + IM_PIXTYPE(rgb) = TY_SHORT + IM_LEN(rgb,1) = 3 * ncblk + IM_LEN(rgb,2) = 3 * nlblk + + # Set the z range + if (logmap) { + rdz = 9. / (rz2 - rz1) + gdz = 9. / (gz2 - gz1) + bdz = 9. / (bz2 - bz1) + } else { + rdz = 1. / (rz2 - rz1) + gdz = 1. / (gz2 - gz1) + bdz = 1. / (bz2 - bz1) + } + rz = 0. + gz = 85. + bz = 170. + rs = 84. + gs = 84. + bs = 84. + + # Setup and do the block averaging + if (blk > 1) { + call salloc (buf[1], ncblk, TY_REAL) + call salloc (buf[2], ncblk, TY_REAL) + call salloc (buf[3], ncblk, TY_REAL) + } + + do j = 0, nlblk-1 { + if (blk > 1) { + do k = 1, 3 { + call aclrr (Memr[buf[k]], ncblk) + do l = 1, blk { + ptr1 = imgl2r (im[k], j*blk+l) + do i = 0, ncblk*blk-1 { + ptr2 = buf[k] + i / blk + Memr[ptr2] = Memr[ptr2] + Memr[ptr1+i] + } + } + call adivkr (Memr[buf[k]], real (blk*blk), + Memr[buf[k]], ncblk) + } + + } else { + buf[1] = imgl2r (im[1], j+1) + buf[2] = imgl2r (im[2], j+1) + buf[3] = imgl2r (im[3], j+1) + } + + # Map the input values to the output levels + ptr1 = buf[1] + ptr2 = buf[2] + ptr3 = buf[3] + if (logmap) { + do i = 1, ncblk { + v = max (1., min (10., 1. + (Memr[ptr1] - rz1) * rdz)) + Memr[ptr1] = nint (rz + rs * log10 (v)) + v = max (1., min (10., 1. + (Memr[ptr2] - gz1) * gdz)) + Memr[ptr2] = nint (gz + gs * log10 (v)) + v = max (1., min (10., 1. + (Memr[ptr3] - bz1) * bdz)) + Memr[ptr3] = nint (bz + bs * log10 (v)) + ptr1 = ptr1 + 1 + ptr2 = ptr2 + 1 + ptr3 = ptr3 + 1 + } + } else { + do i = 1, ncblk { + v = max (0., min (1., (Memr[ptr1] - rz1) * rdz)) + Memr[ptr1] = nint (rz + rs * v) + v = max (0., min (1., (Memr[ptr2] - gz1) * gdz)) + Memr[ptr2] = nint (gz + gs * v) + v = max (0., min (1., (Memr[ptr3] - bz1) * bdz)) + Memr[ptr3] = nint (bz + bs * v) + ptr1 = ptr1 + 1 + ptr2 = ptr2 + 1 + ptr3 = ptr3 + 1 + } + } + + # Build and output the dither pattern + do k = 1, 3 { + ptr1 = buf[dither[1,k]] + ptr2 = buf[dither[2,k]] + ptr3 = buf[dither[3,k]] + rgbbuf = impl2s (rgb, 3*j+k) + do i = 1, ncblk { + Mems[rgbbuf] = Memr[ptr1] + Mems[rgbbuf+1] = Memr[ptr2] + Mems[rgbbuf+2] = Memr[ptr3] + ptr1 = ptr1 + 1 + ptr2 = ptr2 + 1 + ptr3 = ptr3 + 1 + rgbbuf = rgbbuf + 3 + } + } + } + + # Make a record in the output image header + call sprintf (Memc[fname], SZ_FNAME, "%g %g %g %g %g %g %d %b") + call pargr (rz1) + call pargr (rz2) + call pargr (gz1) + call pargr (gz2) + call pargr (bz1) + call pargr (bz2) + call pargi (blk) + call pargb (logmap) + call imastr (rgb, "MKRGB8", Memc[fname]) + + # Finish up + call imunmap (rgb) + call imunmap (im[3]) + call imunmap (im[2]) + call imunmap (im[1]) + + call sfree (sp) +end diff --git a/pkg/proto/color/src/t_rgbsun.x b/pkg/proto/color/src/t_rgbsun.x new file mode 100644 index 00000000..3a99766a --- /dev/null +++ b/pkg/proto/color/src/t_rgbsun.x @@ -0,0 +1,135 @@ +include <imhdr.h> +include <mach.h> + +define RAS_HDRLEN 8 # SunOS4.1 and earlier +define RAS_MAGIC 1504078485 # SunOS4.1 and earlier +define RT_STANDARD 1 # SunOS4.1 and earlier +define RMT_NONE 0 # SunOS4.1 and earlier + +# T_RGBSUN -- IRAF to 24-bit RGB Sun Rasterfile +# This format-specific task is primarily used to display color composites +# on an 8-bit display using a task such as XV. +# ** The format of the output Sun rasterfiles is hard-coded into this task, +# ** and thus could diverge from a future Sun format; we do not want to link +# ** with Sun libraries, as this task should be runnable on other machines. + +procedure t_rgbsun () + +pointer rim, gim, bim # Red, green, blue images +int rgb # Output Sun rasterfile +real rz1, rz2 # Red display range +real gz1, gz2 # Green display range +real bz1, bz2 # Blue display range +bool logmap # Logartihmic intensity mapping? +bool swap # Swap header bytes? + +int i, j, nc, nl, ncrgb, rheader[8], open() +real rdz, gdz, bdz, v +real clgetr() +pointer rbuf, gbuf, bbuf, obuf, rgbbuf, immap(), imgl2r() +bool clgetb() +pointer sp, fname + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + call clgstr ("red", Memc[fname], SZ_FNAME) + rim = immap (Memc[fname], READ_ONLY, 0) + call clgstr ("green", Memc[fname], SZ_FNAME) + gim = immap (Memc[fname], READ_ONLY, 0) + call clgstr ("blue", Memc[fname], SZ_FNAME) + bim = immap (Memc[fname], READ_ONLY, 0) + + i = IM_NDIM(rim) + nc = IM_LEN(rim,1) + nl = IM_LEN(rim,2) + ncrgb = 3 * nc + ncrgb = ncrgb + mod (ncrgb, 2) + if (i != 2 || i != IM_NDIM(gim) || i != IM_NDIM(bim)) + call error (1, "All images must be two dimensional") + if (nc != IM_LEN(gim,1) || nc != IM_LEN(bim,1)) + call error (1, "All images must be the same size") + if (nl != IM_LEN(gim,2) || nl != IM_LEN(bim,2)) + call error (1, "All images must be the same size") + + call clgstr ("rgb", Memc[fname], SZ_FNAME) + rgb = open (Memc[fname], NEW_FILE, BINARY_FILE) + rheader[1] = RAS_MAGIC + rheader[2] = nc + rheader[3] = nl + rheader[4] = 24 + rheader[5] = nc * nl * 3 + rheader[6] = RT_STANDARD + rheader[7] = RMT_NONE + rheader[8] = 0 + + rz1 = clgetr ("rz1") + rz2 = clgetr ("rz2") + gz1 = clgetr ("gz1") + gz2 = clgetr ("gz2") + bz1 = clgetr ("bz1") + bz2 = clgetr ("bz2") + logmap = clgetb ("logmap") + swap = clgetb ("swap") + + if (logmap) { + rdz = 9. / (rz2 - rz1) + gdz = 9. / (gz2 - gz1) + bdz = 9. / (bz2 - bz1) + } else { + rdz = 255. / (rz2 - rz1) + gdz = 255. / (gz2 - gz1) + bdz = 255. / (bz2 - bz1) + } + + call ipak32 (rheader, rheader, RAS_HDRLEN) + if (swap) + call bswap4 (rheader, 1, rheader, 1, RAS_HDRLEN*SZ_INT32*SZB_CHAR) + call write (rgb, rheader, RAS_HDRLEN * SZ_INT32) + + call salloc (rgbbuf, ncrgb, TY_CHAR) + Memc[rgbbuf+ncrgb-1] = 0 + do j = 1, nl { + rbuf = imgl2r (rim, j) + gbuf = imgl2r (gim, j) + bbuf = imgl2r (bim, j) + obuf = rgbbuf + if (logmap) { + do i = 1, nc { + v = max (1., min (10., 1. + (Memr[rbuf] - rz1) * rdz)) + Memc[obuf+2] = max (0, min (255, nint (log10 (v) * 255))) + v = max (1., min (10., 1. + (Memr[gbuf] - gz1) * gdz)) + Memc[obuf+1] = max (0, min (255, nint (log10 (v) * 255))) + v = max (1., min (10., 1. + (Memr[bbuf] - bz1) * bdz)) + Memc[obuf] = max (0, min (255, nint (log10 (v) * 255))) + rbuf = rbuf + 1 + gbuf = gbuf + 1 + bbuf = bbuf + 1 + obuf = obuf + 3 + } + } else { + do i = 1, nc { + Memc[obuf+2] = max (0, min (255, + nint ((Memr[rbuf] - rz1) * rdz))) + Memc[obuf+1] = max (0, min (255, + nint ((Memr[gbuf] - gz1) * gdz))) + Memc[obuf] = max (0, min (255, + nint ((Memr[bbuf] - bz1) * bdz))) + rbuf = rbuf + 1 + gbuf = gbuf + 1 + bbuf = bbuf + 1 + obuf = obuf + 3 + } + } + call chrpak (Memc[rgbbuf], 1, Memc[rgbbuf], 1, ncrgb) + call write (rgb, Memc[rgbbuf], ncrgb / SZB_CHAR) + } + + call close (rgb) + call imunmap (bim) + call imunmap (gim) + call imunmap (rim) + + call sfree (sp) +end diff --git a/pkg/proto/color/src/t_rgbto8.x b/pkg/proto/color/src/t_rgbto8.x new file mode 100644 index 00000000..d304aa7f --- /dev/null +++ b/pkg/proto/color/src/t_rgbto8.x @@ -0,0 +1,1088 @@ +include <imhdr.h> + + +# Size definitions +define A_BITS 8 # Number of bits of color +define B_BITS 5 # Number of bits/pixel to use +define C_BITS 3 # Number of cells/color to use +define A_LEN 256 # 2 ** A_BITS +define B_LEN 32 # 2 ** B_BITS +define C_LEN 8 # 2 ** C_BITS +define AB_SHIFT 8 # 2 ** (A_BITS - B_BITS) +define BC_SHIFT 4 # 2 ** (B_BITS - C_BITS) +define AC_SHIFT 32 # 2 ** (A_BITS - C_BITS) + +# Color metric definitions +define R2FACT 20 # .300 * .300 * 256 = 23 +define G2FACT 39 # .586 * .586 * 256 = 88 +define B2FACT 8 # .114 * .114 * 256 = 3 + +define RED 1 +define GREEN 2 +define BLUE 3 + +# Colorbox structure +define CBOX_LEN 9 +define CBOX_NEXT Memi[$1] # pointer to next colorbox structure +define CBOX_PREV Memi[$1+1] # pointer to previous colorbox structure +define CBOX_RMIN Memi[$1+2] +define CBOX_RMAX Memi[$1+3] +define CBOX_GMIN Memi[$1+4] +define CBOX_GMAX Memi[$1+5] +define CBOX_BMIN Memi[$1+6] +define CBOX_BMAX Memi[$1+7] +define CBOX_TOTAL Memi[$1+8] + +# Color cell structure +define CCELL_LEN (A_LEN*2+1) +define CCELL_NUM_ENTS Memi[$1] +define CCELL_ENTRIES Memi[$1+2*($2)+$3+1] + +# Output color map types and number of colors +define NCOLORS 199 +define MAPTYPES "|saoimage|imtool|ximtool|" +define SAOIMAGE 1 +define IMTOOL 2 +define XIMTOOL 3 + + +# T_RGBTO8 -- Convert RGB IRAF images to 8 bit IRAF image and color map using +# Heckbert's Median Cut algorithm. The implementation of this algorithm +# was modeled, with permission, on that in the program XV written by +# John Bradley. + +procedure t_rgbto8 () + +pointer im[3] # Red, green, blue images +pointer oim # Output image +int maptype # Color map type +int nmap # Number of colors in map +real z1[3], dz[3] # Display range +bool logmap # Logartihmic intensity mapping? + +int i, ncolors, fd +pointer sp, rgb, root, mapname, cmap, box_list, histogram, ColorCells +pointer freeboxes, usedboxes, ptr + +bool clgetb() +int clgeti(), clgwrd(), access(), open(), strlen() +real clgetr() +pointer immap(), largest_box() +errchk open, immap + +begin + call smark (sp) + call salloc (rgb, SZ_FNAME, TY_CHAR) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (mapname, SZ_FNAME, TY_CHAR) + + # Open input images. + call clgstr ("red", Memc[rgb], SZ_FNAME) + im[1] = immap (Memc[rgb], READ_ONLY, 0) + call clgstr ("green", Memc[rgb], SZ_FNAME) + im[2] = immap (Memc[rgb], READ_ONLY, 0) + call clgstr ("blue", Memc[rgb], SZ_FNAME) + im[3] = immap (Memc[rgb], READ_ONLY, 0) + + # Check all input images are 2D and the same size. + i = IM_NDIM(im[1]) + if (i != 2 || i != IM_NDIM(im[2]) || i != IM_NDIM(im[3])) + call error (1, "All images must be two dimensional") + i = IM_LEN(im[1],1) + if (i != IM_LEN(im[2],1) || i != IM_LEN(im[3],1)) + call error (1, "All images must be the same size") + i = IM_LEN(im[1],2) + if (i != IM_LEN(im[2],2) || i != IM_LEN(im[3],2)) + call error (1, "All images must be the same size") + + # Open output color map and image. Do this now rather than later + # to get an immediate error since the following can take some time. + + call clgstr ("rgb", Memc[rgb], SZ_FNAME) + maptype = clgwrd ("maptype", Memc[mapname], SZ_FNAME, MAPTYPES) + call imgimage (Memc[rgb], Memc[root], SZ_FNAME) + i = strlen (Memc[root]) - 1 + switch (Memc[root+i]) { + case 'h': + if (i > 3 && Memc[root+i-3] == '.') + Memc[root+i-3] = EOS + case 'l': + if (i > 2 && Memc[root+i-2] == '.') + Memc[root+i-2] = EOS + } + switch (maptype) { + case SAOIMAGE: + nmap = NCOLORS + call sprintf (Memc[mapname], SZ_FNAME, "%s.sao") + call pargstr (Memc[root]) + if (access (Memc[mapname], 0, 0) == YES) + fd = open (Memc[mapname], NEW_FILE, TEXT_FILE) + case IMTOOL: + nmap = NCOLORS + call sprintf (Memc[mapname], SZ_FNAME, "%s.imt") + call pargstr (Memc[root]) + if (access (Memc[mapname], 0, 0) == YES) + fd = open (Memc[mapname], NEW_FILE, TEXT_FILE) + case XIMTOOL: + nmap = clgeti ("ncolors") + call sprintf (Memc[mapname], SZ_FNAME, "%s.xim") + call pargstr (Memc[root]) + if (access (Memc[mapname], 0, 0) == YES) + fd = open (Memc[mapname], NEW_FILE, TEXT_FILE) + } + + oim = immap (Memc[rgb], NEW_COPY, im[1]) + IM_PIXTYPE(oim) = TY_SHORT + + # Set input image intensity scaling. + z1[1] = clgetr ("rz1") + dz[1] = clgetr ("rz2") + z1[2] = clgetr ("gz1") + dz[2] = clgetr ("gz2") + z1[3] = clgetr ("bz1") + dz[3] = clgetr ("bz2") + logmap = clgetb ("logmap") + + if (logmap) { + dz[1] = 9. / (dz[1] - z1[1]) + dz[2] = 9. / (dz[2] - z1[2]) + dz[3] = 9. / (dz[3] - z1[3]) + } else { + dz[1] = 255. / (dz[1] - z1[1]) + dz[2] = 255. / (dz[2] - z1[2]) + dz[3] = 255. / (dz[3] - z1[3]) + } + + # Allocate color map. + call salloc (cmap, 3 * nmap, TY_SHORT) + + # Allocate and initialize color boxes. + call salloc (box_list, nmap * CBOX_LEN, TY_STRUCT) + + freeboxes = box_list + usedboxes = NULL + ptr = freeboxes + CBOX_PREV(ptr) = NULL + CBOX_NEXT(ptr) = ptr + CBOX_LEN + for (i=2; i<nmap; i=i+1) { + ptr = ptr + CBOX_LEN + CBOX_PREV(ptr) = ptr - CBOX_LEN + CBOX_NEXT(ptr) = ptr + CBOX_LEN + } + ptr = ptr + CBOX_LEN + CBOX_PREV(ptr) = ptr - CBOX_LEN + CBOX_NEXT(ptr) = NULL + + ptr = freeboxes + freeboxes = CBOX_NEXT(ptr) + if (freeboxes != NULL) + CBOX_PREV(freeboxes) = NULL + + CBOX_NEXT(ptr) = usedboxes + usedboxes = ptr + if (CBOX_NEXT(ptr) != NULL) + CBOX_PREV(CBOX_NEXT(ptr)) = ptr + + # Allocate and get histogram. + call salloc (histogram, B_LEN*B_LEN*B_LEN, TY_INT) + call aclri (Memi[histogram], B_LEN*B_LEN*B_LEN) + call get_histogram(im, z1, dz, logmap, ptr, Memi[histogram]) + + # Subdivide boxes until no more free boxes remain + while (freeboxes != NULL) { + ptr = largest_box (usedboxes) + if (ptr != NULL) + call splitbox (ptr, usedboxes, freeboxes, Memi[histogram]) + else + break + } + + # Set color map and write it out. + ptr = usedboxes + for (i=0; i<nmap && ptr!=NULL; i=i+1) { + call assign_color (ptr, Mems[cmap+3*i]) + ptr = CBOX_NEXT(ptr) + } + ncolors = i + + switch (maptype) { + case SAOIMAGE: + call sprintf (Memc[mapname], SZ_FNAME, "%s.sao") + call pargstr (Memc[root]) + fd = open (Memc[mapname], NEW_FILE, TEXT_FILE) + call sao_write (fd, Mems[cmap], nmap, ncolors) + call close (fd) + case IMTOOL: + call sprintf (Memc[mapname], SZ_FNAME, "%s.imt") + call pargstr (Memc[root]) + fd = open (Memc[mapname], NEW_FILE, TEXT_FILE) + call imt_write (fd, Mems[cmap], nmap, ncolors) + call close (fd) + case XIMTOOL: + call sprintf (Memc[mapname], SZ_FNAME, "%s.xim") + call pargstr (Memc[root]) + fd = open (Memc[mapname], NEW_FILE, TEXT_FILE) + call xim_write (fd, Mems[cmap], nmap, ncolors) + call close (fd) + } + + # Scan histogram and map all values to closest color. + # First create cell list as described in Heckbert[2] and then + # create mapping from truncated pixel space to color table entries + + call salloc (ColorCells, C_LEN*C_LEN*C_LEN, TY_POINTER) + call aclri (Memi[ColorCells], C_LEN*C_LEN*C_LEN) + call map_colortable (Memi[histogram], Mems[cmap], ncolors, + Memi[ColorCells]) + + # Scan image and match input values to table entries. + # Apply Floyd-Steinberg dithering. + + call quant_fsdither (im, z1, dz, logmap, Memi[histogram], + Memi[ColorCells], Mems[cmap], ncolors, oim) + + # Finish up. + call imunmap (oim) + call imunmap (im[1]) + call imunmap (im[2]) + call imunmap (im[3]) + + for (i=0; i < C_LEN*C_LEN*C_LEN; i=i+1) { + if (Memi[ColorCells+i] != NULL) + call mfree (Memi[ColorCells+i], TY_STRUCT) + } + + call sfree (sp) +end + + +# SAO_WRITE -- Write color map for SAOIMAGE. + +procedure sao_write (fd, cmap, nmap, ncolors) + +int fd # Output file descriptor +short cmap[3,nmap] # Color map +int nmap # Size of color map +int ncolors # Number of colors assigned + +int i + +begin + call fprintf (fd, "PSEUDOCOLOR\n") + call fprintf (fd, "RED:\n") + call fprintf (fd, "(0.,0.)\n") + for (i=1; i<=199; i=i+1) { + call fprintf (fd, "(%g,%g)\n") + call pargr (real(i)/199.) + call pargr ((int(cmap[1,min(ncolors,i)])*256+1) / 65535.) + } + call fprintf (fd, "\nGREEN:\n") + call fprintf (fd, "(0.,0.)\n") + for (i=1; i<=199; i=i+1) { + call fprintf (fd, "(%g,%g)\n") + call pargr (real(i)/199) + call pargr ((int(cmap[2,min(ncolors,i)])*256+1) / 65535.) + } + call fprintf (fd, "\nBLUE:\n") + call fprintf (fd, "(0.,0.)\n") + for (i=1; i<=199; i=i+1) { + call fprintf (fd, "(%g,%g)\n") + call pargr (real(i)/199) + call pargr ((int(cmap[3,min(ncolors,i)])*256+1) / 65535.) + } + call fprintf (fd, "\n") +end + +procedure imt_write (fd, cmap, nmap, ncolors) + +int fd # Output file descriptor +short cmap[3,nmap] # Color map +int nmap # Size of color map +int ncolors # Number of colors assigned + +int i, j + +begin + for (i=1; i<=256; i=i+1) { + j = (i - 128) * 199. / 255. + 101. + j = max (1, min (ncolors, j)) + call fprintf (fd, "%g %g %g\n") + call pargr ((cmap[1,j] + 0.5) / 255.) + call pargr ((cmap[2,j] + 0.5) / 255.) + call pargr ((cmap[3,j] + 0.5) / 255.) + } +end + + +# XIM_WRITE -- Write color map for XIMTOOL. + +procedure xim_write (fd, cmap, nmap, ncolors) + +int fd # Output file descriptor +short cmap[3,nmap] # Color map +int nmap # Size of color map +int ncolors # Number of colors assigned + +int i + +begin + for (i=1; i<=min(ncolors,200); i=i+1) { + call fprintf (fd, "%g %g %g\n") + call pargr ((cmap[1,i] + 0.5) / 255.) + call pargr ((cmap[2,i] + 0.5) / 255.) + call pargr ((cmap[3,i] + 0.5) / 255.) + } + for (; i<=nmap; i=i+1) + call fprintf (fd, "0 0 0\n") +end + + +# XV_GETLINE -- Get a line of intensity mapped input data. + +procedure xv_getline (im, z1, dz, logmap, line, data) + +pointer im[3] #I IMIO pointers +real z1[3] #I Intensity mapping origins +real dz[3] #I Intensity mapping ranges +bool logmap #I Intensity mapping log map? +int line #I Line to be obtained +pointer data #O Intensity mapped data + +int i, j, nc +real a, b, c +pointer iptr, optr, imgl2s() + +begin + nc = IM_LEN(im[1],1) + + do i = 1, 3 { + iptr = imgl2s (im[i], line) + optr = data + i - 1 + a = z1[i] + b = dz[i] + if (logmap) { + do j = 1, nc { + c = max (1., min (10., 1. + (Mems[iptr] - a) * b)) + Memi[optr] = max (0, min (255, nint (log10 (c) * 255))) + iptr = iptr + 1 + optr = optr + 3 + } + } else { + do j = 1, nc { + Memi[optr] = max (0, min (255, nint ((Mems[iptr] - a) * b))) + iptr = iptr + 1 + optr = optr + 3 + } + } + } +end + + +# GET_HISTOGRAM -- Compute color histogram + +procedure get_histogram (im, z1, dz, logmap, box, histogram) + +pointer im[3] #I IMIO pointers +real z1[3] #I Intensity mapping origins +real dz[3] #I Intensity mapping ranges +bool logmap #I Intensity mapping log map? +pointer box #O Initial box +int histogram[B_LEN,B_LEN,B_LEN] #O Histogram + +int i, j, nc, nl, r, g, b, rmin, gmin, bmin, rmax, gmax, bmax +pointer sp, data, ptr + +begin + nc = IM_LEN(im[1],1) + nl = IM_LEN(im[1],2) + + call smark (sp) + call salloc (data, 3 * nc, TY_INT) + + rmin = A_LEN; rmax = -1 + gmin = A_LEN; gmax = -1 + bmin = A_LEN; bmax = -1 + + # calculate histogram + do j = 1, nl { + call xv_getline (im, z1, dz, logmap, j, data) + ptr = data + do i = 1, nc { + r = Memi[ptr] / AB_SHIFT + 1 + g = Memi[ptr+1] / AB_SHIFT + 1 + b = Memi[ptr+2] / AB_SHIFT + 1 + ptr = ptr + 3 + + histogram[r,g,b] = histogram[r,g,b] + 1 + + rmin = min (rmin, r) + rmax = max (rmax, r) + gmin = min (gmin, g) + gmax = max (gmax, g) + bmin = min (bmin, b) + bmax = max (bmax, b) + } + } + + CBOX_RMIN(box) = rmin + CBOX_GMIN(box) = gmin + CBOX_BMIN(box) = bmin + CBOX_RMAX(box) = rmax + CBOX_GMAX(box) = gmax + CBOX_BMAX(box) = bmax + CBOX_TOTAL(box) = nc * nl + + call sfree (sp) +end + + + +# LARGEST_BOX -- Return pointer to largest box + +pointer procedure largest_box (usedboxes) + +pointer usedboxes #I Pointer to used boxes + +pointer tmp, ptr +int size + +begin + size = -1 + ptr = NULL + + for (tmp=usedboxes; tmp!=NULL; tmp=CBOX_NEXT(tmp)) { + if ((CBOX_RMAX(tmp) > CBOX_RMIN(tmp) || + CBOX_GMAX(tmp) > CBOX_GMIN(tmp) || + CBOX_BMAX(tmp) > CBOX_BMIN(tmp)) && + CBOX_TOTAL(tmp) > size) { + ptr = tmp + size = CBOX_TOTAL(tmp) + } + } + return(ptr) +end + + +# SPLITBOX -- Split a box along largest dimension + +procedure splitbox (box, usedboxes, freeboxes, histogram) + +pointer box #U Box to split +pointer usedboxes #U Used boxes +pointer freeboxes #U Free boxes +int histogram[B_LEN, B_LEN, B_LEN] #I Histogram + +int first, last, i, j, rdel, gdel, bdel, sum1, sum2 +pointer sp, hist, new +int ir, ig, ib +int rmin, rmax, gmin, gmax, bmin, bmax +int which + +begin + call smark (sp) + call salloc (hist, B_LEN, TY_INT) + + # see which axis is the largest, do a histogram along that + # axis. Split at median point. Contract both new boxes to + # fit points and return + + first = 1; last = 1 + rmin = CBOX_RMIN(box); rmax = CBOX_RMAX(box) + gmin = CBOX_GMIN(box); gmax = CBOX_GMAX(box) + bmin = CBOX_BMIN(box); bmax = CBOX_BMAX(box) + + rdel = rmax - rmin + gdel = gmax - gmin + bdel = bmax - bmin + + if (rdel>=gdel && rdel>=bdel) + which = RED + else if (gdel>=bdel) + which = GREEN + else + which = BLUE + + # get histogram along longest axis + switch (which) { + case RED: + for (ir=rmin; ir<=rmax; ir=ir+1) { + sum1 = 0 + for (ig=gmin; ig<=gmax; ig=ig+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + sum1 = sum1 + histogram[ir,ig,ib] + } + } + Memi[hist+ir-1] = sum1 + } + first = rmin; last = rmax + + case GREEN: + for (ig=gmin; ig<=gmax; ig=ig+1) { + sum1 = 0 + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + sum1 = sum1 + histogram[ir,ig,ib] + } + } + Memi[hist+ig-1] = sum1 + } + first = gmin; last = gmax + + case BLUE: + for (ib=bmin; ib<=bmax; ib=ib+1) { + sum1 = 0 + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + sum1 = sum1 + histogram[ir,ig,ib] + } + } + Memi[hist+ib-1] = sum1 + } + first = bmin; last = bmax + } + + + # find median point + sum1 = 0 + sum2 = CBOX_TOTAL(box) / 2 + for (i=first; i<=last; i=i+1) { + sum1 = sum1 + Memi[hist+i-1] + if (sum1 >= sum2) + break + } + if (i == first) + i = i + 1 + + + # Create new box, re-allocate points + + new = freeboxes + freeboxes = CBOX_NEXT(new) + if (freeboxes != NULL) + CBOX_PREV(freeboxes) = NULL + if (usedboxes != NULL) + CBOX_PREV(usedboxes) = new + CBOX_NEXT(new) = usedboxes + usedboxes = new + + sum1 = 0 + sum2 = 0 + for (j = first; j < i; j=j+1) + sum1 = sum1 + Memi[hist+j-1] + for (; j <= last; j=j+1) + sum2 = sum2 + Memi[hist+j-1] + CBOX_TOTAL(new) = sum1 + CBOX_TOTAL(box) = sum2 + + CBOX_RMIN(new) = rmin; CBOX_RMAX(new) = rmax + CBOX_GMIN(new) = gmin; CBOX_GMAX(new) = gmax + CBOX_BMIN(new) = bmin; CBOX_BMAX(new) = bmax + + switch (which) { + case RED: + CBOX_RMAX(new) = i-1; CBOX_RMIN(box) = i + case GREEN: + CBOX_GMAX(new) = i-1; CBOX_GMIN(box) = i + case BLUE: + CBOX_BMAX(new) = i-1; CBOX_BMIN(box) = i + } + + call shrinkbox (new, histogram) + call shrinkbox (box, histogram) + call sfree (sp) +end + + +# SHRINKBOX -- Shrink box + +procedure shrinkbox (box, histogram) + +pointer box #U Box +int histogram[B_LEN,B_LEN,B_LEN] #I Histogram + +int ir, ig, ib +int rmin, rmax, gmin, gmax, bmin, bmax + +define have_rmin 11 +define have_rmax 12 +define have_gmin 13 +define have_gmax 14 +define have_bmin 15 +define have_bmax 16 + +begin + + rmin = CBOX_RMIN(box); rmax = CBOX_RMAX(box) + gmin = CBOX_GMIN(box); gmax = CBOX_GMAX(box) + bmin = CBOX_BMIN(box); bmax = CBOX_BMAX(box) + + if (rmax > rmin) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + if (histogram[ir,ig,ib] != 0) { + rmin = ir + CBOX_RMIN(box) = rmin + goto have_rmin + } + } + } + } + +have_rmin + if (rmax > rmin) { + for (ir=rmax; ir>=rmin; ir=ir-1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + if (histogram[ir,ig,ib] != 0) { + rmax = ir + CBOX_RMAX(box) = rmax + goto have_rmax + } + } + } + } + } + } + + +have_rmax + if (gmax > gmin) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + if (histogram[ir,ig,ib] != 0) { + gmin = ig + CBOX_GMIN(box) = gmin + goto have_gmin + } + } + } + } + +have_gmin + if (gmax > gmin) { + for (ig=gmax; ig>=gmin; ig=ig-1) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + if (histogram[ir,ig,ib] != 0) { + gmax = ig + CBOX_GMAX(box) = gmax + goto have_gmax + } + } + } + } + } + } + +have_gmax + if (bmax > bmin) { + for (ib=bmin; ib<=bmax; ib=ib+1) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + if (histogram[ir,ig,ib] != 0) { + bmin = ib + CBOX_BMIN(box) = bmin + goto have_bmin + } + } + } + } + +have_bmin + if (bmax > bmin) { + for (ib=bmax; ib>=bmin; ib=ib-1) { + for (ir=rmin; ir<=rmax; ir=ir+1) { + for (ig=gmin; ig<=gmax; ig=ig+1) { + if (histogram[ir,ig,ib] != 0) { + bmax = ib + CBOX_BMAX(box) = bmax + goto have_bmax + } + } + } + } + } + } + +have_bmax + return +end + + + +# ASSIGN_COLOR -- Assign colors + +procedure assign_color (box, cmap) + +pointer box #I Box +short cmap[3] #O Color map entry + +begin + # +1 ensures that color represents the middle of the box + + cmap[1] = ((CBOX_RMIN(box) + CBOX_RMAX(box) - 2) * AB_SHIFT) / 2 + cmap[2] = ((CBOX_GMIN(box) + CBOX_GMAX(box) - 2) * AB_SHIFT) / 2 + cmap[3] = ((CBOX_BMIN(box) + CBOX_BMAX(box) - 2) * AB_SHIFT) / 2 +end + + + +# MAP_COLORTABLE -- Map the color table + +procedure map_colortable (histogram, cmap, ncolor, ColorCells) + +int histogram[B_LEN,B_LEN,B_LEN] #U Histogram +short cmap[3,ncolor] #I Color map +int ncolor #I Number of colors +pointer ColorCells[C_LEN,C_LEN,C_LEN] #O Color cells + +int i, j, ir, ig, ib, rcell, bcell, gcell +long dist, d2, tmp +pointer cell, create_colorcell() + +begin + for (ir=0; ir<B_LEN; ir=ir+1) { + rcell = 1 + ir / BC_SHIFT + for (ig=0; ig<B_LEN; ig=ig+1) { + gcell = 1 + ig / BC_SHIFT + for (ib=0; ib<B_LEN; ib=ib+1) { + bcell = 1 + ib / BC_SHIFT + if (histogram[1+ir,1+ig,1+ib]==0) + histogram[1+ir,1+ig,1+ib] = -1 + else { + cell = ColorCells[rcell, gcell, bcell] + + if (cell == NULL) + cell = create_colorcell (ColorCells, + ir*AB_SHIFT, ig*AB_SHIFT, ib*AB_SHIFT, + cmap, ncolor) + + dist = 2000000000 + for (i=0; i<CCELL_NUM_ENTS(cell) && + dist>CCELL_ENTRIES(cell,i,1); i=i+1) { + j = CCELL_ENTRIES(cell,i,0) + d2 = cmap[1,1+j] - (ir * BC_SHIFT) + d2 = (d2 * d2 * R2FACT) + tmp = cmap[2,1+j] - (ig * BC_SHIFT) + d2 = d2 + (tmp*tmp * G2FACT) + tmp = cmap[3,1+j] - (ib * BC_SHIFT) + d2 = d2 + (tmp*tmp * B2FACT) + if (d2 < dist) { + dist = d2 + histogram[1+ir,1+ig,1+ib] = j + } + } + } + } + } + } +end + + + +# CREATE_COLORCELL -- Create a color cell structure + +pointer procedure create_colorcell (ColorCells, ra, ga, ba, cmap, ncolor) + +pointer ColorCells[C_LEN,C_LEN,C_LEN] #U Color cells +int ra, ga, ba #I Color to create cell for +short cmap[3,ncolor] #I Color map +int ncolor #I Number of colors + +int i, n, next_n, ir,ig,ib, r1,g1,b1 +long dist, mindist, tmp +pointer ptr + +begin + ir = ra / AC_SHIFT + ig = ga / AC_SHIFT + ib = ba / AC_SHIFT + + r1 = ir * AC_SHIFT + g1 = ig * AC_SHIFT + b1 = ib * AC_SHIFT + + call malloc (ptr, CCELL_LEN, TY_STRUCT) + ColorCells[1+ir,1+ig,1+ib] = ptr + CCELL_NUM_ENTS(ptr) = 0 + + # step 1: find all colors inside this cell, while we're at + # it, find distance of centermost point to furthest corner + + mindist = 2000000000 + + for (i=1; i<=ncolor; i=i+1) { + if (cmap[1,i]/AC_SHIFT == ir && + cmap[2,i]/AC_SHIFT == ig && + cmap[3,i]/AC_SHIFT == ib) { + CCELL_ENTRIES(ptr,CCELL_NUM_ENTS(ptr),0) = i - 1 + CCELL_ENTRIES(ptr,CCELL_NUM_ENTS(ptr),1) = 0 + CCELL_NUM_ENTS(ptr) = CCELL_NUM_ENTS(ptr) + 1 + + tmp = cmap[1,i] - r1 + if (tmp < (A_LEN/C_LEN/2)) + tmp = A_LEN/C_LEN-1 - tmp + dist = (tmp*tmp * R2FACT) + + tmp = cmap[2,i] - g1 + if (tmp < (A_LEN/C_LEN/2)) + tmp = A_LEN/C_LEN-1 - tmp + dist = dist + (tmp*tmp * G2FACT) + + tmp = cmap[3,i] - b1 + if (tmp < (A_LEN/C_LEN/2)) + tmp = A_LEN/C_LEN-1 - tmp + dist = dist + (tmp*tmp * B2FACT) + + mindist = min (mindist, dist) + } + } + + + # step 3: find all points within that distance to box + + for (i=1; i<=ncolor; i=i+1) { + if (cmap[1,i]/AC_SHIFT != ir || + cmap[2,i]/AC_SHIFT != ig || + cmap[3,i]/AC_SHIFT != ib) { + dist = 0 + tmp = r1 - cmap[1,i] + if (tmp>0) { + dist = dist + (tmp*tmp * R2FACT) + } else { + tmp = cmap[1,i] - (r1 + A_LEN/C_LEN-1) + if (tmp > 0) + dist = dist + (tmp*tmp * R2FACT) + } + + tmp = g1 - cmap[2,i] + if (tmp>0) { + dist = dist + (tmp*tmp * G2FACT) + } else { + tmp = cmap[2,i] - (g1 + A_LEN/C_LEN-1) + if (tmp > 0) + dist = dist + (tmp*tmp * G2FACT) + } + + tmp = b1 - cmap[3,i] + if (tmp>0) { + dist = dist + (tmp*tmp * B2FACT) + } else { + tmp = cmap[3,i] - (b1 + A_LEN/C_LEN-1) + if (tmp > 0) + dist = dist + (tmp*tmp * B2FACT) + } + + if (dist < mindist) { + CCELL_ENTRIES(ptr,CCELL_NUM_ENTS(ptr),0) = i - 1 + CCELL_ENTRIES(ptr,CCELL_NUM_ENTS(ptr),1) = dist + CCELL_NUM_ENTS(ptr) = CCELL_NUM_ENTS(ptr) + 1 + } + } + } + + + # sort color cells by distance, use cheap exchange sort + n = CCELL_NUM_ENTS(ptr) - 1 + while (n > 0) { + next_n = 0 + for (i=0; i<n; i=i+1) { + if (CCELL_ENTRIES(ptr,i,1) > CCELL_ENTRIES(ptr,i+1,1)) { + tmp = CCELL_ENTRIES(ptr,i,0) + CCELL_ENTRIES(ptr,i,0) = CCELL_ENTRIES(ptr,i+1,0) + CCELL_ENTRIES(ptr,i+1,0) = tmp + tmp = CCELL_ENTRIES(ptr,i,1) + CCELL_ENTRIES(ptr,i,1) = CCELL_ENTRIES(ptr,i+1,1) + CCELL_ENTRIES(ptr,i+1,1) = tmp + next_n = i + } + } + n = next_n + } + + return (ptr) +end + + + +# QUANT_FSDITHER -- Quantized Floyd-Steinberg Dither + +procedure quant_fsdither (im, z1, dz, logmap, histogram, + ColorCells, cmap, ncolor, oim) + +pointer im[3] #I IMIO pointers +real z1[3] #I Intensity mapping origins +real dz[3] #I Intensity mapping ranges +bool logmap #I Intensity mapping log map? +int histogram[B_LEN,B_LEN,B_LEN] #U Histogram +pointer ColorCells[C_LEN,C_LEN,C_LEN] #U Color cell data +short cmap[3,ncolor] #I Color map +int ncolor #I Number of colors +pointer oim #O Output IMIO pointer + +pointer thisptr, nextptr, optr, impl2s() +pointer sp, thisline, nextline, tmpptr +int ir, ig, ib, r1, g1, b1, rcell, bcell, gcell +int i, j, nc, nl, oval + +int ci, cj +long dist, d2, tmp +pointer cell + +pointer create_colorcell() + +begin + nc = IM_LEN(im[1], 1) + nl = IM_LEN(im[1], 2) + + call smark (sp) + call salloc (thisline, nc * 3, TY_INT) + call salloc (nextline, nc * 3, TY_INT) + + # get first line of picture + call xv_getline (im, z1, dz, logmap, 1, nextline) + + for (i=1; i<=nl; i=i+1) { + # swap thisline and nextline + tmpptr = thisline + thisline = nextline + nextline = tmpptr + + # read in next line + if (i < nl) + call xv_getline (im, z1, dz, logmap, i, nextline) + + # dither this line and put it into the output picture + thisptr = thisline + nextptr = nextline + optr = impl2s (oim, i) + + for (j=1; j<=nc; j=j+1) { + r1 = Memi[thisptr] + g1 = Memi[thisptr+1] + b1 = Memi[thisptr+2] + thisptr = thisptr + 3 + + r1 = max (0, min (A_LEN-1, r1)) + g1 = max (0, min (A_LEN-1, g1)) + b1 = max (0, min (A_LEN-1, b1)) + + ir = r1 / AB_SHIFT + ig = g1 / AB_SHIFT + ib = b1 / AB_SHIFT + + oval = histogram[1+ir,1+ig,1+ib] + if (oval == -1) { + rcell = 1 + ir / BC_SHIFT + gcell = 1 + ig / BC_SHIFT + bcell = 1 + ib / BC_SHIFT + cell = ColorCells[rcell, gcell, bcell] + if (cell == NULL) + cell = create_colorcell (ColorCells, r1, g1, b1, + cmap, ncolor) + + dist = 2000000000 + for (ci=0; ci<CCELL_NUM_ENTS(cell) && + dist>CCELL_ENTRIES(cell,ci,1); ci=ci+1) { + cj = CCELL_ENTRIES(cell,ci,0) + d2 = (cmap[1,1+cj]/AB_SHIFT) - ir + d2 = (d2*d2 * R2FACT) + tmp = (cmap[2,1+cj]/AB_SHIFT) - ig + d2 = d2 + (tmp*tmp * G2FACT) + tmp = (cmap[3,1+cj]/AB_SHIFT) - ib + d2 = d2 + (tmp*tmp * B2FACT) + if (d2<dist) { + dist = d2 + oval = cj + } + } + histogram[1+ir,1+ig,1+ib] = oval + } + + Mems[optr] = 1 + oval + optr = optr + 1 + + r1 = r1 - cmap[1,1+oval] + g1 = g1 - cmap[2,1+oval] + b1 = b1 - cmap[3,1+oval] + + # don't use tables, because r1,g1,b1 could go negative + if (j < nc) { + tmpptr = thisptr + if (r1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (r1*7-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (r1*7+8)/16 + tmpptr = tmpptr + 1 + if (g1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (g1*7-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (g1*7+8)/16 + tmpptr = tmpptr + 1 + if (b1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (b1*7-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (b1*7+8)/16 + } + + if (i < nl) { + if (j > 1) { + tmpptr = nextptr - 3 + if (r1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (r1*3-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (r1*3+8)/16 + tmpptr = tmpptr + 1 + if (g1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (g1*3-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (g1*3+8)/16 + tmpptr = tmpptr + 1 + if (b1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (b1*3-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (b1*3+8)/16 + } + + tmpptr = nextptr + if (r1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (r1*5-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (r1*5+8)/16 + tmpptr = tmpptr + 1 + if (g1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (g1*5-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (g1*5+8)/16 + tmpptr = tmpptr + 1 + if (b1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (b1*5-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (b1*5+8)/16 + + if (j < nc) { + tmpptr = nextptr + 3 + if (r1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (r1-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (r1+8)/16 + tmpptr = tmpptr + 1 + if (g1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (g1-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (g1+8)/16 + tmpptr = tmpptr + 1 + if (b1 < 0) + Memi[tmpptr] = Memi[tmpptr] + (b1-8)/16 + else + Memi[tmpptr] = Memi[tmpptr] + (b1+8)/16 + } + nextptr = nextptr + 3 + } + } + } + + call sfree (sp) +end diff --git a/pkg/proto/color/src/x_color.x b/pkg/proto/color/src/x_color.x new file mode 100644 index 00000000..7bc78b1b --- /dev/null +++ b/pkg/proto/color/src/x_color.x @@ -0,0 +1,3 @@ +task rgbdither = t_rgbdither, + rgbsun = t_rgbsun, + rgbto8 = t_rgbto8 diff --git a/pkg/proto/doc/binfil.hlp b/pkg/proto/doc/binfil.hlp new file mode 100644 index 00000000..beee0c81 --- /dev/null +++ b/pkg/proto/doc/binfil.hlp @@ -0,0 +1,71 @@ +.help binfil Jul86 proto +.ih +NAME +binfil -- create a 16 bit binary raster file from an IRAF image +.ih +USAGE +binfil input +.ih +PARAMETERS +.ls input +The list of input images to be converted. +.le +.ls scale_fact = 1.0 +A multiplicative scale factor to be applied to each pixel during the +conversion process. This parameter provides the means to minimize loss +of precision when converting from the dynamic range of the IRAF image +pixels to the dynamic range of the output 16-bit signed integer, +-32768 to 32767. +.le +.ls header = no +Prepend a short descriptive header to the output binary raster file? +.le +.ih +DESCRIPTION +BINFIL generates a simple signed 16-bit binary raster file +from IRAF images. BINFIL can be useful when programs other than IRAF +applications are to be used to examine the data. The format of the resulting +file is a simple string of pixels, with the exception that the first +90 bytes or 45 words may optionally form a minimal header. + +The header elements are stored as follows: + +.nj +.nf + word 1 : nrows + word 2 : ncols + word 3 : IRAF pixel type flag + word 4-13 : reserved space + word 14-45: image title (ASCII 64 bytes) +.fi +.ju + +Pixels from the input images are converted to short integers after scaling +by the scale_fact parameter. The resultant pixel values are limited to the +maximum range of a short integer and then written to the binary file. + +The output binary file assumes the name of the input image with an appended +".b" to indicate binary. +.ih +EXAMPLES + +Convert the IRAF image irafimage to the binary file irafimage.b. + +.nj +.nf +cl> binfil irafimage scale=0.01 +.fi +.ju + +.ih +TIME REQUIREMENTS +.ih +BUGS +Only the first 64 characters of the image title are placed in the binary file +header. + +There is no way to specify the output binary file names. +.ih +SEE ALSO +irafil +.endhelp diff --git a/pkg/proto/doc/bscale.hlp b/pkg/proto/doc/bscale.hlp new file mode 100644 index 00000000..af5647f8 --- /dev/null +++ b/pkg/proto/doc/bscale.hlp @@ -0,0 +1,151 @@ +.help bscale Aug91 proto +.ih +NAME +bscale -- linearly transform the intensity scales of a list of images +.ih +USAGE +bscale input output +.ih +PARAMETERS +.ls input +List of images to be transformed. +.le +.ls output +List of output transformed images. If the output list is the same as the input +list the input images are overwritten. +.le +.ls bzero = "0." +The zero point to be subtracted before applying the scale factor. +The options are a numerical value, "mean", "median", or "mode". +.le +.ls bscale = "1." +The scale factor to be applied. The options are a numerical value, +"mean", "median", or "mode". +.le +.ls section = "" +The image section to be used for computing the image statistics. If section +is "", \fIstep\fR is used to define the default image section. \fISection\fR +is used to confine the computation of the mean, median, and mode +to a specific region of the image. +.le +.ls step = 10 +The step size in pixels which defines the default image section to be used +for computing the mean, median, and mode. +In image section notation the default section is equivalent to [*:10,*:10,...]. +\fIStep\fR is used if +the sampling along an axis is not defined by \fIsection\fR. +Subsampling can significantly reduce the memory and +time required for the computation of the mean, median, and mode. +.le +.ls upper = "INDEF" +Upper intensity limit to be used for computing the mean, median, and mode. +.le +.ls lower = "INDEF" +Lower intensity limit to be used for computing the mean, median, and mode. +.le +.ls verbose = yes +Print messages about actions taken by the task? +.le + +.ih +DESCRIPTION + +The specified input images \fIinput\fR are linearly transformed in intensity +and written to the list of output images \fIoutput\fR, using the +zero point specified by \fIbzero\fR and the scale factor specified by +\fIbscale\fR. If the output image list +is the same as the input image list the input images will be overwritten. + +The expression defining the linear transformation is listed below. + + NEW = (OLD - BZERO) / BSCALE + +OLD is the input pixel brightness, NEW is the output +pixel brightness, BZERO is the zero point offset, and BSCALE is the +scale factor. The values of the scaling parameters \fIbzero\fR and +\fIbscale\fR +may be specified explicitly or the mean, median, or mode of the image +may be used for either quantity. If the input image pixel type +is short, integer, or long, overflow or truncation may occur. + +When one of the scaling parameters is the image mean, median, +or mode, then the image mean, median, and mode are calculated. The statistics +computation can be restricted to a section of the input image by setting +the parameter +\fIsection\fR. Otherwise the parameter \fIstep\fR is used to +define a default image section. +Subsampling the image can significantly reduce the memory +and time requirements for computing the statistics of large images. +If numerical values for both the scaling parameters are specified, then +the image statistics are not computed. The statistics computation can +be limited to given intensity range by setting the parameters +\fIlower\fR and \fIupper\fR. + +The mean, median, and mode are computed using the following algorithm. +Note that this algorithm requires that all the data to used for computing +the statistics must be in memory. + +.nf +1. The data in the specified image section is read into a buffer. +2. The data is sorted in increasing order of intensity. +3. The points outside upper and lower are excluded. +4. The median is set to the data value at the midpoint of the remaining + data. +5. The mean and sigma of the remaining data are computed. +6. The histogram bin width (.1*sigma) and separation (.01*sigma) are + computed. +7. The location of the bin containing the most data points is determined. +8. The median of the data values in that bin is used to estimate the mode. +.fi + +.ih +EXAMPLES + +1. Use the mode to subtract a constant background from a list of images. +Overwrite the input images. + +.nf + cl> bscale *.imh *.imh bzero=mode +.fi + +2. Scale a list of images to a unit mean. Overwrite the input images. + +.nf + cl> bscale *.imh *.imh bscale=mean +.fi + +3. Scale a list of images to the intensity range 0 to 511, +where 234. and 1243. are the original data range. Overwrite the input +images. This example uses the CL to calculate bscale. + +.nf + cl> bscale.bzero = 234. + cl> bscale.bscale = (1243. - 234.) / 512. + cl> bscale *.imh *.imh +.fi + +4. Scale an image using a user specified bzero and bscale and create a new +output image: + +.nf + cl> bscale imagein imageout bzero=0.0 bscale=1.10 +.fi + +5. Median subtract a list of input images using the percent replace facility to +create the output image names. + +.nf + cl> bscale images*.imh %i%outi%*.imh bzero=median bscale=1.0 +.fi + +6. Repeat the previous example but use the @ file facility for specifying +the input and output image lists. + +.nf + cl> bscale @infile @outfile bzero=median bscale=1.0 +.fi + +.ih +SEE ALSO +imarith,imcombine +.endhelp diff --git a/pkg/proto/doc/epix.hlp b/pkg/proto/doc/epix.hlp new file mode 100644 index 00000000..e47afe5e --- /dev/null +++ b/pkg/proto/doc/epix.hlp @@ -0,0 +1,55 @@ +.help epix Jun84 proto +.ih +NAME +epix -- edit pixels in an image +.ih +USAGE +epix image_name x y new_value +.ih +PARAMETERS +.ls image_name +Name of image or image section to be edited. +.le +.ls xcoord, ycoord +The coordinates of the pixel to be edited. +.le +.ls new_value +The new value of the pixel. +.le +.ls boxsize = 3 +The width of a square subraster surrounding the pixel to be edited over which +the rejection mean and the median will be computed. +.le +.ls ksigma = 0.0 +The pixel rejection threshold for the iterative rejection algorithm used +to compute the mean. If zero, a rejection threshold will be computed based +on the size of the sample using Chauvenet's relation. +.le +.ls edit_image = yes +Set the pixel value to \fInew_value\fR? If editing is disabled the mean +and median may still be computed, and the subraster may still be printed. +.le +.ls verbose = yes +Print the values of the pixels in the subraster surrounding the image, +and compute the rejection mean and the median. +.le +.ih +DESCRIPTION +A subraster \fIboxsize\fR pixels square is extracted centered on the pixel +(xcoord,ycoord). If the \fIverbose\fR flag is enabled the values +of the pixels in the subraster are printed on the standard output along with +the rejection mean and median of the subraster. If \fIedit_image\fR is yes +the program will ask for the \fInew_value\fR and edit the image. +.ih +EXAMPLES +1. Replace the specified pixels with a value of zero. + +.nf + cl> epix M92 400 87 0.0 + cl> epix M92 45 300 0.0 + cl> epix M92 207 300 0.0 +.fi +.ih +SEE ALSO +imedit +.endhelp diff --git a/pkg/proto/doc/fields.hlp b/pkg/proto/doc/fields.hlp new file mode 100644 index 00000000..8118a6fd --- /dev/null +++ b/pkg/proto/doc/fields.hlp @@ -0,0 +1,65 @@ +.help fields Jan86 proto +.ih +NAME +fields -- extract selected fields from a list. +.ih +USAGE +fields files fields +.ih +PARAMETERS +.ls files +File or files from which the fields are to be extracted. +.le +.ls fields +The fields to be extracted. +.le +.ls lines = "1-" +The lines from which the fields are to be extracted. If multiple files are +being extracted, the same lines apply to each file. +.le +.ls quit_if_missing = no +This flag determines the task behavior when a field is missing from the +specified line. If \fBquit_if_missing\fR = yes, the task exits and an error +is reported. +.le +.ls print_file_names = no +If \fBprint_file_name\fR = yes, the first string of each output line of +extracted fields is the file name. +.le +.ih +DESCRIPTION +The list processing tool \fIfields\fR is used to extract whitespace +separated fields from the specified files and lines. +The input to this task can be either the standard input or a list of +files; output is a new list of the extracted fields. + +The fields of a line are numbered from 1 up to a newline character; those +fields to be extracted are specified as a range of numbers. +If a specified field is missing from a selected +line the action taken is determined by the \fBquit_if_missing\fR flag; +\fIfields\fR will either continue processing after printing a warning +message, or call an error and exit. +.ih +EXAMPLES +1. Reverse the order of the 5 columns in list file "list". +.nf + + cl> fields list 5-1 > newlist +.fi + +2. Extract columns 1 and 3 from file "newlist" and pipe them to task +\fIgraph\fR. +.nf + + cl> fields newlist 1,3 | graph +.fi +.ih +REVISIONS +.ls FIELDS V2.11 +The default value for the \fIlines\fR parameter was changed to an open +upper limit. +.le +.ih +SEE ALSO +joinlines, xtools.ranges +.endhelp diff --git a/pkg/proto/doc/fixpix.hlp b/pkg/proto/doc/fixpix.hlp new file mode 100644 index 00000000..89f8c99b --- /dev/null +++ b/pkg/proto/doc/fixpix.hlp @@ -0,0 +1,190 @@ +.help fixpix Aug96 proto +.ih +NAME +fixpix -- fix pixels identified by a bad pixel mask, image, or file +.ih +USAGE +.nf +fixpix images masks +.fi +.ih +PARAMETERS +.ls images +List of two dimensional images to be "fixed" (modified) by +linear interpolation. +.le +.ls masks +List of bad pixel masks, images, or files (collectively called masks) +identifying the bad pixels. The list of masks must either match the +list of input images in number or a single mask may be specified to apply +to all images. The special name "BPM" may be specified to select a mask +specified by the header keyword "BPM" in the input image. The possible +mask formats are given in the DESCRIPTION section. +.le +.ls linterp = "INDEF", cinterp = "INDEF" +Normally interpolation is performed across the narrowest dimension spanning +the bad pixels with interpolation along image lines if the two dimensions are +equal. However specific values in the mask may be used to +identify the desired interpolation direction. The value in the mask +specifying line interpolation is given by the \fIlinterp\fR parameter and +the value specifying column interpolation is given by the \fIcinterp\fR +parameter. Any values which are do not match one of these parameters +results in interpolation along the narrowest dimension. Note that a +text file mask always has 2 for pixels with narrow dimension along +lines and 3 for pixels with narrow dimension along columns. +.le +.ls verbose = no +If this parameter is set to yes a line identifying each image and +associated mask is printed. If the \fIpixels\fR parameter is +set then a list of the pixels modified is also printed. +.le +.ls pixels = no +List the pixels modified? This is only done if this parameters and +the \fIverbose\fR parameter are set. +.le +.ih +DESCRIPTION +Pixels in a list of images identified by bad pixel masks, images, or text +files (collectively called masks here) are replaced by linear interpolation +along lines or columns using the nearest good pixels. The list of input +images, specified by the \fIimages\fR parameter, are matched with a list of +masks, specified by the \fImasks\fR parameter. The list of masks must +match the list of input images or a single mask name may be given to apply +to all input images. The special mask name "BPM" may be used to +select a mask name given in the input image header under the keyword +"BPM". + +There are three types of masks which may be used. The preferred type +is a bad pixel mask given as a "pixel list" image. Pixel list images +have the extension ".pl" signifying a special compact file of integer +values ideal for identifying sets of pixels. For a bad pixel mask the +good pixels have a value of zero and bad pixels have positive integer +values. + +The second type is any image format. The image will be internally +converted to a bad pixel mask. Note that real image values will be +truncated to integers. Again good pixels will have values of zero and bad +pixels will have positive values. + +The final format is a text file with lines giving the integer coordinates +of a single pixel or a rectangular region. A single pixel is specified by +a column and line number. A region is specified by a starting column, an +ending column, a starting line, and an ending line. Internally this file +is turned into a bad pixel mask of the size of the input image with values +of zero for non-specified pixels, a value of two for pixels with narrowest +interpolation direction along lines, and three for pixels with narrowest +interpolation direction along columns. + +As noted previously, bad pixels are "fixed" by replacing them with values +by linear interpolation to the nearest pixels not identified as bad. +Normally interpolation is performed across the narrowest dimension spanning +bad pixels with interpolation along image lines if the two dimensions are +equal. However specific values in the mask may be used to identify the +desired interpolation direction. The value in the mask specifying line +interpolation is given by the \fIlinterp\fR parameter and the value +specifying column interpolation is given by the \fIcinterp\fR parameter. +Any values which are do not match one of these parameters results in +interpolation along the narrowest dimension. Note that a text file mask +always has 1 for pixels with narrow dimension along lines and 2 for pixels +with narrow dimension along columns. + +The \fIverbose\fR allows printing a line giving the task name, the +image name, and the mask name. In addition, if the \fIpixels\fR +parameter is set the pixels modified are listed. The list of pixels +consists of the column and line of the pixel, the original +and replaced pixel values, and the column and line of the one or two +pixels used for the interpolation. If the bad pixel region has no +pixels at one end, that is there are bad pixels all the way to one edge +of the image, then the single pixel used is printed. + +Normally the input images and the masks will have the same dimension. +However, this task matches bad pixels in the masks with the input images +based on physical coordinates. Thus, the mask image may be bigger or +smaller than the input image and image sections may be used with either +the input images or the bad pixel mask or image mask images. If the +input image is the result of extracting a subsection of a bigger image +the coordinates of the pixels will be those of the original image +and the matching coordinates of the mask will be applied. This has +the effect of allowing image sections to be applied to images having +a bad pixel mask specified in the image and still having the bad pixel +mask be valid. + +Mask images may be made in a variety of ways. Any task which produces +and modifies image values may be used. Some useful tasks are +\fBimexpr, imreplace, imcopy,\fR and \fBmkpattern\fR. If a new image +is specified with the explicit ".pl" extension then the pixel mask +format is produced. Two other ways to make masks are with the +tasks \fBtext2mask\fR and \fBccdmask\fR. The former uses an input +text file consisting of rectangular region. This is the old +"fixpix" format. The task \fBccdmask\fR is specialized to make a mask +of bad pixels from flat fields or, even better, from the ratio of +two flat fields of different exposure levels. +.ih +EXAMPLES +1. A list of images have bad pixel masks defined in the image header. +To replace the bad pixels by interpolation along the narrowest +dimension: + +.nf + cl> fixpix obj* BPM +.fi + +2. A simple mask of 0s and 1s defines bad columns in spectral data +with dispersion along the lines. To interpolate along the lines: + +.nf + cl> fixpix spec00*h ccdmask linterp=1 v+ + FIXPIX: image spec001.imh with mask ccdmask + FIXPIX: image spec002.imh with mask ccdmask + ... +.fi + +3. A text file of bad pixels is used and the modified pixels are printed +with: + +.nf + cl> type mask.dat + 1 2 1 1 + 25 26 25 25 + 26 27 27 27 + 49 50 50 50 + 10 10 + 20 21 20 20 + cl> fixpix myimage mask.dat v+ p+ + FIXPIX: image myimage with mask mask.dat + 1 1 1. 1. 1 2 + 2 1 1. 1. 2 2 + 10 10 1. 1. 9 10 11 10 + 20 20 1. 1. 20 19 20 21 + 21 20 1. 1. 21 19 21 21 + 25 25 1. 1. 25 24 25 26 + 26 25 1. 1. 26 26 26 28 + 26 27 1. 1. 26 26 26 28 + 27 27 1. 1. 27 26 27 28 + 49 50 1. 1. 49 49 + 50 50 1. 1. 50 49 +.fi + +4. Because a text file input automatically sets the mask values to +2 or 3 you may need to set the linterp and cinterp parameters to +force the direction. In particular, to apply FIXPIX to a 1D image, +say a spectrum, if you have regions described by ranges in columns +the mask interpolation values will be assigned as 3. This means +it is trying to interpolation between line 0 and line 2 which is +obviously not what is intended. To make this work set linterp to +3: + +.nf + cl> fixpix myimage mask.dat linterp=3 +.fi +.ih +REVISIONS +.ls FIXPIX V2.11 +This task replaces the old task (now obsolete.ofixpix) and works with the +more general pixel mask facilities. It also provides greater flexibility +in choosing the interpolation direction. +.le +.ih +SEE ALSO +epix, imedit, ccdproc, text2mask, obsolete.ofixpix +.endhelp diff --git a/pkg/proto/doc/hfix.hlp b/pkg/proto/doc/hfix.hlp new file mode 100644 index 00000000..1549ffeb --- /dev/null +++ b/pkg/proto/doc/hfix.hlp @@ -0,0 +1,79 @@ +.help hfix Nov91 proto +.ih +NAME +hfix -- fix image headers with a user specified command +.ih +USAGE +hfix images +.ih +PARAMETERS +.ls images +List of images whose headers are to be fixed. If \fIupdate\fR is yes then +the user must have write permission on the image headers. +.le +.ls command = "edit $fname" +Command to be applied to a file containing the image header. The command +may be any CL command which includes escapes to host commands. The file +containing the header in text form is specified by the special string +"$fname". The command should modify this file to the desired form. The +default is to invoke a text editor but there are many other possibilities. +The image name may also be specified with "$image". See the EXAMPLES +section for some ideas. +.le +.ls update = yes +Update the image header with the modified header. +.le +.ih +DESCRIPTION +This task allows you to extract the image headers into a text file, +modify this file with a specified command, and update the image header +with the modified file. The command to be applied is specified with +the \fIcommand\fR parameter. In this command the text file containing +the header to be acted upon is referenced with the string "$fname". +If it is desired to update the image header with the modified file +the \fIupdate\fR switch must be set. You must have write permission +to update the image headers. + +A common command, which is the default, is to use a text editor. +Other possibilities are to save the file, use a non-interactive host +command such as \fBsed\fR in UNIX, or write your own program or +script. + +This task does very little processing on the header after you are finished +editing. It checks for legal FITS characters in the first 8 columns and if +there is an '=' in column 9 then there must be a ' ' (blank) in column 10. +Lines violating these checks are skipped. It also sets each line in the +header to the correct length. Because you have total freedom to change the +header parameters while in the text editor, you must make sure that the +header has a legal format after you are through editing it. In particular, +be sure each field in the header parameters that you add or change begin in +the proper columns. +.ih +EXAMPLES +1. Edit the header of the image test.imh: + +.nf + cl> hfix test.imh + <Edit the header text> +.fi + +2. Get the header of a single image and save the file: + +.nf + cl> hfix myim command="copy $fname save" update- +.fi + +3. A image header was created with an incorrect format such that the +equal sign is in column 10 instead of 9: + +.nf + cl> hfix *.imh \ + >>> command="!sed 's/ =/=/' $fname >temp;mv temp $fname" +.fi + +Note that this example should not be tried on a valid header where the +equal sign is in column 9. +.ih +SEE ALSO +images.hedit noao.artdata.mkheader +.endhelp diff --git a/pkg/proto/doc/imalign.hlp b/pkg/proto/doc/imalign.hlp new file mode 100644 index 00000000..bf666b6c --- /dev/null +++ b/pkg/proto/doc/imalign.hlp @@ -0,0 +1,328 @@ +.help imalign Feb90 proto +.ih +NAME +imalign -- register a list of images +.ih +USAGE +imalign images coords +.ih +PARAMETERS +.ls images +The list of images to be shifted and trimmed. This list should +normally contain the \fIreference\fR to include its borders in the +calculation of the trim section as well as to preserve the image +alignment following trimming. +.le +.ls coords +A text file containing the coordinates of the registration objects to +be centered in each image, one object per line with the x and y +coordinates in columns one and two respectively. These coordinates +should be measured in the frame of the reference image. +.le +.ls reference +The reference image to which the \fIimages\fR will be aligned. Note +that \fIreference\fR is a query parameter to IMALIGN, but a hidden +parameter to IMCENTROID. +.le +.ls shifts = "" +A text file containing the initial estimate for each image of the +shift in each axis relative to the \fIreference\fR image. These +estimates are used to modify the coordinates of the registration +objects prior to centering. The format of the file is one image per +line with the (fractional) x and y shifts in columns one and two +respectively. The sense of the shifts is such that: +\fIXshift=Xref-Xin\fR and \fBYshift=Yref-Yin\fR. If \fIshifts\fR +is null, a coarse centering pass will be made to attempt to determine +the initial shifts. +.le +.ls prefix = "rg" +The output images will have root names that are prefixed by this +string. If \fIprefix\fR is null, the input \fIimages\fR will be +overwritten. +.le +.ls shiftimages = yes +If \fIshiftimages\fR is yes, the IMSHIFT task will be used to align the +images. If \fIshiftimages\fR is no, the images will not be aligned but +only centered. +.le +.ls trimimages = yes +If \fItrimimages\fR is yes, the output images will be trimmed to +include only the region over which they all overlap. The +trim section that is actually used may differ slightly from that +reported by IMCENTROID. A correction may be applied to compensate for +the boundary extension "contamination" due to multi-pixel (e.g., +\fIinterp_type\fR = poly5) interpolation near the edges of the images. +.le +.ls verbose = yes +Print the centers, shifts, and trim section? +.le +.ls boxsize = 7 +The size in pixels of the box to use for the final centering, during +which all the sources in \fIcoords\fR are recentered in each image +using the initial estimate of the relative shift for each image. +Care should be taken to choose an appropriate value for this parameter, +since it is highly data dependent. +.le +.ls bigbox = 11 +The size in pixels of the box to use for coarse centering. The coarse +pass through the centering algorithm is made with the box centered at +the nominal position of the first source in the coordinate list. +Coarse centering is performed only if \fIshifts\fR is null. +Care should be taken to choose an appropriate value for this parameter, +since it is highly data dependent. Large value should be suspect until +the final results are checked to see that the centering did not converge +on the wrong coordinates, although the usual result for an inappropriate +\fIbigbox\fR size is that the algorithm fails to converge and the task +aborts. +.le +.ls negative = no +Are the features negative? +.le +.ls background = INDEF +The absolute reference level for the marginal centroid calculation. +If \fIbackground\fR is INDEF, this is set to the mean value (between the +thresholds) of the individual sources. +.le +.ls lower = INDEF +The lower threshold for the data. Individual pixels less than this +value will be given zero weight in the centroids. +.le +.ls upper = INDEF +The upper threshold for the data. Individual pixels greater than this +value will be given zero weight in the centroids. +.le +.ls niterate = 2 +The maximum number of centering iterations to perform. The centering +will halt when this limit is reached or when the desired \fItolerance\fR +is achieved. +.le +.ls tolerance = 0 +The tolerance for convergence of the centering algorithm. This is the +integral shift of the centering box from one iteration to the next. +.le +.ls interp_type = "spline3" +The interpolation function type for the IMSHIFT task. See the help +page for IMSHIFT for more information. +.le +.ls boundary_type = "constant" +The boundary extension type for the IMSHIFT task. See the help page +for IMSHIFT for more information. +.le +.ls constant = 0. +The constant to be used if \fIboundary_type\fR is "constant". See the +help page for IMSHIFT for more information. +.le +.ih +DESCRIPTION +IMALIGN measures the X and Y axis shifts between a list of images, +\fIimages\fR and a reference image, \fIreference\fR, that is, the +shifts that should be added to the input image coordinates to convert +them into the reference coordinates. By default it will apply the +measured shifts and then trim the \fIimages\fR to consistent borders. +The task is meant to address the class of two dimensional image +registration problems in which the images have the same pixel scale, +are shifted relative to each other by simple translations and contain +enough high signal/noise, point-like sources in common to form good +average positions. The basic operation of the task is to find centers +for the list of registration objects or features in the coordinate +frame of each image and then to subtract the corresponding centers +found in the reference image. The shifts of the registration objects +are averaged for each image. + +IMALIGN is a simple script front end for IMCENTROID, IMSHIFT, and +IMCOPY (which is used to perform the trimming). Other scripts +can be constructed for similar purposes. You can type: `help +imalign option=source' to view the script. + +A list of the X and Y coordinates of the registration objects should be +provided in the parameter \fIcoords\fR. The registration objects do not +all have to be common to each frame, rather only that subset of the +objects that is contained within the bounds of a given image will be +centered. Only the objects that are common to both the given image and +the reference will be used to calculate the shifts. The coordinates +should be measured in the frame of the \fIreference\fR. If coarse +centering is to be done, which is to say, if no \fIshifts\fR file is +provided, then the first registration source should be separated from +other sources by at least the maximum expected relative shift. + +An initial estimate of the shifts between each of the \fIimages\fR and +the \fIreference\fR is required for the centering algorithm (a marginal +centroid) to work. This estimate can be explicitly supplied in a file +\fIshifts\fR (\fIXshift=Xref-Xin\fR and \fIYshift=Yref-Yin\fR) or can +be generated from the images by measuring the relative shift of the +first source listed in \fIcoords\fR for each image. This coarse +centering pass requires that the first source be detached from other +sources and from the border of each image by a distance that is at +least the maximum shift between the \fIreference\fR and an image. This +source should be point-like and have a high signal to noise ratio. The +value of the \fIbigbox\fR parameter should be chosen to include the +location of the source in each of the images to be aligned while +excluding other sources. Large values of \fIbigbox\fR should be held +suspect until the final convergence of the centering algorithm is +verified, although given a small value for the \fItolerance\fR, the +quality of the final centers is independent of the estimate for the +initial shifts. Better convergence may also be obtained by increasing +the \fIniterate\fR parameter, although the default value of three +should work for most cases. \fINiterate\fR should be kept small to +avoid runaway. + +The \fIboxsize\fR parameter controls the size of the centering box for +the fine centering passes and should be chosen so as to exclude sky +background and other sources while including the wings of the point +spread function. The sense of the shifts that are calculated is +consistent with the file supplied to the \fIshifts\fR parameter and +with that used with the IMSHIFT task. + +If \fIshiftimages\fR is yes the images will actually be shifted using +the IMSHIFT task. Note that if \fIinterp_type\fR is "nearest" the +effect on the images is the same as if the shifts were rounded to +integral values. In this case, the pixels will be shifted without +interpolation. This can be used for data in which it is more important +to preserve the pixel values than it is to achieve perfect +registration. + +If \fItrimimages\fR is yes, the output images will be trimmed to +include only the region over which they all overlap. The trim section +that is actually used may differ slightly from that reported by +IMCENTROID. A one or two pixel correction may be applied to each edge +to compensate for the boundary extension "contamination" due to +multi-pixel (e.g., \fIinterp_type\fR = poly5) interpolation near the +edges of the images. + +IMALIGN may be used with a set of \fIimages\fR which vary in size. +This can result in vignetting of the calculated overlap region because +of the nature of the IMSHIFT task to preserve the size of an input +image. To visualize this, imagine a large reference image and a single +small image to be aligned to it, both containing the same registration +object which is at the center of each image. IMALIGN will cause the +small image to be shifted such that the object is positioned at the same +pixel location as in the reference. In performing the shift, a large +fraction of the area of the small image may be shifted outside of its +own borders, whereas the physical overlap of the large and small images +includes ALL of the pixels of the small image. In the case of such +vignetting, IMALIGN will print a warning message and refuse to proceed +with the trimming although the vignetting will occur whether or not the +images are trimmed. Note that the vignetting will not occur if the +small image is used as the \fIreference\fR. + +The vignetting message may also be printed if the \fIimages\fR are all +the same size but the \fIreference\fR is not included in the list. +This will occur if the sense of the measured shifts in a coordinate are +all positive or all negative since in this case the border of the +\fIreference\fR would have provided one of the limits to the trim +section. The reality of this vignetting depends on your point of view. + +Trimming will also not be performed if the entire overlap region vanishes. + +Note that many of these difficulties are due to the intrinsically fuzzy +nature of the process of image registration. This all leads to a few +"rules of thumb": + +.nf + o Include the \fIreference\fR as one of the \fIimages\fR + + o Use the smallest image as the \fIreference\fR + + o Choose the \fIreference\fR such that the \fIimages\fR are + scattered to either side in the shifts in each axis + + o Align images that are the same size, OR + + o Pad dissimilar sized images with blanks to + the largest size and disable trimming +.fi +.ih +CENTERING ALGORITHM +The algorithm is a "marginal" centroid in which the fit for each axis +is performed separately upon a vector created by collapsing the +centering box perpendicular to that axis. The centroid is calculated +with respect to the level specified by \fIbackground\fR. If +\fIbackground\fR is INDEF, the reference level for each source in each +image is the local mean for those pixels that lie between the +\fIlower\fR and \fIupper\fR thresholds. The thresholds are set to the +local data minimum or maximum if \fIlower\fR or \fIupper\fR, +respectively, are INDEF. If \fInegative\fR is yes, than the marginal +vector will be inverted before being passed to the centroid algorithm. + +The maximum number of centering iterations and the tolerance for +convergence are controlled by \fIniterate\fR and \fItolerance\fR. Note +that the tolerance is an integer value that represents the maximum +movement of the centering box between two successive iterations. The +default value of 0 requires that the centroid lie within the center +pixel of the centering box which is \fIboxsize\fR in extent (note that +\fIboxsize\fR must be an odd number). This should normally be the case +for bright, circularly symmetric point sources in images with a flat +sky background. If the registration sources are not circular symmetric +try increasing the tolerance gingerly. A sky level that varies across +the image should be removed before processing. The centering and +calculation of the shifts may be performed with \fIshiftimages\fR = no +(or directly with IMCENTROID) and the calculated shifts applied to the +images directly with IMSHIFT. +.ih +EXAMPLES +1. Align three images to the first using the list of registration star +coordinates in the file "x1.coords". + +.nf + cl> imalign x1,x2,x3 x1.coords refer=x1 +.fi + +2. Align a list of images contained in the file "imlist", overwriting the +original images with the shifted and trimmed images: + +.nf + cl> imalign @imlist x1.coords refer=x1 prefix="" +.fi + +3. Align the images leaving the output images the same size as the input +images: + +.nf + cl> imalign @imlist x1.coords refer=x1 trimimages- +.fi + +4. Perform the centering but not the shifts: + +.nf + cl> imalign @imlist x1.coords refer=x1 shiftimages- +.fi + +5. Perform the centering, don't calculate the shifts at all (i.e., don't +supply a reference image): + +.nf + pr> imalign @imlist x1.coords shiftimages- +.fi + +6. Take previously measured shifts and apply them directly: + +.nf + pr> imshift @imlist shiftfile=x1.shifts +.fi +.ih +BUGS +The images being shifted must be in the current directory. + +The coarse centering portion of the algorithm can be fooled if the +first source on the list is not well separated from other sources, or +if the first source has a low signal to noise ratio, or if there is a +complicated shape to the background. + +The task can produce output images that do not contain the entire +overlap region. This can only occur if the images are of varying sizes. +This behavior is caused by the action of the IMSHIFT task to preserve the +size of an input image, thus implicitly "trimming" the image. A work +around is to use IMCOPY to place the images into subsections of blank +images that are the size (in each dimension) of the largest image(s) +and use IMALIGN with \fItrimimages\fR set to no. The borders of the output +images can be trimmed manually. This is discussed above in more detail. + +If \fIimages\fR does not contain the \fIreference\fR and \fItrimimages\fR +is set to yes then the set of shifted and trimmed images may no longer +be aligned to the reference. This occurs because any place holder +pixels at the bottom and left edges of the images will be trimmed off. +This is also discussed above. +.ih +SEE ALSO +imcentroid, center, imshift, geomap, geotran +.endhelp diff --git a/pkg/proto/doc/imcentroid.hlp b/pkg/proto/doc/imcentroid.hlp new file mode 100644 index 00000000..2bedc548 --- /dev/null +++ b/pkg/proto/doc/imcentroid.hlp @@ -0,0 +1,247 @@ +.help imcentroid Feb90 proto +.ih +NAME +imcentroid -- center sources in images, optionally find shifts +.ih +USAGE +imcentroid images coords +.ih +PARAMETERS +.ls images +The list of images within which sources are to be centered. If a +\fIreference\fR image is specified, IMCENTROID will calculate the mean +X and Y shifts between the centered sources within each image and those +same sources within the \fIreference\fR. The list of \fIimages\fR +should normally include the \fIreference\fR so that its borders are +used in the calculation of the trim section for the overlap region of +the list of \fIimages\fR. +.le +.ls coords +A text file containing the coordinates of the registration objects to +be centered in each image, one object per line with the x and y +coordinates in columns one and two respectively. These coordinates +should be measured in the frame of the reference image. +.le +.ls reference = "" +The reference image to which the \fIimages\fR will be aligned. If +a \fIreference\fR is specified the mean X and Y shifts between each of +the \fIimages\fR and the \fIreference\fR will be calculated, otherwise +only the centers for the individual sources will be reported. +.le +.ls shifts = "" +A text file containing the initial estimate for each image of the +shift in each axis relative to the \fIreference\fR image. These +estimates are used to modify the coordinates of the registration +objects prior to centering. The format of the file is one image per +line with the (fractional) x and y shifts in columns one and two +respectively. The sense of the shifts is such that: +\fIXshift=Xref-Xin\fR and \fIYshift=Yref-Yin\fR. + If \fIshifts\fR is null, a coarse centering pass will be made to +attempt to determine the initial shifts. +.le +.ls boxsize = 7 +The size in pixels of the box to use for the final centering, during +which all the sources in \fIcoords\fR are recentered in each image +using the initial estimate of the relative shift for each image. +Care should be taken to choose an appropriate value for this parameter, +since it is highly data dependent. +.le +.ls bigbox = 11 +The size in pixels of the box to use for coarse centering. The coarse +pass through the centering algorithm is made with the box centered at +the nominal position of the first source in the coordinate list. +Coarse centering is performed only if \fIshifts\fR is null. +Care should be taken to choose an appropriate value for this parameter, +since it is highly data dependent. Large value should be suspect until +the final results are checked to see that the centering did not converge +on the wrong coordinates, although the usual result for an inappropriate +\fIbigbox\fR size is that the algorithm fails to converge and the task +aborts. +.le +.ls negative = no +Are the features negative? +.le +.ls background = INDEF +The absolute reference level for the marginal centroid calculation. +If \fIbackground\fR is INDEF, this is set to the mean value (between the +thresholds) of the individual sources. +.le +.ls lower = INDEF +The lower threshold for the data. Individual pixels less than this +value will be given zero weight in the centroids. +.le +.ls upper = INDEF +The upper threshold for the data. Individual pixels greater than this +value will be given zero weight in the centroids. +.le +.ls niterate = 2 +The maximum number of centering iterations to perform. The centering +will halt when this limit is reached or when the desired \fItolerance\fR +is achieved. +.le +.ls tolerance = 0 +The tolerance for convergence of the centering algorithm. This is the +integral shift of the centering box from one iteration to the next. +.le +.ls verbose = yes +Print the centers for the individual objects? If \fIverbose\fR is no +only the shifts relative to the reference coordinates will be reported. +If no \fIreference\fR image is supplied, \fIverbose\fR is automatically +set to yes. +.le +.ih +DESCRIPTION +IMCENTROID measures the X and Y coordinates of a list of sources in a +list of images. Optionally, IMCENTROID will find the mean X and Y +shifts between the \fIimages\fR and a \fIreference\fR image, that is, +the shifts that should be added to the input image coordinates to +convert them into the reference coordinates. The task is meant to +address the class of two dimensional image registration problems in +which the images have the same pixel scale, are shifted relative to +each other by simple translations in each axis and contain enough high +signal-to-noise, point-like sources in common to form good average +positions. The basic operation of the task is to find centers for the +list of registration objects in the coordinate frame of each image and +then to subtract the corresponding centers found in the reference +image. The shifts of the objects are averaged for each image. + +The IMALIGN task is a simple script front end for IMCENTROID, IMSHIFT, +and IMCOPY (which is used to perform the trimming). Other scripts can +be constructed for similar purposes. You can type: `help imalign +option=source' to view the script. + +A list of the X and Y coordinates of the registration objects should be +provided in the parameter \fIcoords\fR. The registration objects do not +all have to be common to each frame, rather only that subset of the +objects that is contained within the bounds of a given image will be +centered. Only the objects that are common to both the given image and +the reference will be used to calculate the shifts. The coordinates +should be measured in the frame of the \fIreference\fR. If coarse +centering is to be done, which is to say, if no \fIshifts\fR file is +provided, then the first registration source should be separated from +other sources by at least the maximum expected relative shift. + +An initial estimate of the shifts between each of the \fIimages\fR and +the \fIreference\fR is required for the centering algorithm (a marginal +centroid) to work. This estimate can be explicitly supplied in a file +\fIshifts\fR (\fIXshift=Xref-Xin\fR and \fIYshift=Yref-Yin\fR) +or can be generated from the images by measuring the relative shift of +the first source listed in \fIcoords\fR for each image. This coarse +centering pass requires that the first source be detached from other +sources and from the border of each image by a distance that is at +least the maximum shift between the \fIreference\fR and an image. This +source should be point-like and have a high signal to noise ratio. The +value of the \fIbigbox\fR parameter should be chosen to include the +location of the source in each of the images to be aligned while +excluding other sources. Large values of \fIbigbox\fR should be held +suspect until the final convergence of the centering algorithm is +verified, although given a small value for the \fItolerance\fR, the +quality of the final centers is independent of the estimate for the +initial shifts. Better convergence may also be obtained by increasing +the \fIniterate\fR parameter, although the default value of three +should work for most cases. \fINiterate\fR should be kept small to +avoid runaway. + +The \fIboxsize\fR parameter controls the size of the centering box for +the fine centering pass and should be chosen so as to exclude sky +background and other sources while including the wings of the point +spread function. The sense of the shifts that are calculated is +consistent with the file supplied to the \fIshifts\fR parameter and +with that used with the IMSHIFT task. + +IMCENTROID may be used with a set of \fIimages\fR which vary in size. +This can result in vignetting of the calculated overlap region because +of the nature of tasks such as IMSHIFT to preserve the size of an input +image. To visualize this, imagine a large reference image and a single +small image to be aligned to it, both containing the same registration +object which is at the center of each image. IMCENTROID will cause the +coordinate system of the small image to be shifted such that the object +will be positioned at the same pixel location as in the reference. If +the shift is performed, a large fraction of the area of the small image +may be shifted outside of its own borders, whereas the physical overlap +of the large and small images includes ALL of the pixels of the small +image. In the case of such vignetting, IMCENTROID will print a warning +message and both the vignetted and unvignetted trim sections. Note +that the vignetting will not occur if the small image is used as the +\fIreference\fR. + +The vignetting message may also be printed if the \fIimages\fR are all +the same size but the \fIreference\fR is not included in the list. +This will occur if the sense of the measured shifts in a coordinate are +all positive or all negative since in this case the border of the +\fIreference\fR would have provided one of the limits to the trim +section. The reality of this vignetting depends on your point of view. + +Note that many of these difficulties are due to the intrinsically fuzzy +nature of the process of image registration. This all leads to a few +"rules of thumb": + +.nf + o Include the \fIreference\fR as one of the \fIimages\fR + + o Use the smallest image as the \fIreference\fR + + o Choose the \fIreference\fR such that the \fIimages\fR are + scattered to either side in the shifts in each axis + + o Align images that are the same size, OR + + o Pad dissimilar sized images with blanks to the largest size +.fi +.ih +CENTERING ALGORITHM +The algorithm is a "marginal" centroid in which the fit for each axis +is performed separately upon a vector created by collapsing the +centering box perpendicular to that axis. The centroid is calculated +with respect to the level specified by \fIbackground\fR. If +\fIbackground\fR is INDEF, the reference level for each source in each +image is the local mean for those pixels that lie between the +\fIlower\fR and \fIupper\fR thresholds. The thresholds are set to the +local data minimum or maximum if \fIlower\fR or \fIupper\fR, +respectively, are INDEF. If \fInegative\fR is yes, than the marginal +vector will be inverted before being passed to the centroid algorithm. + +The maximum number of centering iterations and the tolerance for +convergence are controlled by \fIniterate\fR and \fItolerance\fR. Note +that the tolerance is an integer value that represents the maximum +movement of the centering box between two successive iterations. The +default value of 0 requires that the centroid lie within the center +pixel of the centering box which is \fIboxsize\fR in extent (note that +\fIboxsize\fR must be an odd number). This should normally be the case +for bright, circularly symmetric point sources in images with a flat +sky background. If the registration sources are not circular symmetric +try increasing the tolerance gingerly. If the sky background is not +flat, but varies across the image, it can be removed before processing. +.ih +EXAMPLES +1. Calculate the shifts between three images using the list of +registration star coordinates in the file "x1.coords". + +.nf + pr> imcentroid x1,x2,x3 x1.coords refer=x1 +.fi + +2. Calculate the shifts between a list of images contained in the file +"imlist": + +.nf + pr> imcentroid @imlist x1.coords refer=x1 +.fi + +3. Perform the centering, don't calculate the shifts, i.e., don't +supply a reference image. Note that the \fIinput\fR list of shifts, +or a coarse centering pass are still needed: + +.nf + pr> imcentroid @imlist x1.coords +.fi +.ih +BUGS +The coarse centering portion of the algorithm can be fooled if the +first source on the list is not well separated from other sources, or +if the first source has a low signal to noise ratio, or if there is a +complicated shape to the background. +.ih +SEE ALSO +imalign, center, imshift, geomap, geotran +.endhelp diff --git a/pkg/proto/doc/imcntr.hlp b/pkg/proto/doc/imcntr.hlp new file mode 100644 index 00000000..b715fefd --- /dev/null +++ b/pkg/proto/doc/imcntr.hlp @@ -0,0 +1,61 @@ +.help imcntr Dec85 proto +.ih +NAME +imcntr -- locate the center of a stellar image +.ih +USAGE +imcntr input x_init y_init +.ih +PARAMETERS +.ls input +The list of images which contain the star to be centered. +.le +.ls x_init +The approximate column coordinate as a starting point for the centering. +.le +.ls y_init +The approximate line (row) coordinate as a starting point for the centering. +.le +.ls cboxsize = 5 +The size of the extraction box to be used during the centering process. +.le +.ih +DESCRIPTION +Given the approximate coordinates of the center of an object, (x_init, y_init), +IMCNTR will compute a more accurate center using the algorithms described in +the Kitt Peak publication "Stellar Magnitudes from Digital Images" under +the Mountain Photometry Code section. Briefly, this algorithm computes +the sum of all the rows and the sum of all the columns in the extraction +box. These are called "marginal distributions". The center in x (column +value) is then the center of gravity of the row marginal, and the center +in y is the center of gravity of the column marginal. +If the resultant x or y center value deviates from the original input +approximate starting points by more than 1 pixel, the process is repeated +once more around the new center. Only one iteration is attempted to +avoid runaway if a bright star is nearby. + +Because the centers are computed independently for x and y, the result +may be considered inferior to a true two-dimensional centering algorithm. +Nevertheless, in practice the results appear to be very usable. + +The value for the box size should be an odd value. If chosen too large, +nearby objects will affect the result. If too small, the center will be +poorly defined. +.ih +EXAMPLES +1. The following example locates the center of a star near (123, 234) +in 3 images. +.sp 1 +.nj +.nf +cl> imcntr m92red,m92blu,m92grn 123 234 +.fi +.ju +.ih +BUGS +The routine will probably fail if the desired object is within 2 or 3 pixels +of the image boundary. +.ih +SEE ALSO +pradprof +.endhelp diff --git a/pkg/proto/doc/imextensions.hlp b/pkg/proto/doc/imextensions.hlp new file mode 100644 index 00000000..d67c961f --- /dev/null +++ b/pkg/proto/doc/imextensions.hlp @@ -0,0 +1,235 @@ +.help imextensions Jul97 proto +.ih +NAME +imextensions -- make a list of image extensions +.ih +USAGE +.nf +imextensions input +.fi +.ih +PARAMETERS +.ls input +List of input files containing image extensions to be listed. This list +may not contain any image kernel but it can contain an image section. The +image filename extension, such as ".fits", is optional in the same way as +with other IRAF image tasks. +.le +.ls output = "file" (none|list|file) +Output type for the list of image extensions. The choices are: + +.nf + none - no output + list - a list as a single line + file - a list of one image extension per line +.fi + +The "none" output is used to just set the number of image extensions in the +\fInimages\fR parameter. The "list" output is used for a short list that +can be scanned into a CL variable. The "file" output is used for a long +list and to be redirected to a file for use as an "@file". If "list" +output is selected and the list length exceeds 255 characters (the +size of a CL string) the task will abort with an error. +.le +.ls index = "1-" +Extension index range list. The range list syntax is specified under the +help topic \fBranges\fR. Note that the range list may be specified that +includes 0 to select the primary image header in FITS files. +.le +.ls extname = "" +Extension name pattern. If a null string is specified then there is +no check on the extension name. If a pattern is specified then only +image extensions with an extension name matching the pattern will be +selected. The pattern syntax is described under the help topic \fImatch\fR. +.le +.ls extver = "" +Extension version range list. If a null list is specified then there is +no check on the extension version. If a list is given then only image +extensions with extension versions in the list will be selected. +The range list syntax is described under the help topic \fBranges\fR. +.le +.ls lindex = yes +List the image extensions with the extension index? If the value is +"no" then the extension index will not be listed if the extension +name and/or the extension version is listed. If there is no +extension name or extension version then the extension index is +always listed regardless of the value of this parameter. +.le +.ls lname = no +List the image extensions with the extension name if there is one? +.le +.ls lver = no +List the image extensions with the extension version if there is one? +.le +.ls ikparams = "" +Include the specified image kernel parameters in the image extension +names. The image kernel parameters are specific to the various +IRAF image formats. +.le + +.ls nimages +This is an output parameter which is set to the number of image extensions +selected in the last execution of the task. Note that if the task +is run as a background job this parameter will not be set in the +disk parameter file though it can be made available in a background +script using this task by caching the parameter set; i.e. +include the command "cache imextensions" at the beginning of the script. +.le +.ih +DESCRIPTION +\fBImextensions\fR selects and lists image extensions in files. Image +extensions currently occur in multi-extension FITS files and multi-group +Geiss (STF format) files. The image extension names are given in proper +syntax for IRAF image names for use in tasks expecting image names. +The output format type may be a one line list, a list of one image +extension name per line, or no output. These options allow capturing +the expanded list in a CL string variable, in a file for use as +an "@file", or to simply count the number of image extensions matching +the selection criteria. Note that if the "list" output type is selected +and the list of image extensions exceeds 255 characters (the limit +for a CL string) then the task aborts with an error. + +Image extensions may be selected by index value (the position in the file), +by extension name (keyword EXTNAME used in FITS image extensions), and by +extension version number (keyword EXTVER). The numeric selection uses +range lists and the extension name selection uses pattern matching. The +primary image in a multi-extension FITS file may also be selected by +including an index value of 0 in the index range list. + +The output image extension names may be given with the index value and/or +the image kernel specification. The image kernel specification, which is +image type dependent, may include the extension name, extension version, +and other kernel parameters. Note that if the image does not have an +extension name or version then the index value is always given whether or +not the \fIlindex\fR parameter is set to insure that a proper image name is +generated. + +.ih +EXAMPLES +1. Get a list of image extensions in a CL string and use it to select +header keywords. This illustrates the use of the "list" output and +a CL variable. + +.nf + cl> imext obj001 output=list | scan (s1) + cl> = s1 + obj001[1],obj001[2],obj001[3] + cl> if (imext.nimages > 0) + >>> hselect (s1, "$I,title", yes) + obj001[1] Alpha Leo + obj001[2] Beta Leo + obj001[3] Gamma Leo +.fi + +2. Do the same thing as in the first example using an "@file". + +.nf + cl> imext obj001 output=file > list.dat + cl> type list.dat + obj001[1] + obj001[2] + obj001[3] + cl> if (imext.nimages > 0) + >>> hselect @list.dat $I,title yes + obj001[1] Alpha Leo + obj001[2] Beta Leo + obj001[3] Gamma Leo +.fi + +3. Create a list selecting only the first and third extension and using the +image extension name, version, and an image kernel section. + +.nf + cl> imext obj*[1:100,1:100] index=1,3 lindex- lname+ lver+ ikparams=expand + obj001.fits[aleo,1,expand][1:100,1:100] + obj003.fits[gleo,1,expand][1:100,1:100] + obj002.fits[im1,1,expand][1:100,1:100] + obj002.fits[im3,1,expand][1:100,1:100] + cl> = imext.nimages + 4 +.fi + +4. List only the primary images in a set of multi-extension FITS files. +A primary image need not contain image data; i.e. this will select +global headers with NDIM=0 as well as headers with image data. + +.nf + cl> imext *.fits index=0 + abc.fits[0] + def.fits[0] + ghi.fits[0] +.fi + +5. Use this task in a script to test on the existence of extension name +"joy". This example shows the use of the pattern matching and of the +\fBcache\fR command to insure the script works as a background task. + +.nf + procedure example (image) + + file image {prompt="Image"} + + begin + file im + + cache imextensions + im = image + + imextensions (im, output="none", extname="joy") + if (imextensions.nimages == 0) + call printf ("No joy found with %s\n", im) + end +.fi + +Note that proper script programming would make all the hidden parameters +explicit. + + +6. Example of the extension name pattern matching. + +.nf + cl> imext obj.fits extname=joy lindex- lname+ + obj.fits[joy] + obj.fits[nojoy] + obj.fits[joyfull] + cl> imext obj.fits extname="^joy$" lindex- lname+ + obj.fits[joy] + cl> imext obj.fits extname="{joy}$" lindex- lname+ + obj.fits[joy] + obj.fits[Joy] + obj.fits[nojoy] +.fi + +The first example matches "joy" anywhere in the extension name, the +second requires an exact match with the begin and end string characters, +and the last example ignores the case and requires the name end with +joy. + +7. An example with a Geiss file. + +.nf + cl> imext y00vk102r.d0h index="x5" + y00vk102r.d0h[1] + y00vk102r.d0h[6] + y00vk102r.d0h[11] + y00vk102r.d0h[16] + y00vk102r.d0h[21] + y00vk102r.d0h[26] + y00vk102r.d0h[31] + y00vk102r.d0h[36] +.fi + +.ih +REVISIONS +.ls IMEXTENSIONS V2.11.? +Image sections are now allowed in the input names. +.le +.ls IMEXTENSIONS V2.11 +This task is new in this release. +.le +.ih +SEE ALSO +.nf +files, sections, ranges, match +.fi +.endhelp diff --git a/pkg/proto/doc/imfunction.hlp b/pkg/proto/doc/imfunction.hlp new file mode 100644 index 00000000..6b663384 --- /dev/null +++ b/pkg/proto/doc/imfunction.hlp @@ -0,0 +1,130 @@ +.help imfunction Aug91 proto +.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/proto/doc/imreplace.hlp b/pkg/proto/doc/imreplace.hlp new file mode 100644 index 00000000..444f7562 --- /dev/null +++ b/pkg/proto/doc/imreplace.hlp @@ -0,0 +1,62 @@ +.help imreplace Jul95 proto +.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 window 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 +.ih +DESCRIPTION +The pixels in the \fIimages\fR between \fIlower\fR and \fIupper\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 affects 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 +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/proto/doc/imscale.hlp b/pkg/proto/doc/imscale.hlp new file mode 100644 index 00000000..1f8a4a2a --- /dev/null +++ b/pkg/proto/doc/imscale.hlp @@ -0,0 +1,43 @@ +.help imscale Aug84 proto +.ih +NAME +imscale -- Scale an image to a specified windowed mean +.ih +USAGE +imscale input output mean +.ih +PARAMETERS +.ls input +Input image to be scaled. +.le +.ls output +Output scaled image. +.le +.ls mean +Scale the output image to this mean value. +.le +.ls lower = INDEF +Lower limit of window for calculating the input image mean. INDEF corresponds +to the minimum possible pixel value. +.le +.ls upper = INDEF +Upper limit of window for calculating the input image mean. INDEF corresponds +to the maximum possible pixel value. +.le +.ls verbose = no +Print the calculated input and output image means. +.le +.ih +DESCRIPTION +The mean of the \fIinput\fR image between the limits \fIlower\fR +and \fIupper\fR is computed. The image is then scaled to the +specified output \fImean\fR. +.ih +EXAMPLES +To scale an image to a unit mean excluding deviant points below +1000 and above 5000. + +.nf + cl> imscale calib flat 1 lower=1000 upper=5000 +.fi +.endhelp diff --git a/pkg/proto/doc/interp.hlp b/pkg/proto/doc/interp.hlp new file mode 100644 index 00000000..d6492369 --- /dev/null +++ b/pkg/proto/doc/interp.hlp @@ -0,0 +1,84 @@ +.help interp Jan85 proto +.ih +NAME +interp -- compute an interpolated value from a table of x,y pairs +.ih +USAGE +interp tbl_file +.ih +PARAMETERS +.ls tbl_file +Text file containing X,Y pairs comprising the table. +The pairs must be in either ascending or descending order. +.le +.ls curve_gen = no +If set to no, x-values are read from the file(s) specified by the parameter +"input". If set to yes, the parameters x1, x2, and dx are used to create +a list of new x,y pairs interpolated at x1, x1+dx, ... x2. +.le +.ls input = STDIN +File(s) containing x-values for the interpolation +.le +.ls int_mode = 'linear' +The interpolation mode may be either 'linear' or 'spline'. +.le +.ls x1 +The starting x-value for generating a series of new x,y pairs. +.le +.ls x2 +The ending x-value of the generated series of pairs. +.le +.ls dx +The difference by which the x-values are incremented during the +series generation. +.le +.ih +DESCRIPTION +The pairs of X,Y values are read from the tbl_file. There must be +at least 1 pair in the file. The table is then used to interpolate +or extrapolate new y-values for given x-values. The x-values may come +from a file including STDIN (if curve_gen=no), or they may be +internally generated (if curve_gen=yes) to produce a finely sampled +version of the table. This may be useful for plotting a smooth curve +through a series of points. + +The table X,Y values must be in a monotonic order, either ascending +or descending. No restriction is made on spacing. + +If only one point is present in the table, all returned interpolated +values will have the value at that point. If only two points are +present, linear interpolation (or extrapolation) will be used. +If additional points are present, an obscure but reliable algorithm +is used to interpolate (or extrapolate). + +.ih +EXAMPLES + +1. The following command reads the X,Y table from file testdata and waits for + x-values from the terminal. + +.nf + cl> interp testdata STDIN +.fi + + +2. The following command generates points to plot (by piping to graph) in the + range from x=10 to x=20 at intervals of 0.1 (10.0, 10.1 ... 19.9, 20.0). + +.nf + cl> interp testdata curve_gen=yes x1=10 x2=20 dx=.1 | graph +.fi + +3. The curve will be displayed and the original points from the table + may be overlaid by: + +.nf + cl> graph testdata pointmode=yes append=yes +.fi + +.ih +BUGS +If a blank (null) table filename is entered, a floating divide error +occurs. + +.endhelp diff --git a/pkg/proto/doc/irafil.hlp b/pkg/proto/doc/irafil.hlp new file mode 100644 index 00000000..be4f603b --- /dev/null +++ b/pkg/proto/doc/irafil.hlp @@ -0,0 +1,106 @@ +.help irafil mar86 proto +.ih +NAME +irafil -- converts a binary file containing pixel values to an IRAF image +.ih +USAGE +irafil input nrows ncols +.ih +PARAMETERS +.ls input +the input file names to be converted +.le +.ls nrows +the number of rows of data in the image +.le +.ls ncols +the number of columns of data in the image +.le +.ls bits = 16 +the number of data bits per pixel. This must be either 8 or 16 +.le +.ls signed = yes +the pixels are assumed to be signed integers if the bits parameter is 16, +and unsigned if the bits parameter is 8. If signed is set to no, then +the 16 bit pixels will be treated as unsigned integers and the resultant +image will be of type long integers. +.le +.ls tb_flip = no +This parameter allows the image to be "top-to-bottom" flipped during +conversion. +.le +.ls skip = 0 +the number of bytes to skip prior to reading pixel data. This allows +skipping of header data which is otherwise not translatable and would +be confused with the pixel data. +.le +.ih +DESCRIPTION +The specified files are read as integers and converted to IRAF images. +The specified number of header bytes will be skipped, and the specified +data format, 8 or 16 bit pixels, at the rate of ncols by nrows will be +read. Signed data or 8 bit data will be placed into images having data +type short. Unsigned 16 bit pixels will be converted into images of +type long. + +The resultant images will be assigned the same name as the input file, +but with ".i" appended to indicate IRAF format. + +The tb_flip parameter should be set to yes when converting the "snap" +format files from the Compaq image display station, or other devices +which refer to the first row as inverted from the usual IRAF notation. + +This utility is capable of converting a large number of strange +image formats to IRAF images. By skipping any initial header, and specifying +a value for ncols equal to either the row length of the image, or the +number of pixels used in the foreign internal format, almost any +16-bit format can be read. For example, FORTH pictures can be read +by skipping the initial 2048 bytes and reading the pixels assuming +a row length of 1024, even if the actual row length is shorter. There +will be garbage pixels at the end of each row which can be trimmed +with IMCOPY using picture sections. An absurd example is to read an +IRAF pixel file by skipping 1024 bytes and reading with a row length of +1024 [at least for the 800 pixel image I tried]. + +Since no byte swapping is performed, a foreign tape format must be byte swapped +if necessary prior to using IRAFIL. This may be done with REBLOCK in the +dataio package. +.ih +EXAMPLES + +1. Say you've deleted your header file to an IRAF image. The pixel file +is pix3034x. Assuming the pixels are short integers, the image is +10 rows by 800 columns: + +.nj +.nf +lo> irafil pix3034x 10 1024 skip=1024 +lo> imcopy pix3034x.i[1:800,*] phoenix +.fi +.ju + +The first line creates the IRAF image pix3034x.i which is readable +by IRAF tasks, but has 1024 pixels per row. The real image only +has 800 pixels per row, but we had to read it this way because of the +way pixels are stored in IRAF images. So we IMCOPY the good part of +the picture to the new IRAF image we call phoenix. + +2. To read the "snap" format pictures from the Compaq station: + +.nj +.nf +lo> irafil m82.snp 512 512 tb_flip+ bits=8 +.fi +.ju + +This will create the IRAF image m82.snp.i which can then be run +through CRTPICT to make a Dicomed hardcopy. +.ih +TIME REQUIREMENTS +.ih +BUGS +There is no way to explicitly specify the output image name. +.ih +SEE ALSO +binfil,imcopy,reblock +.endhelp diff --git a/pkg/proto/doc/joinlines.hlp b/pkg/proto/doc/joinlines.hlp new file mode 100644 index 00000000..90818095 --- /dev/null +++ b/pkg/proto/doc/joinlines.hlp @@ -0,0 +1,127 @@ +.help joinlines Feb90 proto +.ih +NAME +joinlines -- join input text files line by line. +.ih +USAGE +joinlines list1 [list2] +.ih +PARAMETERS +.ls list1 +List of input text files to be joined. It is an error if a file does +not exist. The special file "STDIN" may be used to read from the +terminal, redirected input, or a pipe. +.le +.ls list2 +Optional second list of input text files to be combined with the +first list. This only applies when two lists are specified on +the command line otherwise this parameter is ignored. +.le +.ls output = "STDOUT" +Output filename. The result of joining the input lines is appended +to the specified file. The special file "STDOUT" selects the standard +output stream, which is usually the terminal but which may be redirected. +.le +.ls delim = " " +The delimiter placed between joined input lines. The default is a space +(note that this will not be visible when viewed with \fBeparam\fR). +.le +.ls missing = "Missing" +This string is substituted for missing lines when going beyond the end +of shorter input files. +.le +.ls maxchars = 161 +Maximum number of characters in output lines. Longer output lines will +be truncated and a warning may be given. Note that this number always +includes the final newline character. +.le +.ls shortest = yes +Stop at the end of the shortest file? If the input files are of unequal +number of lines then this option provides for stopping at the end +of the shortest file or the end of the longest file. In the latter case +the string specified by the parameter \fImissing\fR is used for input +from the shorter files. +.le +.ls verbose = yes +Warnings are printed to the standard error stream giving the number +of lines exceeding the maximum number of output characters, the number +of lines exceeding the IRAF line length limit, and the number of files +completed in case the files are of unequal length. If verbose is no +then no warnings are printed. +.le +.ih +DESCRIPTION +The task \fBjoinlines\fR reads lines from each of the input text files and +joins them into one line separated by the specified delimiter. This is useful +for making multicolumn files from individual files. The output may +be directed to the standard output, the default, or appended to a +file. + +The list of input files may be given in either \fIlist1\fR or with +\fIlist2\fR. The second list is only used if two arguments are given +on the command line. This feature is provided for compatibility with +an earlier version of this task which only joined two files given separately. + +There is no limit to the possible number of characters per output line but +the parameter \fImaxchars\fR may be used to truncate long lines. This +can be important because many IRAF tasks read files a line at a time +with a fixed sized line buffer. Also other tasks and host programs +(for example UNIX/vi) have line limits as well. If an input line +exceeds these limits incorrect results may occur. The IRAF limit is +SZ_LINE characters (see hlib$iraf.h) and so the default for the maximum +number of output characters is set at the current value. One may +chose to go beyond this limit. + +If the input files do not all have the same number of lines then there +are two courses of action. If the \fIshortest\fR parameter is set +then the join operation is terminated with the last line from the +shortest file. If it is not set then the string from the parameter +\fImissing\fR is substituted for input from the shorter files until +the end of the longest file is reached. Note that the delimiter will +still be placed between input lines even when such lines are missing. + +There are three types of warnings which may be produced if the verbose +flag is set. These are warnings for the number of lines exceeding the +specified maximum number of characters resulting in truncated output, +the number of lines exceeding the IRAF line buffer limit, and a warning +when some input files are shorter than others. The +warnings are printed on the standard error stream so that redirection +of the standard output will still leave the warnings on the user's +terminal. To redirect the warnings one must include the standard error +stream in the redirection syntax. See the examples for how to do +this. +.ih +EXAMPLES +1. Join the two files "names" and "titles", redirecting the output into a third +file "personnel_file". + +.nf + cl> joinlines names titles > personnel_file +.fi + +2. Join a set of magnitudes given in separate files and place the +output in "allmags". Separate the columns by tabs. + +.nf + cl> joinlines mags* out=allmags delim=" " +.fi + +3. Join a set of files into long lines and redirect the error output +to a log file. Set missing lines to INDEF value. + +.nf + cl> joinlines tables* out=jointbls miss=INDEF short- ver+ >& log +.fi + +4. Join the second column from the output of a program to the previous +results. This illustrates the use of pipes. + +.nf + cl> myprog | fields STDIN 2 | joinlines last STDIN > new +.fi +.ih +BUGS +.ih +SEE ALSO +fields +.endhelp diff --git a/pkg/proto/doc/mimstat.hlp b/pkg/proto/doc/mimstat.hlp new file mode 100644 index 00000000..c6c389ea --- /dev/null +++ b/pkg/proto/doc/mimstat.hlp @@ -0,0 +1,179 @@ +.help mimstatistics Sep01 proto +.ih +NAME +mimstatistics -- compute and print image pixel statistics using iterative +rejection and masks +.ih +USAGE +imstatistics images +.ih +PARAMETERS +.ls images +The input images or image sections for which pixel statistics are to be +computed. Image sections are automatically applied to the input masks +\fIimasks\fR if input masks are not mask sections. +.le +.ls imasks = "" +The list of input masks or input mask sections associated with \fIimages\fR. +Good and bad data values are assumed to be presented by mask values of 0 and +1 respectively. The number of input masks must be 0, 1, or equal to the number +of input images. Input mask sections if present override the input image +sections. +.le +.ls omasks = "" +The list of output masks which are a combination of the input mask if any +and pixels rejected using the good data limits and / or iterative clipping. +Data used to compute the statistics are represented by 0 in the output mask, +rejected data by zero. The number of output masks must be 0 or equal to +the number of input images. +.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 in sigma used for computing the midpoint +(estimate of the median) and the mode. +.le +.ls format = yes +Label the output columns and print the results 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 if either of the midpt or mode statistics is 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 + mask - the mask 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. + +Pixels are rejected from the initial statistics computation by specifying an +input mask \fIimasks\fR or by setting the good data limits \fIlower\fR +and \fIupper\fR. Iterative rejection can be performed by setting the +clipping parameters \fInclip\fR, \fIlsigma\fR, and \fIusigma\fR. + +The input masks \fIimasks\fR can be specified in a variety of ways as +shown below. + +.nf + "" - empty mask, use all the pixels + EMPTY - empty mask, use all the pixels + !KEYWORD - use mask specified by header keyword KEYWORD + !^KEYWORD - use inverse of mask specified by header keyword KEYWORD + mask - use specified mask + ^mask - use inverse of specified mask +.fi + +In all cases the mask values are assumed to be 0 in good data regions and +non-zero in rejected data regions. The input masks may in pixel list, e.g. +".pl" format, or integer images format, e.g. ".imh", ".fits", etc. + + +.ih +EXAMPLES +1. Find the number of pixels, mean, standard deviation and the minimum +and maximum pixel value of a bias region in an image. + +.nf + cl> mimstat 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> mimstat m51 "" fields="image,mean,midpt,mode,stddev" + # IMAGE PIXELS MEAN MIDPT MODE STDDEV + M51 262144 108.3 88.75 49.4 131.3 +.fi + +3. Compute the image statistics in an image section using a mask. + +.nf + cl> mimstat m51[200:400,200:400] imasks=M51.bpm.pl + + cl> mimstat m51[200:400,200:400] imasks=M51.bpm.pl[200:400,200:400] + + cl> mimstat m51[200:400,200:400] imasks=M51.crm.pl[1:201,1:201] +.fi + +Note that the first two examples are equivalent so there is no need to +specify the input mask section in the second case. + +4. Compute the image statistics using interactive rejection and save the +rejected pixel mask. + +.nf + cl> mimstat m51 omasks=m51.rej.pl nclip=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/proto/doc/mkglbhdr.hlp b/pkg/proto/doc/mkglbhdr.hlp new file mode 100644 index 00000000..1a2415ff --- /dev/null +++ b/pkg/proto/doc/mkglbhdr.hlp @@ -0,0 +1,114 @@ +.help mkglbhdr Feb09 proto +.ih +NAME +mkgblhdr -- make a global header +.ih +USAGE +mkgblhdr input output +.ih +PARAMETERS +.ls input +List of input images. +.le +.ls output +Output global dataless image. +.le +.ls reference = "" +Optional reference image defining the allowed keywords, order, and +blank cards. If no reference image is specified the first image in +the input list serves as the reference image. +.le +.ls exclude = "" +List of keywords to be excluded from the global header even if present +in the reference header and with common values in all the input images. +The case of the keywords in the list is ignored and the are matched to +the headers in uppercase. Typically the list would be specified as an +@file; i.e. the contents of a file with keywords on separate lines. +Note that one may use the output of a header listing without editing +since only the first eight characters of each line are used. +.le +.ih +DESCRIPTION +\fBMkgblhdr\fR makes a global (dataless) header with keywords common to a +set of \fIinput\fR images. Common means present in all headers and +with identical card records (value, formatting, and comments). The +purpose of this thask is to allow appending the images using the FITS +"inherit" convention into a multi-extension file. + +The set of keywords which are allowed to appear in the global header are +those in a reference image which are not in the \fIexclude\fR list and +which have identical card records in all images. The reference image is +that specified by the \fIreference\fR parameter. If the value of that +parameter is a null string then the first image in the \fIinput\fR list +is used. The \fIreference\fR image also determines the order of the cards +including blank cards. + +The way the task works is that the header card records are read from +the reference image. Keywords in the excluded list are eliminated. +Then reference card records which are not exactly matched in the input +headers, independent of position, are eliminated. Finally any leading +blank cards are removed and consecutive blank cards are reduced to single +blank lines. + +.ih +EXAMPLES + +1. An initial multi-extension file with inherited global keywords is split +into separate images. The headers of the separate images are the union +of the global and extension headers as is the convention for inheritance. +After operating on the separate images it is desired to recreate a new +MEF without having recourse to the original global header. + +.nf + cl> type images + image1 + image2 + cl> mkglbhdr @images newimage + cl> imcopy image1 newimage[im1,append,inherit] + cl> imcopy image2 newimage[im2,append,inherit] +.fi + +To check the headers separately use the "noinherit" flag. + +.nf + cl> imhead newimage[0] l+ + cl> imhead newimage[im1,noinherit] l+ +.fi + +Note that if the global header of the original MEF is available it is +probably better to use that header instead of \fBmkglbhdr\fR as follows. + +.nf + cl> imcopy mefimage[0] newimage + cl> imcopy image1 newimage[im1,append,inherit] + cl> imcopy image2 newimage[im2,append,inherit] +.fi + +It is important to understand how inheritance works when appending extensions. +The IRAF FITS "kernel" eliminates keywords from the extension header when +they have the same value as the global header. If there are common +keywords but with different values then they are both present and any +task that read the union of the global and extension headers will see +the value from the extension. + +2. The following example uses an exclusion list. + +.nf + cl> type exclude.dat + CTYPE1 + CTYPE2 + CRVAL1 + CRVAL2 + CRPIX1 + CRPIX2 + CD1_1 + CD1_2 + CD2_1 + CD2_2 + cl> mkglbhdr @images newimage exclude="@exclude.dat" +.fi + +.ih +SEE ALSO +mscsplit, mscjoin +.endhelp diff --git a/pkg/proto/doc/mskexpr.hlp b/pkg/proto/doc/mskexpr.hlp new file mode 100644 index 00000000..9209b625 --- /dev/null +++ b/pkg/proto/doc/mskexpr.hlp @@ -0,0 +1,454 @@ +.help mskexpr Dec01 proto +.ih +NAME +mskexpr -- General mask expression evaluator +.ih +USAGE +mskexpr expr masks refimages +.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. +.le +.ls masks +The output masks. The size of the output masks defaults to the size of +the reference image if any, the size of the reference mask if any, or the +value of the dims parameter, in that order. +.le +.ls refimages +The optional list of reference images. If the reference image list is defined +there must be one reference image for every output mask. The reference image +operand name is "i" and the associated reference image keywords are +referred to as "i.<keyword>". +.le +.ls refmasks +The optional list of reference masks. If the reference mask list is defined +there must be one reference mask for every output mask. The reference mask +operand name is "m" and the associated reference image keywords are +referred to as "m.<keyword>". + +If both a reference image and reference mask are defined the reference mask will +be matched to reference image as described by the help topic \fBpmmatch\fR. +The application default is a match in "logical" coordinates which is +effectively a trim or pad operation to match the size of the reference image. +However, by use of the "pmmatch" environment variable one may match in +"physcial" or "world" coordinates. Note that the simple expression +"m" may be used to create an output mask file from the internal matching. +.le +.ls dims = "512,512" +The default output mask dimensions. The value of dims is a comma delimited +list of dimensions. +.le +.ls depth = 0 +The output mask depth in bits. The maximum depth and current default is +27. +.le +.ls exprdb = "none" +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 +.ls verbose = yes +Print task status messages ? +.le + +.ih +DESCRIPTION + +Mskexpr evaluates a mask expression \fIexpr\fR and writes the results to an +output mask \fImasks\fR image. If expr is preceded by an "@" sign then +the expression is read from the named file. The size of the output mask is +determined by the reference image \fIrefimages\fR if any, the reference masks +\fIrefmasks\fR if any, or the values of the \fIdims\fR parameter, in that +order of precedence. + +The output mask is an integer image. Therefore any mask expression must +evaluate to an integer value. The depth of the output mask in bits is defined +by the \fIdepth\fR parameter. The default value is 27 bits. + +Evaluation of the mask expression is carried out one line at a time. This +is efficient and permits operations on masks with large reference images +to be carried out efficiently without using excessive memory. The entire +expression is evaluated once per line of the output mask. + +\fBReference Images and Masks\fR + +In most cases one wants to make output masks to associate with images. +The reference image list provides a reference image which is used to +define the size and some of the header for the output mask. Note that +a reference mask may be used for this purpose if no reference image +is specified. + +Sometimes one may want to merge previous mask information into the output +mask. The reference mask can be used for this purpose using the operand +"m" in the expressions. + +When both a reference image and a reference mask are specified another +useful feature is provided. This consists of matching the reference +mask to the reference image even when the two are of different sizes or +are related not "pixel-by-pixel" but through various transformations. +The matching feature is described in the help topic \fBpmmatch\fR. +(Note that the default for matching in world coordinates results in +boolean mask values so if the actual mask values are needed the pmmatch +setting must be set appropriately.) The application default is a match +in "logical" coordinates which is effectively a trim or pad operation to +match the size of the reference image. However, by use of the "pmmatch" +environment variable one may match in "physcial" or "world" coordinates. + +This task is one way to create a matched mask for tasks that do not +do the matching. The simple expression "m" when both a reference image +and reference mask are specified will output a mask from for the reference +image that is match in logical pixel space. + +\fBOperands\fR + +Input operands are represented symbolically in the input expression. 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. + +The following operands are recognized: + +.nf + i reference image + i.itime reference image keyword + m reference mask + m.itime reference mask keyword + 1.2345 numeric constant +.fi + +Finally, there is a special builtin type of operand used to represent the +mask pixel coordinates in a mask 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" and "m". + +.nf + I x coordinate of pixel (column) + J y coordinate of pixel (line) + K z coordinate of pixel (band) +.fi + +\fBOperators\fR + +The expression syntax implemented by mskexpr 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 +.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 + + (i > -10 && i < 32000) ? 0 : 1 + +has the constant value 0 if the reference image is greater than -10 and less +than 32000, and 1 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. + +\fBRegion Functions\fR + +Mskexpr supports a group of boolean region functions which can be used to set +values inside or outside of certain geometric shapes. The routines may be +called in two ways. The first way assumes that the output masks are two- +dimensional. The second way assumes that they are multi-dimensional and +specifies which dimensions the geometric operator applies to. + +.nf + point (x1, y1) + circle (xc, yc, r) + ellipse (xc, yc, r, ratio, theta) + box (x1, y1, x2, y2) + rectangle (xc, yc, r, ratio, theta) + vector (x1, y1, x2, y2, width) + pie (xc, yc, theta1, theta2) + polygon (x1, y1, ..., xn, yn) + cols (ranges) + lines (ranges) + cannulus (xc, yc, r1, r2) + eannulus (xc, yc, r1, r2, ratio, theta) + rannulus (xc, yc, r1, r2, ratio, theta) + pannulus (width, x1, y1, ..., xn, yn) + + point (I, J, x1, y1) + circle (I, J, xc, yc, r) + ellipse (I, J, xc, yc, r, ratio, theta) + box (I, J, x1, y1, x2, y2) + rectangle (I, J, xc, yc, r, ratio, theta) + vector (I, J, x1, y1, x2, y2, width) + pie (I, J, xc, yc, theta1, theta2) + polygon (I, J, x1, y1, .., xn, yn) + cols (I, ranges) + lines (J, ranges) + cannulus (I, J, xc, yc, r1, r2) + eannulus (I, J, xc, yc, r1, r2, ratio, theta) + rannulus (I, J, xc, yc, r1, r2, ratio, theta) + pannulus (I, J, width, x1, y1, ..., xn, yn) + + xc,yc - center coordinates in pixels + r1,r2 - semi-major axis lengths in pixels + ratio - ratio of semi-minor / semi-major axes + theta[n] - position angle in degrees + x1,y1 - starting coordinates in pixels + x2,y2 - ending coordinates in pixels + x[n],y[n] - vertices of a polygon + ranges - string defining a range, e.g. "100-200,300,400-500" +.fi + +\fBOther Functions\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. 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 (arg) absolute value + max (arg, 0.0, ...) maximum value + min (arg1, arg2, ...) minimum value + mod (arg1, arg2) modulus + sqrt (arg) square root +.fi + +Mathematical or trigonometric functions + +.nf + acos (arg) arc cosine + asin (arg) arc sine + atan (arg [,arg2]) arc tangent + atan2 (arg [,arg2]) arc tangent + cos (arg) cosine + cosh (arg) hyperbolic cosine + exp (arg) exponential + log (arg) natural logarithm + log10 (arg) logarithm base 10 + sin (arg) sine + sinh (arg) hyperbolic sine + tan (arg) tangent + tanh (arg) 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 (arg) coerce to boolean + short (arg) coerce to short + int (arg) truncate to integer + nint (arg) nearest integer + long (arg) coerce to long (same as int) + real (arg) coerce to real + double (arg) coerce to double + str (arg) 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 (arg) length of a vector + hiv (arg) high value of a vector + lov (arg) low value of a vector + mean (arg [,ksigma]) mean of a vector + median (arg) median of a vector + stddev (arg [, ksigma]) standard deviation + sum (arg) 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 (arg) radians to degrees + rad (arg) degrees to radians + median (arg1, arg2, arg3, ...) vector median of 3-5 vectors + repl (arg, n) replicate + sort (arg) sort a vector + shift (arg, 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 \fImskexpr\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 MSKEXPR expression database file. + + # Constants. + SQRTOF2= 1.4142135623730950488 + PI= 3.1415926535897932385 + + # Simple bad data functions. + bdata1 (i < -100 || i > 25000) + bdata2 (i < -100 || i > 32000) + + # New regions functions. + cmpie(xc,yc,r,t1,t2) circle (xc, yc, r) && (! pie (xc, yc, t1, t2)) +.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. + + +.ih +EXAMPLES + +1. Create a 0-valued 512 x 512 mask and set all the pixels inside a circular +annulus to 1. + +.nf +cl> type expr.dat +cannulus (256., 256., 20., 40.) ? 1 : 0 +cl> mskexpr @expr.dat mask.pl "" +.fi + +2. Repeat the previous example but set all the pixels outside the circular +annulus to 1. + +.nf +cl> type expr.dat +! cannulus (256., 256., 20., 40.) ? 1 : 0 +cl> mskexpr @expr.dat mask.pl "" +.fi + +3. Create a 0-valued 512 x 512 mask and set all the pixels inside the +intersection of 2 circles to 1. + +.nf +cl> type expr.dat +circle (220., 220., 50.) && circle (240., 220., 50.) ? 1 : 0 +cl> mskexpr @expr.dat mask.pl "" +.fi + +4. Create a 0 valued mask and set all the pixels outside the good +data range 0 <= pixval <= 10000 in the reference image and outside +a circle to 1. Note that the i character defines the reference image +operand. + +.nf +cl> type expr.dat +i < 0 || i > 10000 || circle (256., 256., 50.) ? 1 : 0 +cl> mskexpr @expr.dat mask.pl dev$pix +.fi + +5. Create a 0 valued 512 x 512 mask and set all the pixels inside a circle +excluding a wedge shaped region to 1. The expression cmpie is used defined +and stored in the expression database "myexpr.db" + +.nf +cl> type myexpr.db +# Sample MSKEXPR expression database file. + +# Constants. +SQRTOF2= 1.4142135623730950488 +PI= 3.1415926535897932385 + +# Simple bad data functions. +bdata1 (i < -100 || i > 25000) +bdata2 (i < -100 || i > 32000) + +# New regions functions. +cmpie(xc,yc,r,t1,t2) circle (xc, yc, r) && (! pie (xc, yc, t1, t2)) + +cl> type expr.dat +cmpie (256., 256., 50., 0., 30.) ? 1 : 0 + +cl> mskexpr @expr.dat mask.pl "" exprdb=myexpr.db +.fi + +6. A set of dithered images have been transformed to a common world +coordinate system, stacked, and a mask created for the sources. To +create a boolean mask for one of the images from the deep source mask: + +.nf +cl> set pmmatch="world" +cl> mskexpr "m" mask1.pl exp1 refmask=stackmask +.fi + + +.ih +TIME REQUIREMENTS + +.ih +BUGS + +.ih +SEE ALSO +imexpr, mskregions, pmmatch +.endhelp diff --git a/pkg/proto/doc/mskregions.hlp b/pkg/proto/doc/mskregions.hlp new file mode 100644 index 00000000..ed397d8a --- /dev/null +++ b/pkg/proto/doc/mskregions.hlp @@ -0,0 +1,279 @@ +.help mskregions Dec01 proto +.ih +NAME +mskregions -- Create mask from a list of region specifications +.ih +USAGE +mskregions regions masks refimages +.ih +PARAMETERS +.ls regions +The list of input regions files. The number of regions files must be one or +equal to the number of output mask images. Regions files contain a list of +region specifications one region per line. The region specifications may be +a simple region description, e.g. "circle 100. 100. 50.", or a region +expression, e.g. "circle (100., 100., 50.) && circle (125., 100., 50.)". +.le +.ls masks +The output masks. The size of the output masks defaults to the size of +the reference image or the value of the dims parameter in that order of +precedence. +.le +.ls refimages +The optional list of reference images. If the reference image list is defined +there must be one reference image for every output mask. +.le +.ls dims = "512,512" +The default output mask dimensions. The value of dims is a comma delimited +list of dimensions. +.le +.ls depth = 0 +The default output mask depth in bits currently 27. +.le +.ls regnumber = "constant" +The region definition scheme. The options are: +.ls constant +Assign all the mask regions the value of \fIregval\fR. +.le +.ls number +Assign each region a sequential value beginning with \fIregval\fR. +.le +.le +.ls regval = 1 +The starting mask region value. +.le +.ls exprdb = "none" +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 +.ls append = no +Add the region list to an existing mask ? +.le +.ls verbose = yes +Print task status messages ? +.le + +.ih +DESCRIPTION + +Mskregions reads a list of region specifications from the input files +\fIregions\fR and writes the results to the output masks \fImasks\fR image. +The number of regions files must be on or equal to the number of output +masks. The size of the output mask is determined by the reference image +\fIrefimages\fR if any \fIrefmasks\fR if any or the values in the +\fIdims\fR parameter in that order of precedence. + +The output mask is an integer image. Therefore all mask values must be +integer. The mask values assigned to the regions in \fIregions\fR are +determined by the \fIregnumber\fR and \fIregval\fR parameters. By +default all new regions are assigned the value of 1. The depth of the output +mask in bits is defined by the \fIdepth\fR parameter. The default value is +27 bits. + +The input region specifications may be region descriptions or region +expressions. Region descriptions are simple definitions of common geometric +shapes. Evaluation of the regions expressions is carried out one line at a time. + +\fBRegions Definitions\fR + +The following region definitions are supported. + +.nf + point x1 y1 + circle xc yc r + ellipse xc yc r ratio theta + box x1 y1 x2 y2) + rectangle xc yc r ratio theta + vector x1 y1 x2 y2 width + pie xc yc theta1 theta2 + polygon x1 y1 ..., xn yn + cols ranges + lines ranges + cannulus xc yc r1 r2 + eannulus xc yc r1 r2 ratio theta + rannulus xc yc r1 r2 ratio theta + pannulus width x1 y1 ... xn yn +.fi + +\fBOperands Used in Region Expressions\fR + +Input operands are represented symbolically in the input expression. 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. + +There is a special builtin type of operand used to represent the +mask pixel coordinates in a mask 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" and "m". + +.nf + I x coordinate of pixel (column) + J y coordinate of pixel (line) + K z coordinate of pixel (band) +.fi + +\fBOperators Used in Region Expressions\fR + +The expression syntax implemented by mskexpr provides the following +set of operators: + +.nf + ( expr ) grouping + && logical and + || logical or + ! logical not +.fi + + +\fBFunctions Used in Region Expressions\fR + +Mskexpr supports a group of boolean region functions which can be used to set +values inside or outside of certain geometric shapes. The routines may be +called in two ways. The first way assumes that the output masks are two- +dimensional. The second way assumes that they are multi-dimensional and +specifies which dimensions the geometric operator applies to. + +.nf + point (x1, x2) + circle (xc, yc, r) + ellipse (xc, yc, r, ratio, theta) + box (x1, y1, x2, y2) + rectangle (xc, yc, r, ratio, theta) + vector (x1, y1, x2, y2, width) + pie (xc, yc, theta1, theta2) + polygon (x1, y1, ..., xn, yn) + cols (ranges) + lines (ranges) + cannulus (xc, yc, r1, r2) + eannulus (xc, yc, r1, r2, ratio, theta) + rannulus (xc, yc, r1, r2, ratio, theta) + pannulus (width, x1, y1, ..., xn, yn) + + point (I, J, x1, x2) + circle (I, J, xc, yc, r) + ellipse (I, J, xc, yc, r, ratio, theta) + box (I, J, x1, y1, x2, y2) + rectangle (I, J, xc, yc, r, ratio, theta) + vector (I, J, x1, y1, x2, y2, width) + pie (I, J, xc, yc, theta1, theta2) + polygon (I, J, x1, y1, .., xn, yn) + cols (I, ranges) + lines (J, ranges) + cannulus (I, J, xc, yc, r1, r2) + eannulus (I, J, xc, yc, r1, r2, ratio, theta) + rannulus (I, J, xc, yc, r1, r2, ratio, theta) + pannulus (I, J, width, x1, y1, ..., xn, yn) + + xc,yc - center coordinates in pixels + r1,r2 - semi-major axis lengths in pixels + ratio - ratio of semi-minor / semi-major axes + theta[n] - position angle in degrees + x1,y1 - starting coordinates in pixels + x2,y2 - ending coordinates in pixels + x[n],y[n] - vertices of a polygon + ranges - string defining a range, e.g. "100-200,300,400-500" +.fi + +\fBThe Expression Database\fR + +The \fImskexpr\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 MSKEXPR expression database file. + + # Constants. + SQRTOF2= 1.4142135623730950488 + PI= 3.1415926535897932385 + + # Simple bad data functions. + bdata1 (i < -100 || i > 25000) + bdata2 (i < -100 || i > 32000) + + # New regions functions. + cmpie(xc,yc,r,t1,t2) circle (xc, yc, r) && (! pie (xc, yc, t1, t2)) +.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. + + +.ih +EXAMPLES + +1. Create a 0-valued 512 x 512 mask and set all the pixels inside a circular +annulus to 1. + +.nf +cl> type regions.dat +cannulus 256. 256. 20. 40. +cl> mskregions regions.dat mask.pl "" +.fi + +2. Repeat the previous example but set all the pixels outside the circular +annulus to 1. Note that in this case the user must use regions expression +syntax not region definition syntax + +.nf +cl> type region.dat +! cannulus (256., 256., 20., 40.) +cl> mskregions regions.dat mask.pl "" +.fi + +3. Create a 0-valued 512 x 512 mask and set all the pixels inside the +intersection of 2 circles to 1. The & operator produces the same result +as &&. + +.nf +cl> type regions.dat +circle (220., 220., 50.) && circle (240., 220., 50.) +cl> mskexpr regions.dat mask.pl "" +.fi + +4. Create a 0 valued 512 x 512 mask and set all the pixels inside a circle +excluding a wedge shaped region to 1. The expression cmpie is used defined +and stored in the expression database "myexpr.db" + +.nf +cl> type myexpr.db +# Sample MSKEXPR expression database file. + +# Constants. +SQRTOF2= 1.4142135623730950488 +PI= 3.1415926535897932385 + +# Simple bad data functions. +bdata1 (i < -100 || i > 25000) +bdata2 (i < -100 || i > 32000) + +# New regions functions. +cmpie(xc,yc,r,t1,t2) circle (xc, yc, r) && (! pie (xc, yc, t1, t2)) + +cl> type regions.dat +cmpie (256., 256., 50., 0., 30.) ? 1 : 0 + +cl> mskregions regions.dat mask.pl "" exprdb=myexpr.db +.fi + +.ih +TIME REQUIREMENTS + +.ih +BUGS + +.ih +SEE ALSO +imexpr, mskexpr +.endhelp diff --git a/pkg/proto/doc/ringavg.hlp b/pkg/proto/doc/ringavg.hlp new file mode 100644 index 00000000..bdb4a0fd --- /dev/null +++ b/pkg/proto/doc/ringavg.hlp @@ -0,0 +1,83 @@ +.help ringavg Nov02 proto +.ih +NAME +ringavg -- compute pixel averages in concentric rings about given center +.ih +USAGE +ringavg image xc yc +.ih +PARAMETERS +.ls image +Image to be used. +.le +.ls xc, yc +Pixel coordinate for center of rings. +.le +.ls r1 = 0, r2 = 10, dr = 1 +Rings to be measured. \fIr1\fR is the inner radius of the first ring, +\fIr2\fR is the outer radius of the last bin, and \fIdr\fR is the widths +of the rings. The values are in units of pixels. +.le +.ls labels = yes +Print column labels for the output? +.le +.ls vebar = no +If \fIvebar\fR is yes then the standard deviation and standard error will +be printed as negative values for use with \fBgraph\fR. +.le +.ih +DESCRIPTION +Pixels are binned into a series of concentric rings centered on a given +position in the input image. The rings are defined by an inner radius +for the first ring, an outer radius for the last ring, and the width +of the rings. The statistics of the pixel values in each ring are then +computed and list to the standard output. The output lines consist +of the inner and outer ring radii, the number of pixels, the average value, +the standard deviation of the value (corrected for population size), and +the standard error. The parameter \fIlabel\fR selects whether to include +column labels. + +If the ring average are to be plotted with the task \fBgraph\fR using +the option to plot error bars based on the standard deviation or standard +error then the \fIvebar\fR parameter may be set to write the values as +negative values are required by that task. + +This task is a script and so users may copy it and modify it as desired. +Because it is a script it will be very slow if r2 becomes large. +.ih +EXAMPLES +1. Compute the ring averages with labels and output to the terminal. + +.nf + cl> ringavg pwimage 17 17 + # R min R max Npix Average Std Dev Std Err + 0.00 1.00 5 7.336 9.16 4.096 + 1.00 2.00 8 0.2416 0.2219 0.07844 + 2.00 3.00 16 0.3994 0.5327 0.1332 + 3.00 4.00 20 0.06211 0.05491 0.01228 + 4.00 5.00 32 0.0987 0.08469 0.01497 + 5.00 6.00 32 0.06983 0.06125 0.01083 + 6.00 7.00 36 0.0641 0.0839 0.01398 + 7.00 8.00 48 0.06731 0.05373 0.007755 + 8.00 9.00 56 0.06146 0.07601 0.01016 + 9.00 10.00 64 0.05626 0.05846 0.007308 +.fi + +2. Plot the ring averages with standard errors used for error bars. + +.nf + cl> ringavg pwimage 17 17 label- vebar+ | fields STDIN 2,4,6 | + >>> graph point+ marker=vebar +.fi + +3. Plot ring averages for galaxy in dev$pix. + +.nf + cl> ringavg dev$pix 256 256 r2=100 dr=5 label- | fields STDIN 2,4 | + >>> graph logy+ +.fi + +.ih +SEE ALSO +pradprof, psfmeasure, radprof +.endhelp diff --git a/pkg/proto/doc/rskysub.hlp b/pkg/proto/doc/rskysub.hlp new file mode 100644 index 00000000..ab6c8543 --- /dev/null +++ b/pkg/proto/doc/rskysub.hlp @@ -0,0 +1,234 @@ +.help rskysub Sep01 proto +.ih +NAME +rskysub -- sky subtract images using running mean or median +.ih +USAGE +rskysub input output +.ih +PARAMETERS +.ls input +The list of input images to be sky subtracted in time of observation order. +.le +.ls output +The list of output sky subtracted images. The number of output images must +equal the number of input images. If output is "default", "dir$default", or +"dir$" then for every input image an output image called "dir$image.sub.?" +is created, where "dir$" is the optional directory specification, "image" is +the root input image name, and "?" is the next available version number. +.le +.ls imasks = "" +The optional list of input image masks. The input image masks are assumed to +consist of 0's in good pixel regions and > 0 integer values elsewhere. The +number of input images masks must be 0, 1, or equal to the number of input +images. If imasks is "default", "dir$default", or "dir$" then for every input +image a default input image mask called "dir$image.obm.?" is searched for, +where "dir$" is the optional directory specification, "image" is the root +input image name, and "?" is the highest available version number. +.le +.ls omasks = "" +The optional list of output masks. If output masks are defined they are +used to created the sky image in place of the input masks. The output masks +are a combination of the original input mask and pixels masked during the +input image scale factor computation and consist of 0's in good data regions +and 1's elsewhere. Output masks are only computed if \fIscale\fR = "median". +The number of output masks must be 0 or equal to the number of input images. +If imasks is "default", "dir$default", or "dir$" then for every input image +an output mask image called "dir$image.skm.?" is created, where "dir$" is +the optional directory specification, "image" is the root input image name, +and "?" is the next available version number. +.le +.ls hmasks = "" +The list of output holes masks. The holes masks defined bad pixels in the +output images, i.e. those for which the underlying sky image was undefined. +Holes masks are created only if \fIhmasks\fR is defined and there is at least +1 undefined sky image pixel in the output image. Holes masks contain 0's in +undefined sky regions and 1's elsewhere. If hmasks is "default", "dir$default", +or "dir$" then for every input image an output mask image called +"dir$image.hom.?" is created, where "dir$" is the optional directory +specification, "image" is the root input image name, and "?" is the next +available version number. +.le + +.ls rescale = yes +Force recomputation of the individual input image scale factors even though +they have been previously computed and stored in the keyword \fIskyscale\fR? +.le +.ls scale = "median" +The method used to compute the individual image scale factors. The options +are: +.ls none +The individual scale factors are all set to 1.0. +.le +.ls !<keyword> +The individual scale factors are all set to the value of the input image header +keyword \fIkeyword\fR. +.le +.ls median +The individual scale factors are set to 1 / median. The medians are estimated +using the input masks \fIimasks\fR, input image section \fIstatsec\fR, +the minimum and maximum good data values \fIlower\fR and \fIupper\R, the +clipping factors \fImaxiter\fR, \fIlnsigrej\fR, and \fIunsigrej\fR and the +histogram binning parameter \fIbinwidth\fR. +.le +.ls @<file> +The individual image scale factors are read from the file \fIfile\fR. +.le +.le +.ls skyscale = "SKYSCALE" +The image header keyword containing the computed scaling factor. +\fISkyscale\fR is written to both the input and output images. +.le + +.ls statsec = "" +The input image section used to compute the individual image scaling factors. +Statsec is independent of the input image section if any. +.le +.ls lower = INDEF, upper = INDEF +The minimum and maximum input image good data values. +.le +.ls maxiter = 20 +The maximum number of clipping iterations. +.le +.ls lnsigrej = 3.0, unsigrej = 3.0 +The lower and upper side sigma clipping factors. +.le +.ls binwidth = 0.1 +The histogram bin width in sigma used in estimating the median value. +.le + +.ls resubtract = yes +Force recomputation and subtraction of the sky image even though it exists +already ? +.le +.ls combine = "average" +The method used to create the sky images. The options are "average" and +"median". +.le +.ls ncombine = 6 +The default number of images used to create the sky images. +.le +.ls nmin = 3 +The minimum number of images used to create the sky images. +.le +.ls nlorej = 0, nhirej = 0 +The number of high and low side pixels to reject if \fIcombine\fR is "average". +.le +.ls blank = 0.0 +The value assigned to undefined output image pixels, i.e. those for +which the corresponding sky image pixel is undefined. +.le +.ls skysub = "SKYSUB" +The sky subtraction processing keyword which is written to the output +image when processing is complete. +.le +.ls holes = "HOLES" +The homes mask name keyword which is written to the output image if an output +holes mask is created. +.le + +.ls cache = yes +Cache the input images in memory if possible ? +.le +.ls verbose = yes +Print messages about the progress of the task ? +.le + +.ih +DESCRIPTION + +RSKYSUB computes the average sky image for each image in the input image +list \fIinlist\fR using a running mean or median technique and subtracts +it from the input image to create the output sky subtracted images +\fIoutlist\fR. The input image list is assumed to be ordered by time of +observation. If the input image masks list \fIimasks\fR is defined then the +input image pixels in the bad pixel regions are removed from the sky statistics +and sky image computation. RSKYSUB optionally creates a list of output pixel +masks \fIomasks\fR and a list of holes masks \fIhmasks\fR. + +The input masks \fIimasks\fR can be specified in a variety of ways as +shown below. + +.nf + "" - empty mask, use all the pixels + EMPTY - empty mask, use all the pixels + !KEYWORD - use mask specified by header keyword KEYWORD + !^KEYWORD - use inverse of mask specified by header keyword KEYWORD + mask - use specified mask + ^mask - use inverse of specified mask +.fi + +In all cases the mask values are assumed to be 0 in good data regions and +non-zero in rejected data regions. The input masks may in pixel list, e.g. +".pl" format, or any supported integer image format, e.g. ".imh", ".fits", etc. + +The optional output pixel masks \fIomasks\fR are a combination of the +input image masks and the scaling factor computation masks. They consist +entirely of 0's and 1's with 0's defining the good data regions. + +The optional output holes masks \fIhmasks\fR which specify those pixels +in the output images which are undefined consist entirely of 1's and 0's +with 0's defining the holes. + +Before beginning the sky subtraction step RSKYSUB computes a scaling factor for +each individual input image in \fIinlist\fR and stores it in the input image +header keyword \fIskyscale\fR. If \fIscale\fR is "median" then the median of +the input image pixels is computed using the input image masks \fIimasks\fR, +the good data limits \fIlower\fR and \fIupper\fR, the clipping factors +\fImaxiter\fR, \fIlnsigrej\fR, and \fIunisgrej\fR, and the histogram +resolution parameter \fIbinwidth\fR. The scaling factor is set to 1 / median. +If \fIscale\fR is "none", "!<keyword>", or "@<file>" the individual +scale factors are set to 1, read from the input image header keyword +\fI<keyword>\fR, or from a file \fI@<file>\fR respectively. If \fIrescale\fR is +yes and \fIscale\fR is "median" then the scaling computation is redone +regardless of whether or not the \fIskyscale\fR keyword is present in the +input image header. + +RSKYSUB computes the sky image for each input image by multiplying each +input image by the value of its scaling factor and then computing the +combination of \fIncombine\fR neighbor images using the algorithm +specified by \fIcombine\fR. If \fIcombine\fR is average then the +\fInlorej\fR and \fInhirej\fR lowest and highest pixels are rejected from +the stack to be combined. For example if the number of input images is 25 and +ncombine is 6 then images 2-4 are used to compute the sky image for image 1, +images 10-12 and 14-16 are used to compute the sky for image 13, and images +22-24 are used to compute the sky image for image 25. There must be a minimum +of \fInmin\fR neighbor images or the sky image will not be computed. If the +input masks are defined then pixels in bad regions are also rejected +from the final sky image computation. Undefined output image pixels, +i.e. those for which the corresponding sky image pixel is undefined, are +assigned the value \fIblank\fR. The sky subtraction processing keyword +\fIskysub\fR is written to the output image when sky subtraction is complete. + +If \fIcache\fR is "yes" then RSKYSUB will attempt to buffer the active images +in memory and will run significantly faster. If \fIverbose\fR = yes then +the task prints messages about its actions as it goes along. + +.ih +EXAMPLES + +1. Sky subtract a list of 25 images without masking. + +.nf +cl> rskysub @inlist @outlist maxiter=10 lnsigrej=5.0 unsigrej=5.0 +.fi + + +2. Sky subtract the same list of 25 images with masking where the masks +are assumed to be stored in the BPM keyword. + +.nf +cl> rskysub @inlist @outlist imasks="!BPM" maxiter=10 lnsigrej=5.0 \ +unsigrej=5.0 +.fi + +.ih +TIME REQUIREMENTS + +.ih +BUGS + +.ih +SEE ALSO +imcombine, imexpr +.endhelp diff --git a/pkg/proto/doc/suntoiraf.hlp b/pkg/proto/doc/suntoiraf.hlp new file mode 100644 index 00000000..4e14ffc2 --- /dev/null +++ b/pkg/proto/doc/suntoiraf.hlp @@ -0,0 +1,226 @@ +.help suntoiraf Apr92 proto +.ih +NAME +suntoiraf -- convert Sun raster files into IRAF images +.ih +USAGE +suntoiraf input +.ih +PARAMETERS +.ls names +List of raster files to be converted. The output image names will be +the same as the individual input file names with a ".imh" appended +(assuming that you are using the Old Image Format). Rasterfiles with +an extension of `.ras', will have the extension omitted. The images will +appear in the same directory as the raster files, typically the \fBUnix\fR +login directory when the task is used within an imtool R_DISPOSE string. +.le +.ls apply_lut = yes +Apply the lookup table translation to each pixel? If \fBapply_lut\fR = +no, the pixel values will be taken directly from the raster file. If +\fBapply_lut\fR = yes, an NTSC weighted translation from the rasterfile's +color lookup table will be applied to each pixel to convert to grayscale. +.le +.ls delete = no +Delete the rasterfile after making the image? This is useful for making +automated (Unix or IRAF) scripts for producing photographic or other hardcopy. +.le +.ls verbose = yes +Print informative information while the transformation is occurring? +.le +.ls listonly = no +List the rasterfile header information instead? +.le +.ls yflip = yes +Flip the output image top to bottom? Rasterfiles are stored in reverse +vertical order from IRAF images. +.le +.ih +DESCRIPTION +\fBSuntoiraf\fR will convert Sun raster files into IRAF images. This is +useful, for example, to make \fBsolitaire\fR photographic prints or +other hardcopy from an \fBimtool\fR window (see IMTOOL HINTS, below). + +For general use, \fBsuntoiraf\fR will convert non-run-length-encoded +Sun rasterfiles into IRAF images. The output image will have the same +name as the input rasterfile, but with a `.imh' (or other IRAF image +extension) appended. If the rasterfile has an extension of `.ras', this +extension will be omitted from the image name. + +If \fBapply_lut\fR = no, the (typically 8 bit) pixel values will be +copied directly to the output with no interpretation. If \fBapply_lut\fR += yes, the NTSC equalization weighting will be applied to the RGB lookup +table to convert the color rasterfile to a grayscale image. The weights +are 0.299, 0.587, and 0.114 for the red, green, and blue LUT entries, +respectively. + +Various options are available to tailor the operation of the task to +your (or your script's) precise liking. If \fBdelete\fR = yes, the +input raster file will be removed from the disk after the image +conversion. This is useful in script applications. If \fBverbose\fR = +yes, a running commentary will be presented, otherwise the operation of +the task is silent except for error messages. If \fBlistonly\fR = yes, +the task will report information about each input rasterfile, rather +than converting it. If \fByflip\fR = yes, the storage order of the +lines of the output image will be inverted from the input rasterfile. +Since the display convention is inverted for rasterfiles relative to +IRAF images, this will result in an upright output image. On the other +hand, if \fByflip\fR = no, the storage order will be preserved at the +expense of the output orientation appearing inverted. +.ih +IMTOOL HINTS +One possible first step in making a hardcopy is to create the raster files +from the imtool window. The recommended way to do this is to select "Imcopy" +from the imtool frame menu. If the menu is popped up by positioning the +cursor on the right hand side of the window frame (and away from the edge +of the screen), the menu won't overlay the window, possibly contaminating +the hardcopy. The resulting raster file will save not only the pixels from +the imtool buffer but also the lookup table information. + +Another way to generate an imtool screendump is to use the <F7> function +key, but this requires care because of the possibility of catching cursor +fallout in the solitaire. If you do use the <F7> function key, position the +cursor to minimize its visual impact. The cursor will appear in the +hardcopy (solitaire) unless it happens to blink out at the moment that +the hardcopy is made. + +A possibly confusing choice is the "Save" option in the imtool setup menu. +This is inappropriate because no lookup table information is preserved. + +Only the portion of the frame buffer that is displayed in the window +will be snapped - what you see is what you get. + +If you have to adjust the contrast and brightness of the image very +much by using the right mouse button, you may want to redisplay the +image using a different Z1 and Z2. This will preserve the grayscale +resolution in cases in which the "effective" Z1 and Z2 are much +different than the "actual" Z1 and Z2. + +In the setup menu try: + +.nf + Show colorbar: No + Background color: black +.fi + +The choice of the background color may have an effect on any graphics +in the frame. + +If you use the \fBimttodmd\fR shell script available at NOAO/Tucson, +the pixel files for the images will be created in the IRAF directory +`tmp$', which is typically the UNIX directory `/tmp/'. If you have +trouble with this directory filling up, the pixel files may be placed +into another directory by setting the UNIX environment variable `tmp' +to the desired pathname: + +.nf + % setenv tmp '/scr1/v13/pixels/' +.fi + +*before* starting up IMTOOL (IN THE PARENT SHELL OF THE IMTOOL). +Note that if this is set when IRAF is entered, all IRAF temporary +files will end up in this directory. +.ih +EXAMPLES +These are rather specific to NOAO/Tucson, but may suggest ways that the +task may be useful to you. + +To configure imtool for one button solitaire operation: + +The Unix shell script, "/ursa/iraf/extern/nlocal/lib/imttodmd" (on +Ursa and its kin) can be used to make imtool solitaire prints. The +script may move to /usr/local/bin in the future and would thus be +available like any other unix command. Imttodmd is meant to be +called directly by the imtool. For example, place these lines in +your `.login' file: + +.nf + setenv R_RASTERFILE 'snap.%d' + setenv R_DISPOSE '/ursa/iraf/extern/nlocal/lib/imttodmd %s' +.fi + +More recent versions of imtool also allow setting these strings from +the setup panel. + +The parent shell of the imtool must have these variables defined in +its environment prior to starting imtool. If you aren't sure what +this means, the simplest thing to do is to edit these lines into +your \fB.login\fR, log off of the workstation \fBcompletely\fR, and +log back into Unix, Sunview, and IRAF. + +Pressing <F7> will send snaps directly to the solitaire queue, leaving +no intermediate files. Only the windowed portion of the frame buffer +will be snapped. The necessary files will twinkle in and out of +existence in the current working directory of the imtool, typically +your Unix login directory. Your windows will be frozen until the +solitaire is safely on its way, at which time the screen will beep. +This should take on the order of half a minute for a 512 square +imtool on a lightly loaded system. If faster response is needed, +the script may be run in the background: + +.nf + setenv R_DISPOSE '/ursa/iraf/extern/nlocal/lib/imttodmd %s &' +.fi + +Care should be taken in this case to avoid having too many +(\fBtoo many is typically more than one\fR) background job running +at once. + + +To make one-button snap files and solitaires: + +The \fBimttodmd\fR script has various options for leaving the +intermediate files around. To leave the snap images in your +directory and also make solitaires (i.e., if you are highly +suspicious by nature) set the variable: + +.nf + setenv R_DISPOSE '/ursa/iraf/extern/nlocal/lib/imttodmd -image %s' +.fi + + +To only make the images, with no solitaire output: + +.nf + setenv R_DISPOSE '/ursa/iraf/extern/nlocal/lib/imttodmd -nocrt %s' +.fi + +This will allow you to run a single CRTPICT job after collecting all +the snap files. + + +To make solitaires from an imtool window, the old way: + +Enter this from the UNIX shell, \fBbefore starting suntools\fR: + +.nf + % setenv R_RASTERFILE "frame.%d" +.fi + +Start suntools, login to iraf and load the noao, tv and local +packages. Display an image and press the <F7> function key to +create a raster file named "frame.N", where N is an index number +generated by imtool. This raster file will be appear in your +\fBUNIX\fR login directory. + +Dump the raster files to the solitaire queue: + +.nf + lo> suntoiraf frame.* + lo> crtpict frame.*.i.imh ztrans=min_max z1=5 z2=260 + (The z1 & z2 values were empirically determined.) +.fi + +*** Don't forget to clean up! *** + +.nf + lo> imdelete frame.*.i.imh + lo> delete frame.* +.fi + +The solitaires should be ready the next day in the basket by the +main computer lab. +.ih +SEE ALSO +irafil, binfil, and the UNIX man page for imtool +.endhelp diff --git a/pkg/proto/doc/text2mask.hlp b/pkg/proto/doc/text2mask.hlp new file mode 100644 index 00000000..575f611f --- /dev/null +++ b/pkg/proto/doc/text2mask.hlp @@ -0,0 +1,90 @@ +.help text2mask Jun96 proto +.ih +NAME +text2mask -- convert text description to pixel mask +.ih +USAGE +.nf +text2mask text mask ncols nlines +.fi +.ih +PARAMETERS +.ls text +Text file of pixel regions. The format of this file consists of lines of +individual pixels (whitespace separated column and line) or rectangular +regions (whitespace separated starting and ending columns and starting and +ending lines). +.le +.ls mask +Pixel mask name to be created. A pixel list image, .pl extension, +is created so no extension is necessary. +.le +.ls ncols, nlines +Dimensions for pixel mask image. +.le +.ls linterp = 1 +Mask code for rectangular regions which are narrower in the line direction +than the column direction. +.le +.ls cinterp = 2 +Mask code for rectangular regions which are narrower in the column direction +than the line direction. +.le +.ls square = 3 +Mask code for square regions which are larger than a single pixel. +.le +.ls pixel = 4 +Mask code for single pixels. +.le +.ih +DESCRIPTION +A text file describing individual pixels or rectangular regions is +converted to a pixel mask image in pixel list format. The name of +the text file, the name of the pixel mask to be created, and the +dimensions of the pixel mask image are specified. + +The text file consists of lines of two or four numbers. If two numbers +are given, separated by whitespace, they define a single pixel and +the values are the column and line pixel coordinates. If four numbers +are given, separated by whitespace, they define a rectangular region. +The four numbers are the pixel coordinates for the starting column, +the ending column, the starting line, and the ending line. This format +is the same as the old (pre-V2.11) "fixpix" format. This task may +be used to convert these old "fixpix" data files to pixel masks (as used +by the new \fBfixpix\fR task) or to create pixel masks. + +The different region shapes may be coded by the mask values. This is +useful with the \fBfixpix\fR task which can select different replacement +methods based on the mask codes. In particular, one may want to interpolate +along the narrower dimension of a rectangular region. The region +shapes that may be coded are individual pixels, square regions, and +rectangular regions with narrow dimension along lines or columns. + +In addition to this task, +pixel mask images may be made in a variety of ways. Any task which produces +and modifies image values may be used. Some useful tasks are +\fBimexpr, imreplace, imcopy,\fR and \fBmkpattern\fR. If a new image +is specified with the explicit ".pl" extension then the pixel mask +format is produced. Another way to make masks are with the +task \fBccdmask\fR. The task \fBccdmask\fR is specialized to make a mask +of bad pixels from flat fields or, even better, from the ratio of +two flat fields of different exposure levels. +.ih +EXAMPLES +1. Convert a text region description into a mask and then use it to +replace pixels by interpolation along the narrower dimension. + +.nf + cl> list2mask fp.dat mask + cl> fixpix pix mask linterp=1,3,4 cinterp=2 +.fi +.ih +REVISIONS +.ls TEXT2MASK V2.11 +This task is new and appears in conjunction with a new pixel mask +based version of \fBfixpix\fR. +.le +.ih +SEE ALSO +imreplace, imexpr, imcopy, imedit, fixpix +.endhelp diff --git a/pkg/proto/doc/wcsedit.hlp b/pkg/proto/doc/wcsedit.hlp new file mode 100644 index 00000000..e946b782 --- /dev/null +++ b/pkg/proto/doc/wcsedit.hlp @@ -0,0 +1,422 @@ +.help wcsedit Apr92 proto +.ih +NAME +wcsedit -- edit the image world coordinate system +.ih +USAGE +wcsedit image parameter value axes1 +.ih +PARAMETERS +.ls image +The list of images for which the WCS is to be edited. Image sections are +ignored. +.le +.ls parameter +The WCS parameter to be edited. The WCS parameters recognized by +WCSEDIT are: 1) the FITS WCS +parameters crpix, crval, cd and, 2) the IRAF WCS parameters ltv, ltm, wtype, +axtype, units, label, and format. Only one WCS parameter may be edited at a +time. +.le +.ls value +The new parameter value. The numerical parameters crpix, crval, cd, ltv, and +ltm will not be updated if WCSEDIT is unable to decode the parameter value +into a legal floating point number. +.le +.ls axes1 +The list of principal axes for which \fIparameter\fR is to be edited. +Axes1 can +be entered as a list of numbers separated by commas, e.g. "1,2" or as a +range, e.g. "1-2". +.le +.ls axes2 +The list of dependent axes for which \fIparameter\fR is to be edited. +Axes2 can +be entered as a list of numbers separated by commas, e.g. "1,2" or as a +range, e.g. "1-2". The axes2 parameter is only required if +\fIparameter\fR is "cd" or "ltm". +.le +.ls wcs = "world" +The WCS to be edited. The options are: the builtin systems "world" or +"physical", or a named system, e.g. "image" or "multispec". The builtin system +"logical" may not be edited. +.ls world +If \fIwcs\fR is "world" the default WCS is edited. The default WCS +is either 1) the value of the environment variable "defwcs" if +set in the user's IRAF environment (normally it is undefined) and present +in the image header, +2) the value of the "system" +attribute in the image header keyword WAT0_001 if present in the +image header or, 3) the "physical" coordinate system. +.le +.ls physical +If \fIwcs\fR is "physical", WCS is the pixel coordinate system of +the original image, which may be different from the pixel coordinate system +of the current image, if the current image is the result of an +imcopy or other geometric transformation operation. In the "physical" +coordinate system the ltv, ltm and the axis attribute +parameters wtype, axtype, units, label, and format may be edited, but the FITS +parameters crval, crpix, and cd cannot. +.le +.ls name +A user supplied wcs name. +If the named WCS does not exist in the image, a new one of that +name initialized to the identity transform, will be opened for editing, and +the old WCS will be destroyed. This option should only be used for creating +a totally new FITS WCS. +.le +.le +.ls interactive = no +Edit the WCS interactively? +.le +.ls commands = "" +The interactive editing command prompt. +.le +.ls verbose = yes +Print messages about actions taken in interactive or non-interactive mode? +.le +.ls update = yes +Update the image header in non-interactive mode? A specific command exists +to do this in interactive mode. +.le + +.ih +DESCRIPTION + +In non-interactive mode WCSEDIT replaces the current value of the WCS +parameter \fIparameter\fR with the new value \fIvalue\fR in the headers of +\fIimages\fR and prints a summary of the new WCS on the terminal. If +\fIverbose\fR is "no" the summary is not printed. If \fIverbose\fR is +"yes" and \fIupdate\fR is "no", the result of the editing operation +is printed on the terminal but the header is not modified. + +The WCS parameter \fIparameter\fR may be one of: crval, crpix, cd, ltv, ltm, +wtype, axtype, units, label, or format in either upper or lower case. +The WCS array parameters crpix, crval, ltv, wtype, axtype, units, label, +and format +may be edited for more than one axis at a time by setting \fIaxes1\fR to a +range of axes values. The WCS matrix parameters cd and ltm may be edited for +more than one axis at a time by setting both \fIaxes1\fR and \fIaxes2\fR to +a range of values. In this case, if no \fIaxes2\fR values are entered, +\fIaxes2\fR = "", the +diagonal elements of the cd and ltm matrices specified by \fIaxes1\fR are +edited. A single non-diagonal element of the cd or ltm matrices can be +edited by setting \fIaxis1\fR and \fIaxis2\fR to a single number. + +The user can create a new WCS from scratch by setting +\fIwcs\fR to a name different from the name of the WCS in the image header. +A new WCS with the same dimension as the image and initialized +to the identity transformation is presented to the user for editing. +IF THE USER UPDATES THE IMAGE HEADER AFTER EDITING THE NEW WCS, ALL +PREVIOUS WCS INFORMATION IS LOST. + +In interactive mode, WCSEDIT displays the current WCS +on the terminal if \fIverbose\fR = "yes", and prompts the user for +an editing command. The supported editing commands are shown below. + +.nf + BASIC COMMANDS + +? Print the WCSEDIT commands +show Print out the current WCS +update Quit WCSEDIT and update the image WCS +quit Quit WCSEDIT without updating the image WCS + + + PARAMETER DISPLAY AND EDITING COMMANDS + +crval [value axes1] Show/set the FITS crval parameter(s) +crpix [value axes1] Show/set the FITS crpix parameter(s) +cd [value axes1 [axes2]] Show/set the FITS cd parameter(s) +ltv [value axes1] Show/set the IRAF ltv parameter(s) +ltm [value axes1 [axes2]] Show/set the IRAF ltm parameter(s) +wtype [value axes1] Show/set the FITS/IRAF axes transform(s) +axtype [value axes1] Show/set the FITS/IRAF axis type(s) +units [value axes1] Show/set the IRAF units(s) +label [value axes1] Show/set the IRAF axes label(s) +format [value axes1] Show/set the IRAF axes coordinate format(s) +.fi + +.ih +THE WCS PARAMETERS + +Below is a list of the WCS parameters as they appear encoded in the in the +IRAF image header. Parameters marked with E can be edited directly with +WCSEDIT. Parameters marked with U should be updated automatically by WCSEDIT +if the proper conditions are met. The remaining parameters cannot be edited +with WCSEDIT. A brief description of the listed parameters is given below. +For a detailed description of the meaning of these parameters, the user +should consult the two documents listed in the REFERENCES section. + +.nf +WCSDIM WCS dimension (may differ from image) + +CTYPEn U coordinate type +CRPIXn E reference pixel +CRVALn E world coords of reference pixel +CDi_j E CD matrix + +CDELTn U CDi_i if CD matrix not used (input only) +CROTA2 U rotation angle if CD matrix not used + +LTVi E Lterm translation vector +LTMi_j E Lterm rotation matrix + +WATi_jjj U WCS attributes for axis I (wtype,axtype,units,label,format) +WAXMAPii WCS axis map +.fi + +The WCSDIM and WAXMAP parameters cannot be edited by WCSEDIT, unless a +new WCS is created in which case WCSDIM is set to +the dimension of the input image and the axis map is deleted. +The FITS parameters CRPIX, CRVAL, and CD +define the transformation between the world coordinate system and the pixel +coordinate system of the image and may be edited directly. The more general +FITS CD matrix notation supersedes the FITS CDELT/CROTA notation if both are +present on input, and is used by preference on output. The FITS parameter +CTYPE cannot be edited directly by WCSEDIT but is correctly updated on +output using the current values of the WCS parameters wtype and axtype +parameters, if there was a pre-existing FITS header in the image. On input +IRAF currently recognizes the following values of the FITS parameter CTYPE: +RA---TAN and DEC--TAN (the tangent plane sky projection), RA---SIN and +DEC--SIN (the sin sky projection), RA---ARC and DEC--ARC (the arc sky +projection), LINEAR, and MULTISPEC, from which it derives the correct values +for wtype and axtype. + +The LTV and LTM are IRAF parameters which define the transformation between +the +current image pixel coordinate system and the original pixel coordinate system, +if the current image was derived from a previous +image by a geometric transformation, e.g. IMCOPY or IMSHIFT. +Both parameters may be edited directly by WCSEDIT, but with the exception +of resetting the LTV vector to 0 and the LTM matrix to the identity +matrix it is not usually desirable to do so. The task WCSRESET can also +be used for this purpose. + +The WATi_jjj parameters are not directly accessible by WCSEDIT but the five +axis attributes which are encoded under these keywords (wtype, axtype, +units, label, and format) may be edited. +The IRAF WCS code currently +recognizes the following values for "wtype": "linear", "tan", "sin", +"arc", and "multispec". If "wtype" is not defined or cannot +be decoded by the WCS code "linear" is assumed. +Axtype should be "ra" or "dec" if wtype is one of the sky projections +"tan", "sin" or "arc", otherwise it should be undefined. +WCSEDIT will combine the values of "wtype" amd "axtype" on output to +produce the correct value of the FITS keyword CTYPE. +The "label" and "units" parameter may be set to any string constant. +Format must be set to a legal IRAF format as described in the section +below. + +.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 +REFERENCES + +Detailed documentation for the IRAF world coordinate system interface MWCS +can be found in the file "iraf$sys/mwcs/MWCS.hlp". This file can be +formatted and printed with the command "help iraf$sys/mwcs/MWCS.hlp fi+ | +lprint". Details of the FITS header world coordinate system interface can +be found in the document "World Coordinate Systems Representations Within the +FITS Format" by Hanisch and Wells, available from our anonymous ftp +archive. + +.ih +EXAMPLES + +1. Change the default output coordinate formats for an image with a defined +FITS tangent plane projection in its header, for the RA axis (axis 1), and the +DEC axis (axis 2) to %H and %h respectively. Then display the image and use +rimcursor to produce a coordinate list of objects whose coordinates are +printed as hh:mm:ss.s and dd:mm:ss.s respectively. + +.nf + cl> wcsedit image format %H 1 + cl> wcsedit image format %h 2 + cl> display image 1 + cl> rimcursor wcs=world > coordlist + ... mark the coordinates +.fi + +2. Change the default sky projection for an image with a defined tangent +plane projection to one with a sin projection. Note that wtype for both +axis1 and axis2 must be changed to "sin". Check the results first before +doing the actual update. + +.nf + cl> wcsedit image wtype sin 1-2 update- + cl> wcsedit image wtype sin 1-2 +.fi + + +3. Change the diagonal elements of the FITS cd matrix to 2.0. The off +diagonal elements are 0.0. This is equivalent to resetting the image scale. + +.nf + cl> wcsedit image cd 2.0 1-2 "" +.fi + +4. Set the value of the FITS cd matrix elements, cd[2,1] and cd[1,2] to 0.0. +This removes any rotation/skew from the WCS definition. + +.nf + cl> wcsedit image cd 0.0 2 1 + cl> wcsedit image cd 0.0 1 2 +.fi + +5. Change the FITS crval value for axis 2. + +.nf + cl> wcsedit image crval 47.85 2 +.fi + +6. Create a totally new WCS for an image, deleting the previous WCS +and set the diagonal elements of the cd matrix to 0.68. 0.68 is the +scale of the 36 inch telescope at KPNO. + +.nf + cl> wcsedit image cd 1.5 1-2 wcs="kpno9m" +.fi + +7. Interactively edit the WCS of an image. with an existing FITS header. + +.nf + cl> wcsedit image interactive+ + + ... summary of current WCS is printed on terminal + + wcsedit: ? + + ... user types in ? to see list of wcsedit commands + + wcsedit: cd 2.0 1-2 + + ... user changes the scale of the WCS + + wcsedit: format %0.3f 1-2 + + ... user changes format so the coordinates will be printed + out with 3 decimals of precision by any tasks which + can read the WCS format parameter such as rimcursor + and listpixels + + wcsedit: show + + ... user checks the new wcs + + wcsedit: update + + ... user quits editor and updates the image header +.fi + +8. Open and edit a new WCS for an image. Any pre-existing WCS will +be destroyed, assuming that the default wcs is not "newwcs". + +.nf + cl> wcsedit image wcs=newwcs intera+ + + wcsedit: .... + wcsedit: .... + + ... edit in the desired values + + wcsedit: update + + ... update the image header. +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +The IRAF WCS code supports the dimensional reduction of images, +for example creating an image with smaller dimensions than its parent, but +may not be fully compatible with FITS when this occurs. +In this case user may need to fix up an illegal or +incorrect WCS with HEDIT or HFIX bypassing the WCS code used by WCSEDIT. + +WCSEDIT does not permit the user to edit any parameters encoded in the +WATi_jjj keywords other than the five listed: wtype, axtype, units, label, +and format. For example WCSEDIT cannot be used to edit the "speci" parameters +used by the IRAF spectral reductions code "multispec" format. The spectral +reduction code itself should be used to do this, although hfix can +be used to fix a serious problem should it arise. +.ih +SEE ALSO +wcsreset,hedit,hfix +.endhelp diff --git a/pkg/proto/doc/wcsreset.hlp b/pkg/proto/doc/wcsreset.hlp new file mode 100644 index 00000000..6725aa7a --- /dev/null +++ b/pkg/proto/doc/wcsreset.hlp @@ -0,0 +1,272 @@ +.help wcsreset Apr92 proto +.ih +NAME +wcsreset -- reset the image coordinate system +.ih +USAGE +wcsreset image wcs +.ih +PARAMETERS +.ls image +The list of images for which the coordinate system is to be reset. Image +sections are ignored. +.le +.ls wcs +The name of the coordinate system to be reset. The following systems are +pre-defined: +.ls physical +Reset the physical coordinate system to the logical coordinate system, but +leave the default world coordinate system unchanged. This operation removes +the history of past image operations such as imcopy, imshift, magnify, etc +from the definition of the physical coordinate system, but not from the +definition of the world coordinate system. +.le +.ls world +Reset the default world coordinate system to the logical coordinate system. +This operation removes all world coordinate system information from the +image header. +.le + +In addition to these two reserved world coordinate systems, the name of any +other defined world coordinate system, for example "multispec" may be given. +In this case WCSRESET resets the named coordinate system to the logical +coordinate system only if it is present in the image header. +.le +.ls verbose = yes +Print messages about actions taken by the task? +.le +.ih +DESCRIPTION + +WCSRESET resets the coordinate system \fIwcs\fR in the images specified by +\fIimage\fR to the logical coordinate system, and prints messages about the +actions taken if \fIverbose\fR = "yes". Since WCSRESET modifies the +image headers it should be used with caution. + +Logical coordinates are coordinates relative to the current image. The +logical coordinate system is the one used by the image input/output routines +to access the image on disk. In an image raster logical coordinate system, +the coordinates of the pixel centers must lie within the following +range: 1.0 <= x[i] <= nx[i], where x[i] is the coordinate in dimension i, +nx[i] is the size of the image in dimension i, and the current maximum +number of image dimensions is 7. In the case of an image section of an image +raster, the nx[i] refer to the dimensions of the section, not the dimensions +of the full image. The logical coordinate system cannot by definition be +reset. + +The physical coordinate system is the coordinate system in which the +coordinates of an object are invariant to successive linear transformations +of the image. In this coordinate system, the pixel coordinates of an object +in an image raster remain the same, regardless of any imcopy, imshift, +rotate, etc operations on the image. The most common reason for desiring to +reset the physical coordinate system to the logical coordinate system is to +make the new image independent of its history by removing the effects of +these linear transformation operations from its physical coordinate system. +Resetting the physical coordinate system to the logical coordinate system, +does not alter the default world coordinate system. If for example the input +image is a spectrum, with a defined dispersion solution, resetting the +physical coordinate system will not alter the dispersion solution. +Similarly if the input image is a direct CCD image with a defined sky +projection world coordinate system, resetting the physical coordinate system +will not alter the sky projection. + +The world coordinate system is the default coordinate system for the +image. The default world coordinate system is the one named by the +environment variable "defwcs" if defined in the user environment (initially +it is undefined) and present in the image header; else it is the first +world coordinate system +defined for the image (the .imh and .hhh image format support only one wcs +but the .qp format can support more); else it is the physical coordinate +system. Resetting the default coordinate system to the logical +coordinate system will destroy all coordinate information for that system, +for that image. + +If the user sets the parameter wcs to a specific system, for example +to "multispec", only images with the coordinate system "multispec" +will have their coordinate system reset. + +.ih +REFERENCES + +Detailed documentation for the IRAF world coordinate system interface MWCS +can be found in the file "iraf$sys/mwcs/MWCS.hlp". This file can be +formatted and printed with the command "help iraf$sys/mwcs/MWCS.hlp fi+ | +lprint". Details of the FITS header world coordinate system interface can +be found in the document "World Coordinate Systems Representations Within the +FITS Format" by Hanisch and Wells, available from our anonymous ftp +archive. + +.ih +EXAMPLES + +1. The user runs implot on a section of the spectrum outspec with the +wcs parameter set to "physical". + +.nf + implot outsec[30:50] wcs=physical +.fi + +To his/her surprise the range of the plot in x produced by implot is +[129,149] not [30:50] as expected. The user lists the image header with the +imheader task and sees the following. + +.nf + WCSDIM = 1 + CTYPE1 = 'LINEAR ' + CRVAL1 = 4953.94775390626 + CRPIX1 = -98. + CDELT1 = 0.0714096948504449 + CD1_1 = 0.0714096948504449 + WAT0_001= 'system=linear + WAT1_001= 'wtype=linear label=Wavelength units=Angstroms + LTV1 = -99. + LTM1_1 = 1. +.fi + +The standard FITS keywords CTYPE1, CRVAL1, CRPIX1, and CDELT1 are present. +The CD1_1 keyword is part of the new FITS CD matrix notation and in this +example duplicates the function of CDELT1. The remaining keywords WCSDIM, +WAT0_001, WAT1_001, LTV1, and LTM1_1 are IRAF specific keywords. The +user notes that the LTV1 keyword is -99. not 0. and suddenly remembers that +outspec was created by extracting a piece of a larger spectrum using the +imcopy task as shown below. + +.nf + cl> imcopy inspec[100:200] outspec +.fi + +The section [30:50] in outspec actually corresponds to the section [129:149] +in inspec and it is this coordinate system that implot is plotting when +wcs = "physical". The user decides has he/she does not want to know +about the pixel coordinate system of the original image and runs wcsreset +to reset the physical coordinate system to the logical coordinate system. + +.nf + wcsreset outspec physical +.fi + +The new header of outspec looks like the following. + +.nf + WCSDIM = 1 + CTYPE1 = 'LINEAR ' + CRVAL1 = 4953.94775390626 + CRPIX1 = -98. + CDELT1 = 0.0714096948504449 + CD1_1 = 0.0714096948504449 + WAT0_001= 'system=linear + WAT1_001= 'wtype=linear label=Wavelength units=Angstroms + LTM1_1 = 1. +.fi + +It is identical to the header listed above except that the +LTV1 keyword is not defined and is therefore 0. The user runs +implot with wcs = "physical" as before and sees a plot which extends +from 30 to 50 as expected. + +2. Reset the physical coordinate system of the direct CCD image skypix +which has a defined sky projection system. Skypix was created by +copying the central [129:384,129:384] of a 512 square image into a 256 +square image. + +The image header is the following. + +.nf + CRPIX1 = 129.75 + CRPIX2 = 130.93 + CRVAL1 = 201.94541667302 + CRVAL2 = 47.45444 + CTYPE1 = 'RA---TAN' + CTYPE2 = 'DEC--TAN' + CDELT1 = -2.1277777E-4 + CDELT2 = 2.1277777E-4 + WCSDIM = 2 + CD1_1 = -2.1277777000000E-4 + CD2_2 = 2.12777770000000E-4 + LTV1 = -128. + LTV2 = -128. + LTM1_1 = 1. + LTM2_2 = 1. + WAT0_001= 'system=image + WAT1_001= 'wtype=tan axtype=ra + WAT2_001= 'wtype=tan axtype=dec +.fi + +The user runs implot on skypix wcs = "physical" + +.nf + implot skypix wcs=physical +.fi + +and sees a plot in x which extends from 129 to 384 which are the coordinates +of skypix in the original image. +The user resets the physical coordinate system to the logical coordinate +system. + +.nf + cl> wcsreset m51 physical +.fi + +The new header looks like the following. Note that the LTV1 and LTV2 keywords +have disappeared, they are 0. but everything else is the same. + +.nf + CRPIX1 = 129.75 + CRPIX2 = 130.93 + CRVAL1 = 201.94541667302 + CRVAL2 = 47.45444 + CTYPE1 = 'RA---TAN' + CTYPE2 = 'DEC--TAN' + CDELT1 = -2.1277777E-4 + CDELT2 = 2.1277777E-4 + WCSDIM = 2 + CD1_1 = -2.1277777000000E-4 + CD2_2 = 2.12777770000000E-4 + LTM1_1 = 1. + LTM2_2 = 1. + WAT0_001= 'system=image + WAT1_001= 'wtype=tan axtype=ra + WAT2_001= 'wtype=tan axtype=dec +.fi + +When the user runs implot with wcs = "physical" he/she sees a plot which +extends from 1 to 256 as expected. + +3. Initialize the world coordinate system of the previous image. + +.nf + cl> wcsreset skypix world +.fi + +The header now looks like the following. + +.nf + WCSDIM = 2 + LTM1_1 = 1. + LTM2_2 = 1. + WAT0_001= 'system=physical + WAT1_001= 'wtype=linear + WAT2_001= 'wtype=linear +.fi + +The world system defaults to the physical coordinates system and the +physical coordinate system is identical to the logical coordinate system. +All coordinate information has been destroyed. + +4. Initialize the world coordinate system "spec1". If the default world +coordinate +system "spec1" cannot be found in the image header a warning message +will be issued and nothing will be changed. + +.nf + cl> wcsreset spectrum spec1 +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +rimcursor,listpixels,wcsedit,hedit,hfix +.endhelp diff --git a/pkg/proto/epix.par b/pkg/proto/epix.par new file mode 100644 index 00000000..a0180af7 --- /dev/null +++ b/pkg/proto/epix.par @@ -0,0 +1,8 @@ +image_name,s,a,,,,"image to be edited" +xcoord,i,a,,,,"x coordinate of pixel to be edited" +ycoord,i,a,,,,"y coordinate of pixel to be edited" +new_value,r,a,,,,"new value for pixel" +boxsize,i,h,3,,,"size of subraster surrounding pixel" +ksigma,r,h,2.5,,,"pixel rejection threshold" +edit_image,b,h,yes,,,"edit the image" +verbose,b,h,yes,,,"print subraster and median value" diff --git a/pkg/proto/epix.x b/pkg/proto/epix.x new file mode 100644 index 00000000..6a61d224 --- /dev/null +++ b/pkg/proto/epix.x @@ -0,0 +1,110 @@ +include <imhdr.h> + +# EPIX -- Edit the value of a pixel in a two dimensional array. Fetch +# subraster surrouding pixel, print on standard output. Compute median +# value and set default value of new pixel value parameter, then prompt +# for actual value and edit image. + +procedure t_epix() + +char image_name[SZ_FNAME] +int xcoord, ycoord +int x1, x2, y1, y2, m, n +int npix, ncols, nlines, boxsize, half_size, sample_size +real median_value, ksigma, mean, sigma +pointer ahdr, a + +bool clgetb() +int clgeti(), aravr() +real clgetr() +pointer immap(), imgs2r(), imps2r() + +begin + # Get image name and map image. + call clgstr ("image_name", image_name, SZ_FNAME) + ahdr = immap (image_name, READ_WRITE, 0) + + ncols = IM_LEN(ahdr,1) + nlines = IM_LEN(ahdr,2) + + # Get pixel coordinates, size of subraster. + + xcoord = clgeti ("xcoord") + ycoord = clgeti ("ycoord") + boxsize = clgeti ("boxsize") + ksigma = clgetr ("ksigma") + + # Fetch subraster surrounding pixel. + + half_size = max (1, boxsize / 2) + x1 = max (1, xcoord - half_size) + x2 = min (ncols, xcoord + half_size) + y1 = max (1, ycoord - half_size) + y2 = min (nlines, ycoord + half_size) + + a = imgs2r (ahdr, x1, x2, y1, y2) + + # Print subraster on standard output. + + if (clgetb ("verbose")) { + m = x2 - x1 + 1 + n = y2 - y1 + 1 + call print_subraster (Memr[a], m, n, x1, x2, y1, y2) + + # Compute and print the median pixel value, and the mean value + # excluding the central pixel. + + npix = m * n + call asrtr (Memr[a], Memr[a], npix) + median_value = Memr[a + (npix+1)/2 - 1] + sample_size = aravr (Memr[a], npix, mean, sigma, ksigma) + + call printf ("median %g, mean %g, sigma %g, sample %d pixels\n") + call pargr (median_value) + call pargr (mean) + call pargr (sigma) + call pargi (sample_size) + } + + if (clgetb ("edit_image")) { + # Edit the image. + a = imps2r (ahdr, xcoord, xcoord, ycoord, ycoord) + Memr[a] = clgetr ("new_value") + } + + call imunmap (ahdr) +end + + +# PRINT_SUBRASTER -- Print the values of the pixels in a subraster on the +# standard output. + +procedure print_subraster (a, m, n, x1, x2, y1, y2) + +real a[m,n] +int m, n +int x1, x2, y1, y2 +int column, line + +begin + # Print column labels. + + call printf ("%7w") + do column = x1, x2 { + call printf ("%8d ") + call pargi (column) + } + call printf ("\n") + + # Print line labels and pixel values. + + do line = y1, y2 { + call printf ("%8d ") + call pargi (line) + do column = x1, x2 { + call printf ("%8.6g ") + call pargr (a[column-x1+1, line-y1+1]) + } + call printf ("\n") + } +end diff --git a/pkg/proto/fields.par b/pkg/proto/fields.par new file mode 100644 index 00000000..57ff72e5 --- /dev/null +++ b/pkg/proto/fields.par @@ -0,0 +1,5 @@ +files,s,a,,,,Files from which to extract fields +fields,s,q,,,,Fields to extract +lines,s,h,"1-",,,Lines from which to extract fields +quit_if_missing,b,h,no,,,Quit on missing field? +print_file_names,b,h,no,,,Print file names if multiple files? diff --git a/pkg/proto/fields.x b/pkg/proto/fields.x new file mode 100644 index 00000000..df700626 --- /dev/null +++ b/pkg/proto/fields.x @@ -0,0 +1,316 @@ +include <ctype.h> + +define MAX_RANGES 100 +define MAX_FIELDS 100 +define MAX_LINES 10000 +define LEN_WS 3 + +# FIELDS -- Extract whitespace delimited fields from specified lines of +# an input list. A new list consisting of the extracted fields is output. +# Which lines and fields to extract is specified by the user. + +procedure t_fields () + +pointer sp, f_str, l_str, fin +bool quit, name +int list, fields[MAX_FIELDS], lines[3, MAX_LINES], nfields, nlines +int ranges[3,MAX_RANGES], nranges + +bool clgetb() +int decode_ranges(), fi_decode_ranges(), clpopni(), clgfil() + +begin + # Allocate space on stack for char buffers + call smark (sp) + call salloc (f_str, SZ_LINE, TY_CHAR) + call salloc (l_str, SZ_LINE, TY_CHAR) + call salloc (fin, SZ_LINE, TY_CHAR) + + # Open template of input files + list = clpopni ("files") + + # Get boolean parameters + quit = clgetb ("quit_if_missing") + name = clgetb ("print_file_names") + + # Get the lines and fields to be extracted. Decode ranges. + call clgstr ("fields", Memc[f_str], SZ_LINE) + call clgstr ("lines", Memc[l_str], SZ_LINE) + + # Don't impose ordering on field specification + if (fi_decode_ranges (Memc[f_str], ranges, MAX_RANGES, 1, + MAX_FIELDS, nranges) == ERR) { + call error (0, "Error in field specification") + } else + call fi_xpand (ranges, fields, nfields) + + # Lines range will be accessed in ascending order + if (decode_ranges (Memc[l_str], lines, MAX_LINES, nlines) == ERR) + call error (0, "Error in line specification") + + # While list of input files is not depleted, extract fields + while (clgfil (list, Memc[fin], SZ_FNAME) != EOF) + call fi_xtract (Memc[fin], lines, fields, nfields, quit, name) + + call clpcls (list) + call sfree (sp) +end + + +# FI_XPAND -- expands the output from decode_ranges into an array. +# The output array contains the ordinal of each element in the range; +# no ordering is imposed. + +procedure fi_xpand (ranges, out, num) + +int ranges[3*MAX_RANGES] # Input ranges array +int out[MAX_LINES] # Output unordered list +int num # Number of entries in output list + +int ip, number +int first, last, step + +begin + + num = 0 + for (ip=1; ranges[ip] != NULL; ip=ip+3) { + first = ranges[ip] + last = ranges[ip+1] + step = ranges[ip+2] + + if (first == last) { + num = num + 1 + out[num] = first + next + } + + if (first > last) + step = -1 * step + do number = first, last, step { + num = num + 1 + out[num] = number + } + } +end + + +# FI_DECODE_RANGES -- Parse a string containing a list of integer numbers or +# ranges, delimited by either spaces or commas. Return as output a list +# of ranges defining a list of numbers, and the count of list numbers. +# Range limits must be positive nonnegative integers. ERR is returned as +# the function value if a conversion error occurs. The list of ranges is +# delimited by a single NULL. + +int procedure fi_decode_ranges (range_string, ranges, max_ranges, minimum, + maximum, nvalues) + +char range_string[SZ_LINE] # Range string to be decoded +int ranges[3, max_ranges] # Range array +int max_ranges # Maximum number of ranges +int minimum, maximum # Minimum and maximum range values allowed +int nvalues # The number of values in the ranges + +int ip, nrange, a, b, first, last, step, ctoi() + +begin + ip = 1 + nrange = 1 + nvalues = 0 + + while (nrange < max_ranges) { + # Default values + a = minimum + b = maximum + step = 1 + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get first limit. + # Must be a number, '-', 'x', or EOS. If not return ERR. + if (range_string[ip] == EOS) { # end of list + if (nrange == 1) { + # Null string defaults + ranges[1, 1] = a + ranges[2, 1] = b + ranges[3, 1] = step + ranges[1, 2] = NULL + nvalues = (b - a) / step + 1 + return (OK) + } else { + ranges[1, nrange] = NULL + return (OK) + } + } else if (range_string[ip] == '-') + ; + else if (range_string[ip] == 'x') + ; + else if (IS_DIGIT(range_string[ip])) { # ,n.. + if (ctoi (range_string, ip, a) == 0) + return (ERR) + } else + return (ERR) + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get last limit + # Must be '-', or 'x' otherwise b = a. + if (range_string[ip] == 'x') + ; + else if (range_string[ip] == '-') { + ip = ip + 1 + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + if (range_string[ip] == EOS) + ; + else if (IS_DIGIT(range_string[ip])) { + if (ctoi (range_string, ip, b) == 0) + return (ERR) + } else if (range_string[ip] == 'x') + ; + else + return (ERR) + } else + b = a + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get step. + # Must be 'x' or assume default step. + if (range_string[ip] == 'x') { + ip = ip + 1 + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + if (range_string[ip] == EOS) + ; + else if (IS_DIGIT(range_string[ip])) { + if (ctoi (range_string, ip, step) == 0) + ; + } else if (range_string[ip] == '-') + ; + else + return (ERR) + } + + # Output the range triple. + first = a + last = b + ranges[1, nrange] = first + ranges[2, nrange] = last + ranges[3, nrange] = step + nvalues = nvalues + abs (last - first) / step + 1 + nrange = nrange + 1 + } + + return (ERR) # ran out of space +end + + +# FI_XTRACT -- filter out lines from which fields are to be extracted. +# Called once per input file, FI_XTRACT calls FI_PRECORD to process +# each extracted line. + +procedure fi_xtract (in_fname, lines, fields, nfields, quit, name) + +char in_fname[SZ_FNAME] # Input file name +int lines[3,MAX_LINES] # Ranges of lines to be extracted +int fields[MAX_FIELDS] # Fields to be extracted +int nfields # Number of fields to extract +bool quit # Quit if missing field (y/n)? +bool name # Print file name in each line (y/n)? + +pointer sp, lbuf +int in, in_line + +bool is_in_range() +int open(), getlongline() +errchk salloc, open, getlongline, fi_precord + +begin + # Allocate space for line buffer + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + # Open input file + in = open (in_fname, READ_ONLY, TEXT_FILE) + + # Position to specified input line + in_line = 0 + repeat { + repeat { + if (getlongline (in, Memc[lbuf], SZ_LINE, in_line) == EOF) { + call close (in) + call sfree (sp) + return + } + } until (is_in_range (lines, in_line)) + + call fi_precord (in_fname, Memc[lbuf], fields, nfields, quit, name) + } + + call close (in) + call sfree (sp) +end + + +# FI_PRECORD -- extract and output a record of fields. + +procedure fi_precord (in_fname, linebuf, fields, nfields, quit, name) + +char in_fname[SZ_FNAME] # Name of input file +int linebuf[SZ_LINE] # Line containing fields +int fields[MAX_FIELDS] # List of fields to extract +int nfields # Number of fields to extract +bool quit # Quit if missing field (y/n)? +bool name # Print name in output line (y/n)? + +char word[SZ_LINE], white_space[LEN_WS] +int ip, in_field, out_field, i + +int ctowrd() +errchk ctowrd + +begin + # Fill white space array to be used a field delimeter + do i = 1, LEN_WS + call strcpy (" ", white_space[i], 1) + + # Print file name as first field of output list? + if (name) { + call printf ("%s%s") + call pargstr (in_fname) + call pargstr (white_space) + } + + # Position to specific field + for (i=1; i <= nfields; i=i+1) { + out_field = fields[i] + in_field = 0 + ip = 1 + + repeat { + if (ctowrd (linebuf, ip, word, SZ_LINE) == 0) { + if (quit) { + call eprintf ("Missing field in input. FILE: %s\n") + call pargstr (in_fname) + call error (0, "Missing field") + } else { + call printf ("\n") + return + } + } else + in_field = in_field + 1 + } until (in_field == out_field) + + call printf ("%s%s") + call pargstr (word) + call pargstr (white_space) + } + + call printf ("\n") +end diff --git a/pkg/proto/fixpix.par b/pkg/proto/fixpix.par new file mode 100644 index 00000000..699460b1 --- /dev/null +++ b/pkg/proto/fixpix.par @@ -0,0 +1,6 @@ +images,s,a,,,,List of images to be fixed +masks,s,a,,,,List of bad pixel masks +linterp,s,h,"INDEF",,,Mask values for line interpolation +cinterp,s,h,"INDEF",,,Mask values for column interpolation +verbose,b,h,no,,,Verbose output? +pixels,b,h,no,,,List pixels? diff --git a/pkg/proto/hfix.par b/pkg/proto/hfix.par new file mode 100644 index 00000000..8fe65939 --- /dev/null +++ b/pkg/proto/hfix.par @@ -0,0 +1,3 @@ +images,f,a,"",,,"List of images to be fixed" +command,s,h,"edit $fname",,,"User command to be applied" +update,b,h,yes,,,"Update image header?" diff --git a/pkg/proto/imcntr.par b/pkg/proto/imcntr.par new file mode 100644 index 00000000..ee143553 --- /dev/null +++ b/pkg/proto/imcntr.par @@ -0,0 +1,4 @@ +input,s,a,,,,Image names +x_init,r,a,,,,Approx x position of star +y_init,r,a,,,,Approx y position of star +cboxsize,i,h,5,3,,Size of extraction box diff --git a/pkg/proto/imextensions.par b/pkg/proto/imextensions.par new file mode 100644 index 00000000..ac9e4834 --- /dev/null +++ b/pkg/proto/imextensions.par @@ -0,0 +1,12 @@ +input,s,a,,,,List of input files +output,s,h,"file","none|list|file",,Output type +index,s,h,"1-",,,Extension index range list +extname,s,h,"",,,Extension name pattern +extver,s,h,"",,,Extension version range list +lindex,b,h,"yes",,,List with index? +lname,b,h,"no",,,List with extension name? +lver,b,h,"no",,,List with extension version? +ikparams,s,h,"",,,"Image kernel parameters + +# Output parameter" +nimages,i,h,,,,Number of images in list diff --git a/pkg/proto/imscale.par b/pkg/proto/imscale.par new file mode 100644 index 00000000..cd14b62b --- /dev/null +++ b/pkg/proto/imscale.par @@ -0,0 +1,8 @@ +# Parameter file for imscale. + +input,f,a,,,,Input image +output,f,a,,,,Output image +mean,r,a,1.,,,Mean of output image +lower,r,h,INDEF,,,Lower limit for calculating mean +upper,r,h,INDEF,,,Upper limit for calculating mean +verbose,b,h,no,,,Verbose output? diff --git a/pkg/proto/interp.par b/pkg/proto/interp.par new file mode 100644 index 00000000..09991eec --- /dev/null +++ b/pkg/proto/interp.par @@ -0,0 +1,7 @@ +tbl_file,f,a,,,,File containing table of x-y pairs +input,f,a,STDIN,,,input for x-interpolant values +int_mode,s,h,spline,,,Use linear or spline interpolator +curve_gen,b,h,no,,,Generate a curve between specified limits +x1,r,a,,,,First point in range of generated curve +x2,r,a,,,,Last point in range of generated curve +dx,r,a,,,,Interval between generated points diff --git a/pkg/proto/interp.x b/pkg/proto/interp.x new file mode 100644 index 00000000..026c1c66 --- /dev/null +++ b/pkg/proto/interp.x @@ -0,0 +1,132 @@ +include <fset.h> + +define SZ_TABLE 4096 +define LINEAR 1 +define SPLINE 2 + + +# T_INTERP -- Interpolate for values in a table +# +# A table of x,y pairs contained in a file is used to +# find interpolated values, y, for any other given independent +# variable, x. Extrapolation is performed if necessary. +# +# A series of values may be generated to generate a fine grid +# through a coarse sampling for purposes of plotting. This is +# done by setting the hidden parameter curve_gen to yes. +# The starting point, ending point, and sampling interval +# are also needed in this case (x1, x2, dx). +# +# If only a small number of values are needed to be interpolated +# from the table, the user may enter a number of x's from either +# a file or STDIN. + + +procedure t_interp() + +double x, y, x1, x2, dx +pointer xtab, ytab +int npts, ierr, tbsize +int filelist, tbl, in, imode +char fname[SZ_FNAME], tbl_file[SZ_FNAME], mode[SZ_FNAME] +bool gen + +int clpopni(), clgfil(), open(), fscan(), strncmp(), nscan() +real clgetr() +bool clgetb() + +begin + # Initialize interpolator + call intrp0 (1) + + # File containing x,y pairs in a table + call clgstr ("tbl_file", tbl_file, SZ_FNAME) + + # Open table file and read as many points as possible + tbl = open (tbl_file, READ_ONLY, TEXT_FILE) + + npts = 0 + + # Allocate the initial arrays. + call calloc (xtab, SZ_TABLE, TY_DOUBLE) + call calloc (ytab, SZ_TABLE, TY_DOUBLE) + tbsize = SZ_TABLE + + while (fscan(tbl) != EOF) { + npts = npts + 1 + if (npts > tbsize) { + call realloc (xtab, (tbsize+SZ_TABLE), TY_DOUBLE) + call realloc (ytab, (tbsize+SZ_TABLE), TY_DOUBLE) + tbsize = tbsize + SZ_TABLE + } + call gargd (Memd[xtab+npts-1]) + call gargd (Memd[ytab+npts-1]) + if (nscan() < 2) { + call eprintf ("Error reading x,y pairs\n") + npts = npts - 1 + } + } + + call close (tbl) + + if (npts < 1) + call error (1, "Table has no entries.") + + # Linear or spline interpolator? + call clgstr ("int_mode", mode, SZ_FNAME) + if (strncmp (mode, "linear", 6) == 0) + imode = LINEAR + else + imode = SPLINE + + # Generate a curve? + gen = clgetb ("curve_gen") + if (gen) { + x1 = double(clgetr ("x1")) + x2 = double(clgetr ("x2")) + dx = double(clgetr ("dx")) + + # Verify that dx will not cause an infinite loop + if (dx == 0.0 || dx * (x2-x1) < 0.0) + call error (1, "Interval paramater dx implies infinite loop.") + + for (x=x1; x <= x2; x = x+dx) { + call intrp (1, Memd[xtab], Memd[ytab], npts, x, y, ierr) + call printf ("%12.5g %12.5g\n") + call pargd (x) + call pargd (y) + } + + # No, just one point at a time + } else { + + # Open input list + filelist = clpopni ("input") + + while (clgfil (filelist, fname, SZ_FNAME) != EOF) { + call fseti (STDOUT, F_FLUSHNL, YES) + in = open (fname, READ_ONLY, TEXT_FILE) + + # Process input requests + while (fscan(in) != EOF) { + call gargd (x) + if (imode == LINEAR) + call lintrp (1, Memd[xtab], Memd[ytab], npts, x,y, ierr) + else + call intrp (1, Memd[xtab], Memd[ytab], npts, x,y, ierr) + + call printf ("%12.5g %12.5g\n") + call pargd (x) + call pargd (y) + } + + call close (in) + } + + call clpcls (filelist) + } + + # Free the pointers. + call mfree (xtab, TY_DOUBLE) + call mfree (ytab, TY_DOUBLE) +end diff --git a/pkg/proto/intrp.f b/pkg/proto/intrp.f new file mode 100644 index 00000000..0b3b6abf --- /dev/null +++ b/pkg/proto/intrp.f @@ -0,0 +1,313 @@ + subroutine intrp (itab, xtab, ytab, ntab, x, y, ierr) +c +c Interpolator using CODIM1 algorithm which is admittedly +c obscure but works well. +c +c itab - a label between 1 and 20 to identify the table and its +c most recent search index +c xtab - array of length ntab containing the x-values +c ytab - y-values +c ntab - number of x,y pairs in the table +c x - independent for which a y-value is desired +c y - returned interpolated (or extrapolated) value +c ierr - =0 for ok, -1 for extrapolation +c + double precision xtab(ntab), ytab(ntab), x, y + integer itab, ierr, index + double precision t(4), u(4) +c integer savind +c data savind/-1/ +c +c----- Only 1 pt in table + if (ntab .eq. 1) then + y = ytab(1) + ierr = 0 + return + endif +c +c----- +c Locate search index + call srch (itab, x, xtab, ntab, index, ierr) +c if (index .eq. savind) go to 2000 +c savind = index +c +c----- +c Set interpolator index flags + i1 = 2 + i2 = 3 + iload = max0 (index-2, 1) +c + if (ntab .gt. 2) then + if (index.eq. 2) i2 = 4 +c + if (index.eq.ntab) i1 = 1 + endif +c + if (index.gt.2 .and. index.lt.ntab) then + i1 = 1 + i2 = 4 + endif +c----- +c Load interpolation arrays + do 1000 i = i1, i2 + j = iload + (i-i1) + t(i) = xtab (j) + u(i) = ytab (j) +1000 continue +c +c----- +c Get interpolated value +2000 call codim1 (x, t, u, i1, i2, y) + return + end +c +c-------------------------------------------------------------- +c + subroutine srch (itab, x, xtab, ntab, index, ierr) +c +c Search table of x-values to bracket the desired interpolant, x +c +c The returned search index will be: +c 2 - if extrapolation below the table is required +c ntab - above +c index - points to value just above x in the table if bounded. +c +c The index is saved as a starting point for subsequent entries +c in an array indexed through 'itab' which serves to label the +c set of saved search indices. Itab may be between 1 and 20. +c +c itab - The table identifier (1-20) +c x - The value for which an index is desired +c xtab - The table containing the x-values (array of length ntab) +c ntab - number of elements in the table +c index - returned index into the table (points just above x) +c ierr - 0 for ok, -1 for extrapolation +c +c Modified to remove entry points. 3/20/86 Valdes +c + integer ntab, index, init + double precision xtab(ntab), x +c +c common for subroutines intrp0 and intrpi +c + common /insvcm/ insave(20) +c +c initialize + data init/0/ +c +c----- +c Initialize + if (init.eq.0) then + do 1110 i = 1, 20 +1110 insave(i) = 0 + init = 1 + endif +c +c Determine direction of table, ascending or descending + idir = sign (1.0d0, xtab(ntab) - xtab(1)) +c +c----- +c Reset error flag + ierr = 0 +c +c----- +c Check for previous insaved index + last = insave(itab) + if (last .eq. 0 .or. last .gt. ntab) then +c +c----- +c no previous entry + isrch = 1 +c check for extrapolation + if ((x-xtab( 1)) * idir .lt. 0.0d0) go to 2000 + if ((x-xtab(ntab)) * idir .gt. 0.0d0) go to 2100 + else +c +c----- +c previous entry left a valid index + isrch = last +c +c check for still wihin bounds - difference from above should be opposite +c sign of difference from below +c + if ((xtab(last)-x) * (xtab(last-1)-x) .lt. 0.0d0) then + index = last + return + endif + endif +c +c ----- +c Begin searching - first determine direction +c +c This change made because x = xtab(1) was considered extrapolation. +c if ((x - xtab(isrch)) * idir .gt. 0.0d0) then + if ((x - xtab(isrch)) * idir .ge. 0.0d0) then +c forward + do 1100 i = isrch+1, ntab + if ((x-xtab(i)) * idir .gt. 0.0d0) go to 1100 + go to 1500 +1100 continue +c fall thru implies extrapolation required at high end + go to 2100 + else +c +c----- +c negative direction search + do 1200 i = isrch-1,1,-1 + if ((x-xtab(i)) * idir .lt. 0.0d0) go to 1200 + go to 1400 +1200 continue +c fall through implies extrapolation at low end + go to 2000 + endif +c +c----- +c point has been bounded +1400 index = i + 1 + go to 3000 +1500 index = i + go to 3000 +c +c----- +c extrapolations +2000 index = 2 + ierr = -1 + go to 3000 +2100 index = ntab + ierr = -1 + go to 3000 +c +c----- +c insave index +3000 insave(itab) = index + end +c +c------ +c Subroutine to reset saved index + subroutine intrp0 (itab) + integer itab + common /insvcm/ insave(20) +c + insave(itab) = 0 + end +c +c----- +c Subroutine to return current index + subroutine intrpi (itab, ind) + integer itab, ind + common /insvcm/ insave(20) +c + ind = insave(itab) + end +c +c------------------------------------------------------------------- +c + subroutine codim1 (x, t, u, i1, i2, y) +c +c this subroutine performs an interposlation in a fashion +c not really understandable, but it works well. +c +c x - input independent variable +c t - array of 4 table independents surrounding x if possible +c u - array of 4 table dependents corresponding to the t array +c +c i1, i2 - indicators as follows: +c +c i1 = 1, i2 = 4 : 4 pts available in t and u arrays +c i1 = 1, i2 = 3 : 3 pts available (x near right edge of table) +c i1 = 2, i2 = 4 : (x near left edge of table) +c i1 = 2, i2 = 3 : 2 pts available +c i1 = 3, i3 = 3 : 1 pt available +c +c y - output interpolated (or extrapolated) dependent value +c + double precision t(4), u(4), x, y + integer i1, i2 + double precision s, v, z, a1, a2, a3, c1, c2, c3, a4, c4, c5, c6 + double precision e1, e2, p1, p2, slope1, slope2, al, bt, xe + +c +c variable xk affects the extrapolation procedure. a value of -1.0 +c appears to be a reliable value. +c + data xk/-1.0d0/ +c + v = x +c the following code is extracted from an original source +c + a2=v-t(2) + al=a2/(t(3)-t(2)) + s=al*u(3)+(1.-al)*u(2) + if(i1.gt.1.and.i2.lt.4)goto1530 + a3=v-t(3) + if(i1.gt.1)goto1185 +1180 a1=v-t(1) + c1=a2/(t(1)-t(2))*a3/(t(1)-t(3)) + c2=a1/(t(2)-t(1))*a3/(t(2)-t(3)) + c3=a1/(t(3)-t(1))*a2/(t(3)-t(2)) + p1=c1*u(1)+c2*u(2)+c3*u(3) + if(i2.lt.4)goto1400 +1185 a4=v-t(4) + c4=a3/(t(2)-t(3))*a4/(t(2)-t(4)) + c5=a2/(t(3)-t(2))*a4/(t(3)-t(4)) + c6=a2/(t(4)-t(2))*a3/(t(4)-t(3)) + p2=c4*u(2)+c5*u(3)+c6*u(4) + if(i1.eq.1)goto1500 +1200 if(xk.lt.0.)goto1230 + xe=xk + goto1260 +1230 slope1=abs((u(4)-u(3))/(t(4)-t(3))) + slope2=abs((u(3)-u(2))/(t(3)-t(2))) + xe=1.0d0 + if(slope1+slope2.ne.0.)xe=1.-abs(slope1-slope2)/(slope1+slope2) +1260 p1=s+xe*(p2-s) + goto1500 +1400 if(xk.lt.0.)goto1430 + xe=xk + goto1460 +1430 slope1=abs((u(2)-u(1))/(t(2)-t(1))) + slope2=abs((u(3)-u(2))/(t(3)-t(2))) + xe=1.0d0 + if(slope1+slope2.ne.0.)xe=1.-abs(slope1-slope2)/(slope1+slope2) +1460 p2=s+xe*(p1-s) +1500 e1=abs(p1-s) + e2=abs(p2-s) + if(e1+e2.gt.0.)goto1560 +1530 z=s + goto1700 +1560 bt=(e1*al)/(e1*al+(1.-al)*e2) + z=bt*p2+(1.-bt)*p1 +c +1700 y = z + return + end +c +c---------------------------------------------------------------------- +c + subroutine lintrp (itab, xtab, ytab, ntab, x, y, ierr) +c +c Linear interpolator with last index save +c +c Arguments are identical to INTRP, and uses the same index search +c scheme so that values for ITAB should not clash with calls +c to INTRP and LINTRP. +c + double precision xtab(ntab), ytab(ntab), x , y + integer itab, ierr +c +c----- Only 1 pt in table + if (ntab .eq. 1) then + y = ytab (1) + ierr = 0 + return + endif +c +c-----locate search index + call srch (itab, x, xtab, ntab, index, ierr) +c +c----- index points just above x + y = ytab(index-1) + (x - xtab(index-1)) * + 1 (ytab(index) - ytab(index-1)) / (xtab(index) - xtab(index-1)) +c + return + end diff --git a/pkg/proto/irafil.par b/pkg/proto/irafil.par new file mode 100644 index 00000000..d3849b9d --- /dev/null +++ b/pkg/proto/irafil.par @@ -0,0 +1,9 @@ +# Parameter file for IRAFIL - Convert binary bit string to IRAF image file + +input,s,a,,,,Files to convert +nrows,i,a,,1,,Number of rows in image +ncols,i,a,,1,,Number of columns in image +bits,i,h,16,8,16,Number of bits per pixel +signed,b,h,yes,,,Is bit 16 a sign bit +tb_flip,b,h,no,,,Flip image top to bottom during generation +skip,i,h,0,0,,Number of header bytes to skip prior to pixels diff --git a/pkg/proto/joinlines.par b/pkg/proto/joinlines.par new file mode 100644 index 00000000..a29949f4 --- /dev/null +++ b/pkg/proto/joinlines.par @@ -0,0 +1,9 @@ +#input,s,a,,,,List of input files to be joined +list1,s,a,,,,List of input files to be joined +list2,s,a,,,,List of input files to be joined +output,f,h,"STDOUT",,,Output file +delim,s,h," ",,,Delimiter between file lines +missing,s,h,"Missing",,,Marker for missing lines +maxchars,i,h,161,,,Maximum number of output characters per line +shortest,b,h,yes,,,Quit at end of shortest file? +verbose,b,h,yes,,,Print verbose warnings? diff --git a/pkg/proto/maskexpr/gettok.h b/pkg/proto/maskexpr/gettok.h new file mode 100644 index 00000000..90980fa1 --- /dev/null +++ b/pkg/proto/maskexpr/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) + +# Optional flags. +define GT_NOSPECIAL 0003 +define GT_NOFILE 0001 +define GT_NOCOMMAND 0002 diff --git a/pkg/proto/maskexpr/gettok.x b/pkg/proto/maskexpr/gettok.x new file mode 100644 index 00000000..a0975300 --- /dev/null +++ b/pkg/proto/maskexpr/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/proto/maskexpr/megeom.x b/pkg/proto/maskexpr/megeom.x new file mode 100644 index 00000000..602493f8 --- /dev/null +++ b/pkg/proto/maskexpr/megeom.x @@ -0,0 +1,72 @@ +include <math.h> + +# ME_ELLGEOM -- Given the semi-major axis, ratio of semi-minor to semi-major +# axes, and position angle, compute the parameters of the equation of the +# ellipse, where the ellipse is defined as A * X ** 2 + B * x * y + +# C * Y ** 2 - F = 0. + +procedure me_ellgeom (a, ratio, theta, aa, bb, cc, ff) + +real a #I the semi-major axis +real ratio #I the ratio of semi-minor to semi-major axes +real theta #I the position angle of the major axis +real aa #O the coefficient of x ** 2 +real bb #O the coefficient of x * y +real cc #O the coefficient of y ** 2 +real ff #O the constant term + +real cost, sint, costsq, sintsq +real asq, bsq + +begin + # Get the angles. + cost = cos (DEGTORAD(theta)) + sint = sin (DEGTORAD(theta)) + costsq = cost ** 2 + sintsq = sint ** 2 + + # Compute the parameters of the outer ellipse. + asq = a ** 2 + bsq = (ratio * a) ** 2 + aa = bsq * costsq + asq * sintsq + bb = 2.0 * (bsq - asq) * cost * sint + cc = asq * costsq + bsq * sintsq + ff = asq * bsq +end + + +# ME_RECTGEOM -- Construct a polygon representation of a rotated rectangle +# givev the half-width of the long axis, the ratio of the half-width of the +# short axis to the long axis, and the rotation angle. + +procedure me_rectgeom (hwidth, ratio, theta, xout, yout) + +real hwidth #I the half-width of the long axis of the rectangle +real ratio #I the ratio of short to long axes of the rectangle +real theta #I the rotation angle +real xout[ARB] #O the x coordinates of the output vertices +real yout[ARB] #O the y coordinates of the output vertices + +real cost, sint, x, y + +begin + cost = cos (DEGTORAD(theta)) + sint = sin (DEGTORAD(theta)) + x = hwidth + y = ratio * x + xout[1] = x * cost - y * sint + yout[1] = x * sint + y * cost + x = -x + y = y + xout[2] = x * cost - y * sint + yout[2] = x * sint + y * cost + x = x + y = -y + xout[3] = x * cost - y * sint + yout[3] = x * sint + y * cost + x = -x + y = y + xout[4] = x * cost - y * sint + yout[4] = x * sint + y * cost +end + diff --git a/pkg/proto/maskexpr/megsym.x b/pkg/proto/maskexpr/megsym.x new file mode 100644 index 00000000..44a810bc --- /dev/null +++ b/pkg/proto/maskexpr/megsym.x @@ -0,0 +1,31 @@ +include <ctotok.h> +include <ctype.h> +include "gettok.h" + + +# Expression database symbol. +define LEN_SYM 2 +define SYM_TEXT Memi[$1] +define SYM_NARGS Memi[$1+1] + + + +# ME_GSYM -- Get symbol routine for the gettok package. + +pointer procedure me_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/proto/maskexpr/memkmask.x b/pkg/proto/maskexpr/memkmask.x new file mode 100644 index 00000000..f8af553c --- /dev/null +++ b/pkg/proto/maskexpr/memkmask.x @@ -0,0 +1,839 @@ +include <mach.h> +include <ctype.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <evvexpr.h> + +define DEF_LINELEN 8192 + +define LEN_MSKEXPR 42 +define ME_PMIM Memi[$1] # the output mask image +define ME_REFIM Memi[$1+1] # the reference image +define ME_REFMSK Memi[$1+2] # the reference mask image +define ME_REFDAT Memi[$1+3] # current reference image line +define ME_REFTYPE Memi[$1+4] # the input pixel type +define ME_REFPMDAT Memi[$1+5] # current mask image line +define ME_PMV Meml[P2L($1+6+($2)-1)] # position in mask image +define ME_REFV Meml[P2L($1+13+($2)-1)] # position in reference image +define ME_REFPMV Meml[P2L($1+20+($2)-1)] # position in reference mask + + +# ME_MKMASK -- Given an expression, a reference image descriptor, a reference +# mask descriptor, the number of dimensions, size of each dimension, and depth +# in bits create a mask image and return an imio pointer to the mask. + +pointer procedure me_mkmask (expr, mskname, refim, refmsk, ndim, axlen, depth) + +char expr[ARB] #I the input expression +char mskname[ARB] #I the optional input mask name +pointer refim #I the imio pointer to the reference image +pointer refmsk #I the imio pointer to the reference mask +int ndim #I the number of output mask dimensions +long axlen[ARB] #I the size of the output mask +int depth #I the pixel depth of the output mask + +pointer sp, tmpname, pm, pmim, me, obuf, oexpr +pointer pm_create(), im_pmmap(), evvexpr(), immap() +int i, npix, nlines, pmaxval +int imstati() +int imgnli(), imgnll(), imgnlr(), imgnld() +int impnli(), impnls(), impnll() +int locpr() +extern me_getop(), me_fcn() + +begin + # Open the output mask and map it as a virtual image or a disk + # image depending on whether or not you wish to save the mask. + if (mskname[1] == EOS) { + call smark (sp) + call salloc (tmpname, SZ_FNAME, TY_CHAR) + call mktemp ("tmpmsk", Memc[tmpname], SZ_FNAME) + if (refim != NULL) { + pmim = im_pmmap (Memc[tmpname], NEW_COPY, refim) + } else if (refmsk != NULL) { + pmim = im_pmmap (Memc[tmpname], NEW_COPY, refmsk) + } else { + pmim = im_pmmap (Memc[tmpname], NEW_IMAGE, NULL) + IM_NDIM(pmim) = ndim + call amovl (axlen, IM_LEN(pmim,1), ndim) + } + call sfree (sp) + } else { + if (refim != NULL) { + pmim = immap (mskname, NEW_COPY, refim) + } else if (refmsk != NULL) { + pmim = immap (mskname, NEW_COPY, refmsk) + } else { + pmim = immap (mskname, NEW_IMAGE, 0) + IM_NDIM(pmim) = ndim + call amovl (axlen, IM_LEN(pmim,1), ndim) + } + } + IM_PIXTYPE(pmim) = TY_INT + + # Initialize the mask. + pm = imstati (pmim, IM_PLDES) + call pl_close (pm) + pm = pm_create (IM_NDIM(pmim), IM_LEN(pmim,1), depth) + call imseti (pmim, IM_PLDES, pm) + + # Determine the mask depth. + if (depth > 0) { + pmaxval = min (depth, PL_MAXDEPTH) + pmaxval = 2 ** pmaxval - 1 + } else { + pmaxval = 2 ** PL_MAXDEPTH - 1 + } + + # Allocate space for the mask expression structure. + call calloc (me, LEN_MSKEXPR, TY_STRUCT) + ME_PMIM(me) = pmim + ME_REFIM(me) = refim + ME_REFMSK(me) = refmsk + + # Determine the input image type. + if (refim != NULL) { + switch (IM_PIXTYPE(refim)) { + case TY_BOOL, TY_SHORT, TY_INT: + ME_REFTYPE(me) = TY_INT + case TY_LONG: + ME_REFTYPE(me) = TY_LONG + case TY_REAL: + ME_REFTYPE(me) = TY_REAL + case TY_DOUBLE: + ME_REFTYPE(me) = TY_DOUBLE + case TY_COMPLEX: + ME_REFTYPE(me) = TY_REAL + } + } + + # Initalize the i/o pointers. + call amovkl (long(1), ME_PMV(me,1), IM_MAXDIM) + call amovkl (long(1), ME_REFV(me,1), IM_MAXDIM) + call amovkl (long(1), ME_REFPMV(me,1), IM_MAXDIM) + + # Compute the total number of output image lines. + npix = IM_LEN(pmim,1) + nlines = 1 + do i = 2, IM_NDIM(pmim) + nlines = nlines * IM_LEN(pmim, i) + + # Loop over the mask output image lines which are by default always + # integer. + do i = 1, nlines { + + # Get the correct reference image line. + if (refim != NULL) { + switch (ME_REFTYPE(me)) { + case TY_INT: + if (imgnli (refim, ME_REFDAT(me), ME_REFV(me,1)) == EOF) + call error (1, "Error reading reference image data") + case TY_LONG: + if (imgnll (refim, ME_REFDAT(me), ME_REFV(me,1)) == EOF) + call error (1, "Error reading reference image data") + case TY_REAL: + if (imgnlr (refim, ME_REFDAT(me), ME_REFV(me,1)) == EOF) + call error (1, "Error reading reference image data") + case TY_DOUBLE: + if (imgnld (refim, ME_REFDAT(me), ME_REFV(me,1)) == EOF) + call error (1, "Error reading reference image data") + case TY_COMPLEX: + if (imgnlr (refim, ME_REFDAT(me), ME_REFV(me,1)) == EOF) + call error (1, "Error reading reference image data") + } + } + + # Get the correct reference mask line. + if (refmsk != NULL) { + if (imgnli (refmsk, ME_REFPMDAT(me), ME_REFPMV(me,1)) == EOF) + call error (1, "Error reading reference mask data") + } + + # Evalute the expression. + oexpr = evvexpr (expr, locpr(me_getop), me, locpr(me_fcn), me, 0) + if (O_TYPE(oexpr) == ERR) { + call eprintf ("Error evaluting expression\n") + break + } + + # Copy the evaluated expression to the image. + if (O_LEN(oexpr) == 0) { + switch (O_TYPE(oexpr)) { + case TY_BOOL: + if (impnli (pmim, obuf, ME_PMV(me,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropi (NULL, 1, MAX_INT, Memi[obuf], 1, pmaxval, + npix, PIX_CLR + PIX_VALUE(O_VALI(oexpr))) + case TY_SHORT: + if (impnls (pmim, obuf, ME_PMV(me,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixrops (NULL, 1, MAX_SHORT, Mems[obuf], 1, + pmaxval, npix, PIX_CLR + PIX_VALUE(O_VALS(oexpr))) + case TY_INT: + if (impnli (pmim, obuf, ME_PMV(me,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropi (NULL, 1, MAX_INT, Memi[obuf], 1, + pmaxval, npix, PIX_CLR + PIX_VALUE(O_VALI(oexpr))) + case TY_LONG: + if (impnll (pmim, obuf, ME_PMV(me,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropl (NULL, 1, MAX_LONG, Meml[obuf], 1, + pmaxval, npix, PIX_CLR + PIX_VALUE(O_VALL(oexpr))) + case TY_REAL: + call error (3, "Type real expressions are not supported") + case TY_DOUBLE: + call error (3, "Type double expressions are not supported") + default: + call error (3, "Unknown expression value type") + } + + } else { + switch (O_TYPE(oexpr)) { + case TY_BOOL: + if (impnli (pmim, obuf, ME_PMV(me,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropi (Memi[O_VALP(oexpr)], 1, MAX_INT, + Memi[obuf], 1, pmaxval, npix, PIX_SRC) + case TY_SHORT: + if (impnls (pmim, obuf, ME_PMV(me,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixrops (Mems[O_VALP(oexpr)], 1, MAX_SHORT, + Mems[obuf], 1, pmaxval, npix, PIX_SRC) + case TY_INT: + if (impnli (pmim, obuf, ME_PMV(me,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropi (Memi[O_VALP(oexpr)], 1, MAX_INT, + Memi[obuf], 1, pmaxval, npix, PIX_SRC) + case TY_LONG: + if (impnll (pmim, obuf, ME_PMV(me,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropl (Meml[O_VALP(oexpr)], 1, MAX_LONG, + Meml[obuf], 1, pmaxval, npix, PIX_SRC) + case TY_REAL: + call error (3, "Type real expressions are not supported") + case TY_DOUBLE: + call error (3, "Type double expressions are not supported") + default: + call error (3, "Unknown expression value type") + } + } + + call evvfree (oexpr) + } + + # Cleanup. + call mfree (me, TY_STRUCT) + + return (pmim) +end + + +# ME_GETOP -- Called by evvexpr to fetch an input image operand. + +procedure me_getop (me, opname, o) + +pointer me #I mskexpr descriptor +char opname[ARB] #I operand name +pointer o #I output operand to be filled in + +pointer sp, param, data, im +int i, axis +int imgftype(), btoi() +double imgetd() +int imgeti() +bool imgetb() +errchk malloc +define err_ 91 + +begin + call smark (sp) + + # Reference image operand. + if ((opname[1] == 'i') && (opname[2] == EOS)) { + + if (ME_REFIM(me) == NULL) + goto err_ + + O_TYPE(o) = ME_REFTYPE(me) + O_LEN(o) = IM_LEN(ME_REFIM(me), 1) + O_FLAGS(o) = 0 + O_VALP(o) = ME_REFDAT(me) + + call sfree (sp) + return + + # Reference mask operand. + } else if ((opname[1] == 'm') && (opname[2] == EOS)) { + + if (ME_REFMSK(me) == NULL) + goto err_ + + O_TYPE(o) = TY_INT + O_LEN(o) = IM_LEN(ME_REFMSK(me), 1) + O_FLAGS(o) = 0 + O_VALP(o) = ME_REFPMDAT(me) + + call sfree (sp) + return + + # Reference image header parameter operand. + } else if ((opname[1] == 'i' || opname[1] == 'm') && + (opname[2] == '.')) { + + if (opname[1] == 'i') + im = ME_REFIM(me) + else + im = ME_REFMSK(me) + if (im == NULL) + goto err_ + + # Get the parameter value and set up operand struct. + call salloc (param, SZ_FNAME, TY_CHAR) + call strcpy (opname[3], Memc[param], SZ_FNAME) + iferr (O_TYPE(o) = imgftype (im, Memc[param])) + goto err_ + + switch (O_TYPE(o)) { + case TY_BOOL: + O_LEN(o) = 0 + 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_SHORT, TY_INT, TY_LONG: + iferr (O_VALI(o) = imgeti (im, Memc[param])) + goto err_ + + case TY_REAL, TY_DOUBLE: + O_TYPE(o) = TY_DOUBLE + iferr (O_VALD(o) = imgetd (im, Memc[param])) + goto err_ + + default: + goto err_ + } + + call sfree (sp) + return + + # 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. + + } else if (IS_UPPER(opname[1]) && opname[2] == EOS) { + + axis = opname[1] - 'I' + 1 + if (axis == 1) { + O_TYPE(o) = TY_INT + if (IM_LEN(ME_PMIM(me), 1) > 0) + O_LEN(o) = IM_LEN(ME_PMIM(me), 1) + else + 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 + if (IM_LEN(ME_PMIM(me), 1) > 0) + O_LEN(o) = IM_LEN(ME_PMIM(me), 1) + else + 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 (ME_PMV(me,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 + + +# define the builtin functions + +define ME_FUNCS "|circle|ellipse|box|rectangle|polygon|cols|lines|\ +vector|pie|cannulus|eannulus|rannulus|pannulus|point|" + +define ME_CIRCLE 1 +define ME_ELLIPSE 2 +define ME_BOX 3 +define ME_RECTANGLE 4 +define ME_POLYGON 5 +define ME_COLS 6 +define ME_LINES 7 +define ME_VECTOR 8 +define ME_PIE 9 +define ME_CANNULUS 10 +define ME_EANNULUS 11 +define ME_RANNULUS 12 +define ME_PANNULUS 13 +define ME_POINT 14 + + +# ME_FCN -- Called by evvexpr to execute a mskexpr special function. + +procedure me_fcn (me, fcn, args, nargs, o) + +pointer me #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 + +real width +pointer sp, ufunc, rval1, rval2, orval1, orval2, ix, iy +int i, ip, func, v_nargs, nver +int strdic(), ctor() +bool strne() + +begin + # Allocate working space. + call smark (sp) + call salloc (ufunc, SZ_LINE, TY_CHAR) + + # Get the function. + func = strdic (fcn, Memc[ufunc], SZ_LINE, ME_FUNCS) + if (func > 0 && strne (fcn, Memc[ufunc])) + func = 0 + + # Test the function. + if (func <= 0) { + O_TYPE(o) = ERR + call sfree (sp) + return + } + + # Determine number of arguments. This is a separate case statement. + # in case we need to deal with a variable number of arguments + # function at a later point. + switch (func) { + case ME_POINT, ME_CIRCLE, ME_ELLIPSE, ME_BOX, ME_RECTANGLE, ME_POLYGON: + v_nargs = -1 + case ME_CANNULUS, ME_EANNULUS, ME_RANNULUS, ME_PANNULUS: + v_nargs = -1 + case ME_COLS, ME_LINES: + v_nargs = -1 + case ME_VECTOR, ME_PIE: + v_nargs = -1 + default: + v_nargs = 0 + } + + # Check the number of arguments. + if (v_nargs > 0 && nargs != v_nargs) { + O_TYPE(o) = ERR + call sfree (sp) + return + } + if (v_nargs < 0 && nargs < abs (v_nargs)) { + O_TYPE(o) = ERR + call sfree (sp) + return + } + + if (func == ME_POLYGON && nargs < 6) { + O_TYPE(o) = ERR + call sfree (sp) + return + } + + # Type convert the arguments appropriately. At the moment this is + # simple if we assume that all the required arguments are real. + call salloc (rval1, nargs, TY_REAL) + call salloc (rval2, nargs, TY_REAL) + do i = 1, nargs { + switch (O_TYPE(args[i])) { + case TY_CHAR: + ip = 1 + if (ctor (O_VALC(args[i]), ip, Memr[rval1+i-1]) == 0) + Memr[rval1+i-1] = 0. + case TY_INT: + Memr[rval1+i-1] = O_VALI(args[i]) + case TY_REAL: + Memr[rval1+i-1] = O_VALR(args[i]) + case TY_DOUBLE: + Memr[rval1+i-1] = O_VALD(args[i]) + } + } + + # Evaluate the function. Worry about some duplication of code later. + switch (func) { + + case ME_CIRCLE: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 5) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_circle (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4]) + } else if (nargs == 3) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_circle (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_ELLIPSE: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 7) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_ellipse (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6]) + } else if (nargs == 5) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_ellipse (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_BOX: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 6) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_box (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5]) + } else if (nargs == 4) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_box (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_RECTANGLE: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 7) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_rectangle (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6]) + } else if (nargs == 5) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_rectangle (Memi[ix], Memi[iy], Memi[O_VALP(o)], + O_LEN(o), Memr[rval1], Memr[rval1+1], Memr[rval1+2], + Memr[rval1+3], Memr[rval1+4]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_POLYGON: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs < 6) { + O_TYPE(o) = ERR + } else if (O_LEN(args[1]) > 0 && O_LEN(args[2]) > 0) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + nver = (nargs - 2) / 2 + do i = 1, nver + #Memr[rval2+i-1] = Memr[rval1+2*i] + Memr[rval2+i-1] = Memr[rval1+2*i+1] + do i = 1, nver + #Memr[rval1+i-1] = Memr[rval1+2*i+1] + Memr[rval1+i-1] = Memr[rval1+2*i] + call me_polygon (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1], Memr[rval2], nver) + } else { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + nver = nargs / 2 + do i = 1, nver + Memr[rval2+i-1] = Memr[rval1+2*i-1] + do i = 1, nver + Memr[rval1+i-1] = Memr[rval1+2*i-2] + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_polygon (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval2], nver) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } + + case ME_COLS: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 2) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_cols (Memi[O_VALP(args[1])], Memi[O_VALP(o)], O_LEN(o), + O_VALC(args[2])) + } else if (nargs == 1) { + call malloc (ix, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_cols (Memi[ix], Memi[O_VALP(o)], O_LEN(o), + O_VALC(args[1])) + call mfree (ix, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_LINES: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 2) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_lines (Memi[O_VALP(args[1])], Memi[O_VALP(o)], O_LEN(o), + O_VALC(args[2])) + } else if (nargs == 1) { + call malloc (ix, O_LEN(o), TY_INT) + call amovki (ME_PMV(me,2), Memi[ix], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_lines (Memi[ix], Memi[O_VALP(o)], O_LEN(o), + O_VALC(args[1])) + call mfree (ix, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_VECTOR: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 7) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_vector (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6]) + } else if (nargs == 5) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_vector (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_PIE: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 6) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_pie (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], IM_LEN(ME_PMIM(me),1), + IM_LEN(ME_PMIM(me),2)) + } else if (nargs == 4) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_pie (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + IM_LEN(ME_PMIM(me),1), IM_LEN(ME_PMIM(me),2)) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_CANNULUS: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 6) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_cannulus (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5]) + } else if (nargs == 4) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_cannulus (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_EANNULUS: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 8) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_eannulus (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6], Memr[rval1+7]) + } else if (nargs == 6) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_eannulus (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_RANNULUS: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 8) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_rannulus (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6], Memr[rval1+7]) + } else if (nargs == 6) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_rannulus (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case ME_PANNULUS: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs < 7) { + O_TYPE(o) = ERR + } else if (O_LEN(args[1]) > 0 && O_LEN(args[2]) > 0) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + width = Memr[rval1+2] + nver = (nargs - 3) / 2 + do i = 1, nver + #Memr[rval2+i-1] = Memr[rval1+2*i+1] + Memr[rval2+i-1] = Memr[rval1+2*i+2] + do i = 1, nver + #Memr[rval1+i-1] = Memr[rval1+2*i+2] + Memr[rval1+i-1] = Memr[rval1+2*i+1] + call salloc (orval1, nver, TY_REAL) + call salloc (orval2, nver, TY_REAL) + call me_pyexpand (Memr[rval1], Memr[rval2], Memr[orval1], + Memr[orval2], nver, width) + call me_apolygon (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1], Memr[rval2], + Memr[orval1], Memr[orval2], nver) + } else { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + width = Memr[rval1] + nver = (nargs - 1) / 2 + do i = 1, nver + Memr[rval2+i-1] = Memr[rval1+2*i] + do i = 1, nver + Memr[rval1+i-1] = Memr[rval1+2*i-1] + call salloc (orval1, nver, TY_REAL) + call salloc (orval2, nver, TY_REAL) + call me_pyexpand (Memr[rval1], Memr[rval2], Memr[orval1], + Memr[orval2], nver, width) + call me_apolygon (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval2], Memr[orval1], Memr[orval2], nver) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } + + case ME_POINT: + O_LEN(o) = IM_LEN(ME_PMIM(me),1) + O_TYPE(o) = TY_BOOL + if (nargs == 4) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_point (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3]) + } else if (nargs == 2) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (ME_PMV(me,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_point (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + default: + O_TYPE(o) = ERR + } + + call sfree (sp) +end + diff --git a/pkg/proto/maskexpr/meregfuncs.x b/pkg/proto/maskexpr/meregfuncs.x new file mode 100644 index 00000000..467bd1d0 --- /dev/null +++ b/pkg/proto/maskexpr/meregfuncs.x @@ -0,0 +1,1449 @@ +include <mach.h> +include <ctype.h> +include <math.h> + + +# ME_POINT -- Compute which pixels are equal to a point. + +procedure me_point (ix, iy, stat, npts, x1, y1) + +int ix[ARB] #I the integer x coordinates +int iy[ARB] #I the integer y coordinates +int stat[ARB] #O the integer status array containing YES or NO +int npts #I the number of points +real x1, y1 #I the coordinates of the point + +int i + +begin + do i = 1, npts { + if (ix[i] == nint(x1) && iy[i] == nint(y1)) + stat[i] = YES + else + stat[i] = NO + } +end + + +# ME_CIRCLE -- Compute which pixels are within or on a circle. + +procedure me_circle (ix, iy, stat, npts, xc, yc, r) + +int ix[ARB] #I the integer x coordinates +int iy[ARB] #I the integer y coordinates +int stat[ARB] #O the integer status array containing YES or NO +int npts #I the number of points +real xc, yc #I the center of the circle +real r #I the radius of the circle + +real r2, rdist +int i + +begin + r2 = r * r + do i = 1, npts { + rdist = (ix[i] - xc) ** 2 + (iy[i] - yc) ** 2 + if (rdist <= r2) + stat[i] = YES + else + stat[i] = NO + } +end + + +# ME_CANNULUS -- Compute which pixels are within or on a circular annulus +# boundary. + +procedure me_cannulus (ix, iy, stat, npts, xc, yc, r1, r2) + +int ix[ARB] #I the integer x coordinates +int iy[ARB] #I the integer y coordinates +int stat[ARB] #O the integer status array containing YES or NO +int npts #I the number of points +real xc, yc #I the center of the circle +real r1, r2 #I the radius of the circular annulus + +real r12, r22, rdist +int i + +begin + r12 = r1 * r1 + r22 = r2 * r2 + do i = 1, npts { + rdist = (ix[i] - xc) ** 2 + (iy[i] - yc) ** 2 + if (rdist >= r12 && rdist <= r22) + stat[i] = YES + else + stat[i] = NO + } +end + + +# ME_ELLIPSE -- Compute which pixels lie within or on an ellipse. + +procedure me_ellipse (ix, iy, stat, npts, xc, yc, a, ratio, theta) + +int ix[ARB] #I the integer x coordinates +int iy[ARB] #I the integer y coordinates +int stat[ARB] #O the integer status array (YES/NO) +int npts #I the number of points +real xc, yc #I the center of the ellipse +real a #I the semi-major axis of the ellipse +real ratio #I the semi-minor / semi-minor axis +real theta #I the position angle of the ellipse + +real asq, bsq, cost, sint, costsq, sintsq, rdist +real dx, dy, aa, bb, cc, rr +int i + +begin + asq = a * a + bsq = (ratio * a) * (ratio * a) + cost = cos (DEGTORAD(theta)) + sint = sin (DEGTORAD(theta)) + costsq = cost * cost + sintsq = sint * sint + aa = bsq * costsq + asq * sintsq + bb = 2.0 * (bsq - asq) * cost * sint + cc = asq * costsq + bsq * sintsq + rr = asq * bsq + + do i = 1, npts { + dx = (ix[i] - xc) + dy = (iy[i] - yc) + rdist = aa * dx * dx + bb * dx * dy + cc * dy * dy + if (rdist <= rr) + stat[i] = YES + else + stat[i] = NO + } +end + + +# ME_EANNULUS -- Compute which pixels lie within or on an elliptical annular +# boundary. + +procedure me_eannulus (ix, iy, stat, npts, xc, yc, a1, a2, ratio, theta) + +int ix[ARB] #I the integer x coordinates +int iy[ARB] #I the integer y coordinates +int stat[ARB] #O the integer status array (YES/NO) +int npts #I the number of points +real xc, yc #I the center of the ellipse +real a1, a2 #I the semi-major axis of the i/o ellipse +real ratio #I the semi-minor / semi-major axis of ellipse +real theta #I the position angle of the ellipse + +real a1sq, b1sq, aa1, bb1, cc1, rr1, rdist1 +real a2sq, b2sq, aa2, bb2, cc2, rr2, rdist2 +real dx, dy, cost, sint, costsq, sintsq +int i + +begin + # First ellipse. + a1sq = a1 * a1 + b1sq = (ratio * a1) ** 2 + cost = cos (DEGTORAD(theta)) + sint = sin (DEGTORAD(theta)) + costsq = cost * cost + sintsq = sint * sint + aa1 = b1sq * costsq + a1sq * sintsq + bb1 = 2.0 * (b1sq - a1sq) * cost * sint + cc1 = a1sq * costsq + b1sq * sintsq + rr1 = a1sq * b1sq + + # Second ellipse. + a2sq = a2 * a2 + b2sq = (ratio * a2) ** 2 + aa2 = b2sq * costsq + a2sq * sintsq + bb2 = 2.0 * (b2sq - a2sq) * cost * sint + cc2 = a2sq * costsq + b2sq * sintsq + rr2 = a2sq * b2sq + + # Elliptical annulus. + do i = 1, npts { + dx = (ix[i] - xc) + dy = (iy[i] - yc) + rdist1 = aa1 * dx * dx + bb1 * dx * dy + cc1 * dy * dy + rdist2 = aa2 * dx * dx + bb2 * dx * dy + cc2 * dy * dy + if (rdist1 >= rr1 && rdist2 <= rr2) + stat[i] = YES + else + stat[i] = NO + } +end + + +# ME_RECTANGLE -- Compute which pixels lie within or on a rectangle. + +procedure me_rectangle (ix, iy, stat, npts, xc, yc, a, ratio, theta) + +int ix[ARB] #I the integer x coordinates +int iy[ARB] #I the integer y coordinates +int stat[ARB] #O the integer status array (YES/NO) +int npts #I the number of points +real xc, yc #I the center of the rectangle +real a #I the semi-major axis width of the rectangle +real ratio #I the semi-minor axis / semi-major axis +real theta #I the position angle of the rectangle + +real cost, sint, x, y +real xver[4], yver[4] + +begin + # Compute the corners of the equivalent polygon. + cost = cos (DEGTORAD(theta)) + sint = sin (DEGTORAD(theta)) + x = a + y = ratio * a + xver[1] = xc + x * cost - y * sint + yver[1] = yc + x * sint + y * cost + x = -x + y = y + xver[2] = xc + x * cost - y * sint + yver[2] = yc + x * sint + y * cost + x = x + y = -y + xver[3] = xc + x * cost - y * sint + yver[3] = yc + x * sint + y * cost + x = -x + y = y + xver[4] = xc + x * cost - y * sint + yver[4] = yc + x * sint + y * cost + + # Call the polygon routine. + call me_polygon (ix, iy, stat, npts, xver, yver, 4) +end + + +# ME_RANNULUS -- Compute which pixels lie within or on a rectangular annulus. + +procedure me_rannulus (ix, iy, stat, npts, xc, yc, r1, r2, ratio, theta) + +int ix[ARB] #I the integer x coordinates +int iy[ARB] #I the integer y coordinates +int stat[ARB] #O the integer status array (YES/NO) +int npts #I the number of points +real xc, yc #I the center of the rectangle +real r1, r2 #I the semi-major axis width of the rectangle +real ratio #I the semi-minor / semi-major axis ratio +real theta #I the position angle of the rectangle + +real cost, sint, x, y, xver1[4], yver1[4], xver2[4], yver2[4] + +begin + # Compute the corners of the equivalent polygon inner and outer + # polygons. + cost = cos (DEGTORAD(theta)) + sint = sin (DEGTORAD(theta)) + + # The corners of the inner polygon. + x = r1 + y = ratio * r1 + xver1[1] = xc + x * cost - y * sint + yver1[1] = yc + x * sint + y * cost + x = -x + y = y + xver1[2] = xc + x * cost - y * sint + yver1[2] = yc + x * sint + y * cost + x = x + y = -y + xver1[3] = xc + x * cost - y * sint + yver1[3] = yc + x * sint + y * cost + x = -x + y = y + xver1[4] = xc + x * cost - y * sint + yver1[4] = yc + x * sint + y * cost + + # The corners of the outer polygon. + x = r2 + y = ratio * r2 + xver2[1] = xc + x * cost - y * sint + yver2[1] = yc + x * sint + y * cost + x = -x + y = y + xver2[2] = xc + x * cost - y * sint + yver2[2] = yc + x * sint + y * cost + x = x + y = -y + xver2[3] = xc + x * cost - y * sint + yver2[3] = yc + x * sint + y * cost + x = -x + y = y + xver2[4] = xc + x * cost - y * sint + yver2[4] = yc + x * sint + y * cost + + # Write a routine to determine which pixels are inside the polygon + # defined by 2 sets of vertices. + call me_apolygon (ix, iy, stat, npts, xver1, yver1, xver2, yver2, 4) +end + + +# ME_BOX -- Compute which pixels lie within or on a box. + +procedure me_box (ix, iy, stat, npts, x1, y1, x2, y2) + +int ix[ARB] #I the integer x coordinates +int iy[ARB] #I the integer y coordinates +int stat[ARB] #O the integer status array (YES/NO) +int npts #I the number of points +real x1, y1 #I first box corner +real x2, y2 #I first box corner + +real xmin, xmax, ymin, ymax +int i + +begin + xmin = min (x1, x2) + xmax = max (x1, x2) + ymin = min (y1, y2) + ymax = max (y1, y2) + + do i = 1, npts { + if (ix[i] >= xmin && ix[i] <= xmax && + iy[i] >= ymin && iy[i] <= ymax) + stat[i] = YES + else + stat[i] = NO + } +end + + +# ME_POLYGON -- Determine which points lie in or on a specified polygon. + +procedure me_polygon (ix, iy, stat, npts, xver, yver, nver) + +int ix[ARB] #I the x image pixel coordinates +int iy[ARB] #I the y image pixel coordinates +int stat[ARB] #O the output status array +int npts #I the number of image pixel coordinates +real xver[ARB] #I the x polygon vertices coordinates +real yver[ARB] #I the y polygon vertices coordinates +int nver #I the number of polygon coordinates + +real lx, ld +pointer sp, txver, tyver, work1, work2, xintr +int i, j, ixmin, ixmax, nintr +int me_pyclip() + +begin + call smark (sp) + call salloc (txver, nver + 1, TY_REAL) + call salloc (tyver, nver + 1, TY_REAL) + call salloc (work1, nver + 1, TY_REAL) + call salloc (work2, nver + 1, TY_REAL) + call salloc (xintr, nver + 1, TY_REAL) + + # Close the polygon. + call amovr (xver, Memr[txver], nver) + call amovr (yver, Memr[tyver], nver) + Memr[txver+nver] = xver[1] + Memr[tyver+nver] = yver[1] + + # Loop over the points. + call alimi (ix, npts, ixmin, ixmax) + lx = ixmax - ixmin + 1 + do i = 1, npts { + + # Compute the intersection points of the line segment which + # spans an image line with the polygon. Sort the line segments. + ld = iy[i] + if (i == 1) { + nintr = me_pyclip (Memr[txver], Memr[tyver], Memr[work1], + Memr[work2], Memr[xintr], nver + 1, lx, ld) + call asrtr (Memr[xintr], Memr[xintr], nintr) + } else if (iy[i] != iy[i-1]) { + nintr = me_pyclip (Memr[txver], Memr[tyver], Memr[work1], + Memr[work2], Memr[xintr], nver + 1, lx, ld) + call asrtr (Memr[xintr], Memr[xintr], nintr) + } + + # Are the intersection points in range ? + if (nintr <= 0) + stat[i] = NO + else { + stat[i] = NO + do j = 1, nintr, 2 { + if (ix[i] >= Memr[xintr+j-1] && ix[i] <= Memr[xintr+j]) + stat[i] = YES + } + } + + } + + call sfree (sp) +end + + +# ME_APOLYGON -- Determine which points lie in or on a specified polygonal +# annulus. + +procedure me_apolygon (ix, iy, stat, npts, ixver, iyver, oxver, oyver, nver) + +int ix[ARB] #I the x image pixel coordinates +int iy[ARB] #I the y image pixel coordinates +int stat[ARB] #O the output status array +int npts #I the number of image pixel coordinates +real ixver[ARB] #I the x polygon vertices coordinates +real iyver[ARB] #I the y polygon vertices coordinates +real oxver[ARB] #I the x polygon vertices coordinates +real oyver[ARB] #I the y polygon vertices coordinates +int nver #I the number of polygon coordinates + +real lx, ld +pointer sp, tixver, tiyver, toxver, toyver, work1, work2, ixintr, oxintr +int i, j, jj, ixmin, ixmax, inintr, onintr, ibegin, iend +int me_pyclip() + +begin + call smark (sp) + call salloc (tixver, nver + 1, TY_REAL) + call salloc (tiyver, nver + 1, TY_REAL) + call salloc (toxver, nver + 1, TY_REAL) + call salloc (toyver, nver + 1, TY_REAL) + call salloc (work1, nver + 1, TY_REAL) + call salloc (work2, nver + 1, TY_REAL) + call salloc (ixintr, nver + 1, TY_REAL) + call salloc (oxintr, nver + 1, TY_REAL) + + # Close the polygons. + call amovr (ixver, Memr[tixver], nver) + call amovr (iyver, Memr[tiyver], nver) + Memr[tixver+nver] = ixver[1] + Memr[tiyver+nver] = iyver[1] + call amovr (oxver, Memr[toxver], nver) + call amovr (oyver, Memr[toyver], nver) + Memr[toxver+nver] = oxver[1] + Memr[toyver+nver] = oyver[1] + + # Loop over the points. + call alimi (ix, npts, ixmin, ixmax) + lx = ixmax - ixmin + 1 + do i = 1, npts { + + stat[i] = NO + + # Compute the intersection points of the line segment with the + # outer polygon. + ld = iy[i] + if (i == 1) { + onintr = me_pyclip (Memr[toxver], Memr[toyver], Memr[work1], + Memr[work2], Memr[oxintr], nver + 1, lx, ld) + call asrtr (Memr[oxintr], Memr[oxintr], onintr) + } else if (iy[i] != iy[i-1]) { + onintr = me_pyclip (Memr[toxver], Memr[toyver], Memr[work1], + Memr[work2], Memr[oxintr], nver + 1, lx, ld) + call asrtr (Memr[oxintr], Memr[oxintr], onintr) + } + if (onintr <= 0) + next + + # Compute the intersection points of the line segment with the + # inner polygon. + if (i == 1) { + inintr = me_pyclip (Memr[tixver], Memr[tiyver], Memr[work1], + Memr[work2], Memr[ixintr], nver + 1, lx, ld) + call asrtr (Memr[ixintr], Memr[ixintr], inintr) + } else if (iy[i] != iy[i-1]) { + inintr = me_pyclip (Memr[tixver], Memr[tiyver], Memr[work1], + Memr[work2], Memr[ixintr], nver + 1, lx, ld) + call asrtr (Memr[ixintr], Memr[ixintr], inintr) + } + + # Are the intersection points in range ? + if (inintr <= 0) { + do j = 1, onintr, 2 { + if (ix[i] >= Memr[oxintr+j-1] && ix[i] <= Memr[oxintr+j]) { + stat[i] = YES + break + } + } + } else { + do j = 1, onintr, 2 { + do jj = 1, inintr, 2 { + if ((Memr[ixintr+jj-1] > Memr[oxintr+j-1]) && + (Memr[ixintr+jj-1] < Memr[oxintr+j])) { + ibegin = jj + break + } + } + do jj = inintr, 1, -2 { + if ((Memr[ixintr+jj-1] > Memr[oxintr+j-1]) && + (Memr[ixintr+jj-1] < Memr[oxintr+j])) { + iend = jj + break + } + } + if ((ix[i] >= Memr[oxintr+j-1]) && + (ix[i] <= Memr[ixintr+ibegin-1])) { + stat[i] = YES + } else if ((ix[i] >= Memr[ixintr+iend-1]) && + (ix[i] <= Memr[oxintr+j])) { + stat[i] = YES + } else { + do jj = ibegin + 1, iend - 1, 2 { + if ((ix[i] >= Memr[ixintr+jj-1]) && + (ix[i] <= Memr[ixintr+jj])) { + stat[i] = YES + break + } + } + } + + } + } + + } + + call sfree (sp) +end + + +define MAX_NRANGES 100 + +# ME_COLS -- Determine which pixels are in the specified column ranges. + +procedure me_cols (ix, stat, npts, rangstr) + +int ix[ARB] #I the x image pixel coordinates +int stat[ARB] #O the output status array +int npts #I the number of image pixel coordinates +char rangstr[ARB] #I the input range specification string + +pointer sp, ranges +int index, nvals +int me_decode_ranges(), me_next_number() + +begin + # Allocate space for storing the ranges. + call smark (sp) + call salloc (ranges, 3 * MAX_NRANGES + 1, TY_INT) + + # Decode the ranges string. If there was an error set up the ranges + # so as to include everything. + if (me_decode_ranges (rangstr, Memi[ranges], MAX_NRANGES, + nvals) == ERR) { + if (me_decode_ranges ("-", Memi[ranges], MAX_NRANGES, nvals) != ERR) + ; + } + + # Set the status array. + call amovki (NO, stat, npts) + index = 0 + while (me_next_number (Memi[ranges], index) != EOF) + stat[index] = YES + + call sfree (sp) +end + + +# ME_LINES -- Determine which pixels are in the specified column ranges. + +procedure me_lines (ix, stat, npts, rangstr) + +int ix[ARB] #I the x image pixel coordinates +int stat[ARB] #O the output status array +int npts #I the number of image pixel coordinates +char rangstr[ARB] #I the input range specification string + +pointer sp, ranges +int i, lastix, nvals +int me_decode_ranges() +bool me_is_in_range() + +begin + # Allocate space for storing the ranges. + call smark (sp) + call salloc (ranges, 3 * MAX_NRANGES + 1, TY_INT) + + # Decode the ranges string. If there was an error set up the ranges + # so as to include everything. + if (me_decode_ranges (rangstr, Memi[ranges], MAX_NRANGES, + nvals) == ERR) { + if (me_decode_ranges ("-", Memi[ranges], MAX_NRANGES, nvals) != ERR) + ; + } + + # Set the line numbers. + call amovki (NO, stat, npts) + lastix = 0 + do i = 1, npts { + if (ix[i] == lastix) { + stat[i] = YES + } else if (me_is_in_range (Memi[ranges], ix[i])) { + lastix = ix[i] + stat[i] = YES + } + } + + call sfree (sp) +end + + +# ME_VECTOR -- Determine which pixels are on the specified line. + +procedure me_vector (ix, iy, stat, npts, x1, y1, x2, y2, width) + +int ix[ARB] #I the x image pixel coordinates +int iy[ARB] #I the y image pixel coordinates +int stat[ARB] #O the output status array +int npts #I the number of image pixel coordinates +real x1, y1 #I coordinates of the first point +real x2, y2 #I coordinates of the first point +real width #I the vector width + +real x, y, xc, yc, theta, cost, sint +real xver[4], yver[4] + +begin + # Compute the corners of the equivalent polygon. + xc = (x2 + x1) / 2.0 + yc = (y2 + y1) / 2.0 + x = sqrt ((x2 - x1) ** 2 + (y2 - y1) ** 2) / 2.0 + y = width / 2.0 + theta = atan2 (y2 - y1, x2 - x1) + cost = cos (theta) + sint = sin (theta) + xver[1] = xc + x * cost - y * sint + yver[1] = yc + x * sint + y * cost + x = -x + y = y + xver[2] = xc + x * cost - y * sint + yver[2] = yc + x * sint + y * cost + x = x + y = -y + xver[3] = xc + x * cost - y * sint + yver[3] = yc + x * sint + y * cost + x = -x + y = y + xver[4] = xc + x * cost - y * sint + yver[4] = yc + x * sint + y * cost + + # Call the polygon routine. + call me_polygon (ix, iy, stat, npts, xver, yver, 4) +end + + +define SMALL_NUMBER 1.0e-24 + +# ME_PIE -- Determine which pixels are inside a pie shaped wedge that +# intersects the image boundaries. + +procedure me_pie (ix, iy, stat, npts, xc, yc, angle1, angle2, width, height) + +int ix[ARB] #I the x pixel coordinates +int iy[ARB] #I the y pixel coordinates +int stat[ARB] #O the output status array +int npts #I the number of data points +real xc, yc #I the center of the wedge +real angle1, angle2 #I the wedge angles +int width, height #I the image mask width and height + +real sweep, x2, y2, vx[7], vy[7] +int count, intrcpt1, intrcpt2 +int me_pie_intercept(), me_corner_vertex() + +begin + # Set the first vertex + vx[1] = xc + vy[1] = yc + sweep = angle2 - angle1 + + # If the sweep is too small to be noticed don't bother. + if (abs (sweep) < SMALL_NUMBER) { + call amovki (NO, stat, npts) + return + } + if (sweep < 0.0) + sweep = sweep + 360.0 + + # Get the second vertext by computing the intersection of the + # first ray with the image boundaries. + intrcpt1 = me_pie_intercept (width, height, xc, yc, angle1, + vx[2], vy[2]) + + # Compute the second intercept. + intrcpt2 = me_pie_intercept (width, height, xc, yc, angle2, x2, y2) + + # If angles intercept same side and slice is between them, no corners + # else, mark corners until reaching side with second angle intercept. + count = 3 + if ((intrcpt1 != intrcpt2) || (sweep > 180.0)) { + repeat { + intrcpt1 = me_corner_vertex (intrcpt1, width, height, vx[count], + vy[count]) + count = count + 1 + } until (intrcpt1 == intrcpt2) + } + + # Set last vertex. + vx[count] = x2 + vy[count] = y2 + + # Fill in the polygon + call me_polygon (ix, iy, stat, npts, vx, vy, count) +end + + +# ME_PIE_INTERCEPT -- Determine which side is intercepted by a vertex (given +# center and angle) and set edge intercept point and return index of side. + +int procedure me_pie_intercept (width, height, xcen, ycen, angle, xcept, ycept) + +int width, height #I the dimensions of the image field +real xcen, ycen #I the base pivot point of the ray +real angle #I the angle of ray +real xcept, ycept #I coordinates of intercept with edge of image + +real angl, slope + +begin + # Put angles in normal range. + angl = angle + while (angl < 0.0) + angl = angl + 360.0 + while (angl >= 360.0) + angl = angl - 360.0 + + # Check for a horizontal angle. + if (abs (angl) < SMALL_NUMBER) { + #xcept = 0 + xcept = width + 1 + ycept = ycen + #return (2) + return (4) + } + if (abs (angl - 180.0) < SMALL_NUMBER) { + #xcept = width + 1 + xcept = 0 + ycept = ycen + #return (4) + return (2) + } + +# # Convert to a Cartesian angle +# angl = angl + 90.0 +# if (angl >= 360.0) +# angl = angl - 360.0 + + # Check for vertical angle. + if (angl < 180.0) { + ycept = height + 1 + # rule out vertical line + if (abs(angl - 90.0) < SMALL_NUMBER) { + x_cept = xcen + return (1) + } + } else { + ycept = 0.0 + # rule out vertical line + if (abs(angl - 270.0) < SMALL_NUMBER) { + xcept = xcen + return (3) + } + } + + # Convert to radians. + angl = (angl / 180.0) * PI + + # Calculate slope. + slope = tan (angl) + + # Calculate intercept with designated y edge. + xcept = xcen + ((ycept - ycen) / slope) + if (xcept < 0) { + ycept = (ycen - (xcen * slope)) + xcept = 0.0 + return (2) + } else if (xcept > (width + 1)) { + ycept = (ycen + ((width + 1 - xcen) * slope)) + xcept = width + 1 + return (4) + } else { + if (ycept < height) + return (3) + else + return (1) + } +end + + +# ME_CORNER_VERTEX -- Set points just beyond corner to mark the corner in a +# polygon. Note: 1=top, 2=left, 3=bottom, 4=right, corner is between current +# and next advance index to next side and also return its value. + +int procedure me_corner_vertex (index, width, height, x, y) + +int index #I code of side before corner +int width, height #I dimensions of image field +real x, y #O coords of corner + +begin + # Set the corner coordinates. + switch (index) { + case 1: + x = 0.0 + y = height + 1 + case 2: + x = 0.0 + y = 0.0 + case 3: + x = width + 1 + y = 0.0 + case 4: + x = width + 1 + y = height + 1 + default: + ; #call error (1, "index error in mark_corner") + } + + # Set the corner index. + index = index + 1 + if (index > 4) + index = 1 + + return (index) +end + + +# ME_PYEXPAND -- Expand a polygon given a list of vertices and an expansion +# factor in pixels. + +procedure me_pyexpand (xin, yin, xout, yout, nver, width) + +real xin[ARB] #I the x coordinates of the input vertices +real yin[ARB] #I the y coordinates of the input vertices +real xout[ARB] #O the x coordinates of the output vertices +real yout[ARB] #O the y coordinates of the output vertices +int nver #I the number of vertices +real width #I the width of the expansion region + +real xcen, ycen, m1, b1, m2, b2, xp1, yp1, xp2, yp2 +int i +real asumr() + +begin + # Find the center of gravity of the polygon. + xcen = asumr (xin, nver) / nver + ycen = asumr (yin, nver) / nver + + do i = 1, nver { + + # Compute the equations of the line segments parallel to the + # line seqments composing a single vertex. + if (i == 1) { + call me_psegment (xcen, ycen, xin[nver], yin[nver], xin[1], + yin[1], width, m1, b1, xp1, yp1) + call me_psegment (xcen, ycen, xin[1], yin[1], xin[2], yin[2], + width, m2, b2, xp2, yp2) + } else if (i == nver) { + call me_psegment (xcen, ycen, xin[nver-1], yin[nver-1], + xin[nver], yin[nver], width, m1, b1, xp1, yp1) + call me_psegment (xcen, ycen, xin[nver], yin[nver], xin[1], + yin[1], width, m2, b2, xp2, yp2) + } else { + call me_psegment (xcen, ycen, xin[i-1], yin[i-1], xin[i], + yin[i], width, m1, b1, xp1, yp1) + call me_psegment (xcen, ycen, xin[i], yin[i], xin[i+1], + yin[i+1], width, m2, b2, xp2, yp2) + } + + # The new vertex is the intersection of the two new line + # segments. + if (m1 == m2) { + xout[i] = xp2 + yout[i] = yp2 + } else if (IS_INDEFR(m1)) { + xout[i] = xp1 + yout[i] = m2 * xp1 + b2 + } else if (IS_INDEFR(m2)) { + xout[i] = xp2 + yout[i] = m1 * xp2 + b1 + } else { + xout[i] = (b2 - b1) / (m1 - m2) + yout[i] = (m2 * b1 - m1 * b2) / (m2 - m1) + } + } +end + + +# ME_PSEGMENT -- Construct a line segment parallel to an existing line segment +# but a specified distance from it in a direction away from a fixed reference +# point. + +procedure me_psegment (xcen, ycen, xb, yb, xe, ye, width, m, b, xp, yp) + +real xcen, ycen #I the position of the reference point +real xb, yb #I the starting coordinates of the line segment +real xe, ye #I the ending coordinates of the line segment +real width #I the distance of new line segment from old +real m #O the slope of the new line segment +real b #O the intercept of the new line segment +real xp, yp #O the coordinates of a points on new line + +real x1, y1, x2, y2, d1, d2 + +begin + # Compute the slope of the line segment. + m = (xe - xb) + if (m == 0.0) + m = INDEFR + else + m = (ye - yb) / m + + # Construct the perpendicular to the line segement and locate two + # points which are equidistant from the line seqment + if (IS_INDEFR(m)) { + x1 = xb - width + y1 = yb + x2 = xb + width + y2 = yb + } else if (m == 0.0) { + x1 = xb + y1 = yb - width + x2 = xb + y2 = yb + width + } else { + x1 = xb - sqrt ((m * width) ** 2 / (m ** 2 + 1)) + y1 = yb - (x1 - xb) / m + x2 = xb + sqrt ((m * width) ** 2 / (m ** 2 + 1)) + y2 = yb - (x2 - xb) / m + } + + # Choose the point farthest away from the reference point. + d1 = (x1 - xcen) ** 2 + (y1 - ycen) ** 2 + d2 = (x2 - xcen) ** 2 + (y2 - ycen) ** 2 + if (d1 <= d2) { + xp = x2 + yp = y2 + } else { + xp = x1 + yp = y1 + } + + # Compute the intercept. + if (IS_INDEFR(m)) + b = INDEFR + else + b = yp - m * xp +end + + +# ME_PYCLIP -- Compute the intersection of an image line with a polygon defined +# by a list of vertices. The output is a list of ranges stored in the array +# xranges. Two additional work arrays xintr and slope are required for +# the computation. + +int procedure me_pyclip (xver, yver, xintr, slope, xranges, nver, lx, ld) + +real xver[ARB] #I the x vertex coords +real yver[ARB] #I the y vertex coords +real xintr[ARB] #O the array of x intersection points +real slope[ARB] #O the array of y slopes at intersection points +real xranges[ARB] #O the x line segments +int nver #I the number of vertices +real lx, ld #I the equation of the image line + +real u1, u2, u1u2, dx, dy, dd, xa, wa +int i, j, nintr, nplus, nzero, nneg, imin, imax, nadd +bool collinear + +begin + # Initialize. + collinear = false + nplus = 0 + nzero = 0 + nneg = 0 + nintr = 0 + + # Compute the intersection points of the image line and the polygon. + u1 = lx * (- yver[1] + ld) + do i = 2, nver { + + u2 = lx * (- yver[i] + ld) + u1u2 = u1 * u2 + + # Does the polygon side intersect the image line ? + if (u1u2 <= 0.0) { + + + # Compute the x intersection coordinate if the point of + # intersection is not a vertex. + + if ((u1 != 0.0) && (u2 != 0.0)) { + + dy = yver[i-1] - yver[i] + dx = xver[i-1] - xver[i] + dd = xver[i-1] * yver[i] - yver[i-1] * xver[i] + xa = lx * (dx * ld - dd) + wa = dy * lx + nintr = nintr + 1 + xranges[nintr] = xa / wa + slope[nintr] = -dy + if (slope[nintr] < 0.0) + nneg = nneg + 1 + else if (slope[nintr] > 0.0) + nplus = nplus + 1 + else + nzero = nzero + 1 + collinear = false + + # For each collinear line segment add two intersection + # points. Remove interior collinear intersection points. + + } else if (u1 == 0.0 && u2 == 0.0) { + + if (! collinear) { + nintr = nintr + 1 + xranges[nintr] = xver[i-1] + if (i == 2) + slope[nintr] = yver[1] - yver[nver-1] + else + slope[nintr] = yver[i-1] - yver[i-2] + if (slope[nintr] < 0.0) + nneg = nneg + 1 + else if (slope[nintr] > 0.0) + nplus = nplus + 1 + else + nzero = nzero + 1 + nintr = nintr + 1 + xranges[nintr] = xver[i] + slope[nintr] = 0.0 + nzero = nzero + 1 + } else { + xranges[nintr] = xver[i] + slope[nintr] = 0.0 + nzero = nzero + 1 + } + collinear = true + + # If the intersection point is a vertex add it to the + # list if it is not collinear with the next point. Add + # another point to the list if the vertex is at the + # apex of an acute angle. + + } else if (u1 != 0.0) { + + if (i == nver) { + dx = (xver[2] - xver[nver]) + dy = (yver[2] - yver[nver]) + dd = dy * (yver[nver-1] - yver[nver]) + } else { + dx = (xver[i+1] - xver[i]) + dy = (yver[i+1] - yver[i]) + dd = dy * (yver[i-1] - yver[i]) + } + + # Test whether the point is collinear with the point + # ahead. If it is not include the intersection point. + + if (dy != 0.0) { + nintr = nintr + 1 + xranges[nintr] = xver[i] + slope[nintr] = yver[i] - yver[i-1] + if (slope[nintr] < 0.0) + nneg = nneg + 1 + else if (slope[nintr] > 0.0) + nplus = nplus + 1 + else + nzero = nzero + 1 + } + + # If the intersection point is an isolated vertex add + # another point to the list. + + if (dd > 0.0) { + nintr = nintr + 1 + xranges[nintr] = xver[i] + slope[nintr] = dy + if (slope[nintr] < 0.0) + nneg = nneg + 1 + else if (slope[nintr] > 0.0) + nplus = nplus + 1 + else + nzero = nzero + 1 + } + + collinear = false + + } else + collinear = false + } else + collinear = false + + u1 = u2 + } + + # Join up any split collinear line segments. + if (collinear && (slope[1] == 0.0)) { + xranges[1] = xranges[nintr-1] + slope[1] = slope[nintr-1] + nintr = nintr - 2 + nzero = nzero - 2 + } + + # Return the number of intersection points if there are no interior + # collinear line segments. + if (nzero == 0 || nplus == 0 || nneg == 0) + return (nintr) + + # Find the minimum and maximum intersection points. + call me_alimr (xranges, nintr, u1, u2, imin, imax) + + # Check for vertices at the ends of the ranges. + + u1 = xranges[min(imin,imax)] - xranges[1] + u2 = xranges[nintr] - xranges[max(imin,imax)] + + # Vertices were traversed in order of increasing x. + if ((u1 >= 0.0 && u2 > 0.0) || (u1 > 0.0 && u2 >= 0.0) || + (u1 == u2 && imax > imin)) { + do i = imax + 1, nintr { + if (xranges[i] != xranges[i-1]) + break + imax = i + } + do i = imin - 1, 1, -1 { + if (xranges[i] != xranges[i+1]) + break + imin = i + } + } + + # Vertices were traversed in order of decreasing x. + if ((u1 <= 0.0 && u2 < 0.0) || (u1 < 0.0 && u2 <= 0.0) || + (u1 == u2 && imax < imin)) { + do i = imin + 1, nintr { + if (xranges[i] != xranges[i-1]) + break + imin = i + } + do i = imax - 1, 1, -1 { + if (xranges[i] != xranges[i+1]) + break + imax = i + } + } + + # Reorder the x ranges and slopes if necessary. + if ((imax < imin) && ! (imin == nintr && imax == 1)) { + call amovr (xranges, xintr, nintr) + do i = 1, imax + xranges[nintr-imax+i] = xintr[i] + do i = imin, nintr + xranges[i-imax] = xintr[i] + call amovr (slope, xintr, nintr) + do i = 1, imax + slope[nintr-imax+i] = xintr[i] + do i = imin, nintr + slope[i-imax] = xintr[i] + } else if ((imin < imax) && ! (imin == 1 && imax == nintr)) { + call amovr (xranges, xintr, nintr) + do i = 1, imin + xranges[nintr-imin+i] = xintr[i] + do i = imax, nintr + xranges[i-imin] = xintr[i] + call amovr (slope, xintr, nintr) + do i = 1, imin + slope[nintr-imin+i] = xintr[i] + do i = imax, nintr + slope[i-imin] = xintr[i] + } + + # Add any extra intersection points that are required to deal with + # the collinear line segments. + + nadd = 0 + for (i = 1; i <= nintr-2; ) { + if (slope[i] * slope[i+2] > 0.0) { + i = i + 2 + } else { + nadd = nadd + 1 + xranges[nintr+nadd] = xranges[i+1] + for (j = i + 3; j <= nintr; j = j + 1) { + if (slope[i] * slope[j] > 0) + break + nadd = nadd + 1 + xranges[nintr+nadd] = xranges[j-1] + } + i = j + } + } + + return (nintr + nadd) +end + + +# ME_ALIMR -- Compute the maximum and minimum data values and indices of a +# 1D array. + +procedure me_alimr (data, npts, mindat, maxdat, imin, imax) + +real data[npts] #I the input data array +int npts #I the number of points +real mindat, maxdat #O the minimum and maximum data values +int imin, imax #O the indices of the minimum and maximum data values + +int i + +begin + imin = 1 + imax = 1 + mindat = data[1] + maxdat = data[1] + + do i = 2, npts { + if (data[i] > maxdat) { + imax = i + maxdat = data[i] + } + if (data[i] < mindat) { + imin = i + mindat = data[i] + } + } +end + + +define FIRST 1 # Default starting range +define LAST MAX_INT # Default ending range +define STEP 1 # Default step +define EOLIST 0 # End of list + +# ME_DECODE_RANGES -- Parse a string containing a list of integer numbers or +# ranges, delimited by either spaces or commas. Return as output a list +# of ranges defining a list of numbers, and the count of list numbers. +# Range limits must be positive nonnegative integers. ERR is returned as +# the function value if a conversion error occurs. The list of ranges is +# delimited by EOLIST. + +int procedure me_decode_ranges (range_string, ranges, max_ranges, nvalues) + +char range_string[ARB] #I range string to be decoded +int ranges[3, max_ranges] #O output range array +int max_ranges #I maximum number of ranges +int nvalues #O the number of values in the ranges + +int ip, nrange, first, last, step, ctoi() + +begin + ip = 1 + nvalues = 0 + + do nrange = 1, max_ranges - 1 { + # Defaults to all nonnegative integers + first = FIRST + last = LAST + step = STEP + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get first limit. + # Must be a number, '-', 'x', or EOS. If not return ERR. + if (range_string[ip] == EOS) { # end of list + if (nrange == 1) { + # Null string defaults + ranges[1, 1] = first + ranges[2, 1] = last + ranges[3, 1] = step + ranges[1, 2] = EOLIST + nvalues = MAX_INT + return (OK) + } else { + ranges[1, nrange] = EOLIST + return (OK) + } + } else if (range_string[ip] == '-') + ; + else if (range_string[ip] == 'x') + ; + else if (IS_DIGIT(range_string[ip])) { # ,n.. + if (ctoi (range_string, ip, first) == 0) + return (ERR) + } else + return (ERR) + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get last limit + # Must be '-', or 'x' otherwise last = first. + if (range_string[ip] == 'x') + ; + else if (range_string[ip] == '-') { + ip = ip + 1 + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + if (range_string[ip] == EOS) + ; + else if (IS_DIGIT(range_string[ip])) { + if (ctoi (range_string, ip, last) == 0) + return (ERR) + } else if (range_string[ip] == 'x') + ; + else + return (ERR) + } else + last = first + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get step. + # Must be 'x' or assume default step. + if (range_string[ip] == 'x') { + ip = ip + 1 + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + if (range_string[ip] == EOS) + ; + else if (IS_DIGIT(range_string[ip])) { + if (ctoi (range_string, ip, step) == 0) + ; + if (step == 0) + return (ERR) + } else if (range_string[ip] == '-') + ; + else + return (ERR) + } + + # Output the range triple. + ranges[1, nrange] = first + ranges[2, nrange] = last + ranges[3, nrange] = step + nvalues = nvalues + abs (last-first) / step + 1 + } + + return (ERR) # ran out of space +end + + +# ME_NEXT_NUMBER -- Given a list of ranges and the current file number, +# find and return the next file number. Selection is done in such a way +# that list numbers are always returned in monotonically increasing order, +# regardless of the order in which the ranges are given. Duplicate entries +# are ignored. EOF is returned at the end of the list. + +int procedure me_next_number (ranges, number) + +int ranges[ARB] #I the range array +int number #U both input and output parameter + +int ip, first, last, step, next_number, remainder + +begin + # If number+1 is anywhere in the list, that is the next number, + # otherwise the next number is the smallest number in the list which + # is greater than number+1. + + number = number + 1 + next_number = MAX_INT + + for (ip=1; ranges[ip] != EOLIST; ip=ip+3) { + first = min (ranges[ip], ranges[ip+1]) + last = max (ranges[ip], ranges[ip+1]) + step = ranges[ip+2] + if (step == 0) + call error (1, "Step size of zero in range list") + if (number >= first && number <= last) { + remainder = mod (number - first, step) + if (remainder == 0) + return (number) + if (number - remainder + step <= last) + next_number = number - remainder + step + } else if (first > number) + next_number = min (next_number, first) + } + + if (next_number == MAX_INT) + return (EOF) + else { + number = next_number + return (number) + } +end + + +# ME_PREVIOUS_NUMBER -- Given a list of ranges and the current file number, +# find and return the previous file number. Selection is done in such a way +# that list numbers are always returned in monotonically decreasing order, +# regardless of the order in which the ranges are given. Duplicate entries +# are ignored. EOF is returned at the end of the list. + +int procedure me_previous_number (ranges, number) + +int ranges[ARB] # Range array +int number # Both input and output parameter + +int ip, first, last, step, next_number, remainder + +begin + # If number-1 is anywhere in the list, that is the previous number, + # otherwise the previous number is the largest number in the list which + # is less than number-1. + + number = number - 1 + next_number = 0 + + for (ip=1; ranges[ip] != EOLIST; ip=ip+3) { + first = min (ranges[ip], ranges[ip+1]) + last = max (ranges[ip], ranges[ip+1]) + step = ranges[ip+2] + if (step == 0) + call error (1, "Step size of zero in range list") + if (number >= first && number <= last) { + remainder = mod (number - first, step) + if (remainder == 0) + return (number) + if (number - remainder >= first) + next_number = number - remainder + } else if (last < number) { + remainder = mod (last - first, step) + if (remainder == 0) + next_number = max (next_number, last) + else if (last - remainder >= first) + next_number = max (next_number, last - remainder) + } + } + + if (next_number == 0) + return (EOF) + else { + number = next_number + return (number) + } +end + + +# ME_IS_IN_RANGE -- Test number to see if it is in range. If the number is +# INDEFI then it is mapped to the maximum integer. + +bool procedure me_is_in_range (ranges, number) + +int ranges[ARB] # range array +int number # number to be tested against ranges + +int ip, first, last, step, num + +begin + if (IS_INDEFI (number)) + num = MAX_INT + else + num = number + + for (ip = 1; ranges[ip] != EOLIST; ip = ip+3) { + first = min (ranges[ip], ranges[ip+1]) + last = max (ranges[ip], ranges[ip+1]) + step = ranges[ip+2] + if (num >= first && num <= last) + if (mod (num - first, step) == 0) + return (true) + } + + return (false) +end diff --git a/pkg/proto/maskexpr/meregmask.x b/pkg/proto/maskexpr/meregmask.x new file mode 100644 index 00000000..45db9079 --- /dev/null +++ b/pkg/proto/maskexpr/meregmask.x @@ -0,0 +1,753 @@ +include <mach.h> +include <ctype.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <evvexpr.h> + +define DEF_LINELEN 8192 + +define LEN_RGEXPR 25 +define RG_PMIM Memi[$1] # the mask image +define RG_PMIBUF Memi[$1+1] # the mask input data +define RG_IPMV Meml[P2L($1+2+($2)-1)] # input position in mask image +define RG_OPMV Meml[P2L($1+9+($2)-1)] # output position in mask image + + +# ME_RGMASK -- Given a region expression, a condition equals true expression, +# a condition equals false expression, and an existing pixel mask imio +# descriptor of dimensions, size of each dimension, and depth in bits create +# a mask image and return an imio pointer to the mask. + +int procedure me_rgmask (rexpr, texpr, fexpr, pmim) + +char rexpr[ARB] #I the boolean region expression +char texpr[ARB] #I the condition equals true expression +char fexpr[ARB] #I the condition equals true expression +pointer pmim #I the pixel mask imio descriptor + +pointer sp, rg, oexpr, expr, obuf +int i, npix, nlines, depth, pmaxval, stat + +pointer evvexpr() +int imstati(), locpr(), pm_stati() +int imgnli(), impnli(), impnls(), impnll() +extern rg_getop(), rg_fcn() + +begin + # Allocate some work space. + call smark (sp) + call salloc (expr, 3 * SZ_LINE, TY_CHAR) + + # Allocate space for the mask expression structure. + call calloc (rg, LEN_RGEXPR, TY_STRUCT) + RG_PMIM(rg) = pmim + + # Initalize the i/o pointers. + call amovkl (long(1), RG_OPMV(rg,1), IM_MAXDIM) + call amovkl (long(1), RG_IPMV(rg,1), IM_MAXDIM) + + # Create the conditional expression to be evaluated. + call sprintf (Memc[expr], 3 * SZ_LINE, "(%s) ? %s : %s") + call pargstr (rexpr) + call pargstr (texpr) + call pargstr (fexpr) + + # Compute the total number of output image lines. + npix = IM_LEN(pmim,1) + nlines = 1 + do i = 2, IM_NDIM(pmim) + nlines = nlines * IM_LEN(pmim, i) + depth = INDEFI + + # Loop over the mask output image lines which are by default always + # integer. + stat = OK + do i = 1, nlines { + + # Get the input mask lines. + if (imgnli (pmim, RG_PMIBUF(rg), RG_IPMV(rg,1)) == EOF) + call error (2, "Error reading input mask data") + + # Determine the depth of the mask. + if (IS_INDEFI(depth)) { + depth = pm_stati (imstati (pmim, IM_PLDES), P_DEPTH) + if (depth > 0) { + pmaxval = min (depth, PL_MAXDEPTH) + pmaxval = 2 ** depth - 1 + } else + pmaxval = 2 ** PL_MAXDEPTH - 1 + } + + # Evalute the expression. + oexpr = evvexpr (Memc[expr], locpr(rg_getop), rg, locpr(rg_fcn), + rg, 0) + if (O_TYPE(oexpr) == ERR) { + call eprintf ("Error evaluting expression\n") + stat = ERR + break + } + + # Copy the evaluated expression to the image. + if (O_LEN(oexpr) == 0) { + switch (O_TYPE(oexpr)) { + case TY_BOOL: + if (impnli (pmim, obuf, RG_OPMV(rg,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropi (NULL, 1, MAX_INT, Memi[obuf], 1, pmaxval, + npix, PIX_CLR + PIX_VALUE(O_VALI(oexpr))) + case TY_SHORT: + if (impnls (pmim, obuf, RG_OPMV(rg,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixrops (NULL, 1, MAX_SHORT, Mems[obuf], 1, + pmaxval, npix, PIX_CLR + PIX_VALUE(O_VALS(oexpr))) + case TY_INT: + if (impnli (pmim, obuf, RG_OPMV(rg,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropi (NULL, 1, MAX_INT, Memi[obuf], 1, + pmaxval, npix, PIX_CLR + PIX_VALUE(O_VALI(oexpr))) + case TY_LONG: + if (impnll (pmim, obuf, RG_OPMV(rg,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropl (NULL, 1, MAX_LONG, Meml[obuf], 1, + pmaxval, npix, PIX_CLR + PIX_VALUE(O_VALL(oexpr))) + case TY_REAL: + call error (3, "Type real expressions are not supported") + case TY_DOUBLE: + call error (3, "Type double expressions are not supported") + default: + call error (3, "Unknown expression value type") + } + + } else { + switch (O_TYPE(oexpr)) { + case TY_BOOL: + if (impnli (pmim, obuf, RG_OPMV(rg,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropi (Memi[O_VALP(oexpr)], 1, MAX_INT, + Memi[obuf], 1, pmaxval, npix, PIX_SRC) + case TY_SHORT: + if (impnls (pmim, obuf, RG_OPMV(rg,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixrops (Mems[O_VALP(oexpr)], 1, MAX_SHORT, + Mems[obuf], 1, pmaxval, npix, PIX_SRC) + case TY_INT: + if (impnli (pmim, obuf, RG_OPMV(rg,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropi (Memi[O_VALP(oexpr)], 1, MAX_INT, + Memi[obuf], 1, pmaxval, npix, PIX_SRC) + case TY_LONG: + if (impnll (pmim, obuf, RG_OPMV(rg,1)) == EOF) + call error (2, "Error writing output mask data") + call pl_pixropl (Meml[O_VALP(oexpr)], 1, MAX_LONG, + Meml[obuf], 1, pmaxval, npix, PIX_SRC) + case TY_REAL: + call error (3, "Type real expressions are not supported") + case TY_DOUBLE: + call error (3, "Type double expressions are not supported") + default: + call error (3, "Unknown expression value type") + } + } + + call evvfree (oexpr) + } + + # Cleanup. + call mfree (rg, TY_STRUCT) + + call sfree (sp) + + return (stat) +end + + +# RG_GETOP -- Called by evvexpr to fetch an input image operand. + +procedure rg_getop (rg, opname, o) + +pointer rg #I mskexpr descriptor +char opname[ARB] #I operand name +pointer o #I output operand to be filled in + +pointer sp, param, data, im +int i, axis +int imgftype(), btoi() +double imgetd() +int imgeti() +bool imgetb() +errchk malloc +define err_ 91 + +begin + call smark (sp) + + # Pixel image operand. + if ((opname[1] == 'p') && (opname[2] == EOS)) { + + if (RG_PMIM(rg) == NULL) + goto err_ + + O_TYPE(o) = TY_INT + O_LEN(o) = IM_LEN(RG_PMIM(rg), 1) + O_FLAGS(o) = 0 + O_VALP(o) = RG_PMIBUF(rg) + + call sfree (sp) + return + + # Reference image header parameter operand. + } else if ((opname[1] == 'p') && (opname[2] == '.')) { + + im = RG_PMIM(rg) + if (im == NULL) + goto err_ + + # Get the parameter value and set up operand struct. + call salloc (param, SZ_FNAME, TY_CHAR) + call strcpy (opname[3], Memc[param], SZ_FNAME) + iferr (O_TYPE(o) = imgftype (im, Memc[param])) + goto err_ + + switch (O_TYPE(o)) { + + case TY_BOOL: + O_LEN(o) = 0 + 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_SHORT, TY_INT, TY_LONG: + iferr (O_VALI(o) = imgeti (im, Memc[param])) + goto err_ + + case TY_REAL, TY_DOUBLE: + O_TYPE(o) = TY_DOUBLE + iferr (O_VALD(o) = imgetd (im, Memc[param])) + goto err_ + + default: + goto err_ + } + + call sfree (sp) + return + + # 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. + + } else if (IS_UPPER(opname[1]) && opname[2] == EOS) { + + axis = opname[1] - 'I' + 1 + if (axis == 1) { + O_TYPE(o) = TY_INT + if (IM_LEN(RG_PMIM(rg), 1) > 0) + O_LEN(o) = IM_LEN(RG_PMIM(rg), 1) + else + 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 + if (IM_LEN(RG_PMIM(rg), 1) > 0) + O_LEN(o) = IM_LEN(RG_PMIM(rg), 1) + else + 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 (RG_OPMV(rg,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 + + +# define the builtin functions + +define RG_FUNCS "|circle|ellipse|box|rectangle|polygon|cols|lines|\ +vector|pie|cannulus|eannulus|rannulus|pannulus|point|" + +define RG_CIRCLE 1 +define RG_ELLIPSE 2 +define RG_BOX 3 +define RG_RECTANGLE 4 +define RG_POLYGON 5 +define RG_COLS 6 +define RG_LINES 7 +define RG_VECTOR 8 +define RG_PIE 9 +define RG_CANNULUS 10 +define RG_EANNULUS 11 +define RG_RANNULUS 12 +define RG_PANNULUS 13 +define RG_POINT 14 + + +# RG_FCN -- Called by evvexpr to execute a mskexpr special function. + +procedure rg_fcn (rg, fcn, args, nargs, o) + +pointer rg #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 + +real width +pointer sp, ufunc, rval1, rval2, orval1, orval2, ix, iy +int i, ip, func, v_nargs, nver +int strdic(), ctor() +bool strne() + +begin + # Allocate working space. + call smark (sp) + call salloc (ufunc, SZ_LINE, TY_CHAR) + + # Get the function. + func = strdic (fcn, Memc[ufunc], SZ_LINE, RG_FUNCS) + if (func > 0 && strne (fcn, Memc[ufunc])) + func = 0 + + # Test the function. + if (func <= 0) { + O_TYPE(o) = ERR + call sfree (sp) + return + } + + # Determine number of arguments. This is a separate case statement. + # in case we need to deal with a variable number of arguments + # function at a later point. + switch (func) { + case RG_POINT, RG_CIRCLE, RG_ELLIPSE, RG_BOX, RG_RECTANGLE, RG_POLYGON: + v_nargs = -1 + case RG_CANNULUS, RG_EANNULUS, RG_RANNULUS, RG_PANNULUS: + v_nargs = -1 + case RG_COLS, RG_LINES: + v_nargs = -1 + case RG_VECTOR, RG_PIE: + v_nargs = -1 + default: + v_nargs = 0 + } + + # Check the number of arguments. + if (v_nargs > 0 && nargs != v_nargs) { + O_TYPE(o) = ERR + call sfree (sp) + return + } + if (v_nargs < 0 && nargs < abs (v_nargs)) { + O_TYPE(o) = ERR + call sfree (sp) + return + } + + if (func == RG_POLYGON && nargs < 6) { + O_TYPE(o) = ERR + call sfree (sp) + return + } + + # Type convert the arguments appropriately. At the moment this is + # simple if we assume that all the required arguments are real. + call salloc (rval1, nargs, TY_REAL) + call salloc (rval2, nargs, TY_REAL) + do i = 1, nargs { + switch (O_TYPE(args[i])) { + case TY_CHAR: + ip = 1 + if (ctor (O_VALC(args[i]), ip, Memr[rval1+i-1]) == 0) + Memr[rval1+i-1] = 0. + case TY_INT: + Memr[rval1+i-1] = O_VALI(args[i]) + case TY_REAL: + Memr[rval1+i-1] = O_VALR(args[i]) + case TY_DOUBLE: + Memr[rval1+i-1] = O_VALD(args[i]) + } + } + + # Evaluate the function. Worry about some duplication of code later. + switch (func) { + + case RG_CIRCLE: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 5) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_circle (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4]) + } else if (nargs == 3) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_circle (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_ELLIPSE: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 7) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_ellipse (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6]) + } else if (nargs == 5) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_ellipse (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_BOX: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 6) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_box (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5]) + } else if (nargs == 4) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_box (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_RECTANGLE: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 7) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_rectangle (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6]) + } else if (nargs == 5) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_rectangle (Memi[ix], Memi[iy], Memi[O_VALP(o)], + O_LEN(o), Memr[rval1], Memr[rval1+1], Memr[rval1+2], + Memr[rval1+3], Memr[rval1+4]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_POLYGON: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs < 6) { + O_TYPE(o) = ERR + } else if (O_LEN(args[1]) > 0 && O_LEN(args[2]) > 0) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + nver = (nargs - 2) / 2 + do i = 1, nver + Memr[rval2+i-1] = Memr[rval1+2*i+1] + do i = 1, nver + Memr[rval1+i-1] = Memr[rval1+2*i] + call me_polygon (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1], Memr[rval2], nver) + } else { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + nver = nargs / 2 + do i = 1, nver + Memr[rval2+i-1] = Memr[rval1+2*i-1] + do i = 1, nver + Memr[rval1+i-1] = Memr[rval1+2*i-2] + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_polygon (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval2], nver) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } + + case RG_COLS: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 2) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_cols (Memi[O_VALP(args[1])], Memi[O_VALP(o)], O_LEN(o), + O_VALC(args[2])) + } else if (nargs == 1) { + call malloc (ix, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_cols (Memi[ix], Memi[O_VALP(o)], O_LEN(o), + O_VALC(args[1])) + call mfree (ix, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_LINES: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 2) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_lines (Memi[O_VALP(args[1])], Memi[O_VALP(o)], O_LEN(o), + O_VALC(args[2])) + } else if (nargs == 1) { + call malloc (ix, O_LEN(o), TY_INT) + call amovki (RG_OPMV(rg,2), Memi[ix], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_lines (Memi[ix], Memi[O_VALP(o)], O_LEN(o), + O_VALC(args[1])) + call mfree (ix, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_VECTOR: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 7) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_vector (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6]) + } else if (nargs == 5) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_vector (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_PIE: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 6) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_pie (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], IM_LEN(RG_PMIM(rg),1), + IM_LEN(RG_PMIM(rg),2)) + } else if (nargs == 4) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_pie (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + IM_LEN(RG_PMIM(rg),1), IM_LEN(RG_PMIM(rg),2)) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_CANNULUS: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 6) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_cannulus (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5]) + } else if (nargs == 4) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_cannulus (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_EANNULUS: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 8) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_eannulus (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6], Memr[rval1+7]) + } else if (nargs == 6) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_eannulus (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_RANNULUS: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 8) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_rannulus (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5], Memr[rval1+6], Memr[rval1+7]) + } else if (nargs == 6) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_rannulus (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1], Memr[rval1+2], Memr[rval1+3], + Memr[rval1+4], Memr[rval1+5]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + + case RG_PANNULUS: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs < 7) { + O_TYPE(o) = ERR + } else if (O_LEN(args[1]) > 0 && O_LEN(args[2]) > 0) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + width = Memr[rval1+2] + nver = (nargs - 3) / 2 + do i = 1, nver + #Memr[rval2+i-1] = Memr[rval1+2*i+1] + Memr[rval2+i-1] = Memr[rval1+2*i+2] + do i = 1, nver + #Memr[rval1+i-1] = Memr[rval1+2*i+2] + Memr[rval1+i-1] = Memr[rval1+2*i+1] + call salloc (orval1, nver, TY_REAL) + call salloc (orval2, nver, TY_REAL) + call me_pyexpand (Memr[rval1], Memr[rval2], Memr[orval1], + Memr[orval2], nver, width) + call me_apolygon (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1], Memr[rval2], + Memr[orval1], Memr[orval2], nver) + } else { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + width = Memr[rval1] + nver = (nargs - 1) / 2 + do i = 1, nver + Memr[rval2+i-1] = Memr[rval1+2*i] + do i = 1, nver + Memr[rval1+i-1] = Memr[rval1+2*i-1] + call salloc (orval1, nver, TY_REAL) + call salloc (orval2, nver, TY_REAL) + call me_pyexpand (Memr[rval1], Memr[rval2], Memr[orval1], + Memr[orval2], nver, width) + call me_apolygon (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval2], Memr[orval1], Memr[orval2], nver) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } + + case RG_POINT: + O_LEN(o) = IM_LEN(RG_PMIM(rg),1) + O_TYPE(o) = TY_BOOL + if (nargs == 4) { + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_point (Memi[O_VALP(args[1])], Memi[O_VALP(args[2])], + Memi[O_VALP(o)], O_LEN(o), Memr[rval1+2], Memr[rval1+3]) + } else if (nargs == 2) { + call malloc (ix, O_LEN(o), TY_INT) + call malloc (iy, O_LEN(o), TY_INT) + do i = 1, O_LEN(o) + Memi[ix+i-1] = i + call amovki (RG_OPMV(rg,2), Memi[iy], O_LEN(o)) + call malloc (O_VALP(o), O_LEN(o), TY_INT) + call me_point (Memi[ix], Memi[iy], Memi[O_VALP(o)], O_LEN(o), + Memr[rval1], Memr[rval1+1]) + call mfree (ix, TY_INT) + call mfree (iy, TY_INT) + } else { + O_TYPE(o) = ERR + } + default: + O_TYPE(o) = ERR + } + + call sfree (sp) +end + diff --git a/pkg/proto/maskexpr/mesetexpr.x b/pkg/proto/maskexpr/mesetexpr.x new file mode 100644 index 00000000..40c2495f --- /dev/null +++ b/pkg/proto/maskexpr/mesetexpr.x @@ -0,0 +1,36 @@ +# ME_SETEXPR -- Set the pixel mask region to the appropriate number. + +procedure me_setexpr (expr, pmim, pregno, pregval, verbose) + +char expr[ARB] #I the region expression +pointer pmim #I the pixelmask image descriptor +int pregno #I the current region number +int pregval #I the current region value +bool verbose #I print status messages ? + +pointer sp, chregval +int nchars, stat +int itoc(), me_rgmask() + +begin + call smark (sp) + call salloc (chregval, SZ_FNAME, TY_CHAR) + nchars = itoc (pregval, Memc[chregval], SZ_FNAME) + if (nchars <= 0) { + if (verbose) { + call printf (" Region value %d cannot be encoded\n") + call pargi (pregval) + } + } else { + stat = me_rgmask (expr, Memc[chregval], "p", pmim) + if (stat == ERR) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } + } + + call sfree (sp) +end + diff --git a/pkg/proto/maskexpr/mesetreg.x b/pkg/proto/maskexpr/mesetreg.x new file mode 100644 index 00000000..3fbe3f7b --- /dev/null +++ b/pkg/proto/maskexpr/mesetreg.x @@ -0,0 +1,292 @@ +include <imset.h> +include <plset.h> + +define RG_REGIONS "|circle|ellipse|box|rectangle|polygon|vector|columns|\ +lines|pie|cannulus|eannulus|rannulus|pannulus|point|" + +define RG_CIRCLE 1 +define RG_ELLIPSE 2 +define RG_BOX 3 +define RG_RECTANGLE 4 +define RG_POLYGON 5 +define RG_VECTOR 6 +define RG_COLUMNS 7 +define RG_LINES 8 +define RG_PIE 9 +define RG_CANNULUS 10 +define RG_EANNULUS 11 +define RG_RANNULUS 12 +define RG_PANNULUS 13 +define RG_POINT 14 + +define MAX_NVERTICES 100 + +# RG_SETREG -- Set the pixel mask region to the appropriate number. + +procedure me_setreg (region, pmim, pregno, pregval, verbose) + +char region[ARB] #I the region description +pointer pmim #I the pixelmask image descriptor +int pregno #I the current region number +int pregval #I the current region value +bool verbose #I print status messages ? + +real xc, yc, a, b, ratio, theta +real x1, y1, x2, y2, width +pointer sp, function, ufunction, pl, xver, yver, rangestr +int nfuncs, nver, nold +int strdic(), imstati(), nscan() + +begin + # Allocate working space. + call smark (sp) + call salloc (function, SZ_FNAME, TY_CHAR) + call salloc (ufunction, SZ_FNAME, TY_CHAR) + call salloc (xver, MAX_NVERTICES, TY_REAL) + call salloc (yver, MAX_NVERTICES, TY_REAL) + call salloc (rangestr, SZ_FNAME, TY_CHAR) + + # Determine the type of region. + call sscan (region) + call gargwrd (Memc[function], SZ_FNAME) + nfuncs = strdic (Memc[function], Memc[ufunction], SZ_FNAME, RG_REGIONS) + if (nfuncs <= 0) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + call sfree (sp) + return + } + + pl = imstati (pmim, IM_PLDES) + + switch (nfuncs) { + + case RG_CIRCLE: + call gargr (xc) + call gargr (yc) + call gargr (a) + if (nscan() < 4) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_circle (pl, xc, yc, a, PIX_SRC+PIX_VALUE(pregval)) + } + + case RG_ELLIPSE: + call gargr (xc) + call gargr (yc) + call gargr (a) + call gargr (ratio) + call gargr (theta) + if (nscan() < 6) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_ellipse (pl, xc, yc, a, ratio, theta, + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_BOX: + call gargr (x1) + call gargr (y1) + call gargr (x2) + call gargr (y2) + if (nscan() < 5) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_box (pl, x1, y1, x2, y2, PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_RECTANGLE: + call gargr (xc) + call gargr (yc) + call gargr (a) + call gargr (ratio) + call gargr (theta) + if (nscan() < 6) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_rectangle (pl, xc, yc, a, ratio, theta, + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_POLYGON: + nver = 0 + repeat { + nold = nscan() + call gargr (Memr[xver+nver]) + call gargr (Memr[yver+nver]) + if ((nscan() - nold) == 2) + nver = nver + 1 + else + break + } until ((nscan() - nold) < 2) + if (nver <3 ) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_polygon (pl, Memr[xver], Memr[yver], nver, + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_VECTOR: + call gargr (x1) + call gargr (y1) + call gargr (x2) + call gargr (y2) + call gargr (width) + if (nscan() < 6) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_vector (pl, x1, y1, x2, y2, width, + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_COLUMNS: + call gargwrd (Memc[rangestr], SZ_FNAME) + if (nscan() < 2) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_cols (pl, Memc[rangestr], + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_LINES: + call gargwrd (Memc[rangestr], SZ_FNAME) + if (nscan() < 2) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_lines (pl, Memc[rangestr], + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_PIE: + call gargr (xc) + call gargr (yc) + call gargr (a) + call gargr (b) + if (nscan() < 5) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_pie (pl, xc, yc, a, b, PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_CANNULUS: + call gargr (xc) + call gargr (yc) + call gargr (a) + call gargr (b) + if (nscan() < 5) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_cannulus (pl, xc, yc, a, b, + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_EANNULUS: + call gargr (xc) + call gargr (yc) + call gargr (a) + call gargr (b) + call gargr (ratio) + call gargr (theta) + if (nscan() < 7) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_eannulus (pl, xc, yc, a, b, ratio, theta, + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_RANNULUS: + call gargr (xc) + call gargr (yc) + call gargr (a) + call gargr (b) + call gargr (ratio) + call gargr (theta) + if (nscan() < 7) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_rannulus (pl, xc, yc, a, b, ratio, theta, + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_PANNULUS: + call gargr (b) + if (nscan () < 2) { + nver = 0 + } else { + nver = 0 + repeat { + nold = nscan() + call gargr (Memr[xver+nver]) + call gargr (Memr[yver+nver]) + if ((nscan() - nold) == 2) + nver = nver + 1 + else + break + } until ((nscan() - nold) < 2) + } + if (nver < 3) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_apolygon (pl, b, Memr[xver], Memr[yver], nver, + PIX_SRC + PIX_VALUE(pregval)) + } + + case RG_POINT: + call gargr (xc) + call gargr (yc) + if (nscan() < 3) { + if (verbose) { + call printf (" Region %d cannot be decoded\n") + call pargi (pregno) + } + } else { + call pe_point (pl, xc, yc, PIX_SRC+PIX_VALUE(pregval)) + } + + default: + ; + } + + call sfree (sp) +end diff --git a/pkg/proto/maskexpr/mkpkg b/pkg/proto/maskexpr/mkpkg new file mode 100644 index 00000000..ee3e86db --- /dev/null +++ b/pkg/proto/maskexpr/mkpkg @@ -0,0 +1,26 @@ +# Make the MSKEXPR and MSKREGIONS tasks + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + t_mskexpr.x <fset.h> <ctype.h> <imhdr.h> + memkmask.x <mach.h> <ctype.h> <imhdr.h> <imset.h> <pmset.h> \ + <evvexpr.h> + + t_mskregions.x <fset.h> <ctype.h> <imhdr.h> <imset.h> <pmset.h> + mesetreg.x <plset.h> <imset.h> + mesetexpr.x + meregmask.x <mach.h> <ctype.h> <imhdr.h> <imset.h> <pmset.h> \ + <evvexpr.h> + peregfuncs.x <plset.h> <plio.h> <math.h> peregfuncs.h + peregufcn.x <plset.h> <plio.h> <math.h> peregfuncs.h + megeom.x <math.h> + + meregfuncs.x <mach.h> <ctype.h> <math.h> + mskexpand.x <ctotok.h> <ctype.h> gettok.h + megsym.x <ctotok.h> <ctype.h> gettok.h + gettok.x <syserr.h> <error.h> <fset.h> <ctype.h> gettok.h + ; diff --git a/pkg/proto/maskexpr/mskexpand.x b/pkg/proto/maskexpr/mskexpand.x new file mode 100644 index 00000000..5fb6cc9d --- /dev/null +++ b/pkg/proto/maskexpr/mskexpand.x @@ -0,0 +1,261 @@ +include <ctotok.h> +include <ctype.h> +include "gettok.h" + +# Some definitions. + +# Default symbol table size limits. +define DEF_LENINDEX 97 +define DEF_LENSTAB 1024 +define DEF_LENSBUF 8192 + +# 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] + + +# ME_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 me_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 +pointer stopen(), stenter() +int open(), getlline(), ctotok(), stpstr() +errchk open, getlline, stopen, stenter, me_puttok + +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 + ip = lbuf + + # Skip comments and blank lines. + 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], SZ_COMMAND) + if (Memc[tokbuf] == '#') + break + else if (token != TOK_EOS && token != TOK_NEWLINE) + call me_puttok (a_st, text, op, buflen, Memc[tokbuf]) + } 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 + + +# ME_PUTTOK -- Append a token string to a text buffer. + +procedure me_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 + + +# ME_EXPANDTEXT -- Scan an expression, performing macro substitution on the +# contents and returning a fully expanded string. + +pointer procedure me_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 me_gsym() + +begin + buflen = SZ_COMMAND + call malloc (buf, buflen, TY_CHAR) + + gt = gt_opentext (expr, locpr(me_gsym), st, 0, GT_NOFILE) + nchars = gt_expand (gt, buf, buflen) + call gt_close (gt) + + return (buf) +end diff --git a/pkg/proto/maskexpr/peregfuncs.h b/pkg/proto/maskexpr/peregfuncs.h new file mode 100644 index 00000000..cc777a9a --- /dev/null +++ b/pkg/proto/maskexpr/peregfuncs.h @@ -0,0 +1,131 @@ +# PEREGFUNCS.H -- Structure definitions. + +# Circle definitions. + +define LEN_CIRCLEDES 5 +define C_PL Memi[$1] # reference mask +define C_XCEN Memr[P2R($1+1)] # X center of circle +define C_YCEN Memr[P2R($1+2)] # Y center of circle +define C_RADIUS Memr[P2R($1+3)] # radius of circle +define C_PV Memi[$1+4] # pixel value + + +# Ellipse definitions. + +define LEN_ELLDES 10 +define E_PL Memi[$1] # reference mask +define E_XCEN Memr[P2R($1+1)] # X center of ellipse +define E_YCEN Memr[P2R($1+2)] # Y center of ellipse +define E_AA Memr[P2R($1+3)] # aa parameter +define E_BB Memr[P2R($1+4)] # bb parameter +define E_CC Memr[P2R($1+5)] # cc parameter +define E_FF Memr[P2R($1+6)] # ff paramater +define E_DXMAX Memr[P2R($1+7)] # the maximum x offset +define E_DYMAX Memr[P2R($1+8)] # the maximum x offset +define E_PV Memi[$1+9] # pixel value + + +# Box definitions. + +define LEN_BOXDES 6 +define B_PL Memi[$1] # reference mask +define B_X1 Memr[P2R($1+1)] # X1 lower left corner of box +define B_Y1 Memr[P2R($1+2)] # Y1 lower left corner of box +define B_X2 Memr[P2R($1+3)] # X2 upper right corner of box +define B_Y2 Memr[P2R($1+4)] # Y2 upper right corner of box +define B_PV Memi[$1+5] # pixel value + + +# Polygon definitions. + +define TOL 0.0001 # pixel units +define swapi {tempi=$2;$2=$1;$1=tempi} +define swapr {tempr=$2;$2=$1;$1=tempr} +define equal (abs($1-$2)<TOL) + +define LEN_PGONDES 7 +define P_PL Memi[$1] # pointer to X vector +define P_XP Memi[$1+1] # pointer to X vector +define P_YP Memi[$1+2] # pointer to Y vector +define P_OO Memi[$1+3] # pointer to previous range list +define P_OY Memi[$1+4] # y value of previous range list +define P_NS Memi[$1+5] # number of line segments +define P_PV Memi[$1+6] # pixel value + + +# Circular annulus definitions. + +define LEN_CANNDES 6 +define CA_PL Memi[$1] # reference mask +define CA_XCEN Memr[P2R($1+1)] # x center of circle +define CA_YCEN Memr[P2R($1+2)] # y center of circle +define CA_RADIUS1 Memr[P2R($1+3)] # inner radius of annulus +define CA_RADIUS2 Memr[P2R($1+4)] # outer radius of annulus +define CA_PV Memi[$1+5] # pixel value + + +# Elliptical annulus defintiions. + +define LEN_EANNDES 16 +define EA_PL Memi[$1] # reference mask +define EA_XCEN Memr[P2R($1+1)] # x center of ellipse +define EA_YCEN Memr[P2R($1+2)] # y center of ellipse +define EA_AA1 Memr[P2R($1+3)] # aa parameter for inner ellipse +define EA_BB1 Memr[P2R($1+4)] # bb parameter for inner ellipse +define EA_CC1 Memr[P2R($1+5)] # cc parameter for inner ellipse +define EA_FF1 Memr[P2R($1+6)] # ff parameter for inner ellipse +define EA_DXMAX1 Memr[P2R($1+7)] # max dx value for inner ellipse +define EA_DYMAX1 Memr[P2R($1+8)] # max dy value for inner ellipse +define EA_AA2 Memr[P2R($1+9)] # aa parameter for outer ellipse +define EA_BB2 Memr[P2R($1+10)] # bb parameter for outer ellipse +define EA_CC2 Memr[P2R($1+11)] # cc parameter for outer ellipse +define EA_FF2 Memr[P2R($1+12)] # ff parameter for outer ellipse +define EA_DXMAX2 Memr[P2R($1+13)] # max dx value for outer ellipse +define EA_DYMAX2 Memr[P2R($1+14)] # max dy value for outer ellipse +define EA_PV Memi[$1+15] # pixel value + + +# Rasterop annulus definitions. + +define LEN_RANNDES 7 +define RA_PL Memi[$1] # the mask descriptor +define RA_IXP Memi[$1+1] # pointer to inner polygon X vector +define RA_IYP Memi[$1+2] # pointer to inner Y polygon vector +define RA_OXP Memi[$1+3] # pointer to outer X polygon vector +define RA_OYP Memi[$1+4] # pointer to outer Y polygon vector +define RA_NVER Memi[$1+5] # number of vertices +define RA_PV Memi[$1+6] # mask pixel value + + +# Polygon annulus definitions. + +define LEN_PAGONDES 7 +define PA_PL Memi[$1] # the mask descriptor +define PA_IXP Memi[$1+1] # pointer to inner polygon X vector +define PA_IYP Memi[$1+2] # pointer to inner Y polygon vector +define PA_OXP Memi[$1+3] # pointer to outer X polygon vector +define PA_OYP Memi[$1+4] # pointer to outer Y polygon vector +define PA_NVER Memi[$1+5] # number of vertices +define PA_PV Memi[$1+6] # mask pixel value + + +# Column definitions. + +define LEN_COLSDES 4 +define L_PL Memi[$1] # reference mask +define L_RANGES Memi[$1+1] # pointer to the ranges +define L_NRANGES Memi[$1+2] # the number of ranges +define L_XS Memi[$1+3] # the starting x coordinate value +define L_NPIX Memi[$1+4] # the number of pixels value +define L_PV Memi[$1+5] # pixel value + + +# Line definitions. + +define LEN_LINESDES 3 +define L_PL Memi[$1] # reference mask +define L_RANGES Memi[$1+1] # pointer to the ranges +define L_PV Memi[$1+2] # pixel value + +define MAX_NRANGES 100 +define SMALL_NUMBER 1.0e-24 diff --git a/pkg/proto/maskexpr/peregfuncs.x b/pkg/proto/maskexpr/peregfuncs.x new file mode 100644 index 00000000..9e79d422 --- /dev/null +++ b/pkg/proto/maskexpr/peregfuncs.x @@ -0,0 +1,877 @@ +include <math.h> +include <plset.h> +include <plio.h> +include "peregfuncs.h" + + +# PE_POINT -- Rasterop between a point region as source and an existing +# mas as destination. + +procedure pe_point (pl, x, y, rop) + +pointer pl #I mask descriptor +real x,y #I center coords of circle +int rop #I rasterop + +begin + call pl_point (pl, nint(x), nint(y), rop) +end + + +# PE_CIRCLE -- Rasterop between a circular region as source and an existing +# mask as destination. It is not necessary for the center of the circle to +# be inside the mask; if it is outside, the boundary of the circle will be +# clipped to the boundary of the mask. This is a 2-dim operator. If the +# image dimensionality is greater than two the pl_setplane procedure should +# be called first to specify the plane to be modified. These routines are +# a modification of the ones in plio$plcircle. The main difference is +# that the x, y, radius parameters are initially set to real numbers not +# integers. + +procedure pe_circle (pl, x, y, radius, rop) + +pointer pl #I mask descriptor +real x,y #I center coords of circle +real radius #I radius of circle +int rop #I rasterop + +real y1r, y2r, x1r, x2r +int y1, y2 +pointer sp, ufd +extern pe_ucircle() + +begin + # Not sure why we need to call this routine here. + #call plvalid (pl) + + # Test the line and column limits. + y1r = y - radius + y2r = y + radius + x1r = x - radius + x2r = x + radius + if ((y2r < 0.5) || (y1r > PL_AXLEN(pl,2) + 0.5)) + return + if ((x2r < 0.5) || (x1r > PL_AXLEN(pl,1) + 0.5)) + return + + call smark (sp) + call salloc (ufd, LEN_CIRCLEDES, TY_STRUCT) + + y1 = max ( 1, min (PL_AXLEN(pl,2), int(y1r))) + y2 = max (y1, min (PL_AXLEN(pl,2), int(y2r))) + + C_PL(ufd) = pl + C_XCEN(ufd) = x + C_YCEN(ufd) = y + C_RADIUS(ufd) = radius + C_PV(ufd) = 1 + + call pl_regionrop (pl, pe_ucircle, ufd, y1, y2, rop) + + call sfree (sp) +end + + +# PE_ELLIPSE -- Rasterop between an elliptical region as source and an existing +# mask as destination. It is not necessary for the center of the ellipse to +# be inside the mask; if it is outside, the boundary of the ellipse will be +# clipped to the boundary of the mask. This is a 2-dim operator. If the +# image dimensionality is greater than two the pl_setplane procedure should +# be called first to specify the plane to be modified. These routines are +# a modification of the ones in plio$plcircle. The main difference is +# that the x, y, radius parameters are initially set to real numbers not +# integers. + +procedure pe_ellipse (pl, x, y, radius, ratio, theta, rop) + +pointer pl #I mask descriptor +real x,y #I center coords of ellipse +real radius #I semi-major axis of ellipse +real ratio #I the ratio semi-minor / semi-major axes +real theta #I position angle in degrees +int rop #I rasterop + +real aa, bb, cc, ff, dx, dy +real y1r, y2r, x1r, x2r, r2 +int y1, y2 +pointer sp, ufd +extern pe_uellipse() + +begin + # Not sure why we need to call this routine here. + #call plvalid (pl) + + # Get ellipse parameters. + call me_ellgeom (radius, ratio, theta, aa, bb, cc, ff) + r2 = radius * radius + dx = ff / (aa - bb * bb / 4.0 / cc) + if (dx > 0.0) + dx = sqrt (dx) + else + dx = 0.0 + dy = ff / (cc - bb * bb / 4.0 / aa) + if (dy > 0.0) + dy = sqrt (dy) + else + dy = 0.0 + + # Test the line and column limits. + y1r = y - dy + y2r = y + dy + x1r = x - dx + x2r = x + dx + if ((y2r < 0.5) || (y1r > PL_AXLEN(pl,2) + 0.5)) + return + if ((x2r < 0.5) || (x1r > PL_AXLEN(pl,1) + 0.5)) + return + + call smark (sp) + call salloc (ufd, LEN_ELLDES, TY_STRUCT) + y1 = max ( 1, min (PL_AXLEN(pl,2), int(y1r))) + y2 = max (y1, min (PL_AXLEN(pl,2), int(y2r))) + + E_PL(ufd) = pl + E_XCEN(ufd) = x + E_YCEN(ufd) = y + E_DXMAX(ufd) = dx + E_DYMAX(ufd) = dy + E_AA(ufd) = aa / r2 + E_BB(ufd) = bb / r2 + E_CC(ufd) = cc / r2 + E_FF(ufd) = ff / r2 + E_PV(ufd) = 1 + + call pl_regionrop (pl, pe_uellipse, ufd, y1, y2, rop) + + call sfree (sp) +end + + +# PE_BOX -- Rasterop between a rectangular region as source and an existing +# mask as destination. It is not necessary for the corners of the box to +# be inside the mask; if they are outside, the boundary of the box will be +# clipped to the boundary of the mask. This is a 2-dim operator. If the +# image dimensionality is greater than two the pl_setplane procedure should +# be called first to specify the plane to be modified. These routines are +# a modification of the ones in plio$plbox. The main difference is +# that the x, y, radius parameters are initially set to real numbers not +# integers. + +procedure pe_box (pl, x1, y1, x2, y2, rop) + +pointer pl #I mask descriptor +real x1, y1 #I lower left corner of box +real x2, y2 #I upper right corner of box +int rop #I rasterop + +pointer sp, ufd +extern pe_ubox() + +begin + # Not sure why we need to call this routine here. + #call plvalid (pl) + + # Test the line and column limits. + if ((y2 < 0.5) || (y1 > PL_AXLEN(pl,2) + 0.5)) + return + if ((x2 < 0.5) || (x1 > PL_AXLEN(pl,1) + 0.5)) + return + + call smark (sp) + call salloc (ufd, LEN_BOXDES, TY_STRUCT) + + B_PL(ufd) = pl + B_X1(ufd) = max (1, min (PL_AXLEN(pl,1), nint(x1))) + B_Y1(ufd) = max (1, min (PL_AXLEN(pl,2), nint(y1))) + B_X2(ufd) = max (1, min (PL_AXLEN(pl,1), nint(x2))) + B_Y2(ufd) = max (1, min (PL_AXLEN(pl,2), nint(y2))) + B_PV(ufd) = 1 + + call pl_regionrop (pl, pe_ubox, ufd, int(B_Y1(ufd)), int(B_Y2(ufd)), + rop) + + call sfree (sp) +end + + +# PE_RECTANGLE -- Rasterop between a rectangular region as source and an +# existing mask as destination. It is not necessary for the center of the +# rectangle to be inside the mask; if it is outside, the boundary of the +# rectangle will be clipped to the boundary of the mask. This is a 2-dim +# operator. If the image dimensionality is greater than two the pl_setplane +# procedure should be called first to specify the plane to be modified. +# These routines are a modification of the ones in plio$plcircle. The main +# difference is that the x, y, radius parameters are initially set to real +# numbers not integers. + +procedure pe_rectangle (pl, x, y, radius, ratio, theta, rop) + +pointer pl #I mask descriptor +real x,y #I center coords of rectangle +real radius #I semi-major axis of rectangle +real ratio #I the ratio semi-minor / semi-major axes +real theta #I position angle in degrees +int rop #I rasterop + +real xr[4], yr[4] +int i + +begin + # Get rectangle vertices. + call me_rectgeom (radius, ratio, theta, xr, yr) + do i = 1, 4 { + xr[i] = x + xr[i] + yr[i] = y + yr[i] + } + + # Mark the polygon. + call pe_polygon (pl, xr, yr, 4, rop) +end + + +# PE_VECTOR -- Rasterop between a rectangular vector region as source and an +# existing mask as destination. It is not necessary for the center of the +# rectangle to be inside the mask; if it is outside, the boundary of the +# rectangle will be clipped to the boundary of the mask. This is a 2-dim +# operator. If the image dimensionality is greater than two the pl_setplane +# procedure should be called first to specify the plane to be modified. +# These routines are a modification of the ones in plio$plcircle. The main +# difference is that the x, y, radius parameters are initially set to real +# numbers not integers. + +procedure pe_vector (pl, x1, y1, x2, y2, width, rop) + +pointer pl #I mask descriptor +real x1, y1 #I beginning point of vector +real x2, y2 #I ending point of vector +real width #I width of vector +int rop #I rasterop + +real xr[4], yr[4] +real xc, yc, radius, ratio, theta +int i + +begin + # Compute the center of the rectangle. + xc = (x1 + x2) / 2.0 + yc = (y1 + y2) / 2.0 + + # Compute the semi-major axis, axis ratio, and position angle. + radius = sqrt ((x2 - x1) ** 2 + (y2 - y1) ** 2) / 2.0 + if (radius <= 0.0) + return + ratio = width / radius + theta = RADTODEG (atan2 (y2 - y1, x2 - x1)) + + # Get rectangle vertices. + call me_rectgeom (radius, ratio, theta, xr, yr) + + # Add back in the center coordinates. + do i = 1, 4 { + xr[i] = xc + xr[i] + yr[i] = yc + yr[i] + } + + # Mark the polygon. + call pe_polygon (pl, xr, yr, 4, rop) +end + + +# PE_POLYGON -- Perform a rasterop operation on the area enclosed by a polygon +# drawn in a 2-dimensional plane of a mask. If the dimensionality of the mask +# exceeds 2, the pl_setplane() procedure should be called first to define the +# plane of the mask to be modified. + +procedure pe_polygon (pl, x, y, npts, rop) + +pointer pl #I mask descriptor +real x[npts] #I polygon x-vertices +real y[npts] #I polygon y-vertices +int npts #I number of points in polygon +int rop #I rasterop defining operation + +real line_1r, line_2r +pointer sp, ufd, xp, yp, oo +int line_1, line_2, i +extern pe_upolygon() +errchk plvalid + +begin + # Note sure why this is called. + #call plvalid (pl) + if (npts < 3) + return + + call smark (sp) + call salloc (ufd, LEN_PGONDES, TY_STRUCT) + call salloc (oo, RL_FIRST + (npts+1)*3, TY_INT) + call salloc (xp, npts + 1, TY_REAL) + call salloc (yp, npts + 1, TY_REAL) + + # Initialize the region descriptor. + P_PL(ufd) = pl + P_XP(ufd) = xp + P_YP(ufd) = yp + P_PV(ufd) = 1 + P_OO(ufd) = oo + P_OY(ufd) = -1 + P_NS(ufd) = npts - 1 + RLI_LEN(oo) = 0 + + # Copy the user supplied polygon vertices into the descriptor, + # normalizing the polygon in the process. + + do i = 1, npts { + Memr[xp+i-1] = x[i] + Memr[yp+i-1] = y[i] + } + + if (abs(x[1]-x[npts]) > TOL || abs(y[1]-y[npts]) > TOL) { + Memr[xp+npts] = x[1] + Memr[yp+npts] = y[1] + P_NS(ufd) = npts + } + + # Compute the range in Y in which the polygon should be drawn. + call alimr (y, npts, line_1r, line_2r) + line_1 = max (1, min (PL_AXLEN(pl,2), int (line_1r))) + line_2 = max (line_1, min (PL_AXLEN(pl,2), int (line_2r))) + + call pl_regionrop (pl, pe_upolygon, ufd, line_1, line_2, rop) + + call sfree (sp) +end + + +# PE_CANNULUS -- Rasterop between a circular annular region as source and an +# existing mask as destination. It is not necessary for the center of the +# annulus to be inside the mask; if it is outside, the boundary of the +# annulus will be clipped to the boundary of the mask. This is a 2-dim +# operator. If the image dimensionality is greater than two the pl_setplane +# procedure should be called first to specify the plane to be modified. These +# routines are a modification of the ones in plio$plcircle. The main difference +# is that the x, y, radius1, radius2, parameters are initially set to real +# numbers not integers. + +procedure pe_cannulus (pl, x, y, radius1, radius2, rop) + +pointer pl #I mask descriptor +real x,y #I center coords of circular annulus +real radius1 #I inner radius of circular annulus +real radius2 #I outer radius of circular annulus +int rop #I rasterop + +real y1r, y2r, x1r, x2r +int y1, y2 +pointer sp, ufd +extern pe_ucannulus() + +begin + # Not sure why we need to call this routine here + #call plvalid (pl) + + # The outer annulus must be greater than or equal to the inner annulus + if (radius2 < radius1) + return + + # Test image limits. + y1r = y - radius2 + y2r = y + radius2 + if ((y2r < 0.5) || (y1r > (PL_AXLEN(pl,2) + 0.5))) + return + x1r = x - radius2 + x2r = x + radius2 + if ((x2r < 0.5) || (x1r > (PL_AXLEN(pl,1) + 0.5))) + return + + call smark (sp) + call salloc (ufd, LEN_CANNDES, TY_STRUCT) + + y1 = max ( 1, min (PL_AXLEN(pl,2), int(y1r))) + y2 = max (y1, min (PL_AXLEN(pl,2), int(y2r))) + + CA_PL(ufd) = pl + CA_XCEN(ufd) = x + CA_YCEN(ufd) = y + CA_RADIUS1(ufd) = radius1 + CA_RADIUS2(ufd) = radius2 + CA_PV(ufd) = 1 + + call pl_regionrop (pl, pe_ucannulus, ufd, y1, y2, rop) + + call sfree (sp) +end + + +# PE_EANNULUS -- Rasterop between an elliptical annular region as source and an +# existing mask as destination. It is not necessary for the center of the +# annulus to be inside the mask; if it is outside, the boundary of the +# annulus will be clipped to the boundary of the mask. This is a 2-dim +# operator. If the image dimensionality is greater than two the pl_setplane +# procedure should be called first to specify the plane to be modified. These +# routines are a modification of the ones in plio$plcircle. The main difference +# is that the x, y, radius1, radius2, parameters are initially set to real +# numbers not integers. + +procedure pe_eannulus (pl, x, y, radius1, radius2, ratio, theta, rop) + +pointer pl #I mask descriptor +real x,y #I center coords of circular annulus +real radius1 #I inner radius of circular annulus +real radius2 #I outer radius of circular annulus +real ratio #I the semi-minor / semi-major axis ratio +real theta #I the position angle in degrees +int rop #I rasterop + +real aa, bb, cc, ff, r2, dx, dy +real y1r, y2r, x1r, x2r +int y1, y2 +pointer sp, ufd +extern pe_ueannulus() + +begin + # Not sure why we need to call this routine here + #call plvalid (pl) + + # The outer annulus must be greater than or equal to the inner annulus + if (radius2 < radius1) + return + + # Get the outer ellipse parameters. + call me_ellgeom (radius2, ratio, theta, aa, bb, cc, ff) + r2 = radius2 * radius2 + dx = ff / (aa - bb * bb / 4.0 / cc) + if (dx > 0.0) + dx = sqrt (dx) + else + dx = 0.0 + dy = ff / (cc - bb * bb / 4.0 / aa) + if (dy > 0.0) + dy = sqrt (dy) + else + dy = 0.0 + + # Test image limits. + y1r = y - dy + y2r = y + dy + if ((y2r < 0.5) || (y1r > (PL_AXLEN(pl,2) + 0.5))) + return + x1r = x - dx + x2r = x + dx + if ((x2r < 0.5) || (x1r > (PL_AXLEN(pl,1) + 0.5))) + return + + call smark (sp) + call salloc (ufd, LEN_EANNDES, TY_STRUCT) + + EA_PL(ufd) = pl + EA_XCEN(ufd) = x + EA_YCEN(ufd) = y + EA_AA2(ufd) = aa / r2 + EA_BB2(ufd) = bb / r2 + EA_CC2(ufd) = cc / r2 + EA_FF2(ufd) = ff / r2 + EA_DXMAX2(ufd) = dx + EA_DYMAX2(ufd) = dy + EA_PV(ufd) = 1 + + # Get the inner ellipse parameters. + call me_ellgeom (radius1, ratio, theta, aa, bb, cc, ff) + r2 = radius1 * radius1 + dx = ff / (aa - bb * bb / 4.0 / cc) + if (dx > 0.0) + dx = sqrt (dx) + else + dx = 0.0 + dy = ff / (cc - bb * bb / 4.0 / aa) + if (dy > 0.0) + dy = sqrt (dy) + else + dy = 0.0 + + EA_AA1(ufd) = aa / r2 + EA_BB1(ufd) = bb / r2 + EA_CC1(ufd) = cc / r2 + EA_FF1(ufd) = ff / r2 + EA_DXMAX1(ufd) = dx + EA_DYMAX1(ufd) = dy + + y1 = max ( 1, min (PL_AXLEN(pl,2), int(y1r))) + y2 = max (y1, min (PL_AXLEN(pl,2), int(y2r))) + call pl_regionrop (pl, pe_ueannulus, ufd, y1, y2, rop) + + call sfree (sp) +end + + +# PE_RANNULUS -- Perform a rasterop operation on the area enclosed by a +# rectangular annulus drawn in a 2-dimensional plane of a mask. If the +# dimensionality of the mask exceeds 2, the pl_setplane() procedure should be +# called first to define the plane of the mask to be modified. + +procedure pe_rannulus (pl, x, y, radius1, radius2, ratio, theta, rop) + +pointer pl #I mask descriptor +real x, y #I the center of the rectangular annulus +real radius1, radius2 #I inner and outer semi-major axes +real ratio #I ratio of the semi-minor / semi-major axes +real theta #I position angle +int rop #I rasterop defining operation + +real line_1r, line_2r +pointer sp, ufd, ixp, iyp, oxp, oyp +int line_1, line_2, i +extern pe_uarect() +errchk plvalid + +begin + # Note sure why this is called. + #call plvalid (pl) + + # Initialize the + call smark (sp) + call salloc (ufd, LEN_RANNDES, TY_STRUCT) + call salloc (ixp, 5, TY_REAL) + call salloc (iyp, 5, TY_REAL) + call salloc (oxp, 5, TY_REAL) + call salloc (oyp, 5, TY_REAL) + + # Copy and close the inner polygon. + call me_rectgeom (radius1, ratio, theta, Memr[ixp], Memr[iyp]) + do i = 1, 4 { + Memr[ixp+i-1] = Memr[ixp+i-1] + x + Memr[iyp+i-1] = Memr[iyp+i-1] + y + } + Memr[ixp+4] = Memr[ixp] + Memr[iyp+4] = Memr[iyp] + + # Create and close the outer polygon. + call me_rectgeom (radius2, ratio, theta, Memr[oxp], Memr[oyp]) + do i = 1, 4 { + Memr[oxp+i-1] = Memr[oxp+i-1] + x + Memr[oyp+i-1] = Memr[oyp+i-1] + y + } + Memr[oxp+4] = Memr[oxp] + Memr[oyp+4] = Memr[oyp] + + # Compute the range in X in which the polygon should be drawn + # and reject polygons that are off the image. + call alimr (Memr[oxp], 4, line_1r, line_2r) + line_1 = max (1, min (PL_AXLEN(pl,1), int (line_1r))) + line_2 = max (line_1, min (PL_AXLEN(pl,1), int (line_2r))) + if (line_2 < 1 || line_1 > PL_AXLEN(pl,1)) { + call sfree (sp) + return + } + + # Compute the range in Y in which the polygon should be drawn + # and reject polygons that are off the image. + call alimr (Memr[oyp], 4, line_1r, line_2r) + line_1 = max (1, min (PL_AXLEN(pl,2), int (line_1r))) + line_2 = max (line_1, min (PL_AXLEN(pl,2), int (line_2r))) + if (line_2 < 1 || line_1 > PL_AXLEN(pl,2)) { + call sfree (sp) + return + } + + # Initialize the region descriptor. + RA_PL(ufd) = pl + RA_IXP(ufd) = ixp + RA_IYP(ufd) = iyp + RA_OXP(ufd) = oxp + RA_OYP(ufd) = oyp + RA_NVER(ufd) = 4 + RA_PV(ufd) = 1 + + call pl_regionrop (pl, pe_uarect, ufd, line_1, line_2, rop) + + call sfree (sp) +end + + +# PE_APOLYGON -- Perform a rasterop operation on the area enclosed by a +# polygonal annulus drawn in a 2-dimensional plane of a mask. If the +# dimensionality of the mask exceeds 2, the pl_setplane() procedure should be +# called first to define the plane of the mask to be modified. + +procedure pe_apolygon (pl, width, x, y, npts, rop) + +pointer pl #I mask descriptor +real width #I width of the polygonal annulus +real x[npts] #I the inner polygon x-vertices +real y[npts] #I outer polygon y-vertices +int npts #I number of points in polygon +int rop #I rasterop defining operation + +real line_1r, line_2r +pointer sp, ufd, ixp, iyp, oxp, oyp +int line_1, line_2, i +extern pe_uapolygon() +errchk plvalid + +begin + # Note sure why this is called. + #call plvalid (pl) + if (npts < 3) + return + + # Initialize the + call smark (sp) + call salloc (ufd, LEN_PAGONDES, TY_STRUCT) + call salloc (ixp, npts + 1, TY_REAL) + call salloc (iyp, npts + 1, TY_REAL) + call salloc (oxp, npts + 1, TY_REAL) + call salloc (oyp, npts + 1, TY_REAL) + + # Copy and close the inner polygon. + do i = 1, npts { + Memr[ixp+i-1] = x[i] + Memr[iyp+i-1] = y[i] + } + Memr[ixp+npts] = x[1] + Memr[iyp+npts] = y[1] + + # Create and close the outer polygon. + call me_pyexpand (Memr[ixp], Memr[iyp], Memr[oxp], Memr[oyp], + npts, width) + Memr[oxp+npts] = Memr[oxp] + Memr[oyp+npts] = Memr[oyp] + + # Compute the range in X in which the polygon should be drawn + # and reject polygons that are off the image. + call alimr (Memr[oxp], npts, line_1r, line_2r) + line_1 = max (1, min (PL_AXLEN(pl,1), int (line_1r))) + line_2 = max (line_1, min (PL_AXLEN(pl,1), int (line_2r))) + if (line_2 < 1 || line_1 > PL_AXLEN(pl,1)) { + call sfree (sp) + return + } + + # Compute the range in Y in which the polygon should be drawn + # and reject polygons that are off the image. + call alimr (Memr[oyp], npts, line_1r, line_2r) + line_1 = max (1, min (PL_AXLEN(pl,2), int (line_1r))) + line_2 = max (line_1, min (PL_AXLEN(pl,2), int (line_2r))) + if (line_2 < 1 || line_1 > PL_AXLEN(pl,2)) { + call sfree (sp) + return + } + + # Initialize the region descriptor. + PA_PL(ufd) = pl + PA_IXP(ufd) = ixp + PA_IYP(ufd) = iyp + PA_OXP(ufd) = oxp + PA_OYP(ufd) = oyp + PA_NVER(ufd) = npts + PA_PV(ufd) = 1 + + call pl_regionrop (pl, pe_uapolygon, ufd, line_1, line_2, rop) + + call sfree (sp) +end + + +# PE_COLS -- Rasterop between a set of column ranges as source and an existing +# mask as destination. It is not necessary for the ranges to be inside the +# mask; if they are outside, the boundary of the line ranges will be +# clipped to the boundary of the mask. This is a 2-dim operator. If the +# image dimensionality is greater than two the pl_setplane procedure should +# be called first to specify the plane to be modified. These routines are +# a modification of the ones in plio$plcircle. The main difference is +# that the x, y, radius parameters are initially set to real numbers not +# integers. + +procedure pe_cols (pl, rangestr, rop) + +pointer pl #I mask descriptor +char rangestr[ARB] #I the input ranges string +int rop #I rasterop + +int npts, nvalues, colno, x1, x2, nregions +pointer sp, ufd, rgptr, lineptr +int me_decode_ranges(), me_next_number(), me_previous_number(), pl_p2ri() +extern pe_ucols() + +begin + # Not sure why we need to call this routine here. + #call plvalid (pl) + npts = PL_AXLEN(pl,1) + + call smark (sp) + call salloc (ufd, LEN_COLSDES, TY_STRUCT) + call salloc (rgptr, 3 * MAX_NRANGES + 1, TY_INT) + call salloc (lineptr, npts, TY_INT) + + # Decode the ranges string + if (me_decode_ranges (rangestr, Memi[rgptr], MAX_NRANGES, + nvalues) == ERR) { + call sfree (sp) + return + } + + # Get the column limits. + x1 = INDEFI + x2 = INDEFI + colno = 0 + if (me_next_number (Memi[rgptr], colno) != EOF) + x1 = colno + colno = npts + 1 + if (me_previous_number (Memi[rgptr], colno) != EOF) + x2 = colno + if (IS_INDEFI(x1) || IS_INDEFI(x2)) { + call sfree (sp) + return + } + + # Set the pixel values. + call aclri (Memi[lineptr], npts) + colno = 0 + while (me_next_number (Memi[rgptr], colno) != EOF) { + if (colno < 1 || colno > npts) + next + Memi[lineptr+colno-1] = 1 + } + + # Convert the pixel list to a ranges list. + nregions = pl_p2ri (Memi[lineptr], 1, Memi[rgptr], npts) + + L_PL(ufd) = pl + L_RANGES(ufd) = rgptr + L_NRANGES(ufd) = nregions + L_XS(ufd) = 1 + L_NPIX(ufd) = npts + L_PV(ufd) = 1 + + # Call the regions operator. + call pl_regionrop (pl, pe_ucols, ufd, 1, PL_AXLEN(pl,2), rop) + + call sfree (sp) +end + + +# PE_LINES -- Rasterop between a set of line ranges as source and an existing +# mask as destination. It is not necessary for the ranges to be inside the +# mask; if they are outside, the boundary of the line ranges will be +# clipped to the boundary of the mask. This is a 2-dim operator. If the +# image dimensionality is greater than two the pl_setplane procedure should +# be called first to specify the plane to be modified. These routines are +# a modification of the ones in plio$plcircle. The main difference is +# that the x, y, radius parameters are initially set to real numbers not +# integers. + +procedure pe_lines (pl, rangestr, rop) + +pointer pl #I mask descriptor +char rangestr[ARB] #I the input ranges string +int rop #I rasterop + +int i, y1, y2, nvalues +pointer sp, rgptr, ufd +int me_decode_ranges() +bool me_is_in_range() +extern pe_ulines() + +begin + # Not sure why we need to call this routine here. + #call plvalid (pl) + + call smark (sp) + call salloc (ufd, LEN_LINESDES, TY_STRUCT) + call salloc (rgptr, 3 * MAX_NRANGES + 1, TY_INT) + + # Decode the ranges string + if (me_decode_ranges (rangestr, Memi[rgptr], MAX_NRANGES, + nvalues) == ERR) { + call sfree (sp) + return + } + + # Find the line limits. + y1 = INDEFI + y2 = INDEFI + do i = 1, PL_AXLEN(pl,2) { + if (me_is_in_range (Memi[rgptr], i)) { + y1 = i + break + } + } + if (IS_INDEFI(y1)) { + call sfree (sp) + return + } + do i = PL_AXLEN(pl,2), 1, -1 { + if (me_is_in_range (Memi[rgptr], i)) { + y2 = i + break + } + } + if (IS_INDEFI(y2)) { + call sfree (sp) + return + } + + L_PL(ufd) = pl + L_RANGES(ufd) = rgptr + L_PV(ufd) = 1 + + call pl_regionrop (pl, pe_ulines, ufd, y1, y2, rop) + + call sfree (sp) +end + + +# PE_PIE -- Determine which pixels are inside a pie shaped wedge that +# intersects the image boundaries. + +procedure pe_pie (pl, xc, yc, angle1, angle2, rop) + +pointer pl #I the pixel mask descriptor +real xc, yc #I the center of the wedge +real angle1, angle2 #I the wedge angles +int rop #I the mask raster op + +real sweep, x2, y2, vx[7], vy[7] +int count, intrcpt1, intrcpt2 +int me_pie_intercept(), me_corner_vertex() + +begin + # Set the first vertex + vx[1] = xc + vy[1] = yc + sweep = angle2 - angle1 + + # If the sweep is too small to be noticed don't bother. + if (abs (sweep) < SMALL_NUMBER) { + return + } + if (sweep < 0.0) + sweep = sweep + 360.0 + + # Get the second vertext by computing the intersection of the + # first ray with the image boundaries. + intrcpt1 = me_pie_intercept (PL_AXLEN(pl,1), PL_AXLEN(pl,2), xc, yc, + angle1, vx[2], vy[2]) + + # Compute the second intercept. + intrcpt2 = me_pie_intercept (PL_AXLEN(pl,1), PL_AXLEN(pl,2), xc, yc, + angle2, x2, y2) + + # If angles intercept same side and slice is between them, no corners + # else, mark corners until reaching side with second angle intercept. + count = 3 + if ((intrcpt1 != intrcpt2) || (sweep > 180.0)) { + repeat { + intrcpt1 = me_corner_vertex (intrcpt1, PL_AXLEN(pl,1), + PL_AXLEN(pl,2), vx[count], vy[count]) + count = count + 1 + } until (intrcpt1 == intrcpt2) + } + + # Set last vertex. + vx[count] = x2 + vy[count] = y2 + + # Fill in the polygon + call pe_polygon (pl, vx, vy, count, rop) +end diff --git a/pkg/proto/maskexpr/peregufcn.x b/pkg/proto/maskexpr/peregufcn.x new file mode 100644 index 00000000..8d4a64e1 --- /dev/null +++ b/pkg/proto/maskexpr/peregufcn.x @@ -0,0 +1,808 @@ +include <math.h> +include <plset.h> +include <plio.h> +include "peregfuncs.h" + + +# PE_UCIRCLE -- Regionrop ufcn for a circle (circular region), clipped at +# the borders of the mask. + +bool procedure pe_ucircle (ufd, y, rl_reg, xs, npix) + +pointer ufd #I user function descriptor +int y #I mask line number +int rl_reg[3,ARB] #O output range list for line Y +int xs #O first pixel to be edited +int npix #O number of pixels affected + +real radius, dx, dy +pointer pl +int rn, axlen, x1, x1_clipped, x2, x2_clipped + +begin + pl = C_PL(ufd) + rn = RL_FIRST + axlen = PL_AXLEN(pl,1) + radius = C_RADIUS(ufd) + + dy = abs (C_YCEN(ufd) - y) + if (dy < radius) { + dx = radius * radius - dy * dy + if (dx > 0.0) + dx = sqrt (dx) + else + dx = 0.0 + x1 = int(C_XCEN(ufd) - dx) + x2 = int(C_XCEN(ufd) + dx) + x1_clipped = max(1, min (axlen, x1)) + x2_clipped = max(x1, min (axlen, x2)) + xs = x1_clipped + npix = x2_clipped - x1_clipped + 1 + RL_X(rl_reg,rn) = 1 + RL_N(rl_reg,rn) = npix + RL_V(rl_reg,rn) = C_PV(ufd) + rn = rn + 1 + } else { + npix = 0 + xs = 1 + } + + RL_LEN(rl_reg) = rn - 1 + RL_AXLEN(rl_reg) = npix + + return (true) +end + + +# PE_UELLIPSE -- Regionrop ufcn for an ellipse (elliptical region), clipped at +# the borders of the mask. + +bool procedure pe_uellipse (ufd, y, rl_reg, xs, npix) + +pointer ufd #I user function descriptor +int y #I mask line number +int rl_reg[3,ARB] #O output range list for line Y +int xs #O first pixel to be edited +int npix #O number of pixels affected + +real dy, dy2, ady, bb, cc, discr, dx1, dx2 +pointer pl +int rn, axlen, x1, x1_clipped, x2, x2_clipped + +begin + pl = E_PL(ufd) + rn = RL_FIRST + axlen = PL_AXLEN(pl,1) + + dy = y - E_YCEN(ufd) + dy2 = dy * dy + ady = abs (dy) + bb = E_BB(ufd) * dy + cc = E_CC(ufd) * dy2 + if (ady < E_DYMAX(ufd)) { + discr = bb * bb - 4.0 * E_AA(ufd) * (cc - E_FF(ufd)) + if (discr > 0.0) + discr = sqrt (discr) + else + discr = 0.0 + dx1 = (-bb - discr) / 2.0 / E_AA(ufd) + dx2 = (-bb + discr) / 2.0 / E_AA(ufd) + x1 = int(E_XCEN(ufd) + min (dx1, dx2)) + x2 = int(E_XCEN(ufd) + max (dx1, dx2)) + x1_clipped = max(1, min (axlen, x1)) + x2_clipped = max(x1, min (axlen, x2)) + xs = x1_clipped + npix = x2_clipped - x1_clipped + 1 + RL_X(rl_reg,rn) = 1 + RL_N(rl_reg,rn) = npix + RL_V(rl_reg,rn) = E_PV(ufd) + rn = rn + 1 + } else { + npix = 0 + xs = 1 + } + + RL_LEN(rl_reg) = rn - 1 + RL_AXLEN(rl_reg) = npix + + return (true) +end + + +# PE_UBOX -- Regionrop ufcn for an unrotated rectangle (rectangular region), +# clipped at the borders of the mask. + +bool procedure pe_ubox (ufd, y, rl_reg, xs, npix) + +pointer ufd #I user function descriptor +int y #I mask line number +int rl_reg[3,ARB] #O output range list for line Y +int xs #O first pixel to be edited +int npix #O number of pixels affected + +int rn +bool rl_new + +begin + rl_new = true + rn = RL_FIRST + + if (y >= B_Y1(ufd) && y <= B_Y2(ufd)) { + xs = B_X1(ufd) + npix = B_X2(ufd) - B_X1(ufd) + 1 + RL_X(rl_reg,rn) = 1 + RL_N(rl_reg,rn) = npix + RL_V(rl_reg,rn) = B_PV(ufd) + rn = rn + 1 + } else { + npix = 0 + xs = 1 + } + + RL_LEN(rl_reg) = rn - 1 + RL_AXLEN(rl_reg) = npix + + return (true) +end + + +# PE_UPOLYGON -- Regionrop ufcn for a general closed polygonal region. +# This a copy of pl_upolgon which contains the following editorial comment. +# Surely there must be a simpler way to code this ... I have a polygon +# routines of my own which I use in the photometry code which may be +# a bit simpler. Might replace this at some point. + +bool procedure pe_upolygon (ufd, line, rl_reg, xs, npix) + +pointer ufd #I user function descriptor +int line #I mask line number +int rl_reg[3,ARB] #O output range list for line Y +int xs #O start of edit region in dst mask +int npix #O number of pixels affected + +pointer xp, yp, pl +bool rl_new, cross +int nseg, np, low, rn, i1, i2, ii, i, j +int tempi, axlen, rl_len, p_prev, p_next +real tempr, y, y1, y2, x1, x2, p1, p2, p_y, n_y + +int btoi() +bool plr_equali() +define done_ 91 + +begin + pl = P_PL(ufd) + axlen = PL_AXLEN(pl,1) + rn = RL_FIRST + npix = 0 + xs = 1 + + nseg = P_NS(ufd) + xp = P_XP(ufd) + yp = P_YP(ufd) + y = real(line) + + # Find the point(s) of intersection of the current mask line with + # the line segments forming the polygon. Note that the line must + # cross a segment to go from inside to outside or vice versa; if a + # segment (or vertex) is merely touched it should be drawn, but it + # is not a point of crossing. + + do i = 1, nseg { + # Locate next and previous line segments. + if (i == 1) + p_prev = nseg + else + p_prev = i - 1 + if (i == nseg) + p_next = 1 + else + p_next = i + 2 + + # Get endpoints of current segment. + x1 = Memr[xp+i-1]; x2 = Memr[xp+i] + y1 = Memr[yp+i-1]; y2 = Memr[yp+i] + if (y1 > y2) { + swapr (x1, x2) + swapr (y1, y2) + swapi (p_next, p_prev) + } + + # Does current line intersect the polygon line segment? + if (y > y1-TOL && y < y2+TOL) { + p_y = Memr[yp+p_prev-1] + n_y = Memr[yp+p_next-1] + + if (y2 - y1 > TOL) { + # Single point of intersection. + p1 = x1 + ((x2 - x1) / (y2 - y1)) * (y - y1) + p2 = p1 + + if (equal (p1, x1) && equal (y, y1)) + cross = ((p_y - y1) < 0) + else if (equal (p1, x2) && equal (y, y2)) + cross = ((n_y - y2) > 0) + else + cross = true + + } else { + # Intersection is entire line segment. + p1 = x1; p2 = x2 + cross = (((p_y - y) * (n_y - y)) < 0) + } + + i1 = max(1, min(axlen, nint(p1))) + i2 = max(1, min(axlen, nint(p2))) + if (i1 > i2) + swapi (i1, i2) + + np = i2 - i1 + 1 + if (np > 0) { + RL_X(rl_reg,rn) = i1 + RL_N(rl_reg,rn) = np + RL_V(rl_reg,rn) = btoi(cross) + rn = rn + 1 + } + } + } + + rl_len = rn - 1 + if (rl_len <= RL_FIRST) + goto done_ + + # Sort the line intersection-segments in order of increasing X. + do j = RL_FIRST, rl_len { + # Get low X value of initial segment. + i1 = RL_X(rl_reg,j) + np = RL_N(rl_reg,j) + i1 = min (i1, i1 + np - 1) + low = j + + # Find lowest valued segment in remainder of array. + do i = j+1, rl_len { + i2 = RL_X(rl_reg,i) + np = RL_N(rl_reg,i) + i2 = min (i2, i2 + np - 1) + if (i2 < i1) { + i1 = i2 + low = i + } + } + + # Interchange the initial segment and the low segment. + if (low != j) { + swapi (RL_X(rl_reg,j), RL_X(rl_reg,low)) + swapi (RL_N(rl_reg,j), RL_N(rl_reg,low)) + swapi (RL_V(rl_reg,j), RL_V(rl_reg,low)) + } + } + + # Combine any segments which overlap. + rn = RL_FIRST + do i = RL_FIRST + 1, rl_len { + i1 = RL_X(rl_reg,rn) + i2 = RL_N(rl_reg,rn) + i1 - 1 + ii = RL_X(rl_reg,i) + if (ii >= i1 && ii <= i2) { + i2 = ii + RL_N(rl_reg,i) - 1 + RL_N(rl_reg,rn) = max (RL_N(rl_reg,rn), i2 - i1 + 1) + RL_V(rl_reg,rn) = max (RL_V(rl_reg,rn), RL_V(rl_reg,i)) + } else { + rn = rn + 1 + RL_X(rl_reg,rn) = RL_X(rl_reg,i) + RL_N(rl_reg,rn) = RL_N(rl_reg,i) + RL_V(rl_reg,rn) = RL_V(rl_reg,i) + } + } + rl_len = rn + + # Now combine successive pairs of intersections to produce the line + # segments to be drawn. If all points are crossing points (where the + # image line crosses the polygon boundary) then we draw a line between + # the first two points, then the second two points, and so on. Points + # where the image line touches the polygon boundary but does not cross + # it are plotted, but are not joined with other points to make line + # segments. + + rn = RL_FIRST + ii = RL_FIRST + + do j = RL_FIRST, rl_len { + if (j <= ii && j < rl_len) { + next + + } else if (RL_V(rl_reg,ii) == YES) { + # Skip a vertext that touches but does not cross. + if (RL_V(rl_reg,j) == NO && j < rl_len) + next + + # Draw a line between the two crossing points. + RL_X(rl_reg,rn) = RL_X(rl_reg,ii) + RL_N(rl_reg,rn) = max (RL_N(rl_reg,ii), + RL_X(rl_reg,j) + RL_N(rl_reg,j) - RL_X(rl_reg,ii)) + RL_V(rl_reg,rn) = P_PV(ufd) + rn = rn + 1 + ii = j + 1 + + } else { + # Plot only the first point. + RL_X(rl_reg,rn) = RL_X(rl_reg,ii) + RL_N(rl_reg,rn) = RL_N(rl_reg,ii) + RL_V(rl_reg,rn) = P_PV(ufd) + rn = rn + 1 + + if (j >= rl_len && j != ii) { + # Plot the second point, if and end of list. + RL_X(rl_reg,rn) = RL_X(rl_reg,j) + RL_N(rl_reg,rn) = RL_N(rl_reg,j) + RL_V(rl_reg,rn) = P_PV(ufd) + rn = rn + 1 + } else + ii = j + } + } + +done_ + # Convert the X values in the range list to be relative to the start + # of the list. Compute NPIX, the range in pixels spanned by the range + # list. + + rl_len = rn - 1 + xs = RL_X(rl_reg,RL_FIRST) + npix = RL_X(rl_reg,rl_len) + RL_N(rl_reg,rl_len) - xs + + do i = RL_FIRST, rl_len + RL_X(rl_reg,i) = RL_X(rl_reg,i) - xs + 1 + + RL_LEN(rl_reg) = rl_len + RL_AXLEN(rl_reg) = npix + + rl_new = true + if (P_OY(ufd) == line - 1) + rl_new = !plr_equali (rl_reg, Memi[P_OO(ufd)]) + call amovi (rl_reg, Memi[P_OO(ufd)], rn - 1) + P_OY(ufd) = line + + return (rl_new) +end + + +# PE_UCANNULUS -- Regionrop ufcn for a circular annulus clipped at the borders +# of the mask. + +bool procedure pe_ucannulus (ufd, y, rl_reg, xs, npix) + +pointer ufd #I user function descriptor +int y #I mask line number +int rl_reg[3,ARB] #O output range list for line Y +int xs #O first pixel to be edited +int npix #O number of pixels affected + +real radius1, radius2, dx, dy +pointer pl +int rn, axlen, x1o, x1o_clipped, x2o, x2o_clipped, x1i, x1i_clipped +int x2i, x2i_clipped + +begin + pl = CA_PL(ufd) + rn = RL_FIRST + axlen = PL_AXLEN(pl,1) + radius1 = CA_RADIUS1(ufd) + radius2 = CA_RADIUS2(ufd) + + dy = abs (CA_YCEN(ufd) - y) + if (dy < radius2) { + dx = radius2 * radius2 - dy * dy + if (dx > 0.0) + dx = sqrt (dx) + else + dx = 0.0 + x1o = int (CA_XCEN(ufd) - dx) + x2o = int (CA_XCEN(ufd) + dx) + x1o_clipped = max(1, min(axlen, x1o)) + x2o_clipped = max(1, min(axlen, x2o)) + xs = x1o_clipped + if (dy < radius1) { + dx = radius1 * radius1 - dy * dy + if (dx > 0.0) + dx = sqrt (dx) + else + dx = 0.0 + x1i = int (CA_XCEN(ufd) - dx) + x2i = int (CA_XCEN(ufd) + dx) + x1i_clipped = max(1, min (axlen, x1i)) + x2i_clipped = max(1, min (axlen, x2i)) + RL_X(rl_reg,rn) = 1 + RL_N(rl_reg,rn) = x1i_clipped - x1o_clipped + 1 + RL_V(rl_reg,rn) = CA_PV(ufd) + rn = rn + 1 + RL_X(rl_reg,rn) = x2i_clipped - x1o_clipped + 1 + RL_N(rl_reg,rn) = x2o_clipped - x2i_clipped + 1 + RL_V(rl_reg,rn) = CA_PV(ufd) + rn = rn + 1 + npix = x2o_clipped - x1o_clipped + 1 + } else { + RL_X(rl_reg,rn) = 1 + RL_N(rl_reg,rn) = x2o_clipped - x1o_clipped + 1 + RL_V(rl_reg,rn) = CA_PV(ufd) + npix = RL_N(rl_reg,rn) + rn = rn + 1 + } + } else { + npix = 0 + xs = 1 + } + + RL_LEN(rl_reg) = rn - 1 + RL_AXLEN(rl_reg) = npix + + return (true) +end + + +# PE_UEANNULUS -- Regionrop ufcn for a circular annulus clipped at the borders +# of the mask. + +bool procedure pe_ueannulus (ufd, y, rl_reg, xs, npix) + +pointer ufd #I user function descriptor +int y #I mask line number +int rl_reg[3,ARB] #O output range list for line Y +int xs #O first pixel to be edited +int npix #O number of pixels affected + +real dy, dy2, ady, bb2, cc2, bb1, cc1, discr, dx1, dx2 +pointer pl +int rn, axlen, x1o, x1o_clipped, x2o, x2o_clipped, x1i, x1i_clipped +int x2i, x2i_clipped + +begin + pl = EA_PL(ufd) + rn = RL_FIRST + axlen = PL_AXLEN(pl,1) + + dy = y - EA_YCEN(ufd) + dy2 = dy * dy + ady = abs (dy) + bb2 = EA_BB2(ufd) * dy + cc2 = EA_CC2(ufd) * dy2 + bb1 = EA_BB1(ufd) * dy + cc1 = EA_CC1(ufd) * dy2 + + if (ady < EA_DYMAX2(ufd)) { + discr = bb2 * bb2 - 4.0 * EA_AA2(ufd) * (cc2 - EA_FF2(ufd)) + if (discr > 0.0) + discr = sqrt (discr) + else + discr = 0.0 + dx1 = (-bb2 - discr) / 2.0 / EA_AA2(ufd) + dx2 = (-bb2 + discr) / 2.0 / EA_AA2(ufd) + x1o = EA_XCEN(ufd) + min (dx1, dx2) + x2o = EA_XCEN(ufd) + max (dx1, dx2) + x1o_clipped = max(1, min(axlen, x1o)) + x2o_clipped = max(1, min(axlen, x2o)) + xs = x1o_clipped + if (ady < EA_DYMAX1(ufd)) { + discr = bb1 * bb1 - 4.0 * EA_AA1(ufd) * (cc1 - EA_FF1(ufd)) + if (discr > 0.0) + discr = sqrt (discr) + else + discr = 0.0 + dx1 = (-bb1 - discr) / 2.0 / EA_AA1(ufd) + dx2 = (-bb1 + discr) / 2.0 / EA_AA1(ufd) + x1i = EA_XCEN(ufd) + min (dx1, dx2) + x2i = EA_XCEN(ufd) + max (dx1, dx2) + x1i_clipped = max(1, min (axlen, x1i)) + x2i_clipped = max(1, min (axlen, x2i)) + RL_X(rl_reg,rn) = 1 + RL_N(rl_reg,rn) = x1i_clipped - x1o_clipped + 1 + RL_V(rl_reg,rn) = EA_PV(ufd) + rn = rn + 1 + RL_X(rl_reg,rn) = x2i_clipped - x1o_clipped + 1 + RL_N(rl_reg,rn) = x2o_clipped - x2i_clipped + 1 + RL_V(rl_reg,rn) = EA_PV(ufd) + rn = rn + 1 + npix = x2o_clipped - x1o_clipped + 1 + } else { + RL_X(rl_reg,rn) = 1 + RL_N(rl_reg,rn) = x2o_clipped - x1o_clipped + 1 + RL_V(rl_reg,rn) = EA_PV(ufd) + npix = RL_N(rl_reg,rn) + rn = rn + 1 + } + } else { + npix = 0 + xs = 1 + } + + RL_LEN(rl_reg) = rn - 1 + RL_AXLEN(rl_reg) = npix + + return (true) +end + + +# PE_UARECT -- Compute the intersection of an image line and a rectangular +# polygonal annulus and define the region to be masked. + +bool procedure pe_uarect (ufd, y, rl_reg, xs, npix) + +pointer ufd #I the region descriptor structure +int y #I the current line +int rl_reg[3,ARB] #O the output regions list +int xs #O the starting x value +int npix #O the number of pixels affected + +real lx, ld +pointer sp, work1, work2, oxintr, ixintr, pl +int j, jj, rn, onintr, inintr, ix1, ix2, ox1, ox2, ibegin, iend, jx1, jx2 +int me_pyclip() + +begin + # Allocate working memory. + call smark (sp) + call salloc (work1, RA_NVER(ufd) + 1, TY_REAL) + call salloc (work2, RA_NVER(ufd) + 1, TY_REAL) + call salloc (oxintr, RA_NVER(ufd) + 1, TY_REAL) + call salloc (ixintr, RA_NVER(ufd) + 1, TY_REAL) + + # Initialize. + pl = RA_PL(ufd) + rn = RL_FIRST + lx = PL_AXLEN(pl,1) + ld = y + + # Find the intersection of the outer polygon with the image line. + onintr = me_pyclip (Memr[RA_OXP(ufd)], Memr[RA_OYP(ufd)], Memr[work1], + Memr[work2], Memr[oxintr], RA_NVER(ufd) + 1, lx, ld) + call asrtr (Memr[oxintr], Memr[oxintr], onintr) + + if (onintr > 0) { + + # Find the intersection of the inner polygon with the image line. + inintr = me_pyclip (Memr[RA_IXP(ufd)], Memr[RA_IYP(ufd)], + Memr[work1], Memr[work2], Memr[ixintr], RA_NVER(ufd) + 1, + lx, ld) + call asrtr (Memr[ixintr], Memr[ixintr], inintr) + + # Create the region list. + xs = max (1, min (int(Memr[oxintr]), PL_AXLEN(pl,1))) + if (inintr <= 0) { + do j = 1, onintr, 2 { + ox1 = max (1, min (int(Memr[oxintr+j-1]), PL_AXLEN(pl,1))) + ox2 = max (ox1, min (int(Memr[oxintr+j]), PL_AXLEN(pl,1))) + RL_X(rl_reg,rn) = ox1 - xs + 1 + RL_N(rl_reg,rn) = ox2 - ox1 + 1 + RL_V(rl_reg,rn) = RA_PV(ufd) + rn = rn + 1 + } + npix = RL_X(rl_reg, rn-1) + RL_N(rl_reg,rn-1) - 1 + } else { + do j = 1, onintr, 2 { + ox1 = max (1, min (int(Memr[oxintr+j-1]), PL_AXLEN(pl,1))) + ox2 = max (ox1, min (int(Memr[oxintr+j]), PL_AXLEN(pl,1))) + do jj = 1, inintr, 2 { + ix1 = max (1, min (int(Memr[ixintr+jj-1]), + PL_AXLEN(pl,1))) + if (ix1 > ox1 && ix1 < ox2) { + ibegin = jj + break + } + + } + do jj = inintr, 1, -2 { + ix2 = max (1, min (int(Memr[ixintr+jj-1]), + PL_AXLEN(pl,1))) + if (ix2 > ox1 && ix2 < ox2) { + iend = jj + break + } + } + RL_X(rl_reg,rn) = ox1 - xs + 1 + RL_N(rl_reg,rn) = ix1 - ox1 + 1 + RL_V(rl_reg,rn) = RA_PV(ufd) + rn = rn + 1 + do jj = ibegin + 1, iend - 1, 2 { + jx1 = max (1, min (int(Memr[ixintr+jj-1]), + PL_AXLEN(pl,1))) + jx2 = max (jx1, min (int(Memr[ixintr+jj]), + PL_AXLEN(pl,1))) + RL_X(rl_reg,rn) = jx1 - xs + 1 + RL_N(rl_reg,rn) = jx2 - jx1 + 1 + RL_V(rl_reg,rn) = RA_PV(ufd) + rn = rn + 1 + } + RL_X(rl_reg,rn) = ix2 - xs + 1 + RL_N(rl_reg,rn) = ox2 - ix2 + 1 + RL_V(rl_reg,rn) = RA_PV(ufd) + rn = rn + 1 + + } + npix = RL_X(rl_reg, rn-1) + RL_N(rl_reg,rn-1) - 1 + } + + } else { + xs = 1 + npix = 0 + } + + RL_LEN(rl_reg) = rn - 1 + RL_AXLEN(rl_reg) = npix + + call sfree (sp) + + return (true) +end + + +# PE_UAPOLYGON -- Compute the intersection of an image line and the polygonal +# annulus and define the region to be masked. + +bool procedure pe_uapolygon (ufd, y, rl_reg, xs, npix) + +pointer ufd #I the region descriptor structure +int y #I the current line +int rl_reg[3,ARB] #O the output regions list +int xs #O the starting x value +int npix #O the number of pixels affected + +real lx, ld +pointer sp, work1, work2, oxintr, ixintr, pl +int j, jj, rn, onintr, inintr, ix1, ix2, ox1, ox2, ibegin, iend, jx1, jx2 +int me_pyclip() + +begin + # Allocate working memory. + call smark (sp) + call salloc (work1, PA_NVER(ufd) + 1, TY_REAL) + call salloc (work2, PA_NVER(ufd) + 1, TY_REAL) + call salloc (oxintr, PA_NVER(ufd) + 1, TY_REAL) + call salloc (ixintr, PA_NVER(ufd) + 1, TY_REAL) + + # Initialize. + pl = PA_PL(ufd) + rn = RL_FIRST + lx = PL_AXLEN(pl,1) + ld = y + + # Find the intersection of the outer polygon with the image line. + onintr = me_pyclip (Memr[PA_OXP(ufd)], Memr[PA_OYP(ufd)], Memr[work1], + Memr[work2], Memr[oxintr], PA_NVER(ufd) + 1, lx, ld) + call asrtr (Memr[oxintr], Memr[oxintr], onintr) + + if (onintr > 0) { + + # Find the intersection of the inner polygon with the image line. + inintr = me_pyclip (Memr[PA_IXP(ufd)], Memr[PA_IYP(ufd)], + Memr[work1], Memr[work2], Memr[ixintr], PA_NVER(ufd) + 1, + lx, ld) + call asrtr (Memr[ixintr], Memr[ixintr], inintr) + + # Create the region list. + xs = max (1, min (int(Memr[oxintr]), PL_AXLEN(pl,1))) + if (inintr <= 0) { + do j = 1, onintr, 2 { + ox1 = max (1, min (int(Memr[oxintr+j-1]), PL_AXLEN(pl,1))) + ox2 = max (ox1, min (int(Memr[oxintr+j]), PL_AXLEN(pl,1))) + RL_X(rl_reg,rn) = ox1 - xs + 1 + RL_N(rl_reg,rn) = ox2 - ox1 + 1 + RL_V(rl_reg,rn) = PA_PV(ufd) + rn = rn + 1 + } + npix = RL_X(rl_reg, rn-1) + RL_N(rl_reg,rn-1) - 1 + } else { + do j = 1, onintr, 2 { + ox1 = max (1, min (int(Memr[oxintr+j-1]), PL_AXLEN(pl,1))) + ox2 = max (ox1, min (int(Memr[oxintr+j]), PL_AXLEN(pl,1))) + do jj = 1, inintr, 2 { + ix1 = max (1, min (int(Memr[ixintr+jj-1]), + PL_AXLEN(pl,1))) + if (ix1 > ox1 && ix1 < ox2) { + ibegin = jj + break + } + + } + do jj = inintr, 1, -2 { + ix2 = max (1, min (int(Memr[ixintr+jj-1]), + PL_AXLEN(pl,1))) + if (ix2 > ox1 && ix2 < ox2) { + iend = jj + break + } + } + RL_X(rl_reg,rn) = ox1 - xs + 1 + RL_N(rl_reg,rn) = ix1 - ox1 + 1 + RL_V(rl_reg,rn) = PA_PV(ufd) + rn = rn + 1 + do jj = ibegin + 1, iend - 1, 2 { + jx1 = max (1, min (int(Memr[ixintr+jj-1]), + PL_AXLEN(pl,1))) + jx2 = max (jx1, min (int(Memr[ixintr+jj]), + PL_AXLEN(pl,1))) + RL_X(rl_reg,rn) = jx1 - xs + 1 + RL_N(rl_reg,rn) = jx2 - jx1 + 1 + RL_V(rl_reg,rn) = PA_PV(ufd) + rn = rn + 1 + } + RL_X(rl_reg,rn) = ix2 - xs + 1 + RL_N(rl_reg,rn) = ox2 - ix2 + 1 + RL_V(rl_reg,rn) = PA_PV(ufd) + rn = rn + 1 + + } + npix = RL_X(rl_reg, rn-1) + RL_N(rl_reg,rn-1) - 1 + } + + } else { + xs = 1 + npix = 0 + } + + RL_LEN(rl_reg) = rn - 1 + RL_AXLEN(rl_reg) = npix + + call sfree (sp) + + return (true) +end + + +# PE_UCOLS -- Regionrop ufcn for a set of column ranges (column regions), +# clipped at the borders of the mask. + +bool procedure pe_ucols (ufd, y, rl_reg, xs, npix) + +pointer ufd #I user function descriptor +int y #I mask line number +int rl_reg[3,ARB] #O output range list for line Y +int xs #O first pixel to be edited +int npix #O number of pixels affected + +begin + # Copy the ranges. + call amovi (Memi[L_RANGES(ufd)], rl_reg, L_NRANGES(ufd) * 3) + xs = L_XS(ufd) + npix = L_NPIX(ufd) + + return (true) +end + + +# PE_ULINES -- Regionrop ufcn for a set of lines ranges (line regions), +# clipped at the borders of the mask. + +bool procedure pe_ulines (ufd, y, rl_reg, xs, npix) + +pointer ufd #I user function descriptor +int y #I mask line number +int rl_reg[3,ARB] #O output range list for line Y +int xs #O first pixel to be edited +int npix #O number of pixels affected + +pointer pl +int rn, axlen +bool me_is_in_range() + +begin + pl = L_PL(ufd) + rn = RL_FIRST + axlen = PL_AXLEN(pl,1) + + if (me_is_in_range (Memi[L_RANGES(ufd)], y)) { + xs = 1 + npix = axlen + RL_X(rl_reg,rn) = 1 + RL_N(rl_reg,rn) = axlen + RL_V(rl_reg,rn) = L_PV(ufd) + rn = rn + 1 + } else { + xs = 1 + npix = 0 + } + + RL_LEN(rl_reg) = rn - 1 + RL_AXLEN(rl_reg) = npix + + return (true) +end diff --git a/pkg/proto/maskexpr/t_mskexpr.x b/pkg/proto/maskexpr/t_mskexpr.x new file mode 100644 index 00000000..9a1aa912 --- /dev/null +++ b/pkg/proto/maskexpr/t_mskexpr.x @@ -0,0 +1,286 @@ +include <fset.h> +include <ctype.h> +include <imhdr.h> + +# T_MSKEXPR -- Create a list of pixel masks using an expression and a list of +# reference images. +# +# The input expression may be any legal EVVEXPR expression which can be +# converted to a valid integer mask pixel value. The input operands must be one +# of, i for the reference image, i.keyword for a reference image header +# keyword, m for the input mask image, m.keyword for the input mask image +# header keyword a numeric constant, a builtin function, or the pixel operands +# I, J, K, etc. May be desirable to replace the reference image operand +# i with $I. This is a detail however. +# +# This task uses the get tokens library in images to expand the macros. +# This library should probably be removed from images and put in xtools +# for the applications programmers or in the core system as a useful +# library maybe in fmtio like imexpr. There is a similar if not identical(?) +# library in qpoe. + +procedure t_mskexpr() + +pointer expr, st, xexpr, refim, pmim, refmsk +pointer sp, exprdb, dims, uaxlen, mskname, imname, refname +int i, ip, op, msklist, imlist, rmsklist, len_exprbuf, fd, nchars, ch +int undim, npix, depth +bool verbose + +pointer me_getexprdb(), me_expandtext(), immap(), yt_mappm(), me_mkmask() +long fstatl() +int imtopenp(), imtlen(), open(), getci(), imtgetim(), ctoi() +int clgeti(), strmatch(), imaccess() +bool clgetb(), strne() +errchk immap(), yt_pmmap() + +begin + # Get the expression parameter. + call malloc (expr, SZ_COMMAND, TY_CHAR) + call clgstr ("expr", Memc[expr], SZ_COMMAND) + + # Get the output mask list. + msklist = imtopenp ("masks") + if (imtlen (msklist) <= 0) { + call eprintf ("The output mask list is empty\n") + call imtclose (msklist) + call mfree (expr, TY_CHAR) + return + } + + # Get the input reference image list. + imlist = imtopenp ("refimages") + if (imtlen (imlist) > 0 && imtlen (imlist) != imtlen (msklist)) { + call eprintf ( + "The reference image and output mask lists are not the same size\n") + call imtclose (imlist) + call imtclose (msklist) + call mfree (expr, TY_CHAR) + return + } + + # Get the input reference mask list. + rmsklist = imtopenp ("refmasks") + if (imtlen (rmsklist) > 0 && imtlen (rmsklist) != imtlen (msklist)) { + call eprintf ( + "The reference image and output mask lists are not the same size\n") + call imtclose (rmsklist) + call imtclose (msklist) + call imtclose (imlist) + call mfree (expr, TY_CHAR) + return + } + + # Get some working space. + call smark (sp) + call salloc (exprdb, SZ_FNAME, TY_CHAR) + call salloc (dims, SZ_FNAME, TY_CHAR) + call salloc (uaxlen, IM_MAXDIM, TY_LONG) + call salloc (mskname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (refname, SZ_FNAME, TY_CHAR) + + # Get remaining parameters, + call clgstr ("exprdb", Memc[exprdb], SZ_PATHNAME) + call clgstr ("dims", Memc[dims], SZ_FNAME) + depth = clgeti ("depth") + verbose = clgetb ("verbose") + + # Load the expression database if any. + if (strne (Memc[exprdb], "none")) + st = me_getexprdb (Memc[exprdb]) + else + st = NULL + + # Get the expression to be evaluated and expand any file inclusions + # or macro references. + len_exprbuf = SZ_COMMAND + 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 = me_expandtext (st, Memc[expr]) + call mfree (expr, TY_CHAR) + expr = xexpr + } + if (verbose) { + call printf ("Expr: %s\n") + call pargstr (Memc[expr]) + call flush (STDOUT) + } + + # Determine the default dimension and size of the output image. If the + # reference image is defined then the dimensions of the reference + # image determine the dimensions of the output mask. Otherwise the + # default dimensions are used. + + undim = 0 + call aclrl (Meml[uaxlen], IM_MAXDIM) + for (ip = 1; ctoi (Memc[dims], ip, npix) > 0; ) { + Meml[uaxlen+undim] = npix + undim = undim + 1 + for (ch = Memc[dims+ip-1]; IS_WHITE(ch) || ch == ','; + ch = Memc[dims+ip-1]) + ip = ip + 1 + } + + # Loop over the output mask names. + while (imtgetim (msklist, Memc[mskname], SZ_FNAME) != EOF) { + + # Add .pl to output mask name. + if (strmatch (Memc[mskname], ".pl$") == 0) + call strcat (".pl", Memc[mskname], SZ_FNAME) + + # Check whether the output mask already exists. + if (imaccess (Memc[mskname], 0) == YES) { + if (verbose) { + call printf ("Mask %s already exists\n") + call pargstr (Memc[mskname]) + } + next + } + + # Open the reference image. + if (imtlen (imlist) > 0) { + if (imtgetim (imlist, Memc[imname], SZ_FNAME) != EOF) { + iferr (refim = immap (Memc[imname], READ_ONLY, 0)) { + refim = NULL + call printf ( + "Cannot open reference image %s for mask %s\n") + call pargstr (Memc[imname]) + call pargstr (Memc[mskname]) + next + } + } else { + refim = NULL + call printf ("Cannot open reference image for mask %s\n") + call pargstr (Memc[mskname]) + next + } + } else + refim = NULL + + # Open the reference mask. + if (imtlen (rmsklist) > 0) { + if (imtgetim (rmsklist, Memc[refname], SZ_FNAME) != EOF) { + if (refim != NULL) { + iferr (refmsk = yt_mappm (Memc[refname], refim, + "logical", Memc[refname], SZ_FNAME)) + refmsk = NULL + } else { + iferr (refmsk = immap (Memc[refname], READ_ONLY, 0)) + refmsk = NULL + } + if (refmsk == NULL) { + call printf ( + "Cannot open reference mask %s for mask %s\n") + call pargstr (Memc[refname]) + call pargstr (Memc[mskname]) + if (refim != NULL) + call imunmap (refim) + next + } else if (refim != NULL) { + if (IM_NDIM(refim) != IM_NDIM(refmsk)) { + call printf ( + "Reference image and mask for %s don't match\n") + call pargstr (Memc[mskname]) + call imunmap (refmsk) + if (refim != NULL) + call imunmap (refim) + next + } else { + do i = 1, IM_NDIM(refim) { + if (IM_LEN(refim,i) == IM_LEN(refmsk,i)) + next + else + break + } + if (i <= IM_NDIM(refim)) { + call printf ( + "Reference image and mask for %s don't match\n") + call pargstr (Memc[mskname]) + call imunmap (refmsk) + if (refim != NULL) + call imunmap (refim) + next + } + } + } + } else { + refmsk = NULL + call printf ("Cannot open reference mask for mask %s\n") + call pargstr (Memc[refname]) + if (refim != NULL) + call imunmap (refim) + next + } + } else + refmsk = NULL + + if (verbose) { + if (refim != NULL && refmsk != NULL) { + call printf ("Creating mask %s\n") + call pargstr (Memc[mskname]) + call printf (" Using reference image %s and mask %s\n") + call pargstr (Memc[imname]) + call pargstr (Memc[refname]) + } else if (refim != NULL) { + call printf ("Creating mask %s using reference image %s\n") + call pargstr (Memc[mskname]) + call pargstr (Memc[imname]) + } else if (refmsk != NULL) { + call printf ("Creating mask %s using reference image %s\n") + call pargstr (Memc[mskname]) + call pargstr (Memc[refname]) + } else { + call printf ("Creating mask %s\n") + call pargstr (Memc[mskname]) + } + } + + # Evalute the expression return a mask image pointer. + if (refim != NULL) + pmim = me_mkmask (Memc[expr], Memc[mskname], refim, refmsk, + IM_NDIM(refim), IM_LEN(refim,1), depth) + else if (refmsk != NULL) + pmim = me_mkmask (Memc[expr], Memc[mskname], refim, refmsk, + IM_NDIM(refmsk), IM_LEN(refmsk,1), depth) + else + pmim = me_mkmask (Memc[expr], Memc[mskname], refim, refmsk, + undim, Meml[uaxlen], depth) + + # Save the mask. + call imunmap (pmim) + + # Close the reference image. + if (refim != NULL) + call imunmap (refim) + + # Close the reference mask. + if (refmsk != NULL) + call imunmap (refmsk) + } + + # Cleanup. + call mfree (expr, TY_CHAR) + if (st != NULL) + call stclose (st) + call imtclose (rmsklist) + call imtclose (msklist) + call imtclose (imlist) + call sfree (sp) +end + diff --git a/pkg/proto/maskexpr/t_mskregions.x b/pkg/proto/maskexpr/t_mskregions.x new file mode 100644 index 00000000..0313055d --- /dev/null +++ b/pkg/proto/maskexpr/t_mskregions.x @@ -0,0 +1,264 @@ +include <fset.h> +include <ctype.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> + +define RG_NUMOPTIONS "|constant|number|" +define RG_CONSTANT 1 +define RG_NUMBER 2 + +# T_MSKREGIONS -- Create or edit a list of pixel masks using regions +# descriptors and a list of reference images. +# +# The regions descriptor may define a single region or a region expression. +# For example a circle may be defined as a single region, e.g. +# +# circle xc yc radius +# +# whereas the overlap of two circular regions may be defined as a region +# expression +# +# circle (xc1, yc1, r1) && circle (xc2, yc2, r2) +# +# note that brackets are necessary in one case and not the other and can +# be used to decide whether or not to send the regions descriptor off to +# the parser as opposed to sending it off to a simple interpreter. +# +# The regions input operands must be one of the builtin region functions. +# + +procedure t_mskregions() + +pointer sp, exprdb, dims, regnumber, uaxlen, mskname, imname, regfname +pointer st, refim, pmim, expr, xexpr +int reglist, msklist, imlist, undim, regval, depth, regfd, pregval +int ip, npix, ch, regno, pregno +char lbrackett +bool verbose, append + +pointer pl + +pointer me_getexprdb(), immap(), me_expandtext(), pl_create() +int clpopnu(), imtopenp(), clplen(), imtlen(), clgeti(), ctoi(), clgfil() +int imtgetim(), imaccess(), strmatch(), imstati(), fscan(), open() +int strdic(), stridx() +bool clgetb(), strne() +data lbrackett /'('/ +errchk immap() + +begin + # Get the regions file list. + reglist = clpopnu ("regions") + if (clplen (reglist) <= 0) { + call eprintf ("The regions file list is empty\n") + call clpcls (reglist) + return + } + + # Get the output mask list. + msklist = imtopenp ("masks") + if (imtlen (msklist) <= 0) { + call eprintf ("The output mask list is empty\n") + call imtclose (msklist) + call clpcls (reglist) + return + } else if (clplen (reglist) > 1 && clplen (reglist) != + imtlen (msklist)) { + call eprintf ("The regions and mask list have different sizes\n") + call imtclose (msklist) + call clpcls (reglist) + return + } + + # Get the output image list. + imlist = imtopenp ("refimages") + if (imtlen (imlist) > 0 && imtlen (imlist) != imtlen (msklist)) { + call eprintf ( + "The reference image and mask lists are not the same size\n") + call imtclose (imlist) + call imtclose (msklist) + call clpcls (reglist) + return + } + + # Get some working space. + call smark (sp) + call salloc (exprdb, SZ_FNAME, TY_CHAR) + call salloc (dims, SZ_FNAME, TY_CHAR) + call salloc (regnumber, SZ_FNAME, TY_CHAR) + call salloc (uaxlen, IM_MAXDIM, TY_LONG) + call salloc (mskname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (regfname, SZ_FNAME, TY_CHAR) + + # Get remaining parameters, + call clgstr ("dims", Memc[dims], SZ_FNAME) + call clgstr ("regnumber", Memc[regnumber], SZ_FNAME) + regno = strdic (Memc[regnumber], Memc[regnumber], SZ_FNAME, + RG_NUMOPTIONS) + regval = clgeti ("regval") + depth = clgeti ("depth") + call clgstr ("exprdb", Memc[exprdb], SZ_PATHNAME) + append = clgetb ("append") + verbose = clgetb ("verbose") + + # Load the expression database if any. + if (strne (Memc[exprdb], "none")) + st = me_getexprdb (Memc[exprdb]) + else + st = NULL + + # Determine the default dimension and size of the output image. If the + # reference image is defined then the dimensions of the reference + # image determine the dimensions of the output mask. Otherwise the + # default dimensions are used. + + undim = 0 + call aclrl (Meml[uaxlen], IM_MAXDIM) + for (ip = 1; ctoi (Memc[dims], ip, npix) > 0; ) { + Meml[uaxlen+undim] = npix + undim = undim + 1 + for (ch = Memc[dims+ip-1]; IS_WHITE(ch) || ch == ','; + ch = Memc[dims+ip-1]) + ip = ip + 1 + } + + # Loop over the output mask names. + regfd = NULL + while (imtgetim (msklist, Memc[mskname], SZ_FNAME) != EOF) { + + # Add .pl to output mask name. + if (strmatch (Memc[mskname], ".pl$") == 0) + call strcat (".pl", Memc[mskname], SZ_FNAME) + + # Check whether the output mask already exists. + if (imaccess (Memc[mskname], 0) == YES) { + if (! append) { + if (verbose) { + call printf ("Mask %s already exists\n") + call pargstr (Memc[mskname]) + } + next + } + } + + # Open the reference image. + if (imtlen (imlist) > 0) { + if (imtgetim (imlist, Memc[imname], SZ_FNAME) != EOF) { + iferr (refim = immap (Memc[imname], READ_ONLY, 0)) { + refim = NULL + call printf ( + "Cannot open reference image %s for mask %s\n") + call pargstr (Memc[imname]) + call pargstr (Memc[mskname]) + next + } + } else { + refim = NULL + call printf ("Cannot open reference image for mask %s\n") + call pargstr (Memc[mskname]) + next + } + } else + refim = NULL + + # Open the output mask. + if (imaccess (Memc[mskname], 0) == YES) { + pmim = immap (Memc[mskname], READ_WRITE, 0) + } else { + if (refim != NULL) { + pmim = immap (Memc[mskname], NEW_COPY, refim) + } else { + pmim = immap (Memc[mskname], NEW_IMAGE, 0) + IM_NDIM(pmim) = undim + call amovl (Meml[uaxlen], IM_LEN(pmim,1), undim) + } + IM_PIXTYPE(pmim) = TY_INT + pl = imstati (pmim, IM_PLDES) + call pl_close (pl) + #pl = pl_create (undim, Meml[uaxlen], depth) + pl = pl_create (IM_NDIM(pmim), IM_LEN(pmim,1), depth) + call imseti (pmim, IM_PLDES, pl) + call imunmap (pmim) + pmim = immap (Memc[mskname], READ_WRITE, 0) + } + + # Open the regions list. + if (clgfil (reglist, Memc[regfname], SZ_FNAME) != EOF) { + if (regfd != NULL) + call close (regfd) + regfd = open (Memc[regfname], READ_ONLY, TEXT_FILE) + } else if (regfd != NULL) + call seek (regfd, BOF) + + # Print a header banner. + if (verbose) { + if (refim == NULL) { + call printf ("Creating mask %s\n") + call pargstr (Memc[mskname]) + } else { + call printf ("Creating mask %s using reference image %s\n") + call pargstr (Memc[mskname]) + call pargstr (Memc[imname]) + } + call printf (" Using regions file %s\n") + call pargstr (Memc[regfname]) + } + + # Loop over the regions file. + pregval = regval + pregno = 1 + while (fscan (regfd) != EOF) { + + # Get the expression. + call malloc (expr, SZ_LINE, TY_CHAR) + call gargstr (Memc[expr], SZ_LINE) + + # Determine whether or not the region specificationis an + # expression or a region description. If the string is + # an expression expand it as necessary. + if (stridx (lbrackett, Memc[expr]) > 0) { + if (st != NULL) { + xexpr = me_expandtext (st, Memc[expr]) + call mfree (expr, TY_CHAR) + expr = xexpr + } + call me_setexpr (Memc[expr], pmim, pregno, pregval, verbose) + } else { + call me_setreg (Memc[expr], pmim, pregno, pregval, verbose) + } + + # Increment the region number if appropriate. + pregno = pregno + 1 + if (regno == RG_NUMBER) + pregval = pregval + 1 + + call mfree (expr, TY_CHAR) + } + + # Save the output mask. + call imunmap (pmim) + + # Close the reference image. + if (refim != NULL) + call imunmap (refim) + + } + + # Close the last regions file. + if (regfd != NULL) + call close (regfd) + + # Close the expression database symbol table. + if (st != NULL) + call stclose (st) + + # Close the various image and file lists. + call imtclose (imlist) + call imtclose (msklist) + call clpcls (reglist) + + call sfree (sp) +end + diff --git a/pkg/proto/masks/mimstat.h b/pkg/proto/masks/mimstat.h new file mode 100644 index 00000000..95bef65e --- /dev/null +++ b/pkg/proto/masks/mimstat.h @@ -0,0 +1,67 @@ +# Header file for the IMSTATMISTICS task. + +define LEN_MIMSTAT 20 + +define MIS_SUMX Memd[P2D($1)] +define MIS_SUMX2 Memd[P2D($1+2)] +define MIS_SUMX3 Memd[P2D($1+4)] +define MIS_SUMX4 Memd[P2D($1+6)] +define MIS_LO Memr[P2R($1+8)] +define MIS_HI Memr[P2R($1+9)] +define MIS_MIN Memr[P2R($1+10)] +define MIS_MAX Memr[P2R($1+11)] +define MIS_MEAN Memr[P2R($1+12)] +define MIS_MEDIAN Memr[P2R($1+13)] +define MIS_MODE Memr[P2R($1+14)] +define MIS_STDDEV Memr[P2R($1+15)] +define MIS_SKEW Memr[P2R($1+16)] +define MIS_KURTOSIS Memr[P2R($1+17)] +define MIS_NPIX Memi[$1+18] +define MIS_SW Memi[$1+19] + +define LEN_NSWITCHES 8 + +define MIS_SKURTOSIS Memi[$1] +define MIS_SSKEW Memi[$1+1] +define MIS_SSTDDEV Memi[$1+2] +define MIS_SMODE Memi[$1+3] +define MIS_SMEDIAN Memi[$1+4] +define MIS_SMEAN Memi[$1+5] +define MIS_SMINMAX Memi[$1+6] +define MIS_SNPIX Memi[$1+7] + +define MIS_FIELDS "|image|npix|min|max|mean|midpt|mode|stddev|skew|kurtosis|mask|" +define MIS_NFIELDS 11 + +define IS_FIELDS "|image|npix|min|max|mean|midpt|mode|stddev|skew|kurtosis|" + +define IS_NFIELDS 10 + +define MIS_KIMAGE "IMAGE" +define MIS_KNPIX "NPIX" +define MIS_KMIN "MIN" +define MIS_KMAX "MAX" +define MIS_KMEAN "MEAN" +define MIS_KMEDIAN "MIDPT" +define MIS_KMODE "MODE" +define MIS_KSTDDEV "STDDEV" +define MIS_KSKEW "SKEW" +define MIS_KKURTOSIS "KURTOSIS" +define MIS_KMASK "MASK" + +define MIS_FIMAGE 1 +define MIS_FNPIX 2 +define MIS_FMIN 3 +define MIS_FMAX 4 +define MIS_FMEAN 5 +define MIS_FMEDIAN 6 +define MIS_FMODE 7 +define MIS_FSTDDEV 8 +define MIS_FSKEW 9 +define MIS_FKURTOSIS 10 +define MIS_FMASK 11 + +define MIS_FCOLUMN "%10d" +define MIS_FINTEGER "%10d" +define MIS_FREAL "%10.4g" +define MIS_FSTRING "%20s" diff --git a/pkg/proto/masks/mimstat.x b/pkg/proto/masks/mimstat.x new file mode 100644 index 00000000..9207ef66 --- /dev/null +++ b/pkg/proto/masks/mimstat.x @@ -0,0 +1,943 @@ +include <mach.h> +include "mimstat.h" + + +# MST_ALLOCATE -- Allocate space for the statistics structure. + +procedure mst_allocate (mst) + +pointer mst #O the statistics descriptor + +begin + call calloc (mst, LEN_MIMSTAT, TY_STRUCT) + call malloc (MIS_SW(mst), LEN_NSWITCHES, TY_INT) +end + + +# MST_FREE -- Free the statistics structure. + +procedure mst_free (mst) + +pointer mst #O the statistics descriptor + +begin + call mfree (MIS_SW(mst), TY_INT) + call mfree (mst, TY_STRUCT) +end + + +# MST_FIELDS -- Procedure to decode the fields string into a list of the +# fields to be computed and printed. + +int procedure mst_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, MIS_FIELDS) + if (field == 0) + next + nfields = nfields + 1 + fields[nfields] = field + } + call fntclsb (flist) + + call sfree (sp) + + return (nfields) +end + + +# MST_SWITCHES -- Set the processing switches. + +procedure mst_switches (mst, fields, nfields, nclip) + +pointer mst #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 mst_isfield() + +begin + # Initialize. + sw = MIS_SW(mst) + call amovki (NO, Memi[sw], LEN_NSWITCHES) + + # Set the computation switches. + MIS_SNPIX(sw) = mst_isfield (MIS_FNPIX, fields, nfields) + MIS_SMEAN(sw) = mst_isfield (MIS_FMEAN, fields, nfields) + MIS_SMEDIAN(sw) = mst_isfield (MIS_FMEDIAN, fields, nfields) + MIS_SMODE(sw) = mst_isfield (MIS_FMODE, fields, nfields) + if (nclip > 0) + MIS_SSTDDEV(sw) = YES + else + MIS_SSTDDEV(sw) = mst_isfield (MIS_FSTDDEV, fields, nfields) + MIS_SSKEW(sw) = mst_isfield (MIS_FSKEW, fields, nfields) + MIS_SKURTOSIS(sw) = mst_isfield (MIS_FKURTOSIS, fields, nfields) + + # Adjust the computation switches. + if (mst_isfield (MIS_FMIN, fields, nfields) == YES) + MIS_SMINMAX(sw) = YES + else if (mst_isfield (MIS_FMAX, fields, nfields) == YES) + MIS_SMINMAX(sw) = YES + else if (MIS_SMEDIAN(sw) == YES || MIS_SMODE(sw) == YES) + MIS_SMINMAX(sw) = YES + else + MIS_SMINMAX(sw) = NO +end + + +# MST_PHEADER -- Print the banner fields. + +procedure mst_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 MIS_FIMAGE: + call printf (MIS_FSTRING) + call pargstr (MIS_KIMAGE) + case MIS_FMASK: + call printf (MIS_FSTRING) + call pargstr (MIS_KMASK) + case MIS_FNPIX: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KNPIX) + case MIS_FMIN: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KMIN) + case MIS_FMAX: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KMAX) + case MIS_FMEAN: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KMEAN) + case MIS_FMEDIAN: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KMEDIAN) + case MIS_FMODE: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KMODE) + case MIS_FSTDDEV: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KSTDDEV) + case MIS_FSKEW: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KSKEW) + case MIS_FKURTOSIS: + call printf (MIS_FCOLUMN) + call pargstr (MIS_KKURTOSIS) + } + } + + call printf ("\n") + call flush (STDOUT) +end + + +# MST_ISFIELD -- Procedure to determine whether a specified field is one +# of the selected fields or not. + +int procedure mst_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 + + +# MST_INITIALIZE -- Initialize the statistics computation. + +procedure mst_initialize (mst, lower, upper) + +pointer mst #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)) + MIS_LO(mst) = -MAX_REAL + else + MIS_LO(mst) = lower + if (IS_INDEFR(upper)) + MIS_HI(mst) = MAX_REAL + else + MIS_HI(mst) = upper + + MIS_NPIX(mst) = 0 + MIS_SUMX(mst) = 0.0d0 + MIS_SUMX2(mst) = 0.0d0 + MIS_SUMX3(mst) = 0.0d0 + MIS_SUMX4(mst) = 0.0d0 + + MIS_MIN(mst) = MAX_REAL + MIS_MAX(mst) = -MAX_REAL + MIS_MEAN(mst) = INDEFR + MIS_MEDIAN(mst) = INDEFR + MIS_MODE(mst) = INDEFR + MIS_STDDEV(mst) = INDEFR + MIS_SKEW(mst) = INDEFR + MIS_KURTOSIS(mst) = INDEFR +end + + +# MST_ACCUMULATE4 -- Accumulate sums up to the fourth power of the data for +# data values between lower and upper. + +procedure mst_accumulate4 (mst, x, npts, lower, upper, minmax) + +pointer mst #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 = MIS_LO(mst) + hi = MIS_HI(mst) + npix = MIS_NPIX(mst) + sumx = 0.0 + sumx2 = 0.0 + sumx3 = 0.0 + sumx4 = 0.0 + xmin = MIS_MIN(mst) + xmax = MIS_MAX(mst) + + 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 + } + } + } + + MIS_NPIX(mst) = npix + MIS_SUMX(mst) = MIS_SUMX(mst) + sumx + MIS_SUMX2(mst) = MIS_SUMX2(mst) + sumx2 + MIS_SUMX3(mst) = MIS_SUMX3(mst) + sumx3 + MIS_SUMX4(mst) = MIS_SUMX4(mst) + sumx4 + MIS_MIN(mst) = xmin + MIS_MAX(mst) = xmax +end + + +# MST_ACCUMULATE3 -- Accumulate sums up to the third power of the data for +# data values between lower and upper. + +procedure mst_accumulate3 (mst, x, npts, lower, upper, minmax) + +pointer mst #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 = MIS_LO(mst) + hi = MIS_HI(mst) + npix = MIS_NPIX(mst) + sumx = 0.0 + sumx2 = 0.0 + sumx3 = 0.0 + xmin = MIS_MIN(mst) + xmax = MIS_MAX(mst) + + 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 + } + } + } + + MIS_NPIX(mst) = npix + MIS_SUMX(mst) = MIS_SUMX(mst) + sumx + MIS_SUMX2(mst) = MIS_SUMX2(mst) + sumx2 + MIS_SUMX3(mst) = MIS_SUMX3(mst) + sumx3 + MIS_MIN(mst) = xmin + MIS_MAX(mst) = xmax +end + + +# MST_ACCUMULATE2 -- Accumulate sums up to the second power of the data for +# data values between lower and upper. + +procedure mst_accumulate2 (mst, x, npts, lower, upper, minmax) + +pointer mst #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 = MIS_LO(mst) + hi = MIS_HI(mst) + npix = MIS_NPIX(mst) + sumx = 0.0 + sumx2 = 0.0 + xmin = MIS_MIN(mst) + xmax = MIS_MAX(mst) + + 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 + } + } + } + + MIS_NPIX(mst) = npix + MIS_SUMX(mst) = MIS_SUMX(mst) + sumx + MIS_SUMX2(mst) = MIS_SUMX2(mst) + sumx2 + MIS_MIN(mst) = xmin + MIS_MAX(mst) = xmax +end + + +# MST_ACCUMULATE1 -- Accumulate sums up to the first power of the data for +# data values between lower and upper. + +procedure mst_accumulate1 (mst, x, npts, lower, upper, minmax) + +pointer mst #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 = MIS_LO(mst) + hi = MIS_HI(mst) + npix = MIS_NPIX(mst) + sumx = 0.0 + xmin = MIS_MIN(mst) + xmax = MIS_MAX(mst) + + 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 + } + } + } + + MIS_NPIX(mst) = npix + MIS_SUMX(mst) = MIS_SUMX(mst) + sumx + MIS_MIN(mst) = xmin + MIS_MAX(mst) = xmax +end + + +# MST_ACCUMULATE0 -- Accumulate sums up to the 0th power of the data for +# data values between lower and upper. + +procedure mst_accumulate0 (mst, x, npts, lower, upper, minmax) + +pointer mst #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 = MIS_LO(mst) + hi = MIS_HI(mst) + npix = MIS_NPIX(mst) + xmin = MIS_MIN(mst) + xmax = MIS_MAX(mst) + + 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 + } + } + } + + MIS_NPIX(mst) = npix + MIS_MIN(mst) = xmin + MIS_MAX(mst) = xmax +end + + +# MST_STATS -- Procedure to compute the first four central moments of the +# distribution. + +procedure mst_stats (mst) + +pointer mst #I statistics structure + +double mean, var, stdev +pointer sw +bool fp_equalr() + +begin + sw = MIS_SW(mst) + + # Compute the basic statistics regardless of the switches. + if (fp_equalr (MIS_MIN(mst), MAX_REAL)) + MIS_MIN(mst) = INDEFR + if (fp_equalr (MIS_MAX(mst), -MAX_REAL)) + MIS_MAX(mst) = INDEFR + if (MIS_NPIX(mst) <= 0) + return + + mean = MIS_SUMX(mst) / MIS_NPIX(mst) + MIS_MEAN(mst) = mean + if (MIS_NPIX(mst) < 2) + return + + var = (MIS_SUMX2(mst) - MIS_SUMX(mst) * mean) / + (MIS_NPIX(mst) - 1) + if (var <= 0.0) { + MIS_STDDEV(mst) = 0.0 + return + } else { + stdev = sqrt (var) + MIS_STDDEV(mst) = stdev + } + + # Compute higher order moments if the switches are set. + if (MIS_SSKEW(sw)== YES) + MIS_SKEW(mst) = (MIS_SUMX3(mst) - 3.0d0 * MIS_MEAN(mst) * + MIS_SUMX2(mst) + 3.0d0 * mean * mean * + MIS_SUMX(mst) - MIS_NPIX(mst) * mean ** 3) / + MIS_NPIX(mst) / stdev / stdev / stdev + + if (MIS_SKURTOSIS(sw) == YES) + MIS_KURTOSIS(mst) = (MIS_SUMX4(mst) - 4.0d0 * mean * + MIS_SUMX3(mst) + 6.0d0 * mean * mean * + MIS_SUMX2(mst) - 4.0 * mean ** 3 * MIS_SUMX(mst) + + MIS_NPIX(mst) * mean ** 4) / MIS_NPIX(mst) / + stdev / stdev / stdev / stdev - 3.0d0 +end + + + +# MST_IHIST -- Initilaize the histogram of the image pixels. + +int procedure mst_ihist (mst, binwidth, hgm, nbins, hwidth, hmin, hmax) + +pointer mst #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 * MIS_STDDEV(mst) + if (hwidth <= 0.0) + return (NO) + + nbins = (MIS_MAX(mst) - MIS_MIN(mst)) / hwidth + 1 + if (nbins < 3) + return (NO) + + hmin = MIS_MIN(mst) + hmax = MIS_MAX(mst) + + call malloc (hgm, nbins, TY_INT) + + return (YES) +end + + +# MST_HMEDIAN -- Estimate the median from the histogram. + +procedure mst_hmedian (mst, hgm, nbins, hwidth, hmin, hmax) + +pointer mst #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)) + MIS_MEDIAN(mst) = h1 + else if (lo == 0) + MIS_MEDIAN(mst) = h1 + 0.5 / hdiff * hwidth + else + MIS_MEDIAN(mst) = h1 + (0.5 - Memr[ihgm+lo-1]) / hdiff * hwidth + + call sfree (sp) +end + + +# MST_HMODE -- Procedure to compute the mode. + +procedure mst_hmode (mst, hgm, nbins, hwidth, hmin, hmax) + +pointer mst #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) { + MIS_MODE(mst) = 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]) + MIS_MODE(mst) = hmin + 0.5 * hwidth + else if (hgm[2] > hgm[1]) + MIS_MODE(mst) = hmin + 1.5 * hwidth + else + MIS_MODE(mst) = 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) { + MIS_MODE(mst) = hmin + 0.5 * hwidth + return + } + + # If the maximum is in the last bin return the midpoint of the bin. + if (bpeak == nbins) { + MIS_MODE(mst) = 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)) { + MIS_MODE(mst) = hmin + (bpeak + 0.5) * hwidth + } else { + MIS_MODE(mst) = bpeak + 1 + 0.5 * (dh1 - dh2) / denom + MIS_MODE(mst) = hmin + (MIS_MODE(mst) - 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 + + +# MST_PRINT -- Print the fields using builtin format strings. + +procedure mst_print (image, mask, mst, fields, nfields) + +char image[ARB] #I image name +char mask[ARB] #I mask name +pointer mst #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 MIS_FIMAGE: + call printf (MIS_FSTRING) + call pargstr (image) + case MIS_FMASK: + call printf (MIS_FSTRING) + call pargstr (mask) + case MIS_FNPIX: + call printf (MIS_FINTEGER) + call pargi (MIS_NPIX(mst)) + case MIS_FMIN: + call printf (MIS_FREAL) + call pargr (MIS_MIN(mst)) + case MIS_FMAX: + call printf (MIS_FREAL) + call pargr (MIS_MAX(mst)) + case MIS_FMEAN: + call printf (MIS_FREAL) + call pargr (MIS_MEAN(mst)) + case MIS_FMEDIAN: + call printf (MIS_FREAL) + call pargr (MIS_MEDIAN(mst)) + case MIS_FMODE: + call printf (MIS_FREAL) + call pargr (MIS_MODE(mst)) + case MIS_FSTDDEV: + call printf (MIS_FREAL) + call pargr (MIS_STDDEV(mst)) + case MIS_FSKEW: + call printf (MIS_FREAL) + call pargr (MIS_SKEW(mst)) + case MIS_FKURTOSIS: + call printf (MIS_FREAL) + call pargr (MIS_KURTOSIS(mst)) + } + } + + call printf ("\n") + call flush (STDOUT) +end + + +# MST_FPRINT -- Print the fields using a free format. + +procedure mst_fprint (image, mask, mst, fields, nfields) + +char image[ARB] #I image name +char mask[ARB] #I mask name +pointer mst #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 MIS_FIMAGE: + call printf ("%s") + call pargstr (image) + case MIS_FMASK: + call printf ("%s") + call pargstr (mask) + case MIS_FNPIX: + call printf ("%d") + call pargi (MIS_NPIX(mst)) + case MIS_FMIN: + call printf ("%g") + call pargr (MIS_MIN(mst)) + case MIS_FMAX: + call printf ("%g") + call pargr (MIS_MAX(mst)) + case MIS_FMEAN: + call printf ("%g") + call pargr (MIS_MEAN(mst)) + case MIS_FMEDIAN: + call printf ("%g") + call pargr (MIS_MEDIAN(mst)) + case MIS_FMODE: + call printf ("%g") + call pargr (MIS_MODE(mst)) + case MIS_FSTDDEV: + call printf ("%g") + call pargr (MIS_STDDEV(mst)) + case MIS_FSKEW: + call printf ("%g") + call pargr (MIS_SKEW(mst)) + case MIS_FKURTOSIS: + call printf ("%g") + call pargr (MIS_KURTOSIS(mst)) + } + if (i < nfields) + call printf (" ") + } + + call printf ("\n") + call flush (STDOUT) +end diff --git a/pkg/proto/masks/mkpkg b/pkg/proto/masks/mkpkg new file mode 100644 index 00000000..21db5803 --- /dev/null +++ b/pkg/proto/masks/mkpkg @@ -0,0 +1,23 @@ +# Make the protype masks tasks MIMSTAT + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + t_mimstat.x <mach.h> <imhdr.h> <imset.h> <pmset.h> "mimstat.h" + mstcache.x <imhdr.h> <imset.h> + + t_rskysub.x <imhdr.h> "rskysub.h" + rsstats.x <mach.h> <imhdr.h> <imset.h> <pmset.h> "mimstat.h" \ + "rskysub.h" + rsmmean.x <imhdr.h> <imset.h> <pmset.h> "rskysub.h" + rsmean.x <imhdr.h> "rskysub.h" + rsscache.x <imhdr.h> <imset.h> + rsreject.x <imhdr.h> <imset.h> + rsfnames.x + + mimstat.x <mach.h> "mimstat.h" + mptools.x <ctype.h> <imhdr.h> <imset.h> <pmset.h> + ; diff --git a/pkg/proto/masks/mptools.x b/pkg/proto/masks/mptools.x new file mode 100644 index 00000000..7e08cab1 --- /dev/null +++ b/pkg/proto/masks/mptools.x @@ -0,0 +1,468 @@ +include <ctype.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> + +# MP_OPEN -- Open the specified mask for image i/o +# +# Open the specified pixel mask. The input pixel mask specification may be +# +# "" The mask is undefined +# +# "EMPTY" The mask is undefined +# +# "!KEYWORD" The mask is the pixel mask pointed to by the reference +# image header keyword KEYWORD +# "!^KEYWORD" The mask is inverse of the pixel mask pointed to by the +# reference image header keyword KEYWORD +# "MASK" The mask is a pixel mask or image +# +# "^MASK" The mask is inverse of the pixel mask or image +# +# "EXPR" The mask is specified by an integer expression +# +# "@FILE" The mask is specified by the an integer expression in +# the text file FILE +# +# The input mask specification is transformed into a simple 0 and 1 mask +# internally where 0 is the pass value and 1 is the stop value. The format +# of EXPR is still a TBD but I would eventually like to support +# an algebra that includes simple image expressions as in the IMEXPR task, +# and regions descriptors similar to those defined in the PROS XRAY package. +# The latter have the problem in that they must be limited to 1D images (point, +# line egments) or 2D images (box, rectangle, ellipse, # annulus, wedge, etc). +# It maybe possible to expand this to 3D in some cases, e.g. cubes, spheres, +# ellipsoids etc although dealing with the angles may become complicated. At +# any rate I will put aside the issue of on the fly mask generation for the +# moment. If a section is specified on the input image but not on the mask +# image then imio/mio will automatically track the proper section in the mask. +# If a section is specified on the mask that section of the mask will be used, +# and it must correspond in size to the input image or image section. + +pointer procedure mp_open (pmsource, refim, pmname, sz_pmname) + +char pmsource[ARB] #I the pixel mask specificiation +pointer refim #I the reference image pointer +char pmname[ARB] #O the pixel mask name +int sz_pmname #I the maximum pixel name length + +pointer sp, fname, kfname +pointer pmim, pm +int ip, flags, invflag +pointer im_pmmap(), mp_pmmap() +int imaccess(), imstati() +bool streq() +errchk im_pmmap(), mp_pmmap(), imgstr() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (kfname, SZ_FNAME, TY_CHAR) + + # Remove leading whitespace from the pixel source specification. + ip = 1 + while (IS_WHITE(pmsource[ip])) + ip = ip + 1 + call strcpy (pmsource[ip], Memc[fname], SZ_FNAME) + flags = 0 + pmname[1] = EOS + + # If the mask is undefined specify an empty mask. + if (Memc[fname] == EOS || streq (Memc[fname], "EMPTY")) { + + ifnoerr (pmim = im_pmmap ("EMPTY", READ_ONLY+BOOLEAN_MASK, refim)) { + call strcpy ("EMPTY", pmname, sz_pmname) + pm = imstati (pmim, IM_PMDES) + call mp_invert (pm) + call imseti (pmim, IM_PMDES, pm) + } else + pmim = NULL + + # If the mask specification is a keyword. + } else if (Memc[fname] == '!') { + + # Invert the specified mask. Note there is a bug in the + # invert mask flag which needs to be worked around. + ip = 1 + if (Memc[fname+ip] == '^') { + ip = ip + 1 + flags = BOOLEAN_MASK + invflag = NO + } else { + #flags = INVERT_MASK + BOOLEAN_MASK + flags = BOOLEAN_MASK + invflag = YES + } + + # Find the mask name. + ifnoerr (call imgstr (refim, Memc[fname+ip], Memc[kfname], + SZ_FNAME)) { + iferr (pmim = mp_pmmap (Memc[kfname], refim, flags, invflag)) { + pmim = NULL + } else if (invflag == NO) { + call strcpy ("^", pmname, sz_pmname) + call strcat (Memc[kfname], pmname, sz_pmname) + } else { + call strcpy (Memc[kfname], pmname, sz_pmname) + } + } else + pmim = NULL + + # If the mask specification is a mask / or image file. + } else if (imaccess (Memc[fname], READ_ONLY) == YES) { + + #flags = BOOLEAN_MASK+INVERT_MASK + flags = BOOLEAN_MASK + invflag = YES + call strcpy (Memc[fname], pmname, sz_pmname) + iferr (pmim = mp_pmmap (Memc[fname], refim, flags, invflag)) + pmim = NULL + else + call strcpy (Memc[fname], pmname, sz_pmname) + + } else if (Memc[fname] == '^') { + if (imaccess (Memc[fname+1], READ_ONLY) == YES) { + flags = BOOLEAN_MASK + invflag = NO + call strcpy (Memc[fname], pmname, sz_pmname) + iferr (pmim = mp_pmmap (Memc[fname+1], refim, flags, invflag)) + pmim = NULL + else + call strcpy (Memc[fname], pmname, sz_pmname) + } else + pmim = NULL + + } else { + pmim = NULL + } + + call sfree (sp) + + return (pmim) +end + + +# MP_PMMAP - Open a pixel mask READ_ONLY. The input mask may be a pixel +# list image or a non-pixel list image. The invflag is temporary, put into +# deal with the fact that mio has a bug in this flag. + + +pointer procedure mp_pmmap (pmname, refim, flags, invflag) + +char pmname[ARB] #I the pixel list or image name +pointer refim #I the reference image descriptor +int flags #I the pixel list or image flags +int invflag #I invert mask flag, remove when pmio fixed + +pointer sp, section, pmim, pm, tmp_refim +int use_section +pointer im_pmmap(), mp_immap() +int imstati() +errchk im_pmmap(), mp_immap() + +begin + # Does the pmname include an image section. + call smark (sp) + call salloc (section, SZ_FNAME, TY_CHAR) + call imgsection (pmname, Memc[section], SZ_FNAME) + if (Memc[section] == EOS) { + use_section = NO + tmp_refim = refim + } else { + use_section = YES + tmp_refim = NULL + } + + # Open the mask as a pixel list. + ifnoerr (pmim = im_pmmap (pmname, READ_ONLY+flags, tmp_refim)) { + + if (use_section == YES) + call mp_section (pmim) + if (invflag == YES) { + pm = imstati (pmim, IM_PMDES) + call mp_invert (pm) + call imseti (pmim, IM_PMDES, pm) + } + + # Open the mask as an image file. + } else ifnoerr (pmim = mp_immap (pmname)) { + + if (invflag == YES) { + pm = imstati (pmim, IM_PMDES) + call mp_invert (pm) + call imseti (pmim, IM_PMDES, pm) + } + + } else { + pmim = NULL + } + + call sfree (sp) + + return (pmim) +end + + +# MP_IMMAP -- Map an image as a pixel file + +pointer procedure mp_immap (pmname) + +char pmname[ARB] #I the pixel list or image name + +pointer sp, v1, v2, im, pm, data, pmim +int ndim, npix +pointer immap(), pm_newmask(), im_pmmapo() +int imgnli() + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + + # Open the input image. + im = immap (pmname, READ_ONLY, 0) + ndim = IM_NDIM(im) + npix = IM_LEN(im,1) + + # Open the mask with a depth of 1 bit. + pm = pm_newmask (im, 1) + + # Copy the image to a mask. + while (imgnli (im, data, Meml[v1]) != EOF) { + # may need to convert negative values here ... + call pm_plpi (pm, Meml[v2], Memi[data], 0, npix, PIX_SRC) + call amovl (Meml[v1], Meml[v2], ndim) + } + call imunmap (im) + + pmim = im_pmmapo (pm, NULL) + + call sfree (sp) + + return (pmim) +end + + +# MP_SECTION -- Create the a new mask from the specified mask section. + +procedure mp_section (pmim) + +pointer pmim #U mask image descriptor + +pointer newpm, newpmim, sp, v1, v2, ibuf +pointer pl_create(), im_pmmapo() +int ndim, depth, npix +int imgnls() + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + + ndim = IM_NDIM(pmim) + depth = 1 + npix = IM_LEN(pmim,1) + + newpm = pl_create (ndim, IM_LEN(pmim,1), depth) + while (imgnls (pmim, ibuf, Meml[v1]) != EOF) { + call pm_plps (newpm, Meml[v2], Mems[ibuf], 1, npix, PIX_SRC) + call amovl (Meml[v1], Meml[v2], ndim) + } + + call imunmap (pmim) + newpmim = im_pmmapo (newpm, NULL) + pmim = newpmim + + call sfree (sp) +end + + +# MP_MPCOPY -- Copy the input to the output mask setting the mapping +# parameters appropriately + +procedure mp_mpcopy (im, pmim, pmout) + +pointer im #I the input image descriptor +pointer pmim #I the input mask descriptor +pointer pmout #I the output mask descriptor + +pointer sp, axlen, v, oldpm, newpm +int naxes, depth +pointer pl_create() +int imstati(), mp_samesize() + +int pm_stati() +int refim, mapstat + +begin + call smark (sp) + call salloc (axlen, IM_MAXDIM, TY_LONG) + call salloc (v, IM_MAXDIM, TY_LONG) + + # Create new mask. + oldpm = imstati (pmim, IM_PLDES) + call pl_gsize (oldpm, naxes, Meml[axlen], depth) + newpm = pl_create (naxes, Meml[axlen], depth) + + # Store old values of the input mask reference image and mapping + # descriptors here. Maybe ... + refim = pm_stati (oldpm, P_REFIM) + mapstat = pm_stati (oldpm, P_MAPXY) + + # Set the input mask mapping parameters. + call pm_seti (oldpm, P_REFIM, im) + if (mp_samesize (im, pmim) == YES) + call pm_seti (oldpm, P_MAPXY, NO) + + # Restore old values of the input mask reference image and mapping + # descriptors here. Maybe ... + + # Store old values of the output reference image and mapping descriptors + # here. Don't need to do this since this is the desired behavior. + + # Set the input mask mapping parameters. + call pm_seti (newpm, P_REFIM, im) + if (mp_samesize (im, pmim) == YES) + call pm_seti (newpm, P_MAPXY, NO) + + # Restore old values of the output mask reference image and mapping + # descriptors here. Don't need to do this since this is the + # desired behavior. + + # Copy the input to the output mask using the mapping parameters + # as appropriate + call amovkl (long(1), Meml[v], IM_MAXDIM) + call pm_rop (oldpm, Meml[v], newpm, Meml[v], Meml[axlen], PIX_SRC) + + call imseti (pmout, IM_PLDES, newpm) + call sfree (sp) +end + + +# MP_MIOPEN - Open an mio descriptor and set the mapping parameters +# appropriately. This should be done by doing pm_stati calls on +# the pm descriptor via the P_REFIM and P_MAPXY parameters and the +# corresponding PRIVATE1 / PRIVATE2 parameters in plio but this +# mechanism is not working at present. For now test im / pmim for +# equality in number of dimensions and size. + +pointer procedure mp_miopen (im, pmim) + +pointer im #I the input image descriptor +pointer pmim #I the input mask image descriptor + +pointer pm, mp +int samesize +pointer mio_openo() +int imstati(), mp_samesize() + +begin + # Open the pixel mask. + pm = imstati (pmim, IM_PLDES) + + # Open the mio descriptor which set the mapping status using + # the image descriptor, i.e. the mapping status is yes if the + # image was opened with a section. + mp = mio_openo (pm, im) + + # Turn off mapping if the image and mask are exactly the same + # size. + samesize = mp_samesize (im, pmim) + if (samesize == YES) + call pm_seti (pm, P_MAPXY, NO) + + return (mp) +end + + +# MP_SAMESIZE -- Return YES if the image and mask are the same size. + +int procedure mp_samesize (im, pmim) + +pointer im #I the input image descriptor +pointer pmim #I the input image descriptor + +int i, samesize + +begin + if (IM_NDIM(im) == IM_NDIM(pmim)) { + samesize = YES + do i = 1, IM_NDIM(im) { + if (IM_LEN(im,i) == IM_LEN(pmim,i)) + next + samesize = NO + break + } + } else { + samesize = NO + } + + return (samesize) +end + + +# MP_INVERT -- Invert a pixel mask. + +procedure mp_invert (pm) + +pointer pm #U plio descriptor + +pointer sp, axlen, v, newpm +int naxes, depth +pointer pl_create() + +begin + # Allocate some working space. + call smark (sp) + call salloc (axlen, IM_MAXDIM, TY_LONG) + call salloc (v, IM_MAXDIM, TY_LONG) + + # Get pixel mask characteristics. + call pl_gsize (pm, naxes, Meml[axlen], depth) + + # Create the new inverted mask. + newpm = pl_create (naxes, Meml[axlen], depth) + call amovkl (long(1), Meml[v], IM_MAXDIM) + call pl_rop (pm, Meml[v], newpm, Meml[v], Meml[axlen], + PIX_NOT(PIX_SRC)) + + # Close the old mask and update the mask pointer. + call pl_close (pm) + pm = newpm + + call sfree (sp) +end + + +# MP_COPY -- Make a copy of an existing pixel mask. + +pointer procedure mp_copy (oldpm) + +pointer oldpm #I old pixel mask pointer + +pointer sp, axlen, v, newpm +int naxes, depth +pointer pl_create() + +begin + call smark (sp) + call salloc (axlen, IM_MAXDIM, TY_LONG) + call salloc (v, IM_MAXDIM, TY_LONG) + + call pl_gsize (oldpm, naxes, Meml[axlen], depth) + newpm = pl_create (naxes, Meml[axlen], depth) + + call amovkl (long(1), Meml[v], IM_MAXDIM) + call pl_rop (oldpm, Meml[v], newpm, Meml[v], Meml[axlen], + PIX_SRC) + + call sfree (sp) + + return (newpm) +end + diff --git a/pkg/proto/masks/mstcache.x b/pkg/proto/masks/mstcache.x new file mode 100644 index 00000000..d8195a7d --- /dev/null +++ b/pkg/proto/masks/mstcache.x @@ -0,0 +1,100 @@ +include <imhdr.h> +include <imset.h> + +define MEMFUDGE 1.05 + +# MST_CACHE1 -- Cache 1 image in memory using the image i/o buffer sizes. + +procedure mst_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(), mst_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 (mst_memstat (cache, req_size, old_size) == YES) + call mst_pcache (im, INDEFI, buf_size) +end + + +# MST_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 mst_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 + + +# MST_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 mst_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/proto/masks/rsfnames.x b/pkg/proto/masks/rsfnames.x new file mode 100644 index 00000000..2a7c2d5a --- /dev/null +++ b/pkg/proto/masks/rsfnames.x @@ -0,0 +1,549 @@ + +define RS_EXTNLIST "|imh|fits|pl|qpoe|hhh|" + + +# RS_IMLIST -- Create a list of input masks using the input image list and an +# output template string. + +int procedure rs_imlist (inlist, output, defaultstr, extstr) + +int inlist #I the input image list descriptor +char output[ARB] #I the input output file list +char defaultstr[ARB] #I the defaults id string +char extstr[ARB] #I the extension string + +pointer sp, fname, image, dirname, otemplate +int i, outlist, len_dir, len_otemplate, strfd +int imtopen(), imtlen(), imtrgetim(), fnldir(), strncmp(), strlen() +int stropen(), strmatch() +errchk imtopen() + +begin + # Return if the ouyput file list is empty. + iferr (outlist = imtopen (output)) + outlist = imtopen ("") + if (output[1] == EOS || imtlen (outlist) <= 0) + return (outlist) + + # Return if the output image list is the wrong length. + if ((imtlen (outlist) > 1) && (imtlen (outlist) != imtlen(inlist))) { + call imtclose (outlist) + outlist = imtopen ("") + return (outlist) + } + + # Get working space. + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (dirname, SZ_FNAME, TY_CHAR) + + # Get the directory name. + if (imtrgetim (outlist, 1, Memc[fname], SZ_FNAME) == EOF) + Memc[fname] = EOS + len_dir = fnldir (Memc[fname], Memc[dirname], SZ_FNAME) + + # Get the default output file names. There will be one output image per + # input image. + if (strncmp (defaultstr, Memc[fname+len_dir], + strlen (defaultstr)) == 0 || len_dir == strlen (Memc[fname])) { + + # Create a temporary list string. + call imtclose (outlist) + len_otemplate = imtlen (inlist) * SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + # Loop over the input image list. + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + do i = 1, imtlen (inlist) { + + # Get the root image name. + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) + ; + + # Construct the default name. + call rs_oimname (Memc[image], Memc[dirname], extstr, + Memc[fname], SZ_FNAME) + if (strmatch (Memc[fname], ".pl$") == 0) + call strcat (".pl", Memc[fname], SZ_FNAME) + + + # Record the file name. + call fprintf (strfd, "%s,") + call pargstr (Memc[fname]) + } + call close (strfd) + + # Create the final list. + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + outlist = imtopen (Memc[otemplate]) + + # Get the user output names. + } else { + + # Create a temporary list string. + len_otemplate = imtlen (outlist) * SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + # Loop over the fields. + do i = 1, imtlen (inlist) { + + if (imtrgetim (outlist, i, Memc[fname], SZ_FNAME) == EOF) + break + if (strmatch (Memc[fname], ".pl$") == 0) + call strcat (".pl", Memc[fname], SZ_FNAME) + + # Add the output name to the list. + call fprintf (strfd, "%s,") + call pargstr (Memc[fname]) + } + call close (strfd) + + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + call imtclose (outlist) + outlist = imtopen (Memc[otemplate]) + } + + call sfree (sp) + + return (outlist) +end + + +# RS_OLIST -- Create a list of output images using the input image list and an +# output template string. + +int procedure rs_olist (inlist, output, defaultstr, extstr) + +int inlist #I the input image list descriptor +char output[ARB] #I the input output file list +char defaultstr[ARB] #I the defaults id string +char extstr[ARB] #I the extension string + +pointer sp, fname, image, dirname, otemplate +int i, outlist, len_dir, len_otemplate, strfd +int imtopen(), imtlen(), imtrgetim(), fnldir(), strncmp(), strlen() +int stropen() +errchk imtopen() + +begin + # Return if the input file list is empty. + iferr (outlist = imtopen (output)) + outlist = imtopen ("") + if (output[1] == EOS || imtlen (outlist) <= 0) + return (outlist) + + # Return if the output image list is the wrong length. + if ((imtlen (outlist) > 1) && (imtlen (outlist) != imtlen(inlist))) { + call imtclose (outlist) + outlist = imtopen ("") + return (outlist) + } + + # Get working space. + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (dirname, SZ_FNAME, TY_CHAR) + + # Get the directory name. + if (imtrgetim (outlist, 1, Memc[fname], SZ_FNAME) == EOF) + Memc[fname] = EOS + len_dir = fnldir (Memc[fname], Memc[dirname], SZ_FNAME) + + # Get the default output file names. There will be one output image per + # input image. + if (strncmp (defaultstr, Memc[fname+len_dir], + strlen (defaultstr)) == 0 || len_dir == strlen (Memc[fname])) { + + # Create a temporary list string. + call imtclose (outlist) + len_otemplate = imtlen (inlist) * SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + # Loop over the input image list. + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + do i = 1, imtlen (inlist) { + + # Get the root image name. + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) + ; + + # Construct the default name. + call rs_oimname (Memc[image], Memc[dirname], extstr, + Memc[fname], SZ_FNAME) + + # Record the file name. + call fprintf (strfd, "%s,") + call pargstr (Memc[fname]) + } + call close (strfd) + + # Create the final list. + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + outlist = imtopen (Memc[otemplate]) + + # Get the user output names. + } else { + + # Create a temporary list string. + len_otemplate = imtlen (outlist) * SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + # Loop over the fields. + do i = 1, imtlen (inlist) { + + # Get the output file name. + if (imtrgetim (outlist, i, Memc[fname], SZ_FNAME) == EOF) + break + + # Add the output name to the list. + call fprintf (strfd, "%s,") + call pargstr (Memc[fname]) + } + call close (strfd) + + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + call imtclose (outlist) + outlist = imtopen (Memc[otemplate]) + } + + call sfree (sp) + + return (outlist) +end + + +# RS_OMLIST -- Create a list of output masks using the input image list and an +# output template string. + +int procedure rs_omlist (inlist, output, defaultstr, extstr) + +int inlist #I the input image list descriptor +char output[ARB] #I the input output file list +char defaultstr[ARB] #I the defaults id string +char extstr[ARB] #I the extension string + +pointer sp, fname, image, dirname, otemplate +int i, outlist, len_dir, len_otemplate, strfd +int imtopen(), imtlen(), imtrgetim(), fnldir(), strncmp(), strlen() +int stropen(), strmatch() +errchk imtopen() + +begin + # Return if the input file list is empty. + iferr (outlist = imtopen (output)) + outlist = imtopen ("") + if (output[1] == EOS || imtlen (outlist) <= 0) + return (outlist) + + # Return if the output image list is the wrong length. + if ((imtlen (outlist) > 1) && (imtlen (outlist) != imtlen(inlist))) { + call imtclose (outlist) + outlist = imtopen ("") + return (outlist) + } + + # Get working space. + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (dirname, SZ_FNAME, TY_CHAR) + + # Get the directory name. + if (imtrgetim (outlist, 1, Memc[fname], SZ_FNAME) == EOF) + Memc[fname] = EOS + len_dir = fnldir (Memc[fname], Memc[dirname], SZ_FNAME) + + # Get the default output file names. There will be one output image per + # input image. + if (strncmp (defaultstr, Memc[fname+len_dir], + strlen (defaultstr)) == 0 || len_dir == strlen (Memc[fname])) { + + # Create a temporary list string. + call imtclose (outlist) + len_otemplate = imtlen (inlist) * SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + # Loop over the input image list. + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + do i = 1, imtlen (inlist) { + + # Get the root image name. + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) + ; + + # Construct the default name. + call rs_oimname (Memc[image], Memc[dirname], extstr, + Memc[fname], SZ_FNAME) + if (strmatch (Memc[fname], ".pl$") == 0) + call strcat (".pl", Memc[fname], SZ_FNAME) + + + # Record the file name. + call fprintf (strfd, "%s,") + call pargstr (Memc[fname]) + } + call close (strfd) + + # Create the final list. + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + outlist = imtopen (Memc[otemplate]) + + # Get the user output names. + } else { + + # Create a temporary list string. + len_otemplate = imtlen (outlist) * SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + # Loop over the fields. + do i = 1, imtlen (inlist) { + + # Get the output file name. + if (imtrgetim (outlist, i, Memc[fname], SZ_FNAME) == EOF) + break + if (strmatch (Memc[fname], ".pl$") == 0) + call strcat (".pl", Memc[fname], SZ_FNAME) + + # Add the output name to the list. + call fprintf (strfd, "%s,") + call pargstr (Memc[fname]) + } + call close (strfd) + + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + call imtclose (outlist) + outlist = imtopen (Memc[otemplate]) + } + + call sfree (sp) + + return (outlist) +end + + +# RS_OUTNAME -- Construct an output file name. If output is null or a +# directory, a name is constructed from the root of the image name and the +# extension. The disk is searched to avoid name collisions. + +procedure rs_outname (image, output, ext, name, maxch) + +char image[ARB] #I input image name +char output[ARB] #I input output directory or name +char ext[ARB] #I input extension +char name[ARB] #O output file name +int maxch #I maximum size of name + +pointer sp, root, str +int ndir, nimdir, clindex, clsize, nextn +int fnldir(), strlen(), strldx(), strdic() +char period + +begin + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + ndir = fnldir (output, name, maxch) + if (strlen (output) == ndir) { + call imparse (image, Memc[root], SZ_FNAME, Memc[str], SZ_FNAME, + Memc[str], SZ_FNAME, clindex, clsize) + nimdir = fnldir (Memc[root], Memc[str], SZ_FNAME) + period = '.' + nextn = strldx (period, Memc[root]) + if (nextn > 0) { + if (strdic (Memc[root+nextn], Memc[str], SZ_FNAME, + RS_EXTNLIST) > 0) + Memc[root+nextn-1] = EOS + } + if (clindex >= 0) { + if (ext[1] == EOS) { + call sprintf (name[ndir+1], maxch, "%s%d.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + } else { + call sprintf (name[ndir+1], maxch, "%s%d.%s.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + call pargstr (ext) + } + } else { + if (ext[1] == EOS) { + call sprintf (name[ndir+1], maxch, "%s.*") + call pargstr (Memc[root+nimdir]) + } else { + call sprintf (name[ndir+1], maxch, "%s.%s.*") + call pargstr (Memc[root+nimdir]) + call pargstr (ext) + } + } + call rs_oversion (name, name, maxch) + } else + call strcpy (output, name, maxch) + + call sfree (sp) +end + + +# RS_OVERSION -- Compute the next available version number of a given file +# name template and output the new file name. + +procedure rs_oversion (template, filename, maxch) + +char template[ARB] #I the input name template +char filename[ARB] #O the output name +int maxch #I the maximum number of characters + +char period +int newversion, version, len +pointer sp, list, name +int fntgfnb() strldx(), ctoi(), fntopnb() +errchk fntopnb() + +begin + # Allocate temporary space + call smark (sp) + call salloc (name, maxch, TY_CHAR) + period = '.' + iferr (list = fntopnb (template, NO)) + list = fntopnb ("", NO) + + # Loop over the names in the list searchng for the highest version. + newversion = 0 + while (fntgfnb (list, Memc[name], maxch) != EOF) { + len = strldx (period, Memc[name]) + len = len + 1 + if (ctoi (Memc[name], len, version) <= 0) + next + newversion = max (newversion, version) + } + + # Make new output file name. + len = strldx (period, template) + call strcpy (template, filename, len) + call sprintf (filename[len+1], maxch, "%d") + call pargi (newversion + 1) + + call fntclsb (list) + call sfree (sp) +end + + +# RS_OIMNAME -- Construct an output image name. If output is null or a +# directory a name is constructed from the root of the image name and the +# extension. The disk is searched to avoid name collisions. + +procedure rs_oimname (image, output, ext, name, maxch) + +char image[ARB] #I the input image name +char output[ARB] #I the output directory or ouput image name +char ext[ARB] #I the output image extension +char name[ARB] #O the final output image name +int maxch #I maximum size of name + +int ndir, nimdir, clindex, clsize +pointer sp, root, str +int fnldir(), strlen() + +begin + # Allocate some temporary space. + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Determine the length of the directory spec. + ndir = fnldir (output, name, maxch) + + # If the file spec is a directory create a name from the directory and + # the route image name, otherwise use the output name directly. + if (strlen (output) == ndir) { + call imparse (image, Memc[root], SZ_FNAME, Memc[str], SZ_FNAME, + Memc[str], SZ_FNAME, clindex, clsize) + nimdir = fnldir (Memc[root], Memc[str], SZ_FNAME) + if (clindex >= 0) { + if (ext[1] == EOS) { + call sprintf (name[ndir+1], maxch, "%s%d.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + } else { + call sprintf (name[ndir+1], maxch, "%s%d.%s.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + call pargstr (ext) + } + } else { + if (ext[1] == EOS) { + call sprintf (name[ndir+1], maxch, "%s.*") + call pargstr (Memc[root+nimdir]) + } else { + call sprintf (name[ndir+1], maxch, "%s.%s.*") + call pargstr (Memc[root+nimdir]) + call pargstr (ext) + } + } + call rs_oimversion (name, name, maxch) + } else + call strcpy (output, name, maxch) + + call sfree (sp) +end + + +# RS_OIMVERSION -- Determine the next available version number for a given +# image name template and output the new image name. + +procedure rs_oimversion (template, filename, maxch) + +char template[ARB] #I the image name template +char filename[ARB] #O the output image name +int maxch #I the maximum number of characters + +char period +int newversion, version, len +pointer sp, list, name +int imtopen(), imtgetim(), strldx(), ctoi() + +begin + # Allocate temporary space + call smark (sp) + call salloc (name, maxch, TY_CHAR) + period = '.' + list = imtopen (template) + + # Loop over the names in the list searchng for the highest version. + newversion = 0 + while (imtgetim (list, Memc[name], maxch) != EOF) { + len = strldx (period, Memc[name]) + Memc[name+len-1] = EOS + len = strldx (period, Memc[name]) + len = len + 1 + if (ctoi (Memc[name], len, version) <= 0) + next + newversion = max (newversion, version) + } + + # Make new output file name. + len = strldx (period, template) + call strcpy (template, filename, len) + call sprintf (filename[len+1], maxch, "%d") + call pargi (newversion + 1) + + call imtclose (list) + call sfree (sp) +end diff --git a/pkg/proto/masks/rskysub.h b/pkg/proto/masks/rskysub.h new file mode 100644 index 00000000..7c14dfe0 --- /dev/null +++ b/pkg/proto/masks/rskysub.h @@ -0,0 +1,32 @@ +# Define the sky subtraction structure + + +define LEN_RSKYSUB 20 + 5 * SZ_FNAME + +define RS_LOWER Memr[P2R($1)] # lower good data limit +define RS_UPPER Memr[P2R($1+1)] # upper good data limit +define RS_LNSIGREJ Memr[P2R($1+2)] # low side clipping factor +define RS_UNSIGREJ Memr[P2R($1+3)] # high side clipping factor +define RS_BINWIDTH Memr[P2R($1+4)] # histogram binwidth +define RS_BLANK Memr[P2R($1+5)] # undefined pixel value +define RS_RESCALE Memi[$1+6] # recompute scaling factor ? +define RS_RESUBTRACT Memi[$1+7] # compute the subtracted image +define RS_NCOMBINE Memi[$1+8] # number of images to combine +define RS_NMIN Memi[$1+9] # min images to combine +define RS_MAXITER Memi[$1+11] # maximum number of iterations +define RS_COMBINE Memi[$1+12] # combining method +define RS_NLOREJ Memi[$1+13] # low side pixels to reject +define RS_NHIREJ Memi[$1+14] # high side pixels to reject +define RS_KYFSCALE Memc[P2C($1+15)] # scaling factor keyword +define RS_ISCALES Memc[P2C($1+15+SZ_FNAME)] # scaling method +define RS_STATSEC Memc[P2C($1+15+2*SZ_FNAME)] # statistics section +define RS_KYSKYSUB Memc[P2C($1+15+3*SZ_FNAME)] # sky subtraction keyword +define RS_KYHMASK Memc[P2C($1+15+4*SZ_FNAME)] # holes mask keyword + + +# Define the sky combining options + +define RS_COMBINESTR "|average|median|" + +define RS_MEAN 1 +define RS_MEDIAN 2 diff --git a/pkg/proto/masks/rsmean.x b/pkg/proto/masks/rsmean.x new file mode 100644 index 00000000..a39973bb --- /dev/null +++ b/pkg/proto/masks/rsmean.x @@ -0,0 +1,1172 @@ +include <imhdr.h> +include "rskysub.h" + +# RS_MSUB -- Perform a running mean sky subtraction on a list of images +# with no masking or rejection. + +procedure rs_msub (inlist, outlist, rs, cache, verbose) + +int inlist #I the input image list +int outlist #I the output image list +pointer rs #I the sky subtraction descriptor +bool cache #I cache temp image buffer in memory ? +bool verbose #I print task statistics + +real fscale +pointer sp, image, outimage, tmpimage, str +pointer im, outim, tmpim +int i, nimages, nlo, nhi, ostart, ofinish, start, finish, imno, oldsize +int bufsize, first, last +pointer immap() +int imtlen(), imtrgetim(), btoi(), imaccess() +errchk immap() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (tmpimage, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Check image status. If resubtract is yes then delete the output + # images if they already exist. Otherwise determine whether the + # images already exist and if so whether or not they need to be + # sky subtracted again. + + nimages = imtlen (inlist) + if (RS_RESUBTRACT(rs) == NO) { + first = 0 + last = 0 + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == NO) { + if (first == 0) { + first = i + last = i + } else + last = i + } else { + outim = immap (Memc[outimage], READ_ONLY, 0) + iferr (call imgstr (outim, RS_KYSKYSUB(rs), Memc[str], + SZ_FNAME)) { + if (first == 0) { + first = i + last = i + } else + last = i + } + call imunmap (outim) + } + } + } else { + first = 1 + last = nimages + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == YES) + call imdelete (Memc[outimage]) + } + } + + # Check the sky subtraction status. + if (first <= 0 && last <= 0) { + if (verbose) { + call printf ( + "The output images have already been sky subtracted \n") + } + call sfree (sp) + return + } + + # Create the temporary image. + call mktemp ("_rsum", Memc[tmpimage], SZ_FNAME) + tmpim = immap (Memc[tmpimage], NEW_IMAGE, 0) + + # Compute the sliding mean parameters. + nlo = RS_NCOMBINE(rs) / 2 + nhi = RS_NCOMBINE(rs) - nlo + + # Loop over the images. + ostart = 0 + ofinish = 0 + do imno = 1, nimages { + + # Skip over beginning and ending images that have already been + # sky subtracted. + + if (imno < first || imno > last) { + if (verbose) { + if (imtrgetim (outlist, imno, Memc[outimage], + SZ_FNAME) == EOF) { + call printf ( + "The sky subtracted image %s already exists\n") + call pargstr (Memc[outimage]) + } + } + next + } + + # Determine which images will contribute to the sky image. + # Start and finish set the endpoints of the sequence. Imno + # is the current image which is to be sky subtracted. + + if ((imno - nlo) < 1) { + start = 1 + finish = min (nimages, max (2 * imno - 1, RS_NMIN(rs) + 1)) + } else if ((imno + nhi) > nimages) { + start = max (1, min (2 * imno - nimages, nimages - RS_NMIN(rs))) + finish = nimages + } else { + start = imno - nlo + finish = imno + nhi + } + + # Check that the minimum number of images exists. + if ((finish - start) < RS_NMIN(rs)) { + call eprintf ("There are too few images for sky subtraction\n") + break + } + + # Open the current input image. + if (imtrgetim (inlist, imno, Memc[image], SZ_FNAME) == EOF) { + call eprintf ("Error reading input image list\n") + break + } + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call eprintf ("Error opening input image %s\n") + call pargstr (Memc[image]) + break + } + + # Open the output image. + if (imtrgetim (outlist, imno, Memc[outimage], SZ_FNAME) == EOF) { + call eprintf ("Error reading output image list\n") + call imunmap (im) + break + } + iferr (outim = immap (Memc[outimage], NEW_COPY, im)) { + call eprintf ("Error opening output image %s\n") + call pargstr (Memc[outimage]) + call imunmap (im) + break + } + + if (verbose) { + call printf ("Sky subtracting image %s and writing to %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[outimage]) + call flush (STDOUT) + } + + # Accumulate the running mean. The first time through the loop + # the number of dimensions, size, and pixel type of the temporary + # storage image are set and the first set of images are + # accumulated into the temporary image. + + if (imno == first) { + IM_NDIM(tmpim) = IM_NDIM(im) + call amovl (IM_LEN(im,1), IM_LEN(tmpim,1), IM_MAXDIM) + IM_PIXTYPE(tmpim) = TY_REAL + call rs_cachen (btoi(cache), 1, tmpim, oldsize) + call rs_minit (inlist, tmpim, start, finish, RS_KYFSCALE(rs)) + } else if ((ostart > 0 && start > ostart) || (ofinish > 0 && + finish > ofinish)) { + call rs_maddsub (inlist, tmpim, start, finish, ostart, ofinish, + RS_KYFSCALE(rs)) + } + + # Attempt to cache the input and output images. Try to cache + # the output image first since it will be accessed more + # frequently. + call rs_cachen (btoi(cache), 2, outim, bufsize) + call rs_cachen (btoi(cache), 3, im, bufsize) + + # Compute the new normalization factor. + call rs_mnorm (rs, im, tmpim, outim, finish - start + 1, fscale) + + # Write the output image. + call rs_mout (im, tmpim, outim, finish - start + 1, fscale, + RS_KYFSCALE(rs), RS_KYSKYSUB(rs)) + + # Close up images. + call imunmap (outim) + call imunmap (im) + + ostart = start + ofinish = finish + + } + + # Close and delete temporary image. + call imunmap (tmpim) + call imdelete (Memc[tmpimage]) + + call fixmem (oldsize) + + call sfree (sp) +end + + +# RS_RRMSUB -- Perform a running mean sky subtraction on a list of images +# with no masking but with minmax rejection opening and closing the input +# images for each set. + +procedure rs_rrmsub (inlist, outlist, rs, cache, verbose) + +int inlist #I the input image list +int outlist #I the output image list +pointer rs #I the sky subtraction descriptor +bool cache #I cache temp image buffer in memory ? +bool verbose #I print task statistics + +real fscale +pointer sp, image, outimage, tmpimage, imptrs, imids, str +pointer im, tmpim, outim +int i, imno, nlo, nhi, ostart, ofinish, start, finish, nimages +int oldsize, bufsize, first, last +pointer immap() +int imtlen(), imtrgetim(), btoi(), imaccess() +errchk immap(), imgstr() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (tmpimage, SZ_FNAME, TY_CHAR) + call salloc (imptrs, RS_NCOMBINE(rs) + 1, TY_POINTER) + call salloc (imids, RS_NCOMBINE(rs) + 1, TY_INT) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Check image status. If resubtract is yes then delete the output + # images if they already exist. Otherwise determine whether the + # images already exist and if so whether or not they need to be + # sky subtracted again. + + nimages = imtlen (inlist) + if (RS_RESUBTRACT(rs) == NO) { + first = 0 + last = 0 + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == NO) { + if (first == 0) { + first = i + last = i + } else + last = i + } else { + outim = immap (Memc[outimage], READ_ONLY, 0) + iferr (call imgstr (outim, RS_KYSKYSUB(rs), Memc[str], + SZ_FNAME)) { + if (first == 0) { + first = i + last = i + } else + last = i + } + call imunmap (outim) + } + } + } else { + first = 1 + last = nimages + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == YES) + call imdelete (Memc[outimage]) + } + } + + # Check the sky subtraction status. + if (first <= 0 && last <= 0) { + if (verbose) { + call printf ( + "The output images have already been sky subtracted \n") + } + call sfree (sp) + return + } + + # Create the temporary image. + call mktemp ("_rsum", Memc[tmpimage], SZ_FNAME) + tmpim = immap (Memc[tmpimage], NEW_IMAGE, 0) + + # Compute the sliding mean parameters. + nlo = RS_NCOMBINE(rs) / 2 + nhi = RS_NCOMBINE(rs) - nlo + + # Loop over the images. + ostart = 0 + ofinish = 0 + do imno = 1, nimages { + + # Skip over beginning and ending images that have already been + # sky subtracted. + + if (imno < first || imno > last) { + if (verbose) { + if (imtrgetim (outlist, imno, Memc[outimage], + SZ_FNAME) == EOF) { + call printf ( + "The sky subtracted image %s already exists\n") + call pargstr (Memc[outimage]) + } + } + next + } + + # Determine which images will contribute to the sky image. + # Start and finish set the endpoints of the sequence. Imno + # is the current image which is to be sky subtracted. + + if ((imno - nlo) < 1) { + start = 1 + finish = min (nimages, max (2 * imno - 1, RS_NMIN(rs) + 1)) + } else if ((imno + nhi) > nimages) { + start = max (1, min (2 * imno - nimages, nimages - RS_NMIN(rs))) + finish = nimages + } else { + start = imno - nlo + finish = imno + nhi + } + + # Check that the minimum number of images exists. + if ((finish - start) < RS_NMIN(rs)) { + call eprintf ("There are too few images for sky subtraction\n") + break + } + + # Get the input image name. + if (imtrgetim (inlist, imno, Memc[image], SZ_FNAME) == EOF) { + call eprintf ("Error reading input image list\n") + break + } + + # Open the output image name. + if (imtrgetim (outlist, imno, Memc[outimage], SZ_FNAME) == EOF) { + call eprintf ("Error reading output image list\n") + break + } + + if (verbose) { + call printf ("Sky subtracting image %s and writing to %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[outimage]) + call flush (STDOUT) + } + + # Determine which images are to be open at any given time. + + if (imno == first) { + call rs_iptrs (inlist, Memi[imptrs], Memi[imids], start, + finish, cache, oldsize) + IM_NDIM(tmpim) = IM_NDIM(Memi[imptrs]) + call amovl (IM_LEN(Memi[imptrs],1), IM_LEN(tmpim,1), IM_MAXDIM) + IM_PIXTYPE(tmpim) = TY_REAL + call rs_cachen (btoi(cache), finish - start + 2, tmpim, + bufsize) + } else { + call rs_asptrs (inlist, Memi[imptrs], Memi[imids], + start, finish, ostart, ofinish, cache) + } + + # Determine which image is the input image. + im = NULL + do i = 1, finish - start + 1 { + if (Memi[imids+i-1] != imno) + next + im = Memi[imptrs+i-1] + break + } + + # Open the output image and cache it. + iferr { + outim = immap (Memc[outimage], NEW_COPY, im) + } then { + call eprintf ("Error opening output image %s\n") + call pargstr (Memc[outimage]) + } else { + + # Cache the output image. + call rs_cachen (btoi(cache), finish - start + 3, outim, bufsize) + + # Combine images with rejection. + if (RS_COMBINE(rs) == RS_MEAN) + call rs_asumr (Memi[imptrs], Memi[imids], tmpim, start, + finish, imno, RS_NLOREJ(rs), RS_NHIREJ(rs), + RS_KYFSCALE(rs)) + else + call rs_asumr (Memi[imptrs], Memi[imids], tmpim, start, + finish, imno, INDEFI, INDEFI, RS_KYFSCALE(rs)) + + # Compute the normalization factor. + call rs_rmnorm (rs, im, tmpim, outim, fscale) + + # Write output image. + call rs_rmout (im, tmpim, outim, fscale, RS_KYSKYSUB(rs)) + + # Close up images. + call imunmap (outim) + } + + # Unmap the remaining image pointers. + if (imno == last) { + do i = 1, finish - start + 1 + call imunmap (Memi[imptrs+i-1]) + } + + ostart = start + ofinish = finish + } + + # Close and delete temporary image. + call imunmap (tmpim) + call imdelete (Memc[tmpimage]) + + call fixmem (oldsize) + + call sfree (sp) +end + + +# RS_RMSUB -- Perform a running mean sky subtraction on a list of images +# with no masking but with rejection. + +procedure rs_rmsub (inlist, outlist, rs, cache, verbose) + +int inlist #I the input image list +int outlist #I the output image list +pointer rs #I the sky subtraction descriptor +bool cache #I cache temp image buffer in memory ? +bool verbose #I print task statistics + +real fscale +pointer sp, image, outimage, tmpimage, str +pointer im, outim, tmpim +int i, nimages, nlo, nhi, ostart, ofinish, start, finish, imno, oldsize +int newsize, first, last +pointer immap() +int imtlen(), imtrgetim(), btoi(), imaccess() +errchk immap() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (tmpimage, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Check image status. If resubtract is yes then delete the output + # images if they already exist. Otherwise determine whether the + # images already exist and if so whether or not they need to be + # sky subtracted again. + + nimages = imtlen (inlist) + if (RS_RESUBTRACT(rs) == NO) { + first = 0 + last = 0 + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == NO) { + if (first == 0) { + first = i + last = i + } else + last = i + } else { + outim = immap (Memc[outimage], READ_ONLY, 0) + iferr (call imgstr (outim, RS_KYSKYSUB(rs), Memc[str], + SZ_FNAME)) { + if (first == 0) { + first = i + last = i + } else + last = i + } + call imunmap (outim) + } + } + } else { + first = 1 + last = nimages + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == YES) + call imdelete (Memc[outimage]) + } + } + + # Check the sky subtraction status. + if (first <= 0 && last <= 0) { + if (verbose) { + call printf ( + "The output images have already been sky subtracted \n") + } + call sfree (sp) + return + } + + # Create the temporary image. + call mktemp ("_rsum", Memc[tmpimage], SZ_FNAME) + tmpim = immap (Memc[tmpimage], NEW_IMAGE, 0) + + # Compute the sliding mean parameters. + nlo = RS_NCOMBINE(rs) / 2 + nhi = RS_NCOMBINE(rs) - nlo + + # Loop over the images. + ostart = 0 + ofinish = 0 + do imno = 1, nimages { + + # Skip over beginning and ending images that have already been + # sky subtracted. + + if (imno < first || imno > last) { + if (verbose) { + if (imtrgetim (outlist, imno, Memc[outimage], + SZ_FNAME) == EOF) { + call printf ( + "The sky subtracted image %s already exists\n") + call pargstr (Memc[outimage]) + } + } + next + } + + # Determine which images will contribute to the sky image. + # Start and finish set the endpoints of the sequence. Imno + # is the current image which is to be sky subtracted. + + if ((imno - nlo) < 1) { + start = 1 + finish = min (nimages, max (2 * imno - 1, RS_NMIN(rs) + 1)) + } else if ((imno + nhi) > nimages) { + start = max (1, min (2 * imno - nimages, nimages - RS_NMIN(rs))) + finish = nimages + } else { + start = imno - nlo + finish = imno + nhi + } + + # Check that the minimum number of images exists. + if ((finish - start) < RS_NMIN(rs)) { + call eprintf ("There are too few images for sky subtraction\n") + break + } + + # Open the current input image. + if (imtrgetim (inlist, imno, Memc[image], SZ_FNAME) == EOF) { + call eprintf ("Error reading input image list\n") + break + } + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call eprintf ("Error opening input image %s\n") + call pargstr (Memc[image]) + break + } + + # Open the output image. + + if (imtrgetim (outlist, imno, Memc[outimage], SZ_FNAME) == EOF) { + call eprintf ("Error reading output image list\n") + call imunmap (im) + break + } + iferr (outim = immap (Memc[outimage], NEW_COPY, im)) { + call eprintf ("Error opening output image %s\n") + call pargstr (Memc[outimage]) + call imunmap (im) + break + } + + if (verbose) { + call printf ("Sky subtracting image %s and writing to %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[outimage]) + call flush (STDOUT) + } + + # Set the size of the temporary image. + if (imno == first) { + IM_NDIM(tmpim) = IM_NDIM(im) + call amovl (IM_LEN(im,1), IM_LEN(tmpim,1), IM_MAXDIM) + IM_PIXTYPE(tmpim) = TY_REAL + call rs_cachen (btoi(cache), 1, tmpim, oldsize) + } + + # Accumulate the temporary image. + if (RS_COMBINE(rs) == RS_MEAN) + call rs_sumr (inlist, tmpim, start, finish, imno, RS_NLOREJ(rs), + RS_NHIREJ(rs), RS_KYFSCALE(rs)) + else + call rs_sumr (inlist, tmpim, start, finish, imno, INDEFI, + INDEFI, RS_KYFSCALE(rs)) + + # Cache the output image. + call rs_cachen (btoi(cache), 2, outim, newsize) + + # Compute the normalization factor. + call rs_rmnorm (rs, im, tmpim, outim, fscale) + + # Write the output image. + call rs_rmout (im, tmpim, outim, fscale, RS_KYSKYSUB(rs)) + + # Close up images. + call imunmap (outim) + call imunmap (im) + + ostart = start + ofinish = finish + + } + + # Close and delete temporary image. + call imunmap (tmpim) + call imdelete (Memc[tmpimage]) + + call fixmem (oldsize) + + call sfree (sp) +end + + +# RS_MINIT -- Initialize the accumulation buffer for the running median +# in the case of no masks. + +procedure rs_minit (inlist, tmpim, start, finish, skyscale) + +int inlist #I the input image list +pointer tmpim #I the output storage image +int start #I the starting image in the list +int finish #I the ending image in the list +#real normsum #U the normalization accumulator +char skyscale[ARB] #I the scaling factor keyword + +pointer sp, image, imptrs, imnorm, vin, vout, obuf, ibuf +int i, j, nin, npix +real imgetr() +pointer immap() +int imtrgetim(), impnlr(), imgnlr() +errchk imgetr() + +begin + nin = finish - start + 1 + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imptrs, nin, TY_POINTER) + call salloc (imnorm, nin, TY_REAL) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vin, nin * IM_MAXDIM, TY_LONG) + + # Open the input images + j = 1 + #normsum = 0.0 + do i = start, finish { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) == EOF) + ; + Memi[imptrs+j-1] = immap (Memc[image], READ_ONLY, 0) + iferr (Memr[imnorm+j-1] = imgetr (Memi[imptrs+j-1], skyscale)) + Memr[imnorm+j-1] = 1.0 + #normsum = normsum + 1.0 + #else + #normsum = normsum + Memr[imnorm+j-1] + j = j + 1 + } + + call amovkl (long(1), Meml[vin], IM_MAXDIM * nin) + call amovkl (long(1), Meml[vout], IM_MAXDIM) + npix = IM_LEN(tmpim,1) + while (impnlr (tmpim, obuf, Meml[vout]) != EOF) { + call amovkr (0.0, Memr[obuf], npix) + do j = 1, nin { + if (imgnlr (Memi[imptrs+j-1], ibuf, + Meml[vin+(j-1)*IM_MAXDIM]) == EOF) + ; + call amulkr (Memr[ibuf], Memr[imnorm+j-1], Memr[ibuf], npix) + call aaddr (Memr[ibuf], Memr[obuf], Memr[obuf], npix) + } + } + + # Close the input images. + do j = 1, nin + call imunmap (Memi[imptrs+j-1]) + + call sfree (sp) +end + + +# RS_MNORM -- Compute the normalization factor for the new output image. + +procedure rs_mnorm (rs, im, tmpim, outim, nin, fscale) + +pointer rs #I the sky subtraction descriptor +pointer im #I the input image descriptor +pointer tmpim #I the storage image descriptor +pointer outim #I the output image descriptor +int nin #I the number of images +real fscale #I the scaling factor + + +real norm1, normf, rmin, rmax +pointer sp, vin, vout, vtmp, obuf, ibuf, tbuf +int i, npix +real imgetr() +int impnlr(), imgnlr() +errchk imgetr() + +begin + + call smark (sp) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vtmp, IM_MAXDIM, TY_LONG) + + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vtmp], IM_MAXDIM) + + iferr (norm1 = imgetr (im, RS_KYFSCALE(rs))) + norm1 = 1.0 + normf = 1.0 / (nin - 1) + npix = IM_LEN(im,1) + + # Compute the normalized image. + while (impnlr (outim, obuf, Meml[vout]) != EOF && imgnlr (im, ibuf, + Meml[vin]) != EOF && imgnlr (tmpim, tbuf, Meml[vtmp]) != EOF) { + do i = 1, npix { + Memr[obuf+i-1] = normf * (Memr[tbuf+i-1] - norm1 * + Memr[ibuf+i-1]) + if (Memr[obuf+i-1] == 0.0) + Memr[obuf+i-1] = Memr[ibuf+i-1] + else + Memr[obuf+i-1] = Memr[ibuf+i-1] / Memr[obuf+i-1] + } + } + + # Compute the statistic. + rmin = RS_LOWER(rs) + rmax = RS_UPPER(rs) + RS_LOWER(rs) = INDEFR + RS_UPPER(rs) = INDEFR + call rs_med (outim, rs, fscale) + RS_LOWER(rs) = rmin + RS_UPPER(rs) = rmax + + call sfree (sp) + +end + + +# RS_MOUT -- Write the output image. Subtract the normalized input +# image from the accumulation buffer before computing the final average. + +procedure rs_mout (im, tmpim, outim, nin, fscale, skyscale, skysub) + +pointer im #I the input image descriptor +pointer tmpim #I the storage image descriptor +pointer outim #I the output image descriptor +int nin #I the number of images +real fscale #I the normalization factor +char skyscale[ARB] #I the sky scaling keyword +char skysub[ARB] #I the sky subtraction keyword + +real norm1, normf +pointer sp, vin, vout, vtmp, str, obuf, ibuf, tbuf +int i, npix +real imgetr() +int impnlr(), imgnlr() +errchk imgetr() + +begin + call smark (sp) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vtmp, IM_MAXDIM, TY_LONG) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Write a sky subtraction flag to the output image. + call sprintf (Memc[str], SZ_FNAME, + "Sky subtracting with scale factor %g") + call pargr (fscale) + call imastr (outim, skysub, Memc[str]) + + # Get and set the normalization factors + iferr (norm1 = imgetr (im, skyscale)) + norm1 = 1.0 + normf = fscale / (nin - 1) + norm1 = 1.0 + normf * norm1 + + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vtmp], IM_MAXDIM) + npix = IM_LEN(im,1) + while (impnlr (outim, obuf, Meml[vout]) != EOF && imgnlr (im, ibuf, + Meml[vin]) != EOF && imgnlr (tmpim, tbuf, Meml[vtmp]) != EOF) { + do i = 1, npix + Memr[obuf+i-1] = norm1 * Memr[ibuf+i-1] - normf * Memr[tbuf+i-1] + } + + call sfree (sp) +end + + +# RS_MADDSUB -- Add images to and subtract images from the accumulation +# buffer. + +procedure rs_maddsub (inlist, tmpim, start, finish, ostart, ofinish, skyscale) + +int inlist #I the input image list +pointer tmpim #I the storage image descriptor +int start #I the current starting image +int finish #I the current ending image +int ostart #I the previous starting image +int ofinish #I the previous ending image +#real normsum #I the norm factor accumulator +char skyscale #I the sky scaling keyword + +pointer sp, image, vin, vsub, vadd, vout, imsub, imadd, norma, norms +pointer ibuf, obuf, sbuf, abuf +int i, j, nsub, nadd, npix, doadd, dosub +real imgetr() +pointer immap() +int imtrgetim(), impnlr(), imgnlr() +errchk imgetr() + +begin + if (start == ostart && finish == ofinish) + return + nsub = start - ostart + nadd = finish - ofinish + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (imsub, nsub, TY_INT) + call salloc (norms, nsub, TY_REAL) + call salloc (vsub, nsub * IM_MAXDIM, TY_LONG) + call salloc (imadd, nadd, TY_INT) + call salloc (vadd, nadd * IM_MAXDIM, TY_LONG) + call salloc (norma, nadd, TY_REAL) + + # Open the images to be subtracted. In most cases there will be + # one such image. + if (ostart < start) { + dosub = YES + j = 1 + do i = ostart, start - 1 { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) { + Memi[imsub+j-1] = immap (Memc[image], READ_ONLY, 0) + iferr (Memr[norms+j-1] = imgetr (Memi[imsub+j-1], skyscale)) + Memr[norms+j-1] = 1.0 + #normsum = normsum - Memr[norms+j-1] + } + j = j + 1 + } + } else + dosub = NO + + # Open the images to be added. In most cases there will be one + # such image. + if (finish > ofinish) { + doadd = YES + j = 1 + do i = ofinish + 1, finish { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) { + Memi[imadd+j-1] = immap (Memc[image], READ_ONLY, 0) + iferr (Memr[norma+j-1] = imgetr (Memi[imadd+j-1], skyscale)) + Memr[norma+j-1] = 1.0 + #normsum = normsum + Memr[norma+j-1] + } + j = j + 1 + } + } else + doadd = NO + + # Make the vector operators in-line code later if necessary. + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vsub], nsub * IM_MAXDIM) + call amovkl (long(1), Meml[vadd], nadd * IM_MAXDIM) + call amovkl (long(1), Meml[vout], IM_MAXDIM) + npix = IM_LEN(tmpim,1) + while (impnlr (tmpim, obuf, Meml[vout]) != EOF && + imgnlr (tmpim, ibuf, Meml[vin]) != EOF) { + if (dosub == YES && doadd == YES) { + do i = 1, nsub { + if (imgnlr (Memi[imsub+i-1], sbuf, + Meml[vsub+(i-1)*nsub]) != EOF) { + call amulkr (Memr[sbuf], Memr[norms+i-1], Memr[sbuf], + npix) + if (i == 1) + call asubr (Memr[ibuf], Memr[sbuf], Memr[obuf], + npix) + else + call asubr (Memr[obuf], Memr[sbuf], Memr[obuf], + npix) + } + } + do i = 1, nadd { + if (imgnlr (Memi[imadd+i-1], abuf, + Meml[vadd+(i-1)*nadd]) != EOF) { + call amulkr (Memr[abuf], Memr[norma+i-1], Memr[abuf], + npix) + call aaddr (Memr[obuf], Memr[abuf], Memr[obuf], npix) + } + } + } else if (dosub == YES) { + do i = 1, nsub { + if (imgnlr (Memi[imsub+i-1], sbuf, + Meml[vsub+(i-1)*nsub]) != EOF) { + call amulkr (Memr[sbuf], Memr[norms+i-1], Memr[sbuf], + npix) + if (i == 1) + call asubr (Memr[ibuf], Memr[sbuf], Memr[obuf], + npix) + else + call asubr (Memr[obuf], Memr[sbuf], Memr[obuf], + npix) + } + } + } else if (doadd == YES) { + do i = 1, nadd { + if (imgnlr (Memi[imadd+i-1], abuf, + Meml[vadd+(i-1)*nadd]) != EOF) { + call amulkr (Memr[abuf], Memr[norma+i-1], Memr[abuf], + npix) + if ( i == 1) + call aaddr (Memr[ibuf], Memr[abuf], Memr[obuf], + npix) + else + call aaddr (Memr[obuf], Memr[abuf], Memr[obuf], + npix) + } + } + } + } + + # Close the images to be added or subtracted. + do i = 1, nsub { + call imunmap (Memi[imsub+i-1]) + } + do i = 1, nadd { + call imunmap (Memi[imadd+i-1]) + } + + call sfree (sp) +end + + +# RS_IPTRS -- Get the initial set of image points. + +procedure rs_iptrs (inlist, imptrs, imids, start, finish, cache, oldsize) + +int inlist #I the input image list +pointer imptrs[ARB] #O the input image pointers +int imids[ARB] #O the input image ids +int start #I the starting image in the series +int finish #I the ending image in the serious +bool cache #I cache the image in memory ? +int oldsize #O the original working set size + +pointer sp, image +int n, i, bufsize +pointer immap() +int imtrgetim(), btoi() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + + n = 1 + do i = start, finish { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) { + imids[n] = i + imptrs[n] = immap (Memc[image], READ_ONLY, 0) + call rs_cachen (btoi(cache), n, imptrs[n], bufsize) + if (n == 1) + oldsize = bufsize + n = n + 1 + } + } + + call sfree (sp) +end + + +# RS_ASPTRS -- Advance the image pointer and id buffers for the next +# current image. + +procedure rs_asptrs (inlist, imptrs, imids, start, finish, ostart, ofinish, + cache) + +int inlist #I the input image list +pointer imptrs[ARB] #U the input image pointers +int imids[ARB] #U the input image ids +int start #I the starting image in the series +int finish #I the ending image in the serious +int ostart #I the old starting image in the series +int ofinish #I the old ending image in the serious +bool cache #I cache image buffers ? + +pointer sp, image +int i, n, nold, nsub, nadd, bufsize +pointer immap() +int imtrgetim(), btoi() + +begin + # No new images are added or deleted. + if (start == ostart && finish == ofinish) + return + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + + nold = ofinish - start + 1 + + # Delete some images from the combine list. + nsub = start - ostart + if (nsub > 0) { + # Unmap the images to be deleted. + do i = 1, nsub { + call imunmap (imptrs[i]) + } + # Rotate the image pointer buffer. + do i = 1, nold { + imptrs[i] = imptrs[i+nsub] + imids[i] = imids[i+nsub] + } + } + + # Add new images to the combine list. Note that the cacheing + # mechanism must include the temporary image hence a request for + # n + 1 cached image buffers is issued instead of a request for n. + nadd = finish - ofinish + if (nadd > 0) { + n = nold + 1 + do i = ofinish + 1, finish { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) { + imptrs[n] = immap (Memc[image], READ_ONLY, 0) + imids[n] = i + if ((finish - start) > (ofinish - ostart)) + call rs_cachen (btoi(cache), n+1, imptrs[n], bufsize) + n = n + 1 + } + } + } + + call sfree (sp) +end + + +# RS_RMNORM -- Compute the normalization factor for the new output image. + +procedure rs_rmnorm (rs, im, tmpim, outim, fscale) + +pointer rs #I the sky subtraction structure +pointer im #I the input image descriptor +pointer tmpim #I the storage image descriptor +pointer outim #I the output image descriptor +real fscale #O the scaling factor + +real rmin, rmax +pointer sp, vout, vin, vtmp, obuf, tmpbuf, ibuf +int i, npix +int impnlr(), imgnlr() + +begin + call smark (sp) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vtmp, IM_MAXDIM, TY_LONG) + + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[vtmp], IM_MAXDIM) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + + # Compute the normalized input image. + npix = IM_LEN(im,1) + while (impnlr (outim, obuf, Meml[vout]) != EOF && + imgnlr (tmpim, tmpbuf, Meml[vtmp]) != EOF && + imgnlr (im, ibuf, Meml[vin]) != EOF) { + do i = 1, npix { + if (Memr[tmpbuf+i-1] == 0.0) + Memr[obuf+i-1] = Memr[ibuf+i-1] + else + Memr[obuf+i-1] = Memr[ibuf+i-1] / Memr[tmpbuf+i-1] + } + } + + # Compute the normalization factor. Set the good data limits to + # INDEF for this case + rmin = RS_LOWER(rs) + rmax = RS_UPPER(rs) + RS_LOWER(rs) = INDEFR + RS_UPPER(rs) = INDEFR + call rs_med (outim, rs, fscale) + RS_LOWER(rs) = rmin + RS_UPPER(rs) = rmax + + call sfree (sp) +end + + +# RS_RMOUT -- Compute the output sky subtracted image. + +procedure rs_rmout (im, tmpim, outim, fscale, skysub) + +pointer im #I the input image descriptor +pointer tmpim #I the temporary image descriptor +pointer outim #I the output image descriptor +real fscale #I the scaling factor +char skysub[ARB] #I the skyscale keyword + +pointer sp, vout, vtmp, vin, str, obuf, tmpbuf, ibuf +int npix +int imgnlr(), impnlr() + +begin + call smark (sp) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vtmp, IM_MAXDIM, TY_LONG) + call salloc (str, SZ_FNAME, TY_CHAR) + + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[vtmp], IM_MAXDIM) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + + # Add keyword to image header. + call sprintf (Memc[str], SZ_FNAME, + "Sky subtracted with scale factor = %g") + call pargr (fscale) + call imastr (outim, skysub, Memc[str]) + + # Normalize the output image. + npix = IM_LEN(im,1) + while (impnlr (outim, obuf, Meml[vout]) != EOF && + imgnlr (tmpim, tmpbuf, Meml[vtmp]) != EOF && + imgnlr (im, ibuf, Meml[vin]) != EOF) { + call amulkr (Memr[tmpbuf], fscale, Memr[obuf], npix) + call asubr (Memr[ibuf], Memr[obuf], Memr[obuf], npix) + } + + call sfree (sp) +end + + +# RS_DIVERR -- Function for divide by zero error. + +#real procedure rs_diverr (rval) + +#real rval #I input return value. + +#begin +# return (rval) +#end diff --git a/pkg/proto/masks/rsmmean.x b/pkg/proto/masks/rsmmean.x new file mode 100644 index 00000000..a6ea102b --- /dev/null +++ b/pkg/proto/masks/rsmmean.x @@ -0,0 +1,1673 @@ +include <imhdr.h> +include <imset.h> +include <pmset.h> +include "rskysub.h" + +# RS_PRRMSUB -- Perform a running mean sky subtraction on a list of images +# with masking and minmax rejection using a cylindrical buffer of image +# pointers. + +procedure rs_prrmsub (inlist, msklist, outlist, hmsklist, rs, msk_invert, + cache, verbose) + +int inlist #I the input image list +int msklist #I the input mask list +int outlist #I the output image list +int hmsklist #I the output holes mask list +pointer rs #I the sky subtraction descriptor +bool msk_invert #I invert the input masks ? +bool cache #I cache temp image buffer in memory ? +bool verbose #I print task statistics + +real flow, fhigh, fscale +pointer sp, image, imask, outimage, tmpimage, tmpmask, imptrs, mskptrs, str +pointer hmask, imids, tmpim, tmpmsk, im, pmim, outim, hmim +int i, imno, nlo, nhi, ostart, ofinish, start, finish, nimages, old_size +int new_size, first, last, hstat +pointer immap(), im_pmmap() +int imtlen(), imtrgetim(), btoi(), imaccess(), rs_prmout(), imstati() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imask, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (hmask, SZ_FNAME, TY_CHAR) + call salloc (tmpimage, SZ_FNAME, TY_CHAR) + call salloc (tmpmask, SZ_FNAME, TY_CHAR) + call salloc (imptrs, RS_NCOMBINE(rs) + 1, TY_POINTER) + call salloc (mskptrs, RS_NCOMBINE(rs) + 1, TY_POINTER) + call salloc (imids, RS_NCOMBINE(rs) + 1, TY_INT) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Check image status. If resubtract is yes then delete the output + # images if they already exist. Otherwise determine whether the + # images already exist and if so whether or not they need to be + # sky subtracted again. + + nimages = imtlen (inlist) + if (RS_RESUBTRACT(rs) == NO) { + first = 0 + last = 0 + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == NO) { + if (first == 0) { + first = i + last = i + } else + last = i + } else { + outim = immap (Memc[outimage], READ_ONLY, 0) + iferr (call imgstr (outim, RS_KYSKYSUB(rs), Memc[str], + SZ_FNAME)) { + if (first == 0) { + first = i + last = i + } else + last = i + } + call imunmap (outim) + } + } + } else { + first = 1 + last = nimages + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == YES) + call imdelete (Memc[outimage]) + if (imtrgetim (hmsklist, i, Memc[hmask], SZ_FNAME) == EOF) + next + if (imaccess (Memc[hmask], 0) == YES) + call imdelete (Memc[hmask]) + } + } + + # Check the sky subtraction status. + if (first <= 0 && last <= 0) { + if (verbose) { + call printf ( + "The output images have already been sky subtracted \n") + } + call sfree (sp) + return + } + + # Create the temporary image. + call mktemp ("_rsum", Memc[tmpimage], SZ_FNAME) + tmpim = immap (Memc[tmpimage], NEW_IMAGE, 0) + + # Make temporary mask image. Use pmmap instead of immap ? Set mask + # to 8 bits deep to save space. This assumes no more than 255 + # images are averaged. This mask will get converted to a 1 bit + # holes masks if holes mask are saved. + call mktemp ("_rnpts", Memc[tmpmask], SZ_FNAME) + tmpmsk = immap (Memc[tmpmask], NEW_IMAGE, 0) + + # Compute the sliding mean parameters. + nlo = RS_NCOMBINE(rs) / 2 + nhi = RS_NCOMBINE(rs) - nlo + + # Loop over the images. + ostart = 0 + ofinish = 0 + do imno = 1, nimages { + + # Skip over beginning and ending images that have already been + # sky subtracted. + + if (imno < first || imno > last) { + if (verbose) { + if (imtrgetim (outlist, imno, Memc[outimage], + SZ_FNAME) == EOF) { + call printf ( + "The sky subtracted image %s already exists\n") + call pargstr (Memc[outimage]) + } + } + next + } + + # Determine which images will contribute to the sky image. + # Start and finish set the endpoints of the sequence. Imno + # is the current image which is to be sky subtracted. + + if ((imno - nlo) < 1) { + start = 1 + finish = min (nimages, max (2 * imno - 1, RS_NMIN(rs) + 1)) + } else if ((imno + nhi) > nimages) { + start = max (1, min (2 * imno - nimages, nimages - RS_NMIN(rs))) + finish = nimages + } else { + start = imno - nlo + finish = imno + nhi + } + + # Check that the minimum number of images exists. + if ((finish - start) < RS_NMIN(rs)) { + call eprintf ("There are too few images for sky subtraction\n") + break + } + + # Get the input image name. + if (imtrgetim (inlist, imno, Memc[image], SZ_FNAME) == EOF) { + call eprintf ("Error reading input image list\n") + break + } + + # Get the input mask name. + if (imtrgetim (msklist, imno, Memc[imask], SZ_FNAME) == EOF) { + call eprintf ("Error reading input mask list\n") + break + } + + # Get the output image name. + if (imtrgetim (outlist, imno, Memc[outimage], SZ_FNAME) == EOF) { + call eprintf ("Error reading output image list\n") + break + } + + # Get the holes mask name. + if (imtrgetim (hmsklist, imno, Memc[hmask], SZ_FNAME) == EOF) + Memc[hmask] = EOS + + if (verbose) { + call printf ( + "Sky subtracting image %s using mask %s and writing to %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[imask]) + call pargstr (Memc[outimage]) + call flush (STDOUT) + } + + # Accumulate the running mean. The first time through the loop + # the number of dimensions, size, and pixel type of the temporary + # storage image and mask are set and the first set of images are + # accumulated into the temporary image. Attempt to cache the + # input image. It is probably not necessary to cache the mask + # since it is already in memory ... + if (imno == start) { + call rs_piptrs (inlist, msklist, Memi[imptrs], Memi[mskptrs], + Memi[imids], start, finish, msk_invert, cache, old_size) + IM_NDIM(tmpim) = IM_NDIM(Memi[imptrs]) + call amovl (IM_LEN(Memi[imptrs],1), IM_LEN(tmpim,1), IM_MAXDIM) + IM_PIXTYPE(tmpim) = TY_REAL + call rs_cachen (btoi(cache), (finish - start + 2), tmpim, + new_size) + IM_NDIM(tmpmsk) = IM_NDIM(Memi[imptrs]) + call amovl (IM_LEN(Memi[imptrs],1), IM_LEN(tmpmsk,1), IM_MAXDIM) + IM_PIXTYPE(tmpmsk) = TY_INT + call rs_cachen (btoi(cache), (finish - start + 3), tmpmsk, + new_size) + } else { + call rs_pasptrs (inlist, msklist, Memi[imptrs], Memi[mskptrs], + Memi[imids], start, finish, ostart, ofinish, msk_invert, + cache) + } + + # Determine the input image and mask pointers. + im = NULL + pmim = NULL + do i = 1, finish - start + 1 { + if (Memi[imids+i-1] != imno) + next + im = Memi[imptrs+i-1] + pmim = Memi[mskptrs+i-1] + break + } + + iferr { + outim = immap (Memc[outimage], NEW_COPY, im) + } then { + call eprintf ("Error opening output image %s\n") + call pargstr (Memc[outimage]) + + } else { + + # Cache the output image. + call rs_cachen (btoi(cache), (finish - start + 3), outim, + new_size) + + if (Memc[hmask] == EOS) + hmim = NULL + else { + hmim = im_pmmap (Memc[hmask], NEW_IMAGE, 0) + call pm_ssize (imstati(hmim, IM_PLDES), IM_NDIM(outim), + IM_LEN(outim,1), 1) + } + + # Accumulate the sky image. + if (RS_COMBINE(rs) == RS_MEAN) { + flow = RS_NLOREJ(rs) + if (RS_NLOREJ(rs) >= 1) + flow = flow / (finish - start) + else + flow = 0.0 + fhigh = RS_NHIREJ(rs) + if (RS_NHIREJ(rs) >= 1) + fhigh = fhigh / (finish - start) + else + fhigh = 0.0 + call rs_apsumr (Memi[imptrs], Memi[mskptrs], Memi[imids], + tmpim, tmpmsk, start, finish, imno, flow, fhigh, + RS_KYFSCALE(rs)) + } else { + call rs_apsumr (Memi[imptrs], Memi[mskptrs], Memi[imids], + tmpim, tmpmsk, start, finish, imno, INDEFR, INDEFR, + RS_KYFSCALE(rs)) + } + + # Compute the new normalization factor. + call rs_prmnorm (rs, im, pmim, tmpim, tmpmsk, outim, fscale) + + # Write the output image. + hstat = rs_prmout (im, tmpim, tmpmsk, outim, hmim, + RS_BLANK(rs), fscale, RS_KYSKYSUB(rs)) + + # Close up images. + if (hmim != NULL) { + if (hstat == YES) { + call pm_savef (imstati (hmim, IM_PLDES), Memc[hmask], + "", 0) + call imastr (outim, RS_KYHMASK(rs), Memc[hmask]) + } + call imunmap (hmim) + } + call imunmap (outim) + } + + # Close up remaining buffered images + if (imno == last) { + do i = 1, finish - start + 1 + call imunmap (Memi[mskptrs+i-1]) + call imunmap (Memi[imptrs+i-1]) + } + + ostart = start + ofinish = finish + + } + + # Close and delete temporary image. + call imunmap (tmpmsk) + call imunmap (tmpim) + call imdelete (Memc[tmpimage]) + call imdelete (Memc[tmpmask]) + + call fixmem (old_size) + + call sfree (sp) +end + + +# RS_PRMSUB -- Perform a running mean sky subtraction on a list of images +# with masking and minmax rejection using input and output image lists. + +procedure rs_prmsub (inlist, msklist, outlist, hmsklist, rs, msk_invert, + cache, verbose) + +int inlist #I the input image list +int msklist #I the input mask list +int outlist #I the output image list +int hmsklist #I the output mask list +pointer rs #I the sky subtraction descriptor +bool msk_invert #I invert the input masks ? +bool cache #I cache temp image buffer in memory ? +bool verbose #I print task statistics + +real flow, fhigh, fscale +pointer sp, image, imask, outimage, tmpimage, tmpmask, hmask, str +pointer tmpim, tmpmsk, im, pmim, outim, hmim +int i, imno, nlo, nhi, ostart, ofinish, start, finish, nimages, old_size +int new_size, first, last, hstat +pointer immap(), im_pmmap(), mp_open() +int imtlen(), imtrgetim(), btoi(), imaccess(), rs_prmout(), imstati() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imask, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (hmask, SZ_FNAME, TY_CHAR) + call salloc (tmpimage, SZ_FNAME, TY_CHAR) + call salloc (tmpmask, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Check image status. If resubtract is yes then delete the output + # images if they already exist. Otherwise determine whether the + # images already exist and if so whether or not they need to be + # sky again. + + nimages = imtlen (inlist) + if (RS_RESUBTRACT(rs) == NO) { + first = 0 + last = 0 + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == NO) { + if (first == 0) { + first = i + last = i + } else + last = i + } else { + outim = immap (Memc[outimage], READ_ONLY, 0) + iferr (call imgstr (outim, RS_KYSKYSUB(rs), Memc[str], + SZ_FNAME)) { + if (first == 0) { + first = i + last = i + } else + last = i + } + call imunmap (outim) + } + } + } else { + first = 1 + last = nimages + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == YES) + call imdelete (Memc[outimage]) + if (imtrgetim (hmsklist, i, Memc[hmask], SZ_FNAME) == EOF) + next + if (imaccess (Memc[hmask], 0) == YES) + call imdelete (Memc[hmask]) + } + } + + # Check the sky subtraction status. + if (first <= 0 && last <= 0) { + if (verbose) { + call printf ( + "The output images have already been sky subtracted \n") + } + call sfree (sp) + return + } + + # Create the temporary image. + call mktemp ("_rsum", Memc[tmpimage], SZ_FNAME) + tmpim = immap (Memc[tmpimage], NEW_IMAGE, 0) + + # Make temporary mask image. Use pmmap instead of immap? Set mask + # to 8 bits deep to save space. This assumes no more than 255 + # images are averaged. This mask will get converted to a 1 bit + # holes masks if holes mask are saved. + call mktemp ("_rnpts", Memc[tmpmask], SZ_FNAME) + tmpmsk = immap (Memc[tmpmask], NEW_IMAGE, 0) + + # Compute the sliding mean parameters. + nlo = RS_NCOMBINE(rs) / 2 + nhi = RS_NCOMBINE(rs) - nlo + + # Loop over the images. + ostart = 0 + ofinish = 0 + do imno = 1, nimages { + + # Skip over beginning and ending images that have already been + # sky subtracted. + + if (imno < first || imno > last) { + if (verbose) { + if (imtrgetim (outlist, imno, Memc[outimage], + SZ_FNAME) == EOF) { + call printf ( + "The sky subtracted image %s already exists\n") + call pargstr (Memc[outimage]) + } + } + next + } + + # Determine which images will contribute to the sky image. + # Start and finish set the endpoints of the sequence. Imno + # is the current image which is to be sky subtracted. + + if ((imno - nlo) < 1) { + start = 1 + finish = min (nimages, max (2 * imno - 1, RS_NMIN(rs) + 1)) + } else if ((imno + nhi) > nimages) { + start = max (1, min (2 * imno - nimages, nimages - RS_NMIN(rs))) + finish = nimages + } else { + start = imno - nlo + finish = imno + nhi + } + + # Check that the minimum number of images exists. + if ((finish - start) < RS_NMIN(rs)) { + call eprintf ("There are too few images for sky subtraction\n") + break + } + + # Open the current input image. + if (imtrgetim (inlist, imno, Memc[image], SZ_FNAME) == EOF) { + call eprintf ("Error reading input image list\n") + break + } + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call eprintf ("Error opening input image %s\n") + call pargstr (Memc[image]) + break + } + + # Open the current input mask. + if (imtrgetim (msklist, imno, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + pmim = mp_open (Memc[str], im, Memc[imask], SZ_FNAME) + } else + pmim = mp_open (Memc[str+1], im, Memc[imask], SZ_FNAME) + } else if (imtrgetim (msklist, 1, Memc[str], SZ_FNAME) != EOF) { + pmim = mp_open (Memc[str], im, Memc[imask], SZ_FNAME) + } else { + call printf ("Error reading mask for image %s ...\n") + call pargstr (Memc[image]) + call imunmap (im) + break + } + + # Open the output image. At present this is the combined sky image. + # Eventually it will be the sky subtracted input image. Assume + # that the input and output lists are now the same size. + + if (imtrgetim (outlist, imno, Memc[outimage], SZ_FNAME) == EOF) { + call eprintf ("Error reading output image list\n") + call imunmap (im) + break + } + iferr (outim = immap (Memc[outimage], NEW_COPY, im)) { + call eprintf ("Error opening output image %s\n") + call pargstr (Memc[outimage]) + call imunmap (pmim) + call imunmap (im) + break + } + call rs_cachen (btoi(cache), 1, outim, old_size) + + # Open the holes mask as a virtual mask. + if (imtrgetim (hmsklist, imno, Memc[hmask], SZ_FNAME) != EOF) { + hmim = im_pmmap (Memc[hmask], NEW_IMAGE, 0) + call pm_ssize (imstati(hmim, IM_PLDES), IM_NDIM(outim), + IM_LEN(outim,1), 1) + } else { + hmim = NULL + } + + if (verbose) { + call printf ( + "Sky subtracting image %s using mask %s and writing to %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[imask]) + call pargstr (Memc[outimage]) + call flush (STDOUT) + } + + # Accumulate the running mean. The first time through the loop + # the number of dimensions, size, and pixel type of the temporary + # storage image and mask are set and the first set of images are + # accumulated into the temporary image. Attempt to cache the + # input image. It is probably not necessary to cache the mask + # since it is already in memory ... + if (imno == first) { + IM_NDIM(tmpim) = IM_NDIM(im) + call amovl (IM_LEN(im,1), IM_LEN(tmpim,1), IM_MAXDIM) + IM_PIXTYPE(tmpim) = TY_REAL + call rs_cachen (btoi(cache), 2, tmpim, new_size) + IM_NDIM(tmpmsk) = IM_NDIM(im) + call amovl (IM_LEN(im,1), IM_LEN(tmpmsk,1), IM_MAXDIM) + IM_PIXTYPE(tmpmsk) = TY_INT + call rs_cachen (btoi(cache), 3, tmpmsk, new_size) + } + + # Accumulate the sky image. + if (RS_COMBINE(rs) == RS_MEAN) { + flow = RS_NLOREJ(rs) + if (RS_NLOREJ(rs) >= 1) + flow = flow / (finish - start) + else + flow = 0.0 + fhigh = RS_NHIREJ(rs) + if (RS_NHIREJ(rs) >= 1) + fhigh = fhigh / (finish - start) + else + fhigh = 0.0 + call rs_psumr (inlist, msklist, tmpim, tmpmsk, start, finish, + imno, flow, fhigh, msk_invert, RS_KYFSCALE(rs)) + } else + call rs_psumr (inlist, msklist, tmpim, tmpmsk, start, finish, + imno, INDEFR, INDEFR, msk_invert, RS_KYFSCALE(rs)) + + + # Compute the new normalization factor. + call rs_prmnorm (rs, im, pmim, tmpim, tmpmsk, outim, fscale) + + # Write the output image. + hstat = rs_prmout (im, tmpim, tmpmsk, outim, hmim, RS_BLANK(rs), + fscale, RS_KYSKYSUB(rs)) + + # Close up images. + if (hmim != NULL) { + if (hstat == YES) { + call pm_savef (imstati (hmim, IM_PLDES), Memc[hmask], "", 0) + call imastr (outim, RS_KYHMASK(rs), Memc[hmask]) + } + call imunmap (hmim) + } + call imunmap (outim) + call imunmap (pmim) + call imunmap (im) + + ostart = start + ofinish = finish + + } + + # Close and delete temporary image. + call imunmap (tmpmsk) + call imunmap (tmpim) + call imdelete (Memc[tmpimage]) + call imdelete (Memc[tmpmask]) + + call fixmem (old_size) + + call sfree (sp) +end + + +# RS_PMSUB -- Perform a running mean sky subtraction on a list of images +# with masking but no rejection. + +procedure rs_pmsub (inlist, msklist, outlist, hmsklist, rs, msk_invert, + cache, verbose) + +int inlist #I the input image list +int msklist #I the input mask list +int outlist #I the output image list +int hmsklist #I the output holes mask list +pointer rs #I the sky subtraction descriptor +bool msk_invert #I invert the input masks ? +bool cache #I cache temp image buffer in memory ? +bool verbose #I print task statistics + +real fscale +pointer sp, image, imask, outimage, hmask, tmpimage, tmpmask, str +pointer tmpim, tmpmsk, im, pmim, outim, hmim +int i, imno, nlo, nhi, ostart, ofinish, start, finish, nimages, old_size +int new_size, first, last, hstat +pointer immap(), mp_open(), im_pmmap() +int imtlen(), imtrgetim(), btoi(), imaccess(), imstati(), rs_pmout() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imask, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (hmask, SZ_FNAME, TY_CHAR) + call salloc (tmpimage, SZ_FNAME, TY_CHAR) + call salloc (tmpmask, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Check image status. If resubtract is yes then delete the output + # images if they already exist. Otherwise determine whether the + # images already exist and if so whether or not they need to be + # sky again. + + nimages = imtlen (inlist) + if (RS_RESUBTRACT(rs) == NO) { + first = 0 + last = 0 + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == NO) { + if (first == 0) { + first = i + last = i + } else + last = i + } else { + outim = immap (Memc[outimage], READ_ONLY, 0) + iferr (call imgstr (outim, RS_KYSKYSUB(rs), Memc[str], + SZ_FNAME)) { + if (first == 0) { + first = i + last = i + } else + last = i + } + call imunmap (outim) + } + } + } else { + first = 1 + last = nimages + do i = 1, nimages { + if (imtrgetim (outlist, i, Memc[outimage], SZ_FNAME) == EOF) + break + if (imaccess (Memc[outimage], 0) == YES) + call imdelete (Memc[outimage]) + if (imtrgetim (hmsklist, i, Memc[hmask], SZ_FNAME) == EOF) + next + if (imaccess (Memc[hmask], 0) == YES) + call imdelete (Memc[hmask]) + } + } + + # Check the sky subtraction status. + if (first <= 0 && last <= 0) { + if (verbose) { + call printf ( + "The output images have already been sky subtracted \n") + } + call sfree (sp) + return + } + + + # Create the temporary image. + call mktemp ("_rsum", Memc[tmpimage], SZ_FNAME) + tmpim = immap (Memc[tmpimage], NEW_IMAGE, 0) + + # Make temporary mask image. Use pmmap instead of immap? Set mask + # to 8 bits deep to save space. This assumes no more than 255 + # images are averaged. This mask will get converted to a 1 bit + # holes masks if holes mask are saved. + call mktemp ("_rnpts", Memc[tmpmask], SZ_FNAME) + tmpmsk = immap (Memc[tmpmask], NEW_IMAGE, 0) + + # Compute the sliding mean parameters. + nlo = RS_NCOMBINE(rs) / 2 + nhi = RS_NCOMBINE(rs) - nlo + + # Loop over the images. + ostart = 0 + ofinish = 0 + do imno = 1, nimages { + + # Skip over beginning and ending images that have already been + # sky subtracted. + + if (imno < first || imno > last) { + if (verbose) { + if (imtrgetim (outlist, imno, Memc[outimage], + SZ_FNAME) == EOF) { + call printf ( + "The sky subtracted image %s already exists\n") + call pargstr (Memc[outimage]) + } + } + next + } + + # Determine which images will contribute to the sky image. + # Start and finish set the endpoints of the sequence. Imno + # is the current image which is to be sky subtracted. + + if ((imno - nlo) < 1) { + start = 1 + finish = min (nimages, max (2 * imno - 1, RS_NMIN(rs) + 1)) + } else if ((imno + nhi) > nimages) { + start = max (1, min (2 * imno - nimages, nimages - RS_NMIN(rs))) + finish = nimages + } else { + start = imno - nlo + finish = imno + nhi + } + + # Check that the minimum number of images exists. + if ((finish - start) < RS_NMIN(rs)) { + call eprintf ("There are too few images for sky subtraction\n") + break + } + + # Open the current input image. + if (imtrgetim (inlist, imno, Memc[image], SZ_FNAME) == EOF) { + call eprintf ("Error reading input image list\n") + break + } + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call eprintf ("Error opening input image %s\n") + call pargstr (Memc[image]) + break + } + + # Get the input mask. + if (imtrgetim (msklist, imno, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + pmim = mp_open (Memc[str], im, Memc[imask], SZ_FNAME) + } else + pmim = mp_open (Memc[str+1], im, Memc[imask], SZ_FNAME) + } else if (imtrgetim (msklist, 1, Memc[str], SZ_FNAME) != EOF) { + pmim = mp_open (Memc[str], im, Memc[imask], SZ_FNAME) + } else { + call printf ("Error reading mask for image %s ...\n") + call pargstr (Memc[image]) + call imunmap (im) + break + } + + # Open the output image. + if (imtrgetim (outlist, imno, Memc[outimage], SZ_FNAME) == EOF) { + call eprintf ("Error reading output image list\n") + call imunmap (pmim) + call imunmap (im) + break + } + iferr (outim = immap (Memc[outimage], NEW_COPY, im)) { + call eprintf ("Error opening output image %s\n") + call pargstr (Memc[outimage]) + call imunmap (pmim) + call imunmap (im) + break + } + + # Open the holes mask as a virtual mask. + if (imtrgetim (hmsklist, imno, Memc[hmask], SZ_FNAME) != EOF) { + hmim = im_pmmap (Memc[hmask], NEW_IMAGE, 0) + call pm_ssize (imstati(hmim, IM_PLDES), IM_NDIM(outim), + IM_LEN(outim,1), 1) + } else { + hmim = NULL + } + + if (verbose) { + call printf ( + "Sky subtracting image %s using mask %s and writing to %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[imask]) + call pargstr (Memc[outimage]) + call flush (STDOUT) + } + + # Accumulate the running mean. The first time through the loop + # the number of dimensions, size, and pixel type of the temporary + # storage image and mask are set and the first set of images are + # accumulated into the temporary image. Attempt to cache the + # input image. It is probably not necessary to cache the mask + # since it is already in memory ... + if (imno == first) { + IM_NDIM(tmpim) = IM_NDIM(im) + call amovl (IM_LEN(im,1), IM_LEN(tmpim,1), IM_MAXDIM) + IM_PIXTYPE(tmpim) = TY_REAL + call rs_cache1 (btoi(cache), tmpim, old_size) + IM_NDIM(tmpmsk) = IM_NDIM(im) + call amovl (IM_LEN(im,1), IM_LEN(tmpmsk,1), IM_MAXDIM) + IM_PIXTYPE(tmpmsk) = TY_INT + call rs_cachen (btoi(cache), 2, tmpmsk, new_size) + call rs_pminit (inlist, msklist, msk_invert, tmpim, tmpmsk, + start, finish, RS_KYFSCALE(rs)) + } else if ((ostart > 0 && start > ostart) || (ofinish > 0 && + finish > ofinish)) { + call rs_pmaddsub (inlist, msklist, msk_invert, tmpim, tmpmsk, + start, finish, ostart, ofinish, RS_KYFSCALE(rs)) + } + + # Cache the input and output images. + call rs_cachen (btoi(cache), 3, im, new_size) + call rs_cachen (btoi(cache), 4, outim, new_size) + + # Compute the normalization factor. + call rs_pmnorm (rs, im, pmim, tmpim, tmpmsk, outim, fscale) + + # Write the output image. + hstat = rs_pmout (im, pmim, tmpim, tmpmsk, outim, hmim, + RS_BLANK(rs), fscale, RS_KYFSCALE(rs), RS_KYSKYSUB(rs)) + + # Close up images. + if (hmim != NULL) { + if (hstat == YES) + call pm_savef (imstati(hmim, IM_PLDES), Memc[hmask], "", 0) + call imunmap (hmim) + } + call imunmap (outim) + call imunmap (pmim) + call imunmap (im) + + ostart = start + ofinish = finish + + } + + # Close and delete temporary image. + call imunmap (tmpmsk) + call imunmap (tmpim) + call imdelete (Memc[tmpimage]) + call imdelete (Memc[tmpmask]) + + call fixmem (old_size) + + call sfree (sp) +end + + +# RS_PMINIT -- Initialize the accumulation buffer for the running median +# using masks. + +procedure rs_pminit (inlist, msklist, msk_invert, tmpim, tmpmsk, start, + finish, skyscale) + +int inlist #I the input image list +int msklist #I the input mask list +bool msk_invert #I invert the input masks +pointer tmpim #I the output storage image +pointer tmpmsk #I the output mask counts image +int start #I the starting image in the list +int finish #I the ending image in the list +#real normsum #U the normalization accumulator +char skyscale[ARB] #I the scaling factor keyword + +pointer sp, image, imask, imptrs, mkptrs, mpptrs, imnorm +pointer vout, mvout, vs, ve, vin +pointer str, obuf, ibuf, ombuf +int i, j, nin, npix, mval, npts +real imgetr() +pointer immap(), mp_open(), mio_openo() +int imtrgetim(), impnlr(), impnli(), mio_glsegr(), imstati() +errchk imgetr() + +begin + nin = finish - start + 1 + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imask, SZ_FNAME, TY_CHAR) + call salloc (imptrs, nin, TY_INT) + call salloc (imnorm, nin, TY_REAL) + call salloc (mkptrs, nin, TY_INT) + call salloc (mpptrs, nin, TY_INT) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (mvout, IM_MAXDIM, TY_LONG) + call salloc (vs, IM_MAXDIM, TY_LONG) + call salloc (ve, IM_MAXDIM, TY_LONG) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Open the initial input images and masks. + j = 1 + #normsum = 0.0 + do i = start, finish { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) == EOF) + ; + Memi[imptrs+j-1] = immap (Memc[image], READ_ONLY, 0) + if (imtrgetim (msklist, i, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + Memi[mkptrs+j-1] = mp_open (Memc[str], Memi[imptrs+j-1], + Memc[imask], SZ_FNAME) + } else { + Memi[mkptrs+j-1] = mp_open (Memc[str+1], Memi[imptrs+j-1], + Memc[imask], SZ_FNAME) + } + } else if (imtrgetim (msklist, 1, Memc[str], SZ_FNAME) != EOF) { + Memi[mkptrs+j-1] = mp_open (Memc[str], Memi[imptrs+j-1], + Memc[imask], SZ_FNAME) + } else { + Memi[mkptrs+j-1] = mp_open ("", Memi[imptrs+j-1], Memc[imask], + SZ_FNAME) + } + Memi[mpptrs+j-1] = mio_openo (imstati(Memi[mkptrs+j-1], IM_PLDES), + Memi[imptrs+j-1]) + iferr (Memr[imnorm+j-1] = imgetr (Memi[imptrs+j-1], skyscale)) + Memr[imnorm+j-1] = 1.0 + #normsum = normsum + 1.0 + #else + #normsum = normsum + Memr[imnorm+j-1] + j = j + 1 + } + + # Initialize image and mask i/o. + npix = IM_LEN(tmpim,1) + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[mvout], IM_MAXDIM) + call amovkl (long(1), Meml[vs], IM_MAXDIM) + call amovkl (long(1), Meml[ve], IM_MAXDIM) + Meml[ve] = npix + + # Do the initial accumulation of counts and numbers of pixels. + while (impnlr (tmpim, obuf, Meml[vout]) != EOF && + impnli (tmpmsk, ombuf, Meml[mvout]) != EOF) { + call amovkr (0.0, Memr[obuf], npix) + call amovki (0, Memi[ombuf], npix) + do j = 1, nin { + call mio_setrange (Memi[mpptrs+j-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[imptrs+j-1])) + call amovl (Meml[vs], Meml[vin], IM_MAXDIM) + while (mio_glsegr (Memi[mpptrs+j-1], ibuf, mval, + Meml[vin], npts) != EOF) { + call amulkr (Memr[ibuf], Memr[imnorm+j-1], Memr[ibuf], + npts) + call aaddr (Memr[ibuf], Memr[obuf+Meml[vin]-1], + Memr[obuf+Meml[vin]-1], npts) + call aaddki (Memi[ombuf+Meml[vin]-1], 1, + Memi[ombuf+Meml[vin]-1], npts) + } + } + call amovl (Meml[vout], Meml[vs], IM_MAXDIM) + call amovl (Meml[vout], Meml[ve], IM_MAXDIM) + Meml[vs] = 1 + Meml[ve] = npix + } + + # Close the input images. + do j = 1, nin { + call mio_close (Memi[mpptrs+j-1]) + call imunmap (Memi[mkptrs+j-1]) + call imunmap (Memi[imptrs+j-1]) + } + + call sfree (sp) +end + + +# RS_PMNORM -- Compute the normalized image and the new normalization factor. + +procedure rs_pmnorm (rs, im, pmim, tmpim, tmpmsk, outim, fscale) + +pointer rs #I the sky subtraction descriptor +pointer im #I the input image descriptor +pointer pmim #I pointer to the input mask +pointer tmpim #I the storage image descriptor +pointer tmpmsk #I the counter image descriptor +pointer outim #I the output image descriptor +real fscale #O the new normalization factor + +real norm1, pout, rmin, rmax +pointer sp, vin, vmin, vout, vtmp, vmtmp +pointer obuf, ibuf, imbuf, tbuf, tmbuf +int i, npix, npout +real imgetr() +int impnlr(), imgnlr(), imgnli() +errchk imgetr() + +begin + call smark (sp) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vmin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vtmp, IM_MAXDIM, TY_LONG) + call salloc (vmtmp, IM_MAXDIM, TY_LONG) + + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vmin], IM_MAXDIM) + call amovkl (long(1), Meml[vtmp], IM_MAXDIM) + call amovkl (long(1), Meml[vmtmp], IM_MAXDIM) + + # Accumulate the normalized input image. + iferr (norm1 = imgetr (im, RS_KYFSCALE(rs))) + norm1 = 1.0 + npix = IM_LEN(im,1) + while (impnlr (outim, obuf, Meml[vout]) != EOF && + imgnlr (im, ibuf, Meml[vin]) != EOF && + imgnli (pmim, imbuf, Meml[vmin]) != EOF && + imgnlr (tmpim, tbuf, Meml[vtmp]) != EOF && + imgnli (tmpmsk, tmbuf, Meml[vmtmp]) != EOF) { + + do i = 1, npix { + if (Memi[imbuf+i-1] > 0) { + pout = Memr[tbuf+i-1] - norm1 * Memr[ibuf+i-1] + npout = Memi[tmbuf+i-1] - 1 + } else { + pout = Memr[tbuf+i-1] + npout = Memi[tmbuf+i-1] + } + if (npout <= 0 || pout == 0.0) + Memr[obuf+i-1] = Memr[ibuf+i-1] + else + Memr[obuf+i-1] = Memr[ibuf+i-1] / (pout / npout) + } + + } + + # Compute the new normalization factor. + rmin = RS_LOWER(rs) + rmax = RS_UPPER(rs) + RS_LOWER(rs) = INDEFR + RS_UPPER(rs) = INDEFR + call rs_mmed (outim, outim, pmim, NULL, rs, fscale) + RS_LOWER(rs) = rmin + RS_UPPER(rs) = rmax + + call sfree (sp) +end + + +# RS_PMOUT -- Write the output image. Subtract the normalized current input +# image and mask from the accumulation buffers before computing the final +# average. + +int procedure rs_pmout (im, pmim, tmpim, tmpmsk, outim, hmim, blank, + fscale, skyscale, skysub) + +pointer im #I the input image descriptor +pointer pmim #I pointer to the input mask +pointer tmpim #I the storage image descriptor +pointer tmpmsk #I the counter image descriptor +pointer outim #I the output image descriptor +pointer hmim #I the output holes mask descriptor +real blank #I the undefined pixel value +real fscale #I the new normalization factor +char skyscale[ARB] #I the sky scaling keyword +char skysub[ARB] #I the sky subtraction keyword + +real norm1, pout +pointer sp, vin, vmin, vout, vtmp, vmtmp, vs, str +pointer obuf, ibuf, imbuf, tbuf, tmbuf, hbuf +int i, npix, npout, stat +real imgetr() +int impnlr(), imgnlr(), imgnli(), imstati() +errchk imgetr() + +begin + call smark (sp) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vmin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vtmp, IM_MAXDIM, TY_LONG) + call salloc (vmtmp, IM_MAXDIM, TY_LONG) + call salloc (str, SZ_FNAME, TY_CHAR) + + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vmin], IM_MAXDIM) + call amovkl (long(1), Meml[vtmp], IM_MAXDIM) + call amovkl (long(1), Meml[vmtmp], IM_MAXDIM) + + call sprintf (Memc[str], SZ_FNAME, + "Sky subtracted with scale factor = %g") + call pargr (fscale) + call imastr (outim, skysub, Memc[str]) + + iferr (norm1 = imgetr (im, skyscale)) + norm1 = 1.0 + stat = NO + npix = IM_LEN(im,1) + if (hmim == NULL) { + while (impnlr (outim, obuf, Meml[vout]) != EOF && + imgnlr (im, ibuf, Meml[vin]) != EOF && + imgnli (pmim, imbuf, Meml[vmin]) != EOF && + imgnlr (tmpim, tbuf, Meml[vtmp]) != EOF && + imgnli (tmpmsk, tmbuf, Meml[vmtmp]) != EOF) { + + do i = 1, npix { + if (Memi[imbuf+i-1] > 0) { + pout = Memr[tbuf+i-1] - norm1 * Memr[ibuf+i-1] + npout = Memi[tmbuf+i-1] - 1 + } else { + pout = Memr[tbuf+i-1] + npout = Memi[tmbuf+i-1] + } + if (npout <= 0) { + stat = YES + Memr[obuf+i-1] = blank + } else { + Memr[obuf+i-1] = fscale * (pout / npout) + } + } + call asubr (Memr[ibuf], Memr[obuf], Memr[obuf], npix) + } + } else { + call salloc (vs, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[vs], IM_MAXDIM) + call salloc (hbuf, npix, TY_SHORT) + while (impnlr (outim, obuf, Meml[vout]) != EOF && + imgnlr (im, ibuf, Meml[vin]) != EOF && + imgnli (pmim, imbuf, Meml[vmin]) != EOF && + imgnlr (tmpim, tbuf, Meml[vtmp]) != EOF && + imgnli (tmpmsk, tmbuf, Meml[vmtmp]) != EOF) { + + do i = 1, npix { + if (Memi[imbuf+i-1] > 0) { + pout = Memr[tbuf+i-1] - norm1 * Memr[ibuf+i-1] + npout = Memi[tmbuf+i-1] - 1 + } else { + pout = Memr[tbuf+i-1] + npout = Memi[tmbuf+i-1] + } + if (npout <= 0) { + stat = YES + Mems[hbuf+i-1] = 0 + Memr[obuf+i-1] = blank + } else { + Mems[hbuf+i-1] = 1 + Memr[obuf+i-1] = fscale * (pout / npout) + } + } + call asubr (Memr[ibuf], Memr[obuf], Memr[obuf], npix) + + call pm_plps (imstati(hmim, IM_PLDES), Meml[vs], Mems[hbuf], + 1, npix, PIX_SRC) + call amovl (Meml[vin], Meml[vs], IM_MAXDIM) + } + } + + call sfree (sp) + + return (stat) +end + + +# RS_PMADDSUB -- Add images to and subtract images from the accumulation +# buffer using masks. + +procedure rs_pmaddsub (inlist, msklist, msk_invert, tmpim, tmpmsk, start, + finish, ostart, ofinish, skyscale) + +int inlist #I the input image list +int msklist #I the input mask list +bool msk_invert #I invert the input masks +pointer tmpim #I the storage image descriptor +pointer tmpmsk #I the storage counter image +int start #I the current starting image +int finish #I the current ending image +int ostart #I the previous starting image +int ofinish #I the previous ending image +#real normsum #I the norm factor accumulator +char skyscale[ARB] #I the sky scaling keyword + +pointer sp, image, vin, vout, v, imsub, imadd, norma, norms +pointer imask, str, mksub, mkadd, vs, ve, mpsub, mpadd, mvin, mvout +pointer ibuf, obuf, mibuf, mobuf, sbuf, abuf +int i, j, nsub, nadd, npix, doadd, dosub, npts, mval +real imgetr() +pointer immap(), mp_open(), mio_openo() +int imtrgetim(), impnlr(), imgnlr(), impnli(), imgnli(), imstati() +int mio_glsegr() +errchk imgetr() + +begin + if (start == ostart && finish == ofinish) + return + nsub = start - ostart + nadd = finish - ofinish + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imask, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (mvin, IM_MAXDIM, TY_LONG) + call salloc (mvout, IM_MAXDIM, TY_LONG) + call salloc (vs, IM_MAXDIM, TY_LONG) + call salloc (ve, IM_MAXDIM, TY_LONG) + call salloc (v, IM_MAXDIM, TY_LONG) + + call salloc (imsub, nsub, TY_INT) + call salloc (mksub, nsub, TY_INT) + call salloc (mpsub, nsub, TY_INT) + call salloc (norms, nsub, TY_REAL) + call salloc (imadd, nadd, TY_INT) + call salloc (mkadd, nadd, TY_INT) + call salloc (mpadd, nadd, TY_INT) + call salloc (norma, nadd, TY_REAL) + + # Open the images to be subtracted. In most cases there will be + # one such image. + if (ostart < start) { + dosub = YES + j = 1 + do i = ostart, start - 1 { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) { + Memi[imsub+j-1] = immap (Memc[image], READ_ONLY, 0) + if (imtrgetim (msklist, i, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + Memi[mksub+j-1] = mp_open (Memc[str], + Memi[imsub+j-1], Memc[imask], SZ_FNAME) + } else + Memi[mksub+j-1] = mp_open (Memc[str+1], + Memi[imsub+j-1], Memc[imask], SZ_FNAME) + } else if (imtrgetim (msklist, 1, Memc[str], + SZ_FNAME) != EOF) { + Memi[mksub+j-1] = mp_open (Memc[str], Memi[imsub+j-1], + Memc[imask], SZ_FNAME) + } else { + Memi[mksub+j-1] = mp_open ("", Memi[imsub+j-1], + Memc[imask], SZ_FNAME) + } + Memi[mpsub+j-1] = mio_openo (imstati(Memi[mksub+j-1], + IM_PLDES), Memi[imsub+j-1]) + iferr (Memr[norms+j-1] = imgetr (Memi[imsub+j-1], skyscale)) + Memr[norms+j-1] = 1.0 + #normsum = normsum - Memr[norms+j-1] + } + j = j + 1 + } + } else + dosub = NO + + # Open the images to be added. In most cases there will be one + # such image. + if (finish > ofinish) { + doadd = YES + j = 1 + do i = ofinish + 1, finish { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) { + Memi[imadd+j-1] = immap (Memc[image], READ_ONLY, 0) + if (imtrgetim (msklist, i, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + Memi[mkadd+j-1] = mp_open (Memc[str], + Memi[imadd+j-1], Memc[imask], SZ_FNAME) + } else + Memi[mkadd+j-1] = mp_open (Memc[str+1], + Memi[imadd+j-1], Memc[imask], SZ_FNAME) + } else if (imtrgetim (msklist, 1, Memc[str], + SZ_FNAME) != EOF) { + Memi[mkadd+j-1] = mp_open (Memc[str], Memi[imadd+j-1], + Memc[imask], SZ_FNAME) + } else { + Memi[mkadd+j-1] = mp_open ("", Memi[imadd+j-1], + Memc[imask], SZ_FNAME) + } + Memi[mpadd+j-1] = mio_openo (imstati(Memi[mkadd+j-1], + IM_PLDES), Memi[imadd+j-1]) + iferr (Memr[norma+j-1] = imgetr (Memi[imadd+j-1], skyscale)) + Memr[norma+j-1] = 1.0 + #normsum = normsum + Memr[norma+j-1] + } + j = j + 1 + } + } else + doadd = NO + + # Make the vector operators in-line code later if necessary. + npix = IM_LEN(tmpim,1) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[mvin], IM_MAXDIM) + call amovkl (long(1), Meml[mvout], IM_MAXDIM) + call amovkl (long(1), Meml[vs], IM_MAXDIM) + call amovkl (long(1), Meml[ve], IM_MAXDIM) + Meml[ve] = npix + + while (impnlr (tmpim, obuf, Meml[vout]) != EOF && + impnli (tmpmsk, mobuf, Meml[mvout]) != EOF && + imgnlr (tmpim, ibuf, Meml[vin]) != EOF && + imgnli (tmpmsk, mibuf, Meml[mvin]) != EOF) { + call amovr (Memr[ibuf], Memr[obuf], npix) + call amovi (Memi[mibuf], Memi[mobuf], npix) + if (dosub == YES && doadd == YES) { + do i = 1, nsub { + call mio_setrange (Memi[mpsub+i-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[imsub+i-1])) + call amovl (Meml[vs], Meml[v], IM_MAXDIM) + while (mio_glsegr (Memi[mpsub+i-1], sbuf, mval, Meml[v], + npts) != EOF) { + call amulkr (Memr[sbuf], Memr[norms+i-1], Memr[sbuf], + npts) + call asubr (Memr[obuf+Meml[v]-1], Memr[sbuf], + Memr[obuf+Meml[v]-1], npts) + call asubki (Memi[mobuf+Meml[v]-1], 1, + Memi[mobuf+Meml[v]-1], npts) + } + } + do i = 1, nadd { + call mio_setrange (Memi[mpadd+i-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[imadd+i-1])) + call amovl (Meml[vs], Meml[v], IM_MAXDIM) + while (mio_glsegr (Memi[mpadd+i-1], abuf, mval, Meml[v], + npts) != EOF) { + call amulkr (Memr[abuf], Memr[norma+i-1], Memr[abuf], + npts) + call aaddr (Memr[obuf+Meml[v]-1], Memr[abuf], + Memr[obuf+Meml[v]-1], npts) + call aaddki (Memi[mobuf+Meml[v]-1], 1, + Memi[mobuf+Meml[v]-1], npts) + } + } + } else if (dosub == YES) { + do i = 1, nsub { + call mio_setrange (Memi[mpsub+i-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[imsub+i-1])) + call amovl (Meml[vs], Meml[v], IM_MAXDIM) + while (mio_glsegr (Memi[mpsub+i-1], sbuf, mval, Meml[v], + npts) != EOF) { + call amulkr (Memr[sbuf], Memr[norms+i-1], Memr[sbuf], + npts) + call asubr (Memr[obuf+Meml[v]-1], Memr[sbuf], + Memr[obuf+Meml[v]-1], npts) + call asubki (Memi[mobuf+Meml[v]-1], 1, + Memi[mobuf+Meml[v]-1], npts) + } + } + } else if (doadd == YES) { + do i = 1, nadd { + call mio_setrange (Memi[mpadd+i-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[imadd+i-1])) + call amovl (Meml[vs], Meml[v], IM_MAXDIM) + while (mio_glsegr (Memi[mpadd+i-1], abuf, mval, Meml[v], + npts) != EOF) { + call amulkr (Memr[abuf], Memr[norma+i-1], Memr[abuf], + npts) + call aaddr (Memr[ibuf+Meml[v]-1], Memr[abuf], + Memr[obuf+Meml[v]-1], npts) + call aaddki (Memi[mibuf+Meml[v]-1], 1, + Memi[mobuf+Meml[v]-1], npts) + } + } + } + call amovl (Meml[vout], Meml[vs], IM_MAXDIM) + call amovl (Meml[vout], Meml[ve], IM_MAXDIM) + Meml[vs] = 1 + Meml[ve] = npix + } + + # Close the images to be added or subtracted. + do i = 1, nsub { + call mio_close (Memi[mpsub+i-1]) + call imunmap (Memi[mksub+i-1]) + call imunmap (Memi[imsub+i-1]) + } + do i = 1, nadd { + call mio_close (Memi[mpadd+i-1]) + call imunmap (Memi[mkadd+i-1]) + call imunmap (Memi[imadd+i-1]) + } + + call sfree (sp) +end + + +# RS_PRMNORM -- Compute the new normalization factor. + +procedure rs_prmnorm (rs, im, pmim, tmpim, tmpmsk, outim, fscale) + +pointer rs #I the sky subtraction descriptor +pointer im #I the input image descriptor +pointer pmim #I the input image mask descriptor +pointer tmpim #I the storage image descriptor +pointer tmpmsk #I the counter image descriptor +pointer outim #I the output image descriptor +real fscale #O the new scale factor + +real rmin, rmax +pointer sp, vin, vout, vtmp, vmtmp +pointer obuf, ibuf, tbuf, tmbuf +int i, npix +int impnlr(), imgnlr(), imgnli() + +begin + call smark (sp) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vtmp, IM_MAXDIM, TY_LONG) + call salloc (vmtmp, IM_MAXDIM, TY_LONG) + + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vtmp], IM_MAXDIM) + call amovkl (long(1), Meml[vmtmp], IM_MAXDIM) + + # Accumulate the normalized image. + npix = IM_LEN(im,1) + while (impnlr (outim, obuf, Meml[vout]) != EOF && + imgnlr (im, ibuf, Meml[vin]) != EOF && + imgnlr (tmpim, tbuf, Meml[vtmp]) != EOF && + imgnli (tmpmsk, tmbuf, Meml[vmtmp]) != EOF) { + + do i = 1, npix { + if (Memi[tmbuf+i-1] > 0) + Memr[obuf+i-1] = Memr[ibuf+i-1] / Memr[tbuf+i-1] + else + Memr[obuf+i-1] = Memr[ibuf+i-1] + } + + } + + # Compute the new normalization factor. + rmin = RS_LOWER(rs) + rmax = RS_UPPER(rs) + RS_LOWER(rs) = INDEFR + RS_UPPER(rs) = INDEFR + call rs_mmed (outim, outim, pmim, NULL, rs, fscale) + RS_LOWER(rs) = rmin + RS_UPPER(rs) = rmax + + call sfree (sp) +end + + +# RS_PRMOUT -- Write the output image. Currently this is the sky image itself +# not the sky subtracted input image. Note that normsum is not actually +# required (I think I have now got the normalization correct) so we may be +# able to eliminate it from the code eventually. For now keep it in case there +# is a mistake. + +int procedure rs_prmout (im, tmpim, tmpmsk, outim, hmim, blank, fscale, skysub) + +pointer im #I the input image descriptor +pointer tmpim #I the storage image descriptor +pointer tmpmsk #I the counter image descriptor +pointer outim #I the output image descriptor +pointer hmim #I the output mask descriptor +real blank #I the undefined pixel value +real fscale #I the normalization factor +char skysub[ARB] #I the sky subtraction keyword + +pointer sp, vin, vout, vtmp, vmtmp, vs, str, obuf, ibuf, tbuf, tmbuf, hbuf +int i, npix, stat +int impnlr(), imgnlr(), imgnli(), imstati() + +begin + call smark (sp) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (vtmp, IM_MAXDIM, TY_LONG) + call salloc (vmtmp, IM_MAXDIM, TY_LONG) + call salloc (str, SZ_FNAME, TY_CHAR) + + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vtmp], IM_MAXDIM) + call amovkl (long(1), Meml[vmtmp], IM_MAXDIM) + + call sprintf (Memc[str], SZ_FNAME, + "Sky subtracted with scale factor = %g") + call pargr (fscale) + call imastr (outim, skysub, Memc[str]) + + stat = NO + npix = IM_LEN(im,1) + if (hmim != NULL) { + call salloc (hbuf, npix, TY_SHORT) + call salloc (vs, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[vs], IM_MAXDIM) + while (impnlr (outim, obuf, Meml[vout]) != EOF && + imgnlr (im, ibuf, Meml[vin]) != EOF && + imgnlr (tmpim, tbuf, Meml[vtmp]) != EOF && + imgnli (tmpmsk, tmbuf, Meml[vmtmp]) != EOF) { + + do i = 1, npix { + if (Memi[tmbuf+i-1] > 0) { + Mems[hbuf+i-1] = 1 + Memr[obuf+i-1] = fscale * Memr[tbuf+i-1] + } else { + stat = YES + Mems[hbuf+i-1] = 0 + Memr[obuf+i-1] = blank + } + } + call asubr (Memr[ibuf], Memr[obuf], Memr[obuf], npix) + + call pm_plps (imstati(hmim, IM_PLDES), Meml[vs], Mems[hbuf], + 1, npix, PIX_SRC) + call amovl (Meml[vin], Meml[vs], IM_MAXDIM) + } + } else { + while (impnlr (outim, obuf, Meml[vout]) != EOF && + imgnlr (im, ibuf, Meml[vin]) != EOF && + imgnlr (tmpim, tbuf, Meml[vtmp]) != EOF && + imgnli (tmpmsk, tmbuf, Meml[vmtmp]) != EOF) { + + do i = 1, npix { + if (Memi[tmbuf+i-1] > 0) { + Memr[obuf+i-1] = fscale * Memr[tbuf+i-1] + } else { + stat = YES + Memr[obuf+i-1] = blank + } + } + call asubr (Memr[ibuf], Memr[obuf], Memr[obuf], npix) + } + } + + call sfree (sp) + + return (stat) +end + + +# RS_PIPTRS -- Get the initial set of image and mask pointers. + +procedure rs_piptrs (inlist, msklist, imptrs, mskptrs, imids, start, finish, + msk_invert, cache, old_size) + +int inlist #I the input image list +int msklist #I the input mask list +pointer imptrs[ARB] #O the input image pointers +pointer mskptrs[ARB] #O the output mask pointers +int imids[ARB] #O the input image ids +int start #I the starting image in the series +int finish #I the ending image in the serious +bool msk_invert #I invert the input masks +bool cache #I cache the image in memory ? +int old_size #O the original working set size + +pointer sp, image, str +int n, i, bufsize +pointer immap(), mp_open() +int imtrgetim(), btoi() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + n = 1 + do i = start, finish { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) { + imids[n] = i + imptrs[n] = immap (Memc[image], READ_ONLY, 0) + if (imtrgetim (msklist, i, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + mskptrs[n] = mp_open (Memc[str], imptrs[n], + Memc[image], SZ_FNAME) + } else + mskptrs[n] = mp_open (Memc[str+1], imptrs[n], + Memc[image], SZ_FNAME) + } else if (imtrgetim (msklist, 1, Memc[str], SZ_FNAME) != EOF) { + mskptrs[n] = mp_open (Memc[str], imptrs[n], Memc[image], + SZ_FNAME) + } else { + mskptrs[n] = mp_open ("", imptrs[n], Memc[image], SZ_FNAME) + } + call rs_cachen (btoi(cache), n, imptrs[n], bufsize) + if (n == 1) + old_size = bufsize + n = n + 1 + } + } + + call sfree (sp) +end + + +# RS_PASPTRS -- Advance the image pointer and id buffers for the next +# current image. + +procedure rs_pasptrs (inlist, msklist, imptrs, mskptrs, imids, start, finish, + ostart, ofinish, msk_invert, cache) + +int inlist #I the input image list +int msklist #I the input mask list +pointer imptrs[ARB] #U the input image pointers +pointer mskptrs[ARB] #U the input mask pointers +int imids[ARB] #U the input image ids +int start #I the starting image in the series +int finish #I the ending image in the serious +int ostart #I the old starting image in the series +int ofinish #I the old ending image in the serious +bool msk_invert #I invert the input masks +bool cache #I cache image buffers ? + +pointer sp, image, str +int i, n, nold, nsub, nadd, bufsize +pointer immap(), mp_open() +int imtrgetim(), btoi() + +begin + # No new images are added or deleted. + if (start == ostart && finish == ofinish) + return + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + nold = ofinish - start + 1 + + # Delete some images and masks from the combine list. + nsub = start - ostart + if (nsub > 0) { + # Unmap the images to be deleted. + do i = 1, nsub { + call imunmap (mskptrs[i]) + call imunmap (imptrs[i]) + } + # Rotate the image pointer buffer. + do i = 1, nold { + imptrs[i] = imptrs[i+nsub] + mskptrs[i] = mskptrs[i+nsub] + imids[i] = imids[i+nsub] + } + } + + # Add new images to the combine list. Note that the cacheing + # mechanism must include the temporarys image hence a request for + # n + 2 cached image buffers is issued instead of a request for n. + nadd = finish - ofinish + if (nadd > 0) { + n = nold + 1 + do i = ofinish + 1, finish { + if (imtrgetim (inlist, i, Memc[image], SZ_FNAME) != EOF) { + imids[n] = i + imptrs[n] = immap (Memc[image], READ_ONLY, 0) + if (imtrgetim (msklist, i, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + mskptrs[n] = mp_open (Memc[str], imptrs[n], + Memc[image], SZ_FNAME) + } else + mskptrs[n] = mp_open (Memc[str+1], imptrs[n], + Memc[image], SZ_FNAME) + } else if (imtrgetim (msklist, 1, Memc[str], + SZ_FNAME) != EOF) { + mskptrs[n] = mp_open (Memc[str], imptrs[n], Memc[image], + SZ_FNAME) + } else { + mskptrs[n] = mp_open ("", imptrs[n], Memc[image], + SZ_FNAME) + } + if ((finish - start) > (ofinish - ostart)) + call rs_cachen (btoi(cache), n+2, imptrs[n], bufsize) + n = n + 1 + } + } + } + + call sfree (sp) +end + diff --git a/pkg/proto/masks/rsreject.x b/pkg/proto/masks/rsreject.x new file mode 100644 index 00000000..c7a41d2a --- /dev/null +++ b/pkg/proto/masks/rsreject.x @@ -0,0 +1,1220 @@ +include <imhdr.h> +include <imset.h> + +define TMINSW 1.00 # Relative timings for nvecs = 5 +define TMXMNSW 1.46 +define TMED3 0.18 +define TMED5 0.55 + +# RS_APSUMR -- Sum or average images using input masks with optional high and +# low pixel rejection. This version of the routines takes a list of image and +# mask pointers as input. +# +# This procedure is a modified version of code used by the imsum task which +# was easy to modify for the present purposes. + +procedure rs_apsumr (imptrs, mskptrs, imids, im_out, msk_out, start, finish, + current, flow, fhigh, skyscale) + +pointer imptrs[ARB] #I the input image pointers +pointer mskptrs[ARB] #I the input mask pointers +int imids[ARB] #I the list of image ids +pointer im_out #I Output image descriptor +pointer msk_out #I Output "mask" descriptor +int start #I The starting image for the sum +int finish #I The ending image for the sum +int current #I The current image to be skipped +real flow #I Number of low pixels to reject +real fhigh #I Number of high pixels to reject +char skyscale[ARB] #I Keyword containing scaling factor + +pointer sp, im, mpim, norm, vout, mvout, vs, ve, vin +pointer buf_out, buf_msk, buf_in, pbuf +int i, n, nimages, npix, npts, mval + +real imgetr() +pointer mio_openo() +int impnlr(), impnli(), mio_glsegr(), imstati() +errchk imgetr() + +begin + # Initialize. + nimages = finish - start + npix = IM_LEN(im_out, 1) + + # Allocate memory. + call smark (sp) + call salloc (im, nimages, TY_INT) + call salloc (mpim, nimages, TY_INT) + call salloc (norm, nimages, TY_REAL) + call salloc (vs, IM_MAXDIM, TY_LONG) + call salloc (ve, IM_MAXDIM, TY_LONG) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (mvout, IM_MAXDIM, TY_LONG) + + # If there are no pixels to be rejected avoid calls to reject pixels. + # This case will not actually be used in the rskysub task because it + # is handled more efficiently in a different module but is included + # for completeness. + + if ((flow <= 0.0) && (fhigh <= 0.0)) { + + # Open the images. + n = 0 + do i = 1, finish - start + 1 { + if (imids[i] == current) + next + Memi[im+n] = imptrs[i] + iferr (Memr[norm+n] = imgetr (imptrs[i], skyscale)) + Memr[norm+n] = 1.0 + Memi[mpim+n] = mio_openo (imstati(mskptrs[i], IM_PLDES), + imptrs[i]) + n = n + 1 + } + + # Initialize i/o. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[mvout], IM_MAXDIM) + call amovkl (long(1), Meml[vs], IM_MAXDIM) + call amovkl (long(1), Meml[ve], IM_MAXDIM) + Meml[ve] = npix + + # For each input line compute an output line. + while (impnlr (im_out, buf_out, Meml[vout]) != EOF && + impnli (msk_out, buf_msk, Meml[mvout]) != EOF) { + + # Clear the output buffer. + call aclrr (Memr[buf_out], npix) + call aclri (Memi[buf_msk], npix) + + # Accumulate lines from each input image. + do i = 1, n { + call mio_setrange (Memi[mpim+i-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[im+i-1])) + call amovl (Meml[vs], Meml[vin], IM_MAXDIM) + while (mio_glsegr (Memi[mpim+i-1], buf_in, mval, + Meml[vin], npts) != EOF) { + call awsur (Memr[buf_in], Memr[buf_out+Meml[vin]-1], + Memr[buf_out+Meml[vin]-1], npts, Memr[norm+i-1], + 1.0) + call aaddki (Memi[buf_msk+Meml[vin]-1], 1, + Memi[buf_msk+Meml[vin]-1], npts) + } + } + + # Compute the average. + do i = 1, npix { + if (Memi[buf_msk+i-1] > 1) + Memr[buf_out+i-1] = Memr[buf_out+i-1] / + Memi[buf_msk+i-1] + } + + # Set the i/o parameters. + call amovl (Meml[vout], Meml[vs], IM_MAXDIM) + call amovl (Meml[vout], Meml[ve], IM_MAXDIM) + Meml[vs] = 1 + Meml[ve] = npix + } + + # Unmap the images. + do i = 1, n + call mio_close (Memi[mpim+i-1]) + + # Finish up. + call sfree (sp) + return + } + + # Pixel rejection is turned on. + + # Collect the images to be combined and open them for masked i/o. + n = 0 + do i = 1, finish - start + 1 { + if (imids[i] == current) + next + Memi[im+n] = imptrs[i] + iferr (Memr[norm+n] = imgetr (imptrs[i], skyscale)) + Memr[norm+n] = 1.0 + Memi[mpim+n] = mio_openo (imstati(mskptrs[i], IM_PLDES), imptrs[i]) + n = n + 1 + } + + # Allocate additional buffer space. + call salloc (pbuf, nimages * npix, TY_REAL) + + # Initialize the i/o. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[mvout], IM_MAXDIM) + call amovkl (long(1), Meml[vs], IM_MAXDIM) + call amovkl (long(1), Meml[ve], IM_MAXDIM) + Meml[ve] = npix + + # Compute output lines for each input line. + while (impnlr (im_out, buf_out, Meml[vout]) != EOF && + impnli (msk_out, buf_msk, Meml[mvout]) != EOF) { + + # Initialize the output image. + call aclri (Memi[buf_msk], npix) + + # Read lines from the input images. + for (i = 1; i <= n; i = i + 1) { + call mio_setrange (Memi[mpim+i-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[im+i-1])) + call amovl (Meml[vs], Meml[vin], IM_MAXDIM) + while (mio_glsegr (Memi[mpim+i-1], buf_in, mval, Meml[vin], + npts) != EOF) { + call rs_accumr (Memr[buf_in], npts, Meml[vin] - 1, + Memr[norm+i-1], Memr[pbuf], Memi[buf_msk], npix) + } + } + + # Reject pixels. + call rs_mmrejr (Memr[pbuf], Memi[buf_msk], Memr[buf_out], npix, + flow, fhigh) + + # If averaging divide the sum by the number of images averaged. + do i = 1, npix { + if (Memi[buf_msk+i-1] > 1) + Memr[buf_out+i-1] = Memr[buf_out+i-1] / Memi[buf_msk+i-1] + } + + # Set the i/o parameters. + call amovl (Meml[vout], Meml[vs], IM_MAXDIM) + call amovl (Meml[vout], Meml[ve], IM_MAXDIM) + Meml[vs] = 1 + Meml[ve] = npix + } + + # Finish up. + do i = 1, n + call mio_close (Memi[mpim+i-1]) + + call sfree (sp) +end + + +# RS_PSUMR -- Sum or average images using input masks with optional high and +# low pixel rejection. This version of the routines takes a list of images and +# masks as input. +# +# This procedure is a modified version of code used by the imsum task which +# was easy to modify for the present purposes. + +procedure rs_psumr (list, msklist, im_out, msk_out, start, finish, current, + flow, fhigh, msk_invert, skyscale) + +int list #I List of input images +int msklist #I List of input masks +pointer im_out #I Output image descriptor +pointer msk_out #I Output "mask" descriptor +int start #I The starting image for the sum +int finish #I The ending image for the sum +int current #I The current image to be skipped +real flow #I Number of low pixels to reject +real fhigh #I Number of high pixels to reject +bool msk_invert #I inver the input mask ? +char skyscale[ARB] #I Keyword containing scaling factor + +pointer sp, input, str, im, mkim, mpim, norm, vout, mvout, vs, ve, vin +pointer buf_out, buf_msk, buf_in, pbuf +int i, n, nimages, npix, npts, mval + +real imgetr() +pointer immap(), mp_open(), mio_openo() +int imtrgetim(), impnlr(), impnli(), mio_glsegr(), imstati() +errchk imgetr() + +begin + # Initialize. + nimages = finish - start + npix = IM_LEN(im_out, 1) + + # Allocate memory. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (im, nimages, TY_INT) + call salloc (mkim, nimages, TY_INT) + call salloc (mpim, nimages, TY_INT) + call salloc (norm, nimages, TY_REAL) + call salloc (vs, IM_MAXDIM, TY_LONG) + call salloc (ve, IM_MAXDIM, TY_LONG) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + call salloc (mvout, IM_MAXDIM, TY_LONG) + + # If there are no pixels to be rejected avoid calls to reject pixels. + # This case will not actually be used in the rskysub task because it + # is handled more efficiently in a different module but is included + # for completeness. + + if (flow <= 0.0 && fhigh <= 0.0) { + + # Open the images. + n = 0 + do i = start, finish { + if (i == current) + next + if (imtrgetim (list, i, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + iferr (Memr[norm+n] = imgetr (Memi[im+n], skyscale)) + Memr[norm+n] = 1.0 + if (imtrgetim (msklist, i, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + Memi[mkim+n] = mp_open (Memc[str], Memi[im+n], + Memc[input], SZ_FNAME) + } else + Memi[mkim+n] = mp_open (Memc[str+1], Memi[im+n], + Memc[input], SZ_FNAME) + } else if (imtrgetim (msklist, 1, Memc[str], + SZ_FNAME) != EOF) { + Memi[mkim+n] = mp_open (Memc[str], Memi[im+n], + Memc[input], SZ_FNAME) + } else { + Memi[mkim+n] = mp_open ("", Memi[im+n], Memc[input], + SZ_FNAME) + } + Memi[mpim+n] = mio_openo (imstati(Memi[mkim+n], IM_PLDES), + Memi[im+n]) + n = n + 1 + } + } + + # Initialize i/o. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[mvout], IM_MAXDIM) + call amovkl (long(1), Meml[vs], IM_MAXDIM) + call amovkl (long(1), Meml[ve], IM_MAXDIM) + Meml[ve] = npix + + # For each input line compute an output line. + while (impnlr (im_out, buf_out, Meml[vout]) != EOF && + impnli (msk_out, buf_msk, Meml[mvout]) != EOF) { + + # Clear the output buffer. + call aclrr (Memr[buf_out], npix) + call aclri (Memi[buf_msk], npix) + + # Accumulate lines from each input image. + do i = 1, n { + call mio_setrange (Memi[mpim+i-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[im+i-1])) + call amovl (Meml[vs], Meml[vin], IM_MAXDIM) + while (mio_glsegr (Memi[mpim+i-1], buf_in, mval, + Meml[vin], npts) != EOF) { + call awsur (Memr[buf_in], Memr[buf_out+Meml[vin]-1], + Memr[buf_out+Meml[vin]-1], npts, Memr[norm+i-1], + 1.0) + call aaddki (Memi[buf_msk+Meml[vin]-1], 1, + Memi[buf_msk+Meml[vin]-1], npts) + } + } + + # Compute the average. + do i = 1, npix { + if (Memi[buf_msk+i-1] > 1) + Memr[buf_out+i-1] = Memr[buf_out+i-1] / + Memi[buf_msk+i-1] + } + + # Set the i/o parameters. + call amovl (Meml[vout], Meml[vs], IM_MAXDIM) + call amovl (Meml[vout], Meml[ve], IM_MAXDIM) + Meml[vs] = 1 + Meml[ve] = npix + } + + # Unmap the images. + do i = 1, n { + call mio_close (Memi[mpim+i-1]) + call imunmap (Memi[mkim+i-1]) + call imunmap (Memi[im+i-1]) + } + + # Finish up. + call sfree (sp) + return + } + + # Pixel rejection is turned on. + + # Collect the images to be combined and open them for masked i/o. + n = 0 + do i = start, finish { + if (i == current) + next + if (imtrgetim (list, i, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + iferr (Memr[norm+n] = imgetr (Memi[im+n], skyscale)) + Memr[norm+n] = 1.0 + if (imtrgetim (msklist, i, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + Memi[mkim+n] = mp_open (Memc[str], Memi[im+n], + Memc[input], SZ_FNAME) + } else + Memi[mkim+n] = mp_open (Memc[str+1], Memi[im+n], + Memc[input], SZ_FNAME) + } else if (imtrgetim (msklist, 1, Memc[str], SZ_FNAME) != EOF) { + Memi[mkim+n] = mp_open (Memc[str], Memi[im+n], + Memc[input], SZ_FNAME) + } else { + Memi[mkim+n] = mp_open ("", Memi[im+n], Memc[input], + SZ_FNAME) + } + Memi[mpim+n] = mio_openo (imstati(Memi[mkim+n], IM_PLDES), + Memi[im+n]) + n = n + 1 + } + } + + # Allocate additional buffer space. + call salloc (pbuf, nimages * npix, TY_REAL) + + # Initialize the i/o. + call amovkl (long(1), Meml[vout], IM_MAXDIM) + call amovkl (long(1), Meml[mvout], IM_MAXDIM) + call amovkl (long(1), Meml[vs], IM_MAXDIM) + call amovkl (long(1), Meml[ve], IM_MAXDIM) + Meml[ve] = npix + + # Compute output lines for each input line. + while (impnlr (im_out, buf_out, Meml[vout]) != EOF && + impnli (msk_out, buf_msk, Meml[mvout]) != EOF) { + + # Initialize the output image. + call aclri (Memi[buf_msk], npix) + + # Read lines from the input images. + for (i = 1; i <= n; i = i + 1) { + call mio_setrange (Memi[mpim+i-1], Meml[vs], Meml[ve], + IM_NDIM(Memi[im+i-1])) + call amovl (Meml[vs], Meml[vin], IM_MAXDIM) + while (mio_glsegr (Memi[mpim+i-1], buf_in, mval, Meml[vin], + npts) != EOF) { + call rs_accumr (Memr[buf_in], npts, Meml[vin] - 1, + Memr[norm+i-1], Memr[pbuf], Memi[buf_msk], npix) + } + } + + # Reject pixels. + call rs_mmrejr (Memr[pbuf], Memi[buf_msk], Memr[buf_out], npix, + flow, fhigh) + + # If averaging divide the sum by the number of images averaged. + do i = 1, npix { + if (Memi[buf_msk+i-1] > 1) + Memr[buf_out+i-1] = Memr[buf_out+i-1] / Memi[buf_msk+i-1] + } + + # Set the i/o parameters. + call amovl (Meml[vout], Meml[vs], IM_MAXDIM) + call amovl (Meml[vout], Meml[ve], IM_MAXDIM) + Meml[vs] = 1 + Meml[ve] = npix + } + + # Finish up. + do i = 1, n { + call mio_close (Memi[mpim+i-1]) + call imunmap (Memi[mkim+i-1]) + call imunmap (Memi[im+i-1]) + } + call sfree (sp) +end + + +# RS_ASUMR -- Sum or average images with optional high and low pixel rejection. +# This version of the routine takes a list of image pointers as input. Median +# combining is enabled if either of the incoming nlow or nhigh parameters is +# INDEF. +# +# This procedure is a simplified version of code used by the imsum task which +# was easy to modify for the present purposes. + +procedure rs_asumr (imptrs, imids, im_out, start, finish, current, nlow, nhigh, + skyscale) + +pointer imptrs[ARB] #I the image pointers +int imids[ARB] #I the image ids +pointer im_out #I Output image descriptor +int start #I The starting image for the sum +int finish #I The ending image for the sum +int current #I The current image to be skipped +int nlow #I Number of low pixels to reject +int nhigh #I Number of high pixels to reject +char skyscale[ARB] #I Keyword containing scaling factor + +real const +pointer sp, v1, v2, im, norm, buf_out, buf_in, pbuf, rbuf +int i, n, nl, nh, nimages, naccept, npix +real imgetr() +int impnlr(), imgnlr() +errchk imgetr() + +begin + # Initialize. + nimages = finish - start + if (IS_INDEFI(nlow) || IS_INDEFI(nhigh)) { + if (mod (nimages,2) == 0) { + nl = nimages / 2 - 1 + nh = nimages / 2 - 1 + } else { + nl = nimages / 2 + nh = nimages / 2 + } + } else { + nl = nlow + nh = nhigh + } + naccept = nimages - nl - nh + const = naccept + npix = IM_LEN(im_out, 1) + + # Allocate memory. + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (im, nimages, TY_INT) + call salloc (norm, nimages, TY_REAL) + + # If there are no pixels to be rejected avoid calls to reject pixels. + # This case will not actually be used in the rskysub task because it + # is handled more efficiently in a different module but is included + # for completeness. + + if ((nl == 0) && (nh == 0)) { + + # Open the images. + n = 0 + do i = 1, finish - start + 1 { + if (imids[i] == current) + next + Memi[im+n] = imptrs[i] + iferr (Memr[norm+n] = imgetr (Memi[im+n], skyscale)) + Memr[norm+n] = 1.0 + n = n + 1 + } + + # Initialize i/o. + 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. + call aclrr (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 awsur (Memr[buf_in], Memr[buf_out], Memr[buf_out], + npix, Memr[norm+i-1], 1.0) + #call amulkr (Memr[buf_in], Memr[norm+i-1], Memr[buf_in], + #npix) + #call aaddr (Memr[buf_in], Memr[buf_out], Memr[buf_out], + #npix) + } + + # Compute the average. + call adivkr (Memr[buf_out], const, Memr[buf_out], npix) + + # Set the i/o parameters. + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Finish up. + call sfree (sp) + return + } + + # Pixel rejection is turned on. + + n = 0 + do i = 1, finish - start + 1 { + if (imids[i] == current) + next + Memi[im+n] = imptrs[i] + iferr (Memr[norm+n] = imgetr (Memi[im+n], skyscale)) + Memr[norm+n] = 1.0 + n = n + 1 + } + + # Allocate additional buffer space. + call salloc (pbuf, nimages, TY_INT) + call salloc (rbuf, nimages * npix, TY_REAL) + + # Initialize the i/o. + 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 input images. + for (i = 1; i <= n; i = i + 1) { + Memi[pbuf+i-1] = rbuf + (i - 1) * npix + 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 amulkr (Memr[buf_in], Memr[norm+i-1], Memr[Memi[pbuf+i-1]], + npix) + } + + # Reject pixels. Sum the remaining pixels. + call rs_rejr (Memi[pbuf], nimages, Memr[buf_out], npix, nl, nh) + + # If averaging divide the sum by the number of images averaged. + if (naccept > 1) { + const = naccept + call adivkr (Memr[buf_out], const, Memr[buf_out], npix) + } + + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Finish up. + call sfree (sp) +end + + +# RS_SUMR -- Sum or average images with optional high and low pixel rejection. +# This version of the routines takes a list of images as input. Medianing +# combining is enabled if either of the incoming nlow or nhigh values is +# INDEF +# +# This procedure is a simplified version of code used by the imsum task which +# was easy to modify for the present purposes. + +procedure rs_sumr (list, im_out, start, finish, current, nlow, nhigh, skyscale) + +int list #I List of input images +pointer im_out #I Output image descriptor +int start #I The starting image for the sum +int finish #I The ending image for the sum +int current #I The current image to be skipped +int nlow #I Number of low pixels to reject +int nhigh #I Number of high pixels to reject +char skyscale[ARB] #I Keyword containing scaling factor + +real const +pointer sp, input, v1, v2, im, norm, buf_out, buf_in, buf +int i, n, nimages, naccept, npix, nl, nh +real imgetr() +pointer immap() +int imtrgetim(), impnlr(), imgnlr() +errchk imgetr() + +begin + # Initialize. + nimages = finish - start + if (IS_INDEFI(nlow) || IS_INDEFI(nhigh)) { + if (mod (nimages,2) == 0) { + nl = nimages / 2 - 1 + nh = nimages / 2 - 1 + } else { + nl = nimages / 2 + nh = nimages / 2 + } + } else { + nl = nlow + nh = nhigh + } + naccept = nimages - nl - nh + const = naccept + npix = IM_LEN(im_out, 1) + + # 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) + call salloc (norm, nimages, TY_REAL) + + # If there are no pixels to be rejected avoid calls to reject pixels. + # This case will not actually be used in the rskysub task because it + # is handled more efficiently in a different module but is included + # for completeness. + + if ((nl == 0) && (nh == 0)) { + + # Open the images. + n = 0 + do i = start, finish { + if (i == current) + next + if (imtrgetim (list, i, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + iferr (Memr[norm+n] = imgetr (Memi[im+n], skyscale)) + Memr[norm+n] = 1.0 + n = n + 1 + } + } + + # Initialize i/o. + 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. + call aclrr (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 amulkr (Memr[buf_in], Memr[norm+i-1], Memr[buf_in], + npix) + call aaddr (Memr[buf_in], Memr[buf_out], Memr[buf_out], + npix) + } + + # Compute the average. + call adivkr (Memr[buf_out], const, Memr[buf_out], npix) + + # Set the i/o parameters. + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + } + + # Unmap the images. + do i = 1, n + call imunmap (Memi[im+i-1]) + + # Finish up. + call sfree (sp) + return + } + + # Pixel rejection is turned on. + + n = 0 + do i = start, finish { + if (i == current) + next + if (imtrgetim (list, i, Memc[input], SZ_FNAME) != EOF) { + Memi[im+n] = immap (Memc[input], READ_ONLY, 0) + iferr (Memr[norm+n] = imgetr (Memi[im+n], skyscale)) + Memr[norm+n] = 1.0 + n = n + 1 + } + } + + # Allocate additional buffer space. + call salloc (buf, nimages, TY_INT) + + # Initialize the i/o. + 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 input images. + 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") + call amulkr (Memr[Memi[buf+i-1]], Memr[norm+i-1], + Memr[Memi[buf+i-1]], npix) + } + + # Reject pixels. Sum the remaining pixels. + call rs_rejr (Memi[buf], nimages, Memr[buf_out], npix, nl, nh) + + # If averaging divide the sum by the number of images averaged. + if (naccept > 1) { + 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 + + +# RS_ACCUMR -- Acumulate the masked data into the input buffer. + +procedure rs_accumr (indata, npts, offset, norm, outdata, ndata, npix) + +real indata[npts] #I the input data +int npts #I the number of input data points +int offset #I the offset of the first data point +real norm #I the normalization factor +real outdata[npix,ARB] #U the output array +int ndata[npix] #U the number of good data points +int npix #I number of points in a line + +int i + +begin + do i = 1, npts { + ndata[i+offset] = ndata[i+offset] + 1 + outdata[i+offset,ndata[i+offset]] = norm * indata[i] + } +end + + +# RS_MMREJR -- Reject a specified number of high and low pixels. This routine +# is a modified version of one in imcombine. It works off a real data +# buffer rather than a set of image i/o buffers. It also sums the points at +# the end + +procedure rs_mmrejr (indata, n, out, npts, flo, fhi) + +real indata[npts,ARB] #U the data buffer of good pixels +int n[npts] #U The number of good pixels +real out[npts] #O the output sum +int npts #I The number of output points per line +real flo #I Fraction of low points to reject +real fhi #I Fraction of high points to reject + + +real d1, d2, dmin, dmax, sum +int n1, npairs, nlow, nhigh, naccept, np, nlo, nhi, medflag +int i, j, jmax, jmin + + +begin + if (IS_INDEFR(flo) || IS_INDEFR(fhi)) + medflag = YES + else + medflag = NO + + do i = 1, npts { + + n1 = n[i] + if (medflag == YES) { + if (mod (n1, 2) == 0) { + nlo = n1 / 2 - 1 + nhi = n1 / 2 - 1 + } else { + nlo = n1 / 2 + nhi = n1 / 2 + } + } else { + nlo = flo * n1 + 0.001 + nhi = fhi * n1 + 0.001 + } + naccept = n1 - nlo - nhi + + # No points are rejected. + if (naccept == n1) + next + + # All points are rejected. + if (naccept <= 0) { + n[i] = 0 + next + } + + npairs = min (nlo, nhi) + nlow = nlo - npairs + nhigh = nhi - npairs + + # Reject the npairs low and high points. + do np = 1, npairs { + d1 = indata[i,1] + dmax = d1; dmin = d1; jmax = 1; jmin = 1 + do j = 2, n1 { + d2 = d1 + d1 = indata[i,j] + if (d1 > dmax) { + dmax = d1; jmax = j + } else if (d1 < dmin) { + dmin = d1; jmin = j + } + } + j = n1 - 1 + if (jmax < j) { + if (jmin != j) + indata[i,jmax] = d2 + else + indata[i,jmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + indata[i,jmin] = d1 + else + indata[i,jmin] = d2 + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + d1 = indata[i,1] + dmin = d1; jmin = 1 + do j = 2, n1 { + d1 = indata[i,j] + if (d1 < dmin) { + dmin = d1; jmin = j + } + } + if (jmin < n1) + indata[i,jmin] = d1 + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + d1 = indata[i,1] + dmax = d1; jmax = 1 + do j = 2, n1 { + d1 = indata[i,j] + if (d1 > dmax) { + dmax = d1; jmax = j + } + } + if (jmax < n1) + indata[i,jmax] = d1 + n1 = n1 - 1 + } + + n[i] = n1 + } + + # Compute the sum. + do i = 1, npts { + if (n[i] == 0) { + out[i] = 0.0 + } else if (n[i] == 1) { + out[i] = indata[i,1] + } else { + sum = indata[i,1] + do j = 2, n[i] + sum = sum + indata[i,j] + out[i] = sum + } + } +end + + +## RS_MMREJR -- Reject a specified number of high and low pixels from a +## buffer by doing min / max comparison, reordering the data buffer, and +## editing the number of good pixels array. This routine is a modified +## version of the one in the imcombine task. +# +#procedure rs_mmrejr (d, n, npts, nlo, nhi) +# +#pointer d[ARB] #I The input data pointers +#int n[npts] #U The number of good pixels +#int npts #I The number of output points per line +#int nlo #I Number of low points to reject +#int nhi #I Number of high points to reject +# +#real d1, d2, dmin, dmax +#pointer k, kmax, kmin +#int n1, npairs, nlow, nhigh, np +#int i, i1, j, jmax, jmin +# +#begin +# npairs = min (nlo, nhi) +# nlow = nlo - npairs +# nhigh = nhi - npairs +# do i = 1, npts { +# +# i1 = i - 1 +# n1 = n[i] +# naccept = n1 - nlo - nhi +# if (naccept == n1) +# next +# if (naccept <= 0) { +# n[i] = 0 +# next +# } +# +# +# +# # Reject the npairs low and high points. +# do np = 1, npairs { +# k = d[1] + i1 +# d1 = Memr[k] +# dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k +# do j = 2, n1 { +# d2 = d1 +# k = d[j] + i1 +# d1 = Memr[k] +# if (d1 > dmax) { +# dmax = d1; jmax = j; kmax = k +# } else if (d1 < dmin) { +# dmin = d1; jmin = j; kmin = k +# } +# } +# j = n1 - 1 +# if (jmax < j) { +# if (jmin != j) +# Memr[kmax] = d2 +# else +# Memr[kmax] = d1 +# } +# if (jmin < j) { +# if (jmax != n1) +# Memr[kmin] = d1 +# else +# Memr[kmin] = d2 +# } +# n1 = n1 - 2 +# } +# +# # Reject the excess low points. +# do np = 1, nlow { +# k = d[1] + i1 +# d1 = Memr[k] +# dmin = d1; jmin = 1; kmin = k +# do j = 2, n1 { +# k = d[j] + i1 +# d1 = Memr[k] +# if (d1 < dmin) { +# dmin = d1; jmin = j; kmin = k +# } +# } +# if (jmin < n1) +# Memr[kmin] = d1 +# n1 = n1 - 1 +# } +# +# # Reject the excess high points. +# do np = 1, nhigh { +# k = d[1] + i1 +# d1 = Memr[k] +# dmax = d1; jmax = 1; kmax = k +# do j = 2, n1 { +# k = d[j] + i1 +# d1 = Memr[k] +# if (d1 > dmax) { +# dmax = d1; jmax = j; kmax = k +# } +# } +# if (jmax < n1) +# Memr[kmax] = d1 +# n1 = n1 - 1 +# } +# +# n[i] = n1 +# } +#end + + +# RS_REJR -- Reject the number of high and low points and sum the rest. + +procedure rs_rejr (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 rs_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 rs_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 rs_mxmnswr (a, i, npts) + i = i - 2 + } + # Reject the excess low points. + for (j = 1; j <= nlow1; j = j + 1) { + call rs_minswr (a, i, npts) + i = i - 1 + } + # Reject the excess high points. + for (j = 1; j <= nhigh1; j = j + 1) { + call rs_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 + + +# RS_MINSWR -- Given an array of vector pointers for each element in the vectors +# swap the minimum element with that of the last vector. + +procedure rs_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 + + +# RS_MAXSW -- Given an array of vector pointers for each element in the vectors +# swap the maximum element with that of the last vector. + +procedure rs_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 + + +# RS_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 rs_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 + diff --git a/pkg/proto/masks/rsscache.x b/pkg/proto/masks/rsscache.x new file mode 100644 index 00000000..efce9e7c --- /dev/null +++ b/pkg/proto/masks/rsscache.x @@ -0,0 +1,123 @@ +include <imhdr.h> +include <imset.h> + +define MEMFUDGE 1.05 + +# RS_CACHEN -- Cache N same sized images in memory using the image i/o +# buffer sizes. + +procedure rs_cachen (cache, nimages, im, old_size) + +int cache #I cache the image pixels in the imio buffer +int nimages #I the number of images +pointer im #I the current image descriptor +int old_size #O the old working set size + +int i, req_size, buf_size +int sizeof(), rs_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) + req_size = nimages * req_size + if (rs_memstat (cache, req_size, old_size) == YES) + call rs_pcache (im, INDEFI, buf_size) +end + + +# RS_CACHE1 -- Cache 1 image in memory using the image i/o buffer sizes. + +procedure rs_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(), rs_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 (rs_memstat (cache, req_size, old_size) == YES) + call rs_pcache (im, INDEFI, buf_size) +end + + +# RS_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 rs_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 + + +# RS_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 rs_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/proto/masks/rsstats.x b/pkg/proto/masks/rsstats.x new file mode 100644 index 00000000..9c7a1b32 --- /dev/null +++ b/pkg/proto/masks/rsstats.x @@ -0,0 +1,492 @@ +include <mach.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include "mimstat.h" +include "rskysub.h" + + +# RS_STATS -- Compute the input image scaling factors. + +procedure rs_stats (inlist, imsklist, omsklist, sclist, rs, msk_invert, + cache, verbose) + +int inlist #I the input image list +int imsklist #I the input mask list +int omsklist #I the output mask list +int sclist #I the input scale factors list +pointer rs #I the sky subtraction descriptor +bool msk_invert #I invert the pixel masks ? +bool cache #I cache the image i/o buffers ? +bool verbose #I print image statistics ? + +real fscale +pointer sp, image, imaskname, omaskname, masktemp, str +pointer im, ims, pmim, pmout +int ip, old_size +real imgetr() +pointer immap(), im_pmmap(), mp_open() +int imtgetim(), imtlen(), imtrgetim(), ctor(), ctowrd(), btoi() +int fntgfnb(), imstati(), imaccess() +bool strne(), streq() +errchk immap() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imaskname, SZ_FNAME, TY_CHAR) + call salloc (omaskname, SZ_FNAME, TY_CHAR) + call salloc (masktemp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Loop over the input images and compute the scale factors. + # At some point we might combine this with the later running + # mean / median loop for more efficient operation especially in an + # observing environment but that can easily be rearranged later. + + while (imtgetim (inlist, Memc[image], SZ_FNAME) != EOF) { + + # Open the input image. This image is opened READ_WRITE + # so some header information can be added ... + iferr (im = immap (Memc[image], READ_WRITE, 0)) { + call printf ("Error opening image %s ...\n") + call pargstr (Memc[image]) + next + } + + # Check for a statistics section. If the image image already + # includes a section strip it off, append the statistics + # section to the input image name, and open the statistics + # section image. + + if (streq (RS_ISCALES(rs), "median") && RS_STATSEC(rs) != EOS) { + call imgimage (Memc[image], Memc[str], SZ_FNAME) + call strcat (RS_STATSEC(rs), Memc[str], SZ_FNAME) + iferr (ims = immap (Memc[str], READ_ONLY, 0)) { + call imunmap (im) + call printf ("Error opening image %s ...\n") + call pargstr (Memc[image]) + next + } + } else + ims = NULL + + # Open input the mask if any. The input and output mask + # lists are ignored if the scaling factor is not median + # or if the list lengths are both zero. + if (strne (RS_ISCALES(rs), "median")) { + pmim = NULL + pmout = NULL + } else if (imtlen (omsklist) == 0 && imtlen (imsklist) == 0) { + pmim = NULL + pmout = NULL + } else { + + # Get the input mask which defaults to the empty mask if + # there is none. + if (imtgetim (imsklist, Memc[str+1], SZ_FNAME) != EOF) { + if (msk_invert) { + Memc[str] = '^' + pmim = mp_open (Memc[str], im, Memc[imaskname], + SZ_FNAME) + } else + pmim = mp_open (Memc[str+1], im, Memc[imaskname], + SZ_FNAME) + } else if (imtrgetim (imsklist, 1, Memc[str], + SZ_FNAME) != EOF) { + pmim = mp_open (Memc[str], im, Memc[imaskname], SZ_FNAME) + } else { + pmim = mp_open ("", im, Memc[imaskname], SZ_FNAME) + } + if (pmim == NULL) { + call printf ("Error reading mask for image %s ...\n") + call pargstr (Memc[image]) + call imunmap (im) + next + } + + # Get the output mask name if any. + if (imtlen (omsklist) > 0) { + if (imtgetim (omsklist, Memc[omaskname], SZ_FNAME) == EOF) { + call imunmap (pmim) + call imunmap (im) + next + } else { + if (Memc[imaskname] == '^') + call xt_mkimtemp (Memc[imaskname+1], + Memc[omaskname], Memc[masktemp], SZ_FNAME) + else + call xt_mkimtemp (Memc[imaskname], Memc[omaskname], + Memc[masktemp], SZ_FNAME) + pmout = im_pmmap (Memc[omaskname], NEW_IMAGE, 0) + call mp_mpcopy (im, pmim, pmout) + } + } else { + pmout = NULL + } + } + + + # Print title. + if (verbose) { + if (pmim == NULL) { + call printf ("Computing scale factor for image %s\n") + call pargstr (Memc[image]) + } else { + call printf ( + "Computing scale factor for image %s using mask %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[imaskname]) + } + call flush (STDOUT) + } + + # Check for existence of scaling keyword. If the keyword is + # present and the rescaling flag is turned off then proceed + # to the next image, otherwise compute the new scale factor. + + if (RS_RESCALE(rs) == NO) { + ifnoerr (fscale = imgetr (im, RS_KYFSCALE(rs))) { + if (verbose) { + call printf (" Using precomputed value %g\n") + call pargr (fscale) + } + call imunmap (pmim) + if (ims != NULL) + call imunmap (ims) + call imunmap (im) + next + } + } + + # Compute the scaling factor. The scaling factor defaults + # to, 1 if the scaling method is "none", the value of the image + # header keyowrd if the scaling factor is !KEYWORD, 1 / median + # if the the scaling methid is "median", or the value in the + # scaling factors file if the scaling factor is "@file". If an + # error occurs the scaling factor is set to 1.0. + + if (streq (RS_ISCALES(rs), "none")) { + fscale = 1.0 + } else if (RS_ISCALES(rs) == '!') { + ip = 2 + if (ctowrd (RS_ISCALES(rs), ip, Memc[str], SZ_FNAME) <= 0) + Memc[str] = EOS + iferr (fscale = imgetr (im, Memc[str])) + fscale = 1.0 + } else if (streq (RS_ISCALES(rs), "median")) { + if (ims != NULL) + call rs_cache1 (btoi(cache), ims, old_size) + else + call rs_cache1 (btoi(cache), im, old_size) + if (pmim == NULL) { + if (ims != NULL) + call rs_med (ims, rs, fscale) + else + call rs_med (im, rs, fscale) + } else { + if (ims != NULL) + call rs_mmed (im, ims, pmim, pmout, rs, fscale) + else + call rs_mmed (im, im, pmim, pmout, rs, fscale) + } + if (IS_INDEFR(fscale)) + fscale = 1.0 + else + fscale = 1.0 / fscale + call fixmem (old_size) + } else if (fntgfnb (sclist, Memc[str], SZ_FNAME) != EOF) { + ip = 1 + if (ctor (Memc[str], ip, fscale) <= 0) + fscale = 1.0 + } else { + fscale = 1.0 + } + + # Print the computed scaling factor. + if (verbose) { + call printf (" New scale factor is 1 / %g\n") + call pargr (1.0 / fscale) + if (pmout != NULL) { + call printf (" Writing new image mask %s\n") + call pargstr (Memc[masktemp]) + } + call flush (STDOUT) + } + + # Store the new scaling factor in the input image header. + call imaddr (im, RS_KYFSCALE(rs), fscale) + + # Close the input image and mask. + if (pmout != NULL) { + if (imaccess (Memc[omaskname], YES) == YES) + call imdelete (Memc[omaskname]) + call pm_savef (imstati (pmout, IM_PMDES), Memc[omaskname], + "", 0) + call imunmap (pmout) + if (pmim != NULL) + call imunmap (pmim) + call xt_delimtemp (Memc[omaskname], Memc[masktemp]) + } else { + if (pmim != NULL) + call imunmap (pmim) + } + if (ims != NULL) + call imunmap (ims) + call imunmap (im) + } + + call sfree (sp) +end + + +# RS_MMED -- Estimate the image median using iterative rejection and +# a pixel mask. The input image and input statistics image descriptors may +# be the same. + +procedure rs_mmed (im, ims, pmim, pmout, rs, fscale) + +pointer im #I the input image descriptor +pointer ims #I the input image statistics descriptor +pointer pmim #I the input mask image descriptor +pointer pmout #I the output mask image descriptor +pointer rs #I the sky subtraction pointer +real fscale #O the scaling factor + +real low, up, hmin, hmax, hwidth +pointer sp, vs, ve, mst, pm, mp, buf, hgm, smsk +int i, mval, npts, npix, nbins, nbad + +pointer mp_miopen() +int imstati(), mio_glsegr(), mst_ihist(), rs_umask() + +begin + call smark (sp) + call salloc (vs, IM_MAXDIM, TY_LONG) + call salloc (ve, IM_MAXDIM, TY_LONG) + + # Allocate space for statistics structure. + call mst_allocate (mst) + + # Get the selected fields. + #nfields = mst_fields ("midpt,stddev" Memi[fields], MIS_NFIELDS) + + # Set the processing switches + #call mst_switches (mst, Memi[fields], nfields, RS_MAXITER(rs)) + + # Set up the region masking parameters. + mp = mp_miopen (ims, pmim) + + # Compute the image statistics. + low = RS_LOWER(rs) + up = RS_UPPER(rs) + do i = 0 , RS_MAXITER(rs) { + + # Set up the mask i/o boundaries. + call amovkl (long(1), Meml[vs], IM_NDIM(ims)) + call amovl (IM_LEN(ims,1), Meml[ve], IM_NDIM(ims)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(ims)) + + # Initialize the statistics computation. + call mst_initialize (mst, low, up) + + # Accumulate the statistics. + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate2 (mst, Memr[buf], npts, low, up, YES) + + # Compute the 2nd order central moment statistics. + call mst_stats (mst) + + # Compute new limits and iterate. + if (i < RS_MAXITER(rs)) { + if (IS_INDEFR(RS_LNSIGREJ(rs))) + low = -MAX_REAL + else if (RS_LNSIGREJ(rs) > 0.0 || IS_INDEFR(MIS_MEAN(mst)) || + IS_INDEFR(MIS_STDDEV(mst))) + low = MIS_MEAN(mst) - RS_LNSIGREJ(rs) * MIS_STDDEV(mst) + else + low = -MAX_REAL + if (IS_INDEFR(RS_UNSIGREJ(rs))) + up = MAX_REAL + else if (RS_UNSIGREJ(rs) > 0.0 || IS_INDEFR(MIS_MEAN(mst)) || + IS_INDEFR(MIS_STDDEV(mst))) + up = MIS_MEAN(mst) + RS_UNSIGREJ(rs) * MIS_STDDEV(mst) + else + up = MAX_REAL + if (i > 0) { + if (MIS_NPIX(mst) == npix) + break + } + npix = MIS_NPIX(mst) + } + + } + + # Estimate the median and the mode by accumulating the histogram. + hgm = NULL + if (mst_ihist (mst, RS_BINWIDTH(rs), hgm, nbins, hwidth, hmin, + hmax) == YES) { + call aclri (Memi[hgm], nbins) + call amovkl (long(1), Meml[vs], IM_NDIM(ims)) + call amovl (IM_LEN(ims,1), Meml[ve], IM_NDIM(ims)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(ims)) + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call ahgmr (Memr[buf], npts, Memi[hgm], nbins, hmin, hmax) + call mst_hmedian (mst, Memi[hgm], nbins, hwidth, hmin, hmax) + } + if (hgm != NULL) + call mfree (hgm, TY_INT) + + # Set the statistic + fscale = MIS_MEDIAN(mst) + + if (pmout != NULL) { + call malloc (smsk, IM_LEN(im,1), TY_SHORT) + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + call amovl (IM_LEN(im,1), Meml[ve], IM_NDIM(im)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(im)) + pm = imstati (pmout, IM_PMDES) + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) { + nbad = rs_umask (Memr[buf], Mems[smsk], npts, low, up) + if (nbad > 0) + call pm_plps (pm, Meml[vs], Mems[smsk], 1, npts, PIX_SRC) + } + call mp_invert (pm) + call imseti (pmout, IM_PMDES, pm) + call mfree (smsk, TY_SHORT) + } + + # Close the maskio descriptor. + call mio_close (mp) + + call mst_free (mst) + call sfree (sp) +end + + +# RS_MED -- Estimate the image median using iterative rejection and +# no pixel mask. + +procedure rs_med (im, rs, fscale) + +pointer im #I the input image descriptor +pointer rs #I the sky subtraction descriptor +real fscale #I the computed scaling factor + + +real low, up, hmin, hmax, hwidth +pointer sp, v, mst, buf, hgm +int i, npts, npix, nbins +int imgnlr(), mst_ihist() + +begin + call smark (sp) + call salloc (v, IM_MAXDIM, TY_LONG) + + # Allocate space for statistics structure. + call mst_allocate (mst) + + # Get the selected fields. + #nfields = mst_fields ("midpt,stddev" Memi[fields], MIS_NFIELDS) + + # Set the processing switches + #call mst_switches (mst, Memi[fields], nfields, RS_MAXITER(rs)) + + # Compute the image statistics. + low = RS_LOWER(rs) + up = RS_UPPER(rs) + do i = 0 , RS_MAXITER(rs) { + + # Initialize the statistics computation. + call mst_initialize (mst, low, up) + + # Accumulate the statistics. + npts = IM_LEN(im,1) + call amovkl (long(1), Meml[v], IM_NDIM(im)) + while (imgnlr (im, buf, Meml[v]) != EOF) + call mst_accumulate2 (mst, Memr[buf], npts, low, up, YES) + + # Compute the 2nd order central moment statistics. + call mst_stats (mst) + + # Compute new limits and iterate. + if (i < RS_MAXITER(rs)) { + if (IS_INDEFR(RS_LNSIGREJ(rs))) + low = -MAX_REAL + else if (RS_LNSIGREJ(rs) > 0.0) + low = MIS_MEAN(mst) - RS_LNSIGREJ(rs) * MIS_STDDEV(mst) + else + low = -MAX_REAL + if (IS_INDEFR(RS_UNSIGREJ(rs))) + up = MAX_REAL + else if (RS_UNSIGREJ(rs) > 0.0) + up = MIS_MEAN(mst) + RS_UNSIGREJ(rs) * MIS_STDDEV(mst) + else + up = MAX_REAL + if (i > 0) { + if (MIS_NPIX(mst) == npix) + break + } + npix = MIS_NPIX(mst) + } + + } + + # Estimate the median and the mode by accumulating the histogram. + hgm = NULL + if (mst_ihist (mst, RS_BINWIDTH(rs), hgm, nbins, hwidth, hmin, + hmax) == YES) { + call aclri (Memi[hgm], nbins) + call amovkl (long(1), Meml[v], IM_NDIM(im)) + while (imgnlr (im, buf, Meml[v]) != EOF) + call ahgmr (Memr[buf], npts, Memi[hgm], nbins, hmin, hmax) + call mst_hmedian (mst, Memi[hgm], nbins, hwidth, hmin, hmax) + } + if (hgm != NULL) + call mfree (hgm, TY_INT) + + # Set the statistic + fscale = MIS_MEDIAN(mst) + + call mst_free (mst) + call sfree (sp) +end + + +# RS_UMASK -- Update the mask. + +int procedure rs_umask (pix, msk, npts, lower, upper) + +real pix[ARB] #I array of image pixels +short msk[ARB] #O array of mask pixels, set to 1 and 0 +int npts #I the number of pixels +real lower #I the lower good data limit +real upper #I the upper good data limit + +real lo, up +int i, nbad + +begin + if (IS_INDEFR(lower) && IS_INDEFR(upper)) + return (0) + + if (IS_INDEFR(lower)) + lo = -MAX_REAL + else + lo = lower + if (IS_INDEFR(upper)) + up = MAX_REAL + else + up = upper + + nbad = 0 + do i = 1, npts { + if (pix[i] < lo || pix[i] > up) { + msk[i] = 0 + nbad = nbad + 1 + } else + msk[i] = 1 + } + + return (nbad) +end diff --git a/pkg/proto/masks/t_mimstat.x b/pkg/proto/masks/t_mimstat.x new file mode 100644 index 00000000..99d5ab09 --- /dev/null +++ b/pkg/proto/masks/t_mimstat.x @@ -0,0 +1,363 @@ +include <mach.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include "mimstat.h" + +# T_MIMSTATISTICS -- Compute image statistics through masks. + +procedure t_mimstatistics() + +real lower, upper, lsigma, usigma, binwidth, low, up, hwidth, hmin, hmax +pointer sp, inmasks, fieldstr, fields, image, imask, omask, masktemp, str, str2 +pointer mst, vs, ve, im, pmim, pmout, opm, mp, buf, hgm, smsk +int i, imlist, inlist, outlist, nclip, nfields, format, mval, npts, npix +int nbins, in_invert, nbad, cache, old_size + +real clgetr() +pointer yt_mappm(), mp_miopen() +int imtopenp(), imtopen(), imtlen(), imtgetim(), immap(), clgeti() +int mst_fields(), btoi(), mio_glsegr(), mst_ihist(), imstati() +int mst_umask(), strmatch() +bool clgetb() +errchk immap(), yt_mappm(), yt_pminvert() + +begin + # Allocate working space. + call smark (sp) + call salloc (inmasks, SZ_FNAME, TY_CHAR) + call salloc (fieldstr, SZ_LINE, TY_CHAR) + call salloc (fields, MIS_NFIELDS, TY_INT) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imask, SZ_FNAME, TY_CHAR) + call salloc (omask, SZ_FNAME, TY_CHAR) + call salloc (masktemp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + + call salloc (vs, IM_MAXDIM, TY_LONG) + call salloc (ve, IM_MAXDIM, TY_LONG) + + # Open the input image list. + imlist = imtopenp ("images") + if (imtlen (imlist) <= 0) { + call eprintf ("The input image list is empty\n") + call imtclose (imlist) + call sfree (sp) + return + } + + # Get the input mask specification + call clgstr ("imasks", Memc[inmasks+1], SZ_FNAME) + if (Memc[inmasks+1] == '^') { + in_invert = YES + inlist = imtopen (Memc[inmasks+2]) + } else { + in_invert = NO + inlist = imtopen (Memc[inmasks+1]) + } + if (imtlen (inlist) > 1 && imtlen (inlist) != imtlen (imlist)) { + call eprintf ("The input mask and image lists don't match\n") + call imtclose (inlist) + call imtclose (imlist) + call sfree (sp) + return + } + + # Open the output mask list. The number of output masks must be + # zero equal to the number of input images. + outlist = imtopenp ("omasks") + if (imtlen (outlist) > 0 && imtlen(outlist) != imtlen(imlist)) { + call eprintf ("The output mask and image lists don't match\n") + call imtclose (outlist) + call imtclose (inlist) + call imtclose (imlist) + call sfree (sp) + return + } + + # Get algorithm parameters. + 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") + if (nclip > 0 && IS_INDEFR(lsigma) && IS_INDEFR(usigma)) + nclip = 0 + + # Get the other parameters. + format = btoi(clgetb ("format")) + cache = btoi(clgetb ("cache")) + + # Allocate space for statistics structure. + call mst_allocate (mst) + + # Get the selected fields. + nfields = mst_fields (Memc[fieldstr], Memi[fields], MIS_NFIELDS) + if (nfields <= 0) { + call imtclose (outlist) + call imtclose (inlist) + call imtclose (imlist) + call sfree (sp) + return + } + + # Set the processing switches + call mst_switches (mst, Memi[fields], nfields, nclip) + + if (format == YES) + call mst_pheader (Memi[fields], nfields) + + # Loop over the input images. + while (imtgetim (imlist, Memc[image], SZ_FNAME) != EOF) { + + # Open the input image. + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call printf ("Error reading image %s ...\n") + call pargstr (Memc[image]) + next + } + + # Open the input mask. + if (imtgetim (inlist, Memc[str+1], SZ_FNAME) != EOF) { + Memc[str] = '^' + if (in_invert == YES) + pmim = yt_mappm (Memc[str+1], im, "logical", + Memc[imask], SZ_FNAME) + else + pmim = yt_mappm (Memc[str], im, "logical", + Memc[imask], SZ_FNAME) + } else if (imtlen (inlist) == 1) { + Memc[inmasks] = '^' + if (in_invert == YES) + pmim = yt_mappm (Memc[inmasks+1], im, "logical", + Memc[imask], SZ_FNAME) + else + pmim = yt_mappm (Memc[inmasks], im, "logical", + Memc[imask], SZ_FNAME) + } else + pmim = yt_mappm ("^EMPTY", im, "logical", Memc[imask], SZ_FNAME) + + # Check the mask status and open an empty mask if there + # was an error. + if (pmim == NULL) { + call printf ("Error reading mask for image %s ...\n") + call pargstr (Memc[image]) + call imunmap (im) + next + } + + # Get the output mask name if any and open a VIRTUAL output + # mask. + if (imtlen (outlist) > 0) { + if (imtgetim (outlist, Memc[omask], SZ_FNAME) == EOF) { + call imunmap (pmim) + call imunmap (im) + next + } else { + if (strmatch (Memc[omask], ".pl$") == 0) + call strcat (".pl", Memc[omask], SZ_FNAME) + if (Memc[imask] == '^') + call xt_mkimtemp (Memc[imask+1], Memc[omask], + Memc[masktemp], SZ_FNAME) + else + call xt_mkimtemp (Memc[imask], Memc[omask], + Memc[masktemp], SZ_FNAME) + pmout = immap (Memc[omask], NEW_COPY, im) + call mp_mpcopy (im, pmim, pmout) + } + } else { + pmout = NULL + } + + if (cache == YES) + call mst_cache1 (cache, im, old_size) + + # Set up the input masking parameters. + mp = mp_miopen (im, pmim) + + # Compute the image statistics. + low = lower + up = upper + do i = 0 , nclip { + + # Set up the mask i/o boundaries. + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + call amovl (IM_LEN(im,1), Meml[ve], IM_NDIM(im)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(im)) + + # Initialize the statistics computation. + call mst_initialize (mst, low, up) + + # Accumulate the sums. + if (MIS_SKURTOSIS(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate4 (mst, Memr[buf], npts, low, up, + MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SSKEW(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate3 (mst, Memr[buf], npts, + low, up, MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SSTDDEV(MIS_SW(mst)) == YES || + MIS_SMEDIAN(MIS_SW(mst)) == YES || + MIS_SMODE(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate2 (mst, Memr[buf], npts, + low, up, MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SMEAN(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate1 (mst, Memr[buf], npts, + low, up, MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SNPIX(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate0 (mst, Memr[buf], npts, + low, up, MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SMINMAX(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate0 (mst, Memr[buf], npts, + low, up, YES) + } + + # Compute the central moment statistics. + call mst_stats (mst) + + # Compute new limits and iterate. + if (i < nclip) { + if (IS_INDEFR(lsigma) || IS_INDEFR(MIS_MEAN(mst)) || + IS_INDEFR(MIS_STDDEV(mst))) + low = -MAX_REAL + else if (lsigma > 0.0) + low = MIS_MEAN(mst) - lsigma * MIS_STDDEV(mst) + else + low = -MAX_REAL + if (IS_INDEFR(usigma) || IS_INDEFR(MIS_MEAN(mst)) || + IS_INDEFR(MIS_STDDEV(mst))) + up = MAX_REAL + else if (usigma > 0.0) + up = MIS_MEAN(mst) + usigma * MIS_STDDEV(mst) + else + up = MAX_REAL + if (!IS_INDEFR(lower)) + low = max (low, lower) + if (!IS_INDEFR(upper)) + up = min (up, upper) + if (i > 0) { + if (MIS_NPIX(mst) == npix) + break + } + npix = MIS_NPIX(mst) + } + + } + + # Estimate the median and the mode by accumulating the histogram. + hgm = NULL + if ((MIS_SMEDIAN(MIS_SW(mst)) == YES || + MIS_SMODE(MIS_SW(mst)) == YES) && mst_ihist (mst, binwidth, + hgm, nbins, hwidth, hmin, hmax) == YES) { + call aclri (Memi[hgm], nbins) + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + call amovl (IM_LEN(im,1), Meml[ve], IM_NDIM(im)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(im)) + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call ahgmr (Memr[buf], npts, Memi[hgm], nbins, hmin, hmax) + if (MIS_SMEDIAN(MIS_SW(mst)) == YES) + call mst_hmedian (mst, Memi[hgm], nbins, hwidth, hmin, + hmax) + if (MIS_SMODE(MIS_SW(mst)) == YES) + call mst_hmode (mst, Memi[hgm], nbins, hwidth, hmin, hmax) + } + if (hgm != NULL) + call mfree (hgm, TY_INT) + + # Print the statistics. + if (format == YES) + call mst_print (Memc[image], Memc[imask], mst, Memi[fields], + nfields) + else + call mst_fprint (Memc[image], Memc[imask], mst, Memi[fields], + nfields) + + # Save the new mask to an output image. + if (pmout != NULL) { + call malloc (smsk, IM_LEN(im,1), TY_SHORT) + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + call amovl (IM_LEN(im,1), Meml[ve], IM_NDIM(im)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(im)) + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + opm = imstati (pmout, IM_PMDES) + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) { + nbad = mst_umask (Memr[buf], Mems[smsk], npts, low, up) + if (nbad > 0) + call pm_plps (opm, Meml[vs], Mems[smsk], 1, npts, + PIX_SRC) + } + call yt_pminvert (opm) + call imseti (pmout, IM_PMDES, opm) + call mfree (smsk, TY_SHORT) + } + + # Close the images and descriptors. + call mio_close (mp) + if (pmout != NULL) { + #call pm_savef (opm, Memc[omask], "", 0) + call imunmap (pmout) + call imunmap (pmim) + call xt_delimtemp (Memc[omask], Memc[masktemp]) + } else + call imunmap (pmim) + call imunmap (im) + if (cache == YES) + call fixmem (old_size) + } + + call mst_free (mst) + call imtclose (outlist) + call imtclose (inlist) + call imtclose (imlist) + + call sfree (sp) +end + + +# MST_UMASK -- Update the mask. + +int procedure mst_umask (pix, msk, npts, lower, upper) + +real pix[ARB] #I array of image pixels +short msk[ARB] #O array of mask pixels, set to 1 and 0 +int npts #I the number of pixels +real lower #I the lower good data limit +real upper #I the upper good data limit + +real lo, up +int i, nbad + +begin + if (IS_INDEFR(lower) && IS_INDEFR(upper)) + return (0) + + if (IS_INDEFR(lower)) + lo = -MAX_REAL + else + lo = lower + if (IS_INDEFR(upper)) + up = MAX_REAL + else + up = upper + + nbad = 0 + do i = 1, npts { + if (pix[i] < lo || pix[i] > up) { + msk[i] = 0 + nbad = nbad + 1 + } else + msk[i] = 1 + } + + return (nbad) +end + + diff --git a/pkg/proto/masks/t_mimstat.xBAK b/pkg/proto/masks/t_mimstat.xBAK new file mode 100644 index 00000000..e986b5c5 --- /dev/null +++ b/pkg/proto/masks/t_mimstat.xBAK @@ -0,0 +1,366 @@ +include <mach.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include "mimstat.h" + +# T_MIMSTATISTICS -- Compute image statistics through masks. + +procedure t_mimstatistics() + +real lower, upper, lsigma, usigma, binwidth, low, up, hwidth, hmin, hmax +pointer sp, inmasks, fieldstr, fields, image, imask, omask, masktemp, str, str2 +pointer mst, vs, ve, im, pmim, pmout, opm, mp, buf, hgm, smsk +int i, imlist, inlist, outlist, nclip, nfields, format, mval, npts, npix +int nbins, in_invert, nbad, cache, old_size + +real clgetr() +pointer yt_mappm(), mp_miopen() +int imtopenp(), imtopen(), imtlen(), imtgetim(), immap(), clgeti() +int mst_fields(), btoi(), mio_glsegr(), mst_ihist(), imstati() +int mst_umask(), strmatch() +bool clgetb() +errchk immap(), yt_mappm(), yt_pminvert() + +begin + # Allocate working space. + call smark (sp) + call salloc (inmasks, SZ_FNAME, TY_CHAR) + call salloc (fieldstr, SZ_LINE, TY_CHAR) + call salloc (fields, MIS_NFIELDS, TY_INT) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imask, SZ_FNAME, TY_CHAR) + call salloc (omask, SZ_FNAME, TY_CHAR) + call salloc (masktemp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + + call salloc (vs, IM_MAXDIM, TY_LONG) + call salloc (ve, IM_MAXDIM, TY_LONG) + + # Open the input image list. + imlist = imtopenp ("images") + if (imtlen (imlist) <= 0) { + call eprintf ("The input image list is empty\n") + call imtclose (imlist) + call sfree (sp) + return + } + + # Get the input mask specification + call clgstr ("imasks", Memc[inmasks], SZ_FNAME) + if (Memc[inmasks] == '^') { + in_invert = YES + inlist = imtopen (Memc[inmasks+1]) + } else { + in_invert = NO + inlist = imtopen (Memc[inmasks]) + } + if (imtlen (inlist) > 1 && imtlen (inlist) != imtlen (imlist)) { + call eprintf ("The input mask and image lists don't match\n") + call imtclose (inlist) + call imtclose (imlist) + call sfree (sp) + return + } + + # Open the output mask list. The number of output masks must be + # zero equal to the number of input images. + outlist = imtopenp ("omasks") + if (imtlen (outlist) > 0 && imtlen(outlist) != imtlen(imlist)) { + call eprintf ("The output mask and image lists don't match\n") + call imtclose (outlist) + call imtclose (inlist) + call imtclose (imlist) + call sfree (sp) + return + } + + # Get algorithm parameters. + 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") + if (nclip > 0 && IS_INDEFR(lsigma) && IS_INDEFR(usigma)) + nclip = 0 + + # Get the other parameters. + format = btoi(clgetb ("format")) + cache = btoi(clgetb ("cache")) + + # Allocate space for statistics structure. + call mst_allocate (mst) + + # Get the selected fields. + nfields = mst_fields (Memc[fieldstr], Memi[fields], MIS_NFIELDS) + if (nfields <= 0) { + call imtclose (outlist) + call imtclose (inlist) + call imtclose (imlist) + call sfree (sp) + return + } + + # Set the processing switches + call mst_switches (mst, Memi[fields], nfields, nclip) + + if (format == YES) + call mst_pheader (Memi[fields], nfields) + + # Loop over the input images. + while (imtgetim (imlist, Memc[image], SZ_FNAME) != EOF) { + + # Open the input image. + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call printf ("Error reading image %s ...\n") + call pargstr (Memc[image]) + next + } + + # Open the input mask. + if (imtgetim (inlist, Memc[str+1], SZ_FNAME) != EOF) { + if (in_invert == YES) { + Memc[str] = '^' + #pmim = mp_open (Memc[str], im, Memc[imask], SZ_FNAME) + pmim = yt_mappm (Memc[str], im, "logical", + Memc[imask], SZ_FNAME) + } else + #pmim = mp_open (Memc[str+1], im, Memc[imask], SZ_FNAME) + pmim = yt_mappm (Memc[str+1], im, "logical", + Memc[imask], SZ_FNAME) + } else if (imtlen (inlist) == 1) { + #pmim = mp_open (Memc[inmasks], im, Memc[imask], SZ_FNAME) + pmim = yt_mappm (Memc[inmasks], im, "logical", + Memc[imask], SZ_FNAME) + } else { + #pmim = mp_open ("", im, Memc[imask], SZ_FNAME) + pmim = yt_mappm ("EMPTY", im, "logical", Memc[imask], SZ_FNAME) + } + + # Check the mask status and open an empty mask if there + # was an error. + if (pmim == NULL) { + call printf ("Error reading mask for image %s ...\n") + call pargstr (Memc[image]) + call imunmap (im) + next + } + + # Invert the mask. + if (pmim != NULL) { + opm = imstati (pmim, IM_PMDES) + call yt_pminvert (opm) + call imseti (pmim, IM_PMDES, opm) + } + + # Get the output mask name if any and open a VIRTUAL output + # mask. + if (imtlen (outlist) > 0) { + if (imtgetim (outlist, Memc[omask], SZ_FNAME) == EOF) { + call imunmap (pmim) + call imunmap (im) + next + } else { + if (strmatch (Memc[omask], ".pl$") == 0) + call strcat (".pl", Memc[omask], SZ_FNAME) + if (Memc[imask] == '^') + call xt_mkimtemp (Memc[imask+1], Memc[omask], + Memc[masktemp], SZ_FNAME) + else + call xt_mkimtemp (Memc[imask], Memc[omask], + Memc[masktemp], SZ_FNAME) + pmout = immap (Memc[omask], NEW_COPY, im) + call mp_mpcopy (im, pmim, pmout) + } + } else { + pmout = NULL + } + + if (cache == YES) + call mst_cache1 (cache, im, old_size) + + # Set up the input masking parameters. + mp = mp_miopen (im, pmim) + + # Compute the image statistics. + low = lower + up = upper + do i = 0 , nclip { + + # Set up the mask i/o boundaries. + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + call amovl (IM_LEN(im,1), Meml[ve], IM_NDIM(im)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(im)) + + # Initialize the statistics computation. + call mst_initialize (mst, low, up) + + # Accumulate the sums. + if (MIS_SKURTOSIS(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate4 (mst, Memr[buf], npts, low, up, + MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SSKEW(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate3 (mst, Memr[buf], npts, + low, up, MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SSTDDEV(MIS_SW(mst)) == YES || + MIS_SMEDIAN(MIS_SW(mst)) == YES || + MIS_SMODE(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate2 (mst, Memr[buf], npts, + low, up, MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SMEAN(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate1 (mst, Memr[buf], npts, + low, up, MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SNPIX(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate0 (mst, Memr[buf], npts, + low, up, MIS_SMINMAX(MIS_SW(mst))) + } else if (MIS_SMINMAX(MIS_SW(mst)) == YES) { + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call mst_accumulate0 (mst, Memr[buf], npts, + low, up, YES) + } + + # Compute the central moment statistics. + call mst_stats (mst) + + # Compute new limits and iterate. + if (i < nclip) { + if (IS_INDEFR(lsigma) || IS_INDEFR(MIS_MEAN(mst)) || + IS_INDEFR(MIS_STDDEV(mst))) + low = -MAX_REAL + else if (lsigma > 0.0) + low = MIS_MEAN(mst) - lsigma * MIS_STDDEV(mst) + else + low = -MAX_REAL + if (IS_INDEFR(usigma) || IS_INDEFR(MIS_MEAN(mst)) || + IS_INDEFR(MIS_STDDEV(mst))) + up = MAX_REAL + else if (usigma > 0.0) + up = MIS_MEAN(mst) + usigma * MIS_STDDEV(mst) + else + up = MAX_REAL + if (i > 0) { + if (MIS_NPIX(mst) == npix) + break + } + npix = MIS_NPIX(mst) + } + + } + + # Estimate the median and the mode by accumulating the histogram. + hgm = NULL + if ((MIS_SMEDIAN(MIS_SW(mst)) == YES || + MIS_SMODE(MIS_SW(mst)) == YES) && mst_ihist (mst, binwidth, + hgm, nbins, hwidth, hmin, hmax) == YES) { + call aclri (Memi[hgm], nbins) + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + call amovl (IM_LEN(im,1), Meml[ve], IM_NDIM(im)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(im)) + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) + call ahgmr (Memr[buf], npts, Memi[hgm], nbins, hmin, hmax) + if (MIS_SMEDIAN(MIS_SW(mst)) == YES) + call mst_hmedian (mst, Memi[hgm], nbins, hwidth, hmin, + hmax) + if (MIS_SMODE(MIS_SW(mst)) == YES) + call mst_hmode (mst, Memi[hgm], nbins, hwidth, hmin, hmax) + } + if (hgm != NULL) + call mfree (hgm, TY_INT) + + # Print the statistics. + if (format == YES) + call mst_print (Memc[image], Memc[imask], mst, Memi[fields], + nfields) + else + call mst_fprint (Memc[image], Memc[imask], mst, Memi[fields], + nfields) + + # Save the new mask to an output image. + if (pmout != NULL) { + call malloc (smsk, IM_LEN(im,1), TY_SHORT) + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + call amovl (IM_LEN(im,1), Meml[ve], IM_NDIM(im)) + call mio_setrange (mp, Meml[vs], Meml[ve], IM_NDIM(im)) + call amovkl (long(1), Meml[vs], IM_NDIM(im)) + opm = imstati (pmout, IM_PMDES) + while (mio_glsegr (mp, buf, mval, Meml[vs], npts) != EOF) { + nbad = mst_umask (Memr[buf], Mems[smsk], npts, low, up) + if (nbad > 0) + call pm_plps (opm, Meml[vs], Mems[smsk], 1, npts, + PIX_SRC) + } + call mp_invert (opm) + call imseti (pmout, IM_PMDES, opm) + call mfree (smsk, TY_SHORT) + } + + # Close the images and descriptors. + call mio_close (mp) + if (pmout != NULL) { + #call pm_savef (opm, Memc[omask], "", 0) + call imunmap (pmout) + call imunmap (pmim) + call xt_delimtemp (Memc[omask], Memc[masktemp]) + } else + call imunmap (pmim) + call imunmap (im) + if (cache == YES) + call fixmem (old_size) + } + + call mst_free (mst) + call imtclose (outlist) + call imtclose (inlist) + call imtclose (imlist) + + call sfree (sp) +end + + +# MST_UMASK -- Update the mask. + +int procedure mst_umask (pix, msk, npts, lower, upper) + +real pix[ARB] #I array of image pixels +short msk[ARB] #O array of mask pixels, set to 1 and 0 +int npts #I the number of pixels +real lower #I the lower good data limit +real upper #I the upper good data limit + +real lo, up +int i, nbad + +begin + if (IS_INDEFR(lower) && IS_INDEFR(upper)) + return (0) + + if (IS_INDEFR(lower)) + lo = -MAX_REAL + else + lo = lower + if (IS_INDEFR(upper)) + up = MAX_REAL + else + up = upper + + nbad = 0 + do i = 1, npts { + if (pix[i] < lo || pix[i] > up) { + msk[i] = 0 + nbad = nbad + 1 + } else + msk[i] = 1 + } + + return (nbad) +end + + diff --git a/pkg/proto/masks/t_rskysub.x b/pkg/proto/masks/t_rskysub.x new file mode 100644 index 00000000..85f0b991 --- /dev/null +++ b/pkg/proto/masks/t_rskysub.x @@ -0,0 +1,248 @@ +include <imhdr.h> +include "rskysub.h" + +# T_RSKYSUB -- Sky subtract a set of input images using image scaling and +# a running statistics compution + +procedure t_rskysub() + +pointer sp, imasks, str +pointer rs +int inlist, imsklist, outlist, omsklist, hmsklist, sclist, tmplist +bool msk_invert, useimasks, cache, verbose + +real clgetr() +int imtopenp(), imtopen(), imtlen(), fntopnb(), fntlenb() +int clgeti(), btoi(), clgwrd(), rs_imlist(), rs_olist(), rs_omlist() +bool clgetb(), strne() + +begin + # Allocate working space. + call smark (sp) + call salloc (imasks, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Open the input image list. Make this a test versus nmin ? + inlist = imtopenp ("input") + if (imtlen (inlist) <= 0) { + call eprintf ("The input image list is empty\n") + call imtclose (inlist) + call sfree (sp) + return + } + + # Open the output image list. The number of output images must be + # zero equal to the number of input images. + call clgstr ("output", Memc[str], SZ_FNAME) + outlist = rs_olist (inlist, Memc[str], "default", "sub") + if (imtlen (outlist) > 0 && imtlen(outlist) != imtlen(inlist)) { + call eprintf ("The output mask and image lists don't match\n") + call imtclose (outlist) + call imtclose (inlist) + call sfree (sp) + return + } + + # Open the input mask list. + call clgstr ("imasks", Memc[imasks], SZ_FNAME) + if (Memc[imasks] == '^') { + #imsklist = imtopen (Memc[imasks+1]) + imsklist = rs_imlist (inlist, Memc[imasks+1], "default", "obm") + msk_invert = true + } else { + #imsklist = imtopen (Memc[imasks]) + imsklist = rs_imlist (inlist, Memc[imasks], "default", "obm") + msk_invert = false + } + if (imtlen (imsklist) > 1 && imtlen (imsklist) != imtlen (inlist)) { + call eprintf ("The input mask and image lists don't match\n") + call imtclose (imsklist) + call imtclose (outlist) + call imtclose (inlist) + call sfree (sp) + return + } + + # Open the output mask list. The number of output masks must be + # zero equal to the number of input images. + call clgstr ("omasks", Memc[str], SZ_FNAME) + omsklist = rs_omlist (inlist, Memc[str], "default", "skm") + if (imtlen (omsklist) > 0 && imtlen(omsklist) != imtlen(inlist)) { + call eprintf ("The output mask and image lists don't match\n") + call imtclose (omsklist) + call imtclose (imsklist) + call imtclose (outlist) + call imtclose (inlist) + call sfree (sp) + return + } + + # Open the output holes mask list. The number of output holes masks + # must be zero equal to the number of input images. + call clgstr ("hmasks", Memc[str], SZ_FNAME) + hmsklist = rs_omlist (inlist, Memc[str], "default", "hom") + if (imtlen (hmsklist) > 0 && imtlen(hmsklist) != imtlen(inlist)) { + call eprintf ("The holes mask and image lists don't match\n") + call imtclose (hmsklist) + call imtclose (omsklist) + call imtclose (imsklist) + call imtclose (outlist) + call imtclose (inlist) + call sfree (sp) + return + } + + # Allocate the sky subtraction structure + call malloc (rs, LEN_RSKYSUB, TY_STRUCT) + + # Get the scaling factor computation method. + RS_RESCALE(rs) = btoi(clgetb ("rescale")) + call clgstr ("scale", RS_ISCALES(rs), SZ_FNAME) + sclist = fntopnb (RS_ISCALES(rs), NO) + if (fntlenb (sclist) > 1 && fntlenb (sclist) != imtlen (inlist)) { + call eprintf ("The scaling factor and image lists don't match\n") + call fntclsb (sclist) + call imtclose (hmsklist) + call imtclose (omsklist) + call imtclose (imsklist) + call imtclose (outlist) + call imtclose (inlist) + call sfree (sp) + return + } + + # If the scaling algorith is not "median" then new output masks + # cannot be created. + if (strne (RS_ISCALES(rs), "median")) { + call imtclose (omsklist) + omsklist = imtopen ("") + } + call clgstr ("skyscale", RS_KYFSCALE(rs), SZ_FNAME) + + # Get statisitics computation parameters. + useimasks = clgetb ("useimasks") + call clgstr ("statsec", RS_STATSEC(rs), SZ_FNAME) + RS_LOWER(rs) = clgetr ("lower") + RS_UPPER(rs) = clgetr ("upper") + RS_MAXITER(rs) = clgeti ("maxiter") + RS_LNSIGREJ(rs) = clgetr ("lnsigrej") + RS_UNSIGREJ(rs) = clgetr ("unsigrej") + RS_BINWIDTH(rs) = clgetr ("binwidth") + if (RS_MAXITER(rs) > 0 && IS_INDEFR(RS_LNSIGREJ(rs)) && + IS_INDEFR(RS_UNSIGREJ(rs))) + RS_MAXITER(rs) = 0 + + # Get the sky subtraction parameters + RS_RESUBTRACT(rs) = btoi(clgetb ("resubtract")) + RS_COMBINE(rs) = clgwrd ("combine", Memc[str], SZ_FNAME, RS_COMBINESTR) + RS_NCOMBINE(rs) = clgeti ("ncombine") + RS_NMIN(rs) = clgeti ("nmin") + if (RS_NMIN(rs) <= 0 || RS_NMIN(rs) > RS_NCOMBINE(rs)) { + RS_NMIN(rs) = RS_NCOMBINE(rs) + call eprintf ("Warning: resetting nmin to %d\n") + call pargi (RS_NMIN(rs)) + } + + # Get starting values for the rejection parameters. These may have + # to be adjusted if image masking is enabled and for cases where + # the number of combined images is greater then equal to nmin but + # less than ncombine. + RS_NLOREJ(rs) = clgeti ("nlorej") + RS_NHIREJ(rs) = clgeti ("nhirej") + switch (RS_COMBINE(rs)) { + case RS_MEAN: + if ((RS_NMIN(rs) - RS_NLOREJ(rs) - RS_NHIREJ(rs)) < 1) { + call eprintf ("Too many rejected pixels\n") + call fntclsb (sclist) + call imtclose (hmsklist) + call imtclose (omsklist) + call imtclose (imsklist) + call imtclose (outlist) + call imtclose (inlist) + call sfree (sp) + return + } + case RS_MEDIAN: + if (mod (RS_NCOMBINE(rs), 2) == 0) { + RS_NLOREJ(rs) = RS_NCOMBINE(rs) / 2 - 1 + RS_NHIREJ(rs) = RS_NCOMBINE(rs) / 2 - 1 + } else { + RS_NLOREJ(rs) = RS_NCOMBINE(rs) / 2 + RS_NHIREJ(rs) = RS_NCOMBINE(rs) / 2 + } + default: + } + RS_BLANK(rs) = clgetr ("blank") + call clgstr ("skysub", RS_KYSKYSUB(rs), SZ_FNAME) + call clgstr ("holes", RS_KYHMASK(rs), SZ_FNAME) + + cache = clgetb ("cache") + verbose = clgetb ("verbose") + + # Compute the sky statistics and optionally the output sky masks. + + if (useimasks) { + call rs_stats (inlist, imsklist, omsklist, sclist, rs, msk_invert, + cache, verbose) + } else { + tmplist = imtopen ("") + call rs_stats (inlist, tmplist, omsklist, sclist, rs, msk_invert, + cache, verbose) + call imtclose (tmplist) + } + + # Do the sky subtraction with or without image masking and with or + # without bad pixel rejection. Unmasked image medians can be handled + # by setting the high and low pixel rejection parameters appropriately. + # Masked image means and medians may require dynaimc altering of the + # high and low rejection parameters. + + switch (RS_COMBINE(rs)) { + case RS_MEAN, RS_MEDIAN: + if (imtlen (omsklist) > 0) { + if (RS_NLOREJ(rs) > 0 || RS_NHIREJ(rs) > 0) + # Choose which of the two routines to use later based + # on timing tests. + #call rs_prmsub (inlist, omsklist, outlist, hmsklist, rs, + #msk_invert, cache, verbose) + call rs_prrmsub (inlist, omsklist, outlist, hmsklist, rs, + msk_invert, cache, verbose) + else + call rs_pmsub (inlist, omsklist, outlist, hmsklist, rs, + msk_invert, cache, verbose) + } else if (imtlen (imsklist) > 0) { + if (RS_NLOREJ(rs) > 0 || RS_NHIREJ(rs) > 0) + # Choose which of the two routines to use later based on + # timing tests. + #call rs_prmsub (inlist, imsklist, outlist, hmsklist, rs, + #msk_invert, cache, verbose) + call rs_prrmsub (inlist, imsklist, outlist, hmsklist, rs, + msk_invert, cache, verbose) + else + call rs_pmsub (inlist, imsklist, outlist, hmsklist, rs, + msk_invert, cache, verbose) + } else { + if (RS_NLOREJ(rs) > 0 || RS_NHIREJ(rs) > 0) + # Choose which of the two routines to use later based on + # timing tests. + #call rs_rmsub (inlist, outlist, rs, cache, verbose) + call rs_rrmsub (inlist, outlist, rs, cache, verbose) + else + call rs_msub (inlist, outlist, rs, cache, verbose) + } + default: + ; + } + + # Close image and file lists. + call fntclsb (sclist) + call imtclose (hmsklist) + call imtclose (imsklist) + call imtclose (omsklist) + call imtclose (outlist) + call imtclose (inlist) + + call mfree (rs, TY_STRUCT) + call sfree (sp) +end + diff --git a/pkg/proto/mimstatistics.par b/pkg/proto/mimstatistics.par new file mode 100644 index 00000000..84585cb8 --- /dev/null +++ b/pkg/proto/mimstatistics.par @@ -0,0 +1,13 @@ +images,f,a,,,,List of input images +imasks,f,h,"",,,List of input image masks +omasks,f,h,"",,,List of output image masks +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 image histogram in sigma +format,b,h,yes,,,Format output and print column labels ? +cache,b,h,no,,,Cache the image in memory ? + diff --git a/pkg/proto/mkglbhdr.par b/pkg/proto/mkglbhdr.par new file mode 100644 index 00000000..3763402f --- /dev/null +++ b/pkg/proto/mkglbhdr.par @@ -0,0 +1,4 @@ +input,s,a,,,,List of images +output,f,a,,,,Output image +reference,f,h,"",,,Optional reference image +exclude,s,h,"",,,Optional keyword exclusion list diff --git a/pkg/proto/mkpkg b/pkg/proto/mkpkg new file mode 100644 index 00000000..d1f20350 --- /dev/null +++ b/pkg/proto/mkpkg @@ -0,0 +1,47 @@ +# Make the PROTO package. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $call relink@color + $call relink@vol + + $update libpkg.a + $omake x_proto.x + $link x_proto.o libpkg.a -lxtools -liminterp -o xx_proto.e + ; + +install: + $call install@color + $call install@vol + + $move xx_proto.e bin$x_proto.e + ; + +libpkg.a: + epix.x <imhdr.h> + fields.x <ctype.h> + interp.x <fset.h> + intrp.f + t_binfil.x <mach.h> <error.h> <imhdr.h> + t_bscale.x <ctype.h> <error.h> <imhdr.h> <mach.h> + t_fixpix.x <error.h> <imhdr.h> <imset.h> <pmset.h> + t_hfix.x <ctype.h> <error.h> <imhdr.h> <imio.h> + t_imext.x <error.h> <syserr.h> <imhdr.h> <imset.h> <mach.h> \ + <ctype.h> + t_imcntr.x <imhdr.h> + t_imscale.x <imhdr.h> <mach.h> + t_joinlines.x + t_mask2text.x <imhdr.h> + t_mkglbhdr.x <error.h> <imhdr.h> + t_suntoiraf.x <mach.h> <error.h> <imhdr.h> + t_text2mask.x <imhdr.h> + @masks + @maskexpr + ; diff --git a/pkg/proto/mskexpr.par b/pkg/proto/mskexpr.par new file mode 100644 index 00000000..29b62b01 --- /dev/null +++ b/pkg/proto/mskexpr.par @@ -0,0 +1,10 @@ +# MSKEXPR parameters + +expr,s,a,,,,The mask generating expression +masks,f,a,,,,The list of output mask images +refimages,f,a,,,,The list of input reference images +refmasks,f,h,"",,,The list of input reference masks +dims,s,h,"512,512",,,The default output mask dimensions +depth,i,h,0,,,The default output mask depth in bits +exprdb,s,h,none,,,The optional expression database +verbose,b,h,yes,,,Print task status messages ? diff --git a/pkg/proto/mskregions.par b/pkg/proto/mskregions.par new file mode 100644 index 00000000..eab9af38 --- /dev/null +++ b/pkg/proto/mskregions.par @@ -0,0 +1,12 @@ +# MSKREGIONS parameters + +regions,s,a,,,,The list of region specifications +masks,f,a,,,,The list of output mask images +refimages,f,a,,,,The list of input reference images +dims,s,h,"512,512",,,The default output mask dimensions +depth,i,h,0,,,The default output mask depth in bits +regnumber,s,h,"constant", "|constant|number|",,The region numbering scheme +regval,i,h,1,,,The default starting mask region value +exprdb,s,h,"none",,,The optional expression database +append,b,h,no,,,Append new regions to an existing mask ? +verbose,b,h,yes,,,Print task status messages ? diff --git a/pkg/proto/proto.cl b/pkg/proto/proto.cl new file mode 100644 index 00000000..a4ff9462 --- /dev/null +++ b/pkg/proto/proto.cl @@ -0,0 +1,38 @@ +#{ Package script task for the PROTO package. + +images + +package proto + +task binfil, + bscale, + epix, + fields, + fixpix, + hfix, + imcntr, + imextensions, + imscale, + interp, + irafil, + joinlines, + $mask2text, + mkglbhdr, + mimstatistics, + mskexpr, + mskregions, + suntoiraf, + rskysub, + text2mask = proto$x_proto.e + +task ringavg = proto$ringavg.cl + +set color = "proto$color/" +set vol = "proto$vol/" + +task color.pkg = color$color.cl +task vol.pkg = vol$vol.cl + +hidetask mask2text + +clbye diff --git a/pkg/proto/proto.hd b/pkg/proto/proto.hd new file mode 100644 index 00000000..edbcc7d4 --- /dev/null +++ b/pkg/proto/proto.hd @@ -0,0 +1,46 @@ +# Help directory for the PROTO package. + +$doc = "pkg$proto/doc/" +$masks = "pkg$proto/masks/" +$maskexpr = "pkg$proto/maskexpr/" + +$color = "pkg$proto/color/" +$vol = "pkg$proto/vol/" + + +color men=color$color.men, + hlp=.., + sys=color$color.hlp, + pkg=color$color.hd, + src=color$color.cl + +vol men=vol$vol.men, + hlp=.., + sys=vol$vol.hlp, + pkg=vol$vol.hd, + src=vol$vol.cl + + +binfil hlp =doc$binfil.hlp, src = x_binfil.x +bscale hlp =doc$bscale.hlp, src = t_bscale.x +epix hlp =doc$epix.hlp, src = epix.x +fields hlp =doc$fields.hlp, src = fields.x +hfix hlp =doc$hfix.hlp, src = t_hfix.x +imcntr hlp =doc$imcntr.hlp, src = t_imcntr.x +fixpix hlp =doc$fixpix.hlp, src = t_fixpix.x +imextensions hlp =doc$imextensions.hlp, src = t_imext.x +imscale hlp =doc$imscale.hlp, src = t_imscale.x +interp hlp =doc$interp.hlp, src = interp.x +irafil hlp =doc$irafil.hlp, src = x_binfil.x +joinlines hlp =doc$joinlines.hlp, src = t_joinlines.x +mkglbhdr hlp =doc$mkglbhdr.hlp, src = t_mkglbhdr.x +mskregions hlp =doc$mskregions.hlp, src = t_mskregions.x +mskexpr hlp =doc$mskexpr.hlp, src = t_mskexpr.x +mskregions hlp =doc$mskregions.hlp, src = t_mskregions.x +mimstatistics hlp =doc$mimstat.hlp, src = masks$t_mimstat.x +ringavg hlp =doc$ringavg.hlp, src = ringavg.cl +rskysub hlp =doc$rskysub.hlp, src = masks$t_rskysub.x +suntoiraf hlp =doc$suntoiraf.hlp, src = t_suntoiraf.x +text2mask hlp =doc$text2mask.hlp, src = t_text2mask.x + +revisions sys =Revisions diff --git a/pkg/proto/proto.men b/pkg/proto/proto.men new file mode 100644 index 00000000..968a186e --- /dev/null +++ b/pkg/proto/proto.men @@ -0,0 +1,24 @@ + + color - Prototype color image display/conversion package + vol - Prototype volume rendering package + + binfil - Create a binary file from an IRAF image + bscale - Linearly transform the intensities of a list of images + epix - Edit pixels in an image + fields - Extract specified fields from a list + fixpix - Fix bad pixels by linear interpolation from nearby pixels + hfix - Fix image headers with a user specified command + imcntr - Locate the center of a stellar image + imextensions - Make a list of image extensions + imscale - Scale an image to a specified (windowed) mean + interp - Interpolate for a value in a table of X,Y pairs + irafil - Create an IRAF image from a binary data file + joinlines - Join text files line by line + mimstatistics - Do image statistics through a mask + mkglbhdr - Make global header from keywords in images and reference + mskexpr - Create masks using an expression and reference images + mskregions - Create or modify masks using regions lists + ringavg - Compute pixel averages in concentric rings about given center + rskysub - Sky subtract images using running mean or median + suntoiraf - Convert Sun rasters into IRAF images + text2mask - Convert text description to pixel mask diff --git a/pkg/proto/proto.par b/pkg/proto/proto.par new file mode 100644 index 00000000..1ad539cc --- /dev/null +++ b/pkg/proto/proto.par @@ -0,0 +1,3 @@ +# PROTO package parameter file. + +version,s,h,"October 2010" diff --git a/pkg/proto/ringavg.cl b/pkg/proto/ringavg.cl new file mode 100644 index 00000000..a7504642 --- /dev/null +++ b/pkg/proto/ringavg.cl @@ -0,0 +1,172 @@ +# RINGAVG (Nov02) proto RINGAVG (Nov02) +# +# +# NAME +# ringavg -- compute pixel averages in concentric rings about given +# center +# +# +# USAGE +# ringavg image xc yc +# +# +# PARAMETERS +# +# image +# Image to be used. +# +# xc, yc +# Pixel coordinate for center of rings. +# +# r1 = 0, r2 = 10, dr = 1 +# Rings to be measured. R1 is the inner radius of the first ring, +# R2 is the outer radius of the last bin, and DR is the widths of +# the rings. The values are in units of pixels. +# +# labels = yes +# Print column labels for the output? +# +# vebar = no +# If VEBAR is yes then the standard deviation and standard error +# will be printed as negative values for use with GRAPH. +# +# +# DESCRIPTION +# Pixels are binned into a series of concentric rings centered on a +# given position in the input image. The rings are defined by an +# inner radius for the first ring, an outer radius for the last ring, +# and the width of the rings. The statistics of the pixel values in +# each ring are then computed and list to the standard output. The +# output lines consist of the inner and outer ring radii, the number +# of pixels, the average value, the standard deviation of the value +# (corrected for population size), and the standard error. The +# parameter LABEL selects whether to include column labels. +# +# If the ring average are to be plotted with the task GRAPH using the +# option to plot error bars based on the standard deviation or +# standard error then the VEBAR parameter may be set to write the +# values as negative values are required by that task. +# +# This task is a script and so users may copy it and modify it as +# desired. Because it is a script it will be very slow if r2 becomes +# large. +# +# +# EXAMPLES +# 1. Compute the ring averages with labels and output to the terminal. +# +# cl> ringavg pwimage 17 17 +# # R min R max Npix Average Std Dev Std Err +# 0.00 1.00 5 7.336 9.16 4.096 +# 1.00 2.00 8 0.2416 0.2219 0.07844 +# 2.00 3.00 16 0.3994 0.5327 0.1332 +# 3.00 4.00 20 0.06211 0.05491 0.01228 +# 4.00 5.00 32 0.0987 0.08469 0.01497 +# 5.00 6.00 32 0.06983 0.06125 0.01083 +# 6.00 7.00 36 0.0641 0.0839 0.01398 +# 7.00 8.00 48 0.06731 0.05373 0.007755 +# 8.00 9.00 56 0.06146 0.07601 0.01016 +# 9.00 10.00 64 0.05626 0.05846 0.007308 +# +# 2. Plot the ring averages with standard errors used for error bars. +# +# cl> ringavg pwimage 17 17 label- vebar+ | fields STDIN 2,4,6 | +# >>> graph point+ marker=vebar +# +# 3. Plot ring averages for galaxy in dev$pix. +# +# cl> ringavg dev$pix 256 256 r2=100 dr=5 label- | fields STDIN 2,4 | +# >>> graph logy+ +# +# +# +# SEE ALSO +# pradprof, psfmeasure, radprof +# +# +# To install: +# +# Copy to your home or other personal directory. Enter the command +# "task ringavg = home$ringavg.cl" interactively, in login.cl or in +# your loginuser.cl. Substitute the host or logical path for home$ +# if the script is placed in a different directory. + + +procedure ringavg (image, xc, yc) + +file image {prompt="Input image"} +real xc {prompt="X center"} +real yc {prompt="Y center"} + +real r1 = 0 {prompt="Inner radius of first bin"} +real r2 = 10 {prompt="Outer radius of last bin"} +real dr = 1 {prompt="Radial bin width"} + +bool labels = yes {prompt="Print column labels?"} +bool vebars = no {prompt="Format for error bars in GRAPH?"} + +struct *fd + +begin + file temp + real n, r, val, ra, rb, ravg, rstddev, rmean + + # Extract the pixel values sorted by radius. + temp = mktemp ("temp") + pradprof (image, xc, yc, radius=r2, center=no, list=yes) | + sort ("STDIN", column=1, ignore_white+, numeric+, reverse-, > temp) + + if (label) + printf ("# %6s %8s %8s %10s %10s %10s\n", "R min", "R max", "Npix", + "Average", "Std Dev", "Std Err") + + # Read through the file. Skip the first two comment lines. + fd = temp + i = fscan (fd) + i = fscan (fd) + n = 0 + rb = -1 + while (fscan (fd, r, val) != EOF) { + if (r < r1) + next + if (r > r2) + break + if (r > rb) { + if (n > 0) { + ravg = ravg / n + rstddev = sqrt (rstddev / n - ravg ** 2) + if (vebar) + rstddev = -rstddev + if (n > 1) + rstddev = rstddev * sqrt (n / (n - 1.)) + rmean = rstddev / sqrt (n) + printf ("%8.2f %8.2f %8d %10.4g %10.4g %10.4g\n", + ra, rb, n, ravg, rstddev, rmean) + } + ravg = 0. + rstddev = 0. + n = 0 + ra = int (r / dr) * dr + rb = ra + dr + } + + ravg = ravg + val + rstddev = rstddev + val * val + n = n + 1 + } + + if (n > 0) { + ravg = ravg / n + rstddev = sqrt (rstddev / n - ravg ** 2) + if (vebar) + rstddev = -rstddev + if (n > 1) + rstddev = rstddev * sqrt (n / (n - 1.)) + rmean = rstddev / sqrt (n) + printf ("%8.2f %8.2f %8d %10.4g %10.4g %10.4g\n", + ra, rb, n, ravg, rstddev, rmean) + } + + fd = "" + delete (temp, verify-) +end diff --git a/pkg/proto/rskysub.par b/pkg/proto/rskysub.par new file mode 100644 index 00000000..510f32cf --- /dev/null +++ b/pkg/proto/rskysub.par @@ -0,0 +1,33 @@ +# PARAMETERS FOR THE RUNNING SKY SUBTRACTION TASK + +input,f,a,,,,"List of input images to be sky subtracted" +output,f,a,"",,,"List of output sky subtracted images" +imasks,f,h,"",,,"List of input image masks" +omasks,f,h,"",,,"List of output input image masks" +hmasks,f,h,"",,,"List of output image holes masks\n" + +rescale,b,h,yes,,,"Force recomputation of the scale factors ?" +scale,f,h,"median",,,"The scale factor computation method" +useimasks,b,h,no,,,"Use input masks to compute image statistics" +statsec,s,h,"",,,"Image section used for computing image medians" +lower,r,h,INDEF,,,"Minimum good data value" +upper,r,h,INDEF,,,"Maximum good data value" +maxiter,i,h,20,0,,"Maximum number of clipping iterations" +lnsigrej,r,h,3.0,0,,"Lower side sigma clipping factor" +unsigrej,r,h,3.0,0,,"Upper side sigma clipping factor" +binwidth,r,h,0.1,,,"Histogram bin width in sigma\n" +skyscale,s,h,"SKYSCALE",,,"The scale factor storage keyword" + +resubtract,b,h,yes,,,"Force recomputation and subtraction of sky frame ?" +combine,s,h,average,|average|median|,,"The input image combining method" +ncombine,i,h,6,2,,"The default number of input images to combine" +nmin,i,h,3,2,,"The minimum number of input images to combine" +nlorej,i,h,0,0,,"The number of low side pixels to reject" +nhirej,i,h,0,0,,"The number of high side pixels to reject" +blank,r,h,0.0,,,"Value assigned to undefined output image pixels" +skysub,s,h,"SKYSUB",,,"The output sky subtraction keyword" +holes,s,h,"HOLES",,,"The output sky subtraction keyword\n" + +cache,b,h,yes,,,"Cache images in memory if possible ?" +verbose,b,h,yes,,,"Print messages about the progress of the task ?" + diff --git a/pkg/proto/suntoiraf.par b/pkg/proto/suntoiraf.par new file mode 100644 index 00000000..c074a500 --- /dev/null +++ b/pkg/proto/suntoiraf.par @@ -0,0 +1,6 @@ +names,s,a,,,,Files to convert / images to create +apply_lut,b,h,yes,,,Apply the lookup table for the rasterfile? +delete,b,h,no,,,Delete the raster files after making the images? +verbose,b,h,yes,,,Verbose output? +listonly,b,h,no,,,List the rasterfile headers only? +yflip,b,h,yes,,,Flip the output image top to bottom? diff --git a/pkg/proto/t_binfil.x b/pkg/proto/t_binfil.x new file mode 100644 index 00000000..d2d025e7 --- /dev/null +++ b/pkg/proto/t_binfil.x @@ -0,0 +1,257 @@ +include <imhdr.h> +include <error.h> +include <mach.h> + +# Binary file image transfer utilities -- +# 1. Convert from IRAF image to binary format +# 1. Convert from binary formats to IRAF image + +define LEN_USER_AREA 720 + +# BINFIL -- Convert IRAF image file of shorts to a binary string +# A short header of 90 bytes is prepended and has the +# following elements; +# +# bytes content +# 1-2 nrows +# 3-4 ncols +# 5-6 IRAF pixel type +# 7-26 space set to 0 +# 27-90 header (ASCII) + +procedure t_binfil() + +char ifile[SZ_FNAME], header[64], out_image[SZ_FNAME] +int infile, nfiles, fd, i, file_nr, ncols, nrows, ptype +short space[10], sncols, snrows, sptype +long v1[IM_MAXDIM] +real scale_fact, temp +bool add_header +pointer im, pix, sp, inpix + +int clpopni(), clplen(), clgfil(), open(), imgnlr(), strlen() +real clgetr() +bool clgetb() +pointer immap() + +begin + # Get file names + infile = clpopni ("input") + nfiles = clplen (infile) + + # Get optional scaling factor + scale_fact = clgetr ("scale_fact") + if (scale_fact == 0.0) + scale_fact = 1.0 + + # Should a header string be added? + add_header = clgetb ("header") + + # Zero header spaces + do i = 1, 10 + space[i] = 0 + + # Loop over all images + while (clgfil (infile, ifile, SZ_FNAME) != EOF) { + iferr (im = immap (ifile, READ_ONLY, LEN_USER_AREA)) { + call eprintf ("[%s] not found\n") + call pargstr (ifile) + go to 10 + } + + ncols = IM_LEN (im, 1) + nrows = IM_LEN (im, 2) + ptype = IM_PIXTYPE (im) + + # Pack header characters + call strpak (IM_TITLE(im), header, strlen (IM_TITLE(im))) + + # Create output file name and open it - append ".b" + call sprintf (out_image, SZ_FNAME, "%s.b") + call pargstr (ifile) + call printf ("%s --> %s\n") + call pargstr (ifile) + call pargstr (out_image) + call flush (STDOUT) + + file_nr = file_nr + 1 + + fd = open (out_image, NEW_FILE, BINARY_FILE) + + # Write header parameters + if (add_header) { + sncols = ncols + snrows = nrows + sptype = ptype + call write (fd, sncols, SZ_SHORT/SZ_CHAR) + call write (fd, snrows, SZ_SHORT/SZ_CHAR) + call write (fd, sptype, SZ_SHORT/SZ_CHAR) + call write (fd, space, 10 * SZ_SHORT/SZ_CHAR) + call write (fd, header, 64 / SZB_CHAR) + } + + call smark (sp) + call salloc (pix, ncols, TY_SHORT) + + # Access pixels and write them out for each row + call amovkl (long(1), v1, IM_MAXDIM) + while (imgnlr (im, inpix, v1) != EOF) { + do i = 1, ncols { + temp = Memr[inpix+i-1] * scale_fact + + if (temp > MAX_SHORT) + temp = MAX_SHORT + else if (temp < -(MAX_SHORT)) + temp = -MAX_SHORT + + Mems[pix+i-1] = temp + } + + call write (fd, Mems[pix], ncols * SZ_SHORT/SZ_CHAR) + + } + call close (fd) + call sfree (sp) + + call imunmap (im) +10 ; + } +end + +# IRAFIL -- Convert 16 or 8-bit binary string to IRAF image file + +procedure t_irafil() + +char ifile[SZ_FNAME], out_image[SZ_FNAME] +int infile, nfiles, fd, i, j, file_nr, ncols, nrows, ptype, krow +int nr_bits, nr_chars, nr_skip, nc_skip, ival +long offset +bool flip, sign16 +pointer im, pix, sp, temp, opix, sp1, hdr, src + +int clpopni(), clplen(), clgfil(), clgeti() +int open(), read() +bool clgetb() +pointer immap(), impl2s(), impl2l() + +begin + # Get file names + infile = clpopni ("input") + nfiles = clplen (infile) + + # Get image dimensions + nrows = clgeti ("nrows") + ncols = clgeti ("ncols") + + # Is input string of data 8 or 16 bits? + nr_bits = clgeti ("bits") + if (nr_bits != 8 && nr_bits != 16) + call error (0, "Must be 8 or 16 bits") + + # Is bit 16 to be used as a sign bit? + if (nr_bits == 16) { + sign16 = clgetb ("signed") + offset = 65536 + } else { + sign16 = true + offset = 256 + } + + # Should image be top-bottom flipped? + # For some input images (e.g. Compaq 286 display) this is + # needed to make SNAPS look correct. + flip = clgetb ("tb_flip") + + # Header info can be skipped if number of bytes is given + nr_skip = clgeti ("skip") + + # Loop over all images + while (clgfil (infile, ifile, SZ_FNAME) != EOF) { + iferr (fd = open (ifile, READ_ONLY, BINARY_FILE)) { + call eprintf ("cannot open %s\n") + call pargstr (ifile) + go to 10 + } + + if (sign16) + ptype = TY_SHORT + else + ptype = TY_LONG + + # Create output file name and open it - append ".i" + call sprintf (out_image, SZ_FNAME, "%s.i") + call pargstr (ifile) + file_nr = file_nr + 1 + call printf ("%s --> %s\n") + call pargstr (ifile) + call pargstr (out_image) + call flush (STDOUT) + + im = immap (out_image, NEW_IMAGE, 0) + IM_NDIM (im) = 2 + IM_LEN (im, 1) = ncols + IM_LEN (im, 2) = nrows + IM_PIXTYPE (im) = ptype + + call smark (sp) + call salloc (pix, ncols, TY_SHORT) + call salloc (temp, ncols, TY_SHORT) + + # Skip over header pixels if any + nc_skip = nr_skip / 2 + if (nr_skip > 0) { + call smark (sp1) + call salloc (hdr, nc_skip, TY_SHORT) + if (read (fd, Mems[hdr], nc_skip) != EOF) + ; + call sfree (sp1) + } + + # Access pixels and write them out for each row + nr_chars = ncols * nr_bits / 8 / 2 + do i = 1, nrows { + iferr (nc_skip = read (fd, Mems[pix], nr_chars)) + call amovks (0, Mems[pix], nr_chars) + else { + if (nr_bits == 8) { + call chrupk (Mems[pix], 1, Mems[temp], 1, ncols) + src = temp + } else + src = pix + } + + # Provide top-bottom flip for special image formats + if (flip) + krow = nrows-i+1 + else + krow = i + + # Select proper pointer type + if (sign16) + opix = impl2s (im, krow) + else + opix = impl2l (im, krow) + + # Transfer all pixels, correcting for signed/unsigned data + do j = 1, ncols { + ival = Mems[src+j-1] + if (sign16) { + if (nr_bits == 8 && ival < 0) + Mems[opix+j-1] = ival + offset + else + Mems[opix+j-1] = ival + } else { + if (ival < 0) + Meml[opix+j-1] = ival + offset + else + Meml[opix+j-1] = ival + } + } + } + + call sfree (sp) + call close (fd) + call imunmap (im) +10 ; + } +end diff --git a/pkg/proto/t_bscale.x b/pkg/proto/t_bscale.x new file mode 100644 index 00000000..c3133454 --- /dev/null +++ b/pkg/proto/t_bscale.x @@ -0,0 +1,581 @@ +include <imhdr.h> +include <error.h> +include <ctype.h> +include <mach.h> + +define OPTIONS "|mean|median|mode|" +define MEAN 1 # mean of image +define MEDIAN 2 # median of image +define MODE 3 # mode of image + +define BINWIDTH 0.1 # bin width (in sigmas) for mode +define BINSEP 0.01 # bin separation (in sigmas) for mode + +# T_BSCALE -- Linearly transform the intensity scales of a list of images +# using the following expression. +# +# out = (in - bzero) / bscale + +procedure t_bscale () + +pointer inlist # list of input images +pointer outlist # list of output images +real bzero # zero point +real bscale # scale factor +real lower # lower limit for mean, median, or mode computation +real upper # upper limit for mean, median, or mode computation +pointer section # image section for statistics +int step # default sample step +int verbose # verbose mode + +double temp +int i, bz, bs +real mean, median, mode, sigma, tlower, tupper +pointer sp, str, image1, image2, imtemp, inim, outim + +bool clgetb() +int btoi(), imtopenp(), strdic(), gctod(), clgeti(), imtgetim(), imtlen() +pointer immap() +real clgetr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, 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 (section, SZ_FNAME, TY_CHAR) + + # Open the input and output image lists. + inlist = imtopenp ("input") + outlist = imtopenp ("output") + if (imtlen(inlist) != imtlen(outlist)) { + call sfree (sp) + call imtclose (inlist) + call imtclose (outlist) + call error (0, "Length of input and output lists not equal.") + } + + # Get the zero point algorithm. + call clgstr ("bzero", Memc[str], SZ_LINE) + bz = strdic (Memc[str], Memc[str], SZ_LINE, OPTIONS) + if (bz == 0) { + i = 1 + if (gctod (Memc[str], i, temp) == 0) + call error (0, "Invalid `bzero' parameter") + bzero = temp + } + + # Get the scale algorithm. + call clgstr ("bscale", Memc[str], SZ_LINE) + bs = strdic (Memc[str], Memc[str], SZ_LINE, OPTIONS) + if (bs == 0) { + i = 1 + if (gctod (Memc[str], i, temp) == 0) + call error (0, "Invalid `bscale' parameter") + bscale = temp + } + + # Get the section to be used for statistics computation. + call clgstr ("section", Memc[section], SZ_FNAME) + step = max (1, clgeti ("step")) + + # Get the upper and lower good data limits. + lower = clgetr ("lower") + if (IS_INDEFR(lower)) + tlower = -MAX_REAL + else + tlower = lower + upper = clgetr ("upper") + if (IS_INDEFR(upper)) + tupper = MAX_REAL + else + tupper = upper + + verbose = btoi (clgetb ("verbose")) + + # Loop over the input and output image lists. + while ((imtgetim (inlist, Memc[image1], SZ_FNAME) != EOF) && + (imtgetim (outlist, Memc[image2], SZ_FNAME) != EOF)) { + + # Open the input and output images. + call xt_mkimtemp (Memc[image1], Memc[image2], Memc[imtemp], + SZ_FNAME) + iferr (inim = immap (Memc[image1], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + iferr (outim = immap (Memc[image2], NEW_COPY, inim)) { + call imunmap (inim) + call erract (EA_WARN) + next + } + + # Compute the required statistics. + if ((bz != 0) || (bs != 0)) + call bs_imstats (inim, Memc[section], step, BINWIDTH, BINSEP, + mean, median, mode, sigma, tupper, tlower) + else { + mean = INDEF + median = INDEF + mode = INDEF + } + + switch (bz) { + case MODE: + bzero = mode + case MEAN: + bzero = mean + case MEDIAN: + bzero = median + } + + switch (bs) { + case MODE: + bscale = mode + case MEAN: + bscale = mean + case MEDIAN: + bscale = median + } + + # Log the output. + if (verbose == YES) { + call bs_log (Memc[image1], Memc[imtemp], mean, median, mode, + bzero, bscale, upper, lower) + call flush (STDOUT) + } + + # Scale the image. + call bs_scale (inim, outim, bzero, bscale) + + call imunmap (inim) + call imunmap (outim) + call xt_delimtemp (Memc[image2], Memc[imtemp]) + } + + call imtclose (inlist) + call imtclose (outlist) + call sfree (sp) +end + + +# BSCALE -- Scale the image brightness. + +procedure bs_scale (inim, outim, bzero, bscale) + +pointer inim # pointer to the input image +pointer outim # pointer to the output image +real bzero # zero point +real bscale # scale + +int nc +long v1[IM_MAXDIM], v2[IM_MAXDIM] +real bz, bs + +pointer in, out +int imgnlr(), impnlr(), imgnlx(), impnlx(), imgnld(), impnld() + +begin + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + bz = -bzero + bs = 1. / bscale + nc = IM_LEN(inim,1) + + switch (IM_PIXTYPE(inim)) { + case TY_DOUBLE : + while ((imgnld (inim, in, v1) != EOF) && (impnld (outim, + out, v2) != EOF)) + call altad (Memd[in], Memd[out], nc, double(bz), double(bs)) + + case TY_COMPLEX: + while ((imgnlx (inim, in, v1) != EOF) && (impnlx (outim, + out, v2) != EOF)) + call altax (Memx[in], Memx[out], nc, bz, bs) + + default: + while ((imgnlr (inim, in, v1) != EOF) && (impnlr (outim, + out, v2) != EOF)) + call altar (Memr[in], Memr[out], nc, bz, bs) + } +end + + +# BS_LOG -- Log the scaling operation. + +procedure bs_log (image1, image2, mean, median, mode, bzero, bscale, upper, + lower) + +char image1[ARB] # input image name +char image2[ARB] # output image name +real mean # input image mean +real median # input image median +real mode # input image mode +real bzero, bscale # the computed scale values +real upper # upper limit for mean +real lower # lower limit for mean + +begin + call printf ("%s -> %s using bzero: %g and bscale: %g\n") + call pargstr (image1) + call pargstr (image2) + call pargr (bzero) + call pargr (bscale) + + if (! IS_INDEF(mean)) { + call printf (" mean: %g median: %g mode: %g ") + call pargr (mean) + call pargr (median) + call pargr (mode) + call printf (" upper: %g lower: %g\n") + call pargr (upper) + call pargr (lower) + } +end + + +# BS_IMSTATS -- Compute the image statistics within a section of an image. +# This routine parses the image section and samples the image. The actual +# statistics are evaluated by BS_STATS. + +procedure bs_imstats (im, section, step, binwidth, binsep, mean, median, mode, + sigma, upper, lower) + +pointer im # input image +char section[ARB] # sample section +int step # default sample step +real binwidth # bin width +real binsep # separation between bins +real mean # mean +real median # median +real mode # mode +real sigma # sigma +real upper # upper limit for statistics +real lower # lower limit for statistics + +int i, n, nx, ndim +pointer sp, x1, x2, xs, v, v1, dv, data, ptr1, ptr2 +int imgnlr() + +begin + call smark (sp) + call salloc (x1, IM_MAXDIM, TY_INT) + call salloc (x2, IM_MAXDIM, TY_INT) + call salloc (xs, IM_MAXDIM, TY_INT) + call salloc (v, IM_MAXDIM, TY_LONG) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + + # Initialize the section. + ndim = IM_NDIM(im) + do i = 1, ndim { + Memi[x1+i-1] = 1 + Memi[x2+i-1] = IM_LEN(im,i) + Memi[xs+i-1] = 0 + } + + # Parse the sample section. + call bs_section (section, Memi[x1], Memi[x2], Memi[xs], ndim) + + # Check the step sizes. + do i = 1, ndim { + if (Memi[xs+i-1] == 0) + Memi[xs+i-1] = step + } + + # Define the region of the image to be extracted. + n = 1 + do i = 1, ndim { + nx = (Memi[x2+i-1] - Memi[x1+i-1]) / Memi[xs+i-1] + 1 + Meml[v+i-1] = Memi[x1+i-1] + if (nx == 1) + Meml[dv+i-1] = 1 + else + Meml[dv+i-1] = (Memi[x2+i-1] - Memi[x1+i-1]) / (nx - 1) + n = n * nx + } + + # Accumulate the pixel values within the section. + call salloc (data, n, TY_REAL) + Meml[v] = 1 + ptr1 = data + call amovl (Meml[v], Meml[v1], IM_MAXDIM) + while (imgnlr (im, ptr2, Meml[v1]) != EOF) { + + ptr2 = ptr2 + Memi[x1] - 1 + do i = Memi[x1], Memi[x2], Meml[dv] { + Memr[ptr1] = Memr[ptr2] + ptr1 = ptr1 + 1 + ptr2 = ptr2 + Meml[dv] + } + + for (i=2; i<=ndim; i=i+1) { + Meml[v+i-1] = Meml[v+i-1] + Meml[dv+i-1] + if (Meml[v+i-1] <= Memi[x2+i-1]) + break + Meml[v+i-1] = Memi[x1+i-1] + } + + if (i > ndim) + break + + call amovl (Meml[v], Meml[v1], IM_MAXDIM) + } + + # Compute the statistics. + call bs_stats (Memr[data], n, binwidth, binsep, mean, median, mode, + sigma, upper, lower) + + call sfree (sp) +end + + +# BS_STATS -- Compute the vector statistics. +# +# 1. Sort the data +# 2. Exclude the extreme points +# 3. The median is at the midpoint of the sorted data +# 4. Compute the mean +# 5. Compute the sigmas about the mean +# 6. Scale the bin width and separations by the sigma +# 7. Find the mode over all the bins (which may overlap) + +procedure bs_stats (data, npts, binwidth, binsep, mean, median, mode, sigma, + upper, lower) + +real data[npts] # sata array which will be sorted. +int npts # number of data points +real binwidth # bin width +real binsep # separation between bins +real mean # mean +real median # median +real mode # mode +real sigma # sigma +real upper # upper limit for mean +real lower # lower limit for mean + +int x1, x2, x3, n, nmax +real width, sep, y1, y2 +int bs_awvgr() + +begin + # Initialize. + if (npts <= 0) { + mean = INDEFR + median = INDEFR + mode = INDEFR + sigma = INDEFR + return + } + + # Sort the data. + call asrtr (data, data, npts) + + # Find the array indices for the lower and upper data bounds. + x1 = 1 + while (data[x1] < lower) + x1 = x1 + 1 + x3 = npts + while (data[x3] > upper) + x3 = x3 - 1 + + # Assign number of elements within the bounds. + n = x3 - x1 + 1 + + # Compute the median. + median = data[x1 + n/2 - 1] + mode = median + + # Compute the mean and sigma. + if (bs_awvgr (data[x1], n, mean, sigma, 0.0, 0.0) <= 0) + return + + # Check for no dispersion in the data. + if (sigma <= 0.0) + return + + width = binwidth * sigma + sep = binsep * sigma + + # Compute the mode. + nmax = 0 + x2 = x1 + for (y1 = data[x1]; x2 < x3; y1 = y1 + sep) { + for (; data[x1] < y1; x1 = x1 + 1) + ; + y2 = y1 + width + for (; (x2 < x3) && (data[x2] < y2); x2 = x2 + 1) + ; + if (x2 - x1 > nmax) { + nmax = x2 - x1 + mode = data[(x2+x1)/2] + } + } +end + + +# BS_AWVGR -- Compute the mean and standard deviation (sigma) of a sample. +# Pixels whose value lies outside the specified lower and upper limits are +# not used. If the upper and lower limits have the same value (e.g., zero), +# no limit checking is performed. The number of pixels in the sample is +# returned as the function value. + +int procedure bs_awvgr (a, npix, mean, sigma, lcut, hcut) + +real a[ARB] # input array of data +int npix # the number of data points +real mean # the computed mean +real sigma # the computed standard deviation +real lcut, hcut # lower and upper cutoff for statistics calculation + +int i, ngpix +real value, sum, sumsq, temp + +begin + sum = 0.0 + sumsq = 0.0 + ngpix = 0 + + # Accumulate sum, sum of squares. The test to disable limit checking + # requires numerical equality of two floating point numbers; this + # should be ok since they are used as flags not as numbers (they are + # not used in computations). + + if (hcut == lcut) { + do i = 1, npix { + value = a[i] + sum = sum + value + sumsq = sumsq + value ** 2 + } + ngpix = npix + + } else { + do i = 1, npix { + value = a[i] + if (value >= lcut && value <= hcut) { + ngpix = ngpix + 1 + sum = sum + value + sumsq = sumsq + value ** 2 + } + } + } + + switch (ngpix) { # compute mean and sigma + case 0: + mean = INDEFR + sigma = INDEFR + case 1: + mean = sum + sigma = INDEFR + default: + mean = sum / ngpix + temp = (sumsq - mean * sum) / (ngpix - 1) + if (temp <= 0.0) + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngpix) +end + + +# BS_SECTION -- Parse an image section into its elements. +# +# 1. The default values must be set by the caller. +# 2. A null image section is OK. +# 3. The first nonwhitespace character must be '['. +# 4. The last interpreted character must be ']'. +# +# This procedure should be replaced with an IMIO procedure at some point. + +procedure bs_section (section, x1, x2, xs, ndim) + +char section[ARB] # Image section +int x1[ndim] # Starting pixel +int x2[ndim] # Ending pixel +int xs[ndim] # Step size in pixels +int ndim # Number of dimensions + +int i, ip, a, b, c, temp, ctoi() +define error_ 99 + +begin + # Decode the section string. + ip = 1 + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == '[') + ip = ip + 1 + else if (section[ip] == EOS) + return + else + goto error_ + + do i = 1, ndim { + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ']') + break + + # Default values + a = x1[i] + b = x2[i] + c = xs[i] + + # Get a:b:c. Allow notation such as "-*:c" + # (or even "-:c") where the step is obviously negative. + + if (ctoi (section, ip, temp) > 0) { # a + a = temp + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, b) == 0) # a:b + goto error_ + } else + b = a + c = 1 + } else if (section[ip] == '-') { # -* + temp = a + a = b + b = temp + c = 1 + ip = ip + 1 + if (section[ip] == '*') + ip = ip + 1 + } else if (section[ip] == '*') { # * + c = 1 + ip = ip + 1 + } + + if (section[ip] == ':') { # :step + ip = ip + 1 + if (ctoi (section, ip, c) == 0) + goto error_ + else if (c == 0) + goto error_ + } + + if ((a > b) && (c > 0)) + c = -c + + x1[i] = a + x2[i] = b + xs[i] = c + + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ',') + ip = ip + 1 + } + + if (section[ip] != ']') + goto error_ + + return +error_ + call error (0, "Error in image section specification") +end diff --git a/pkg/proto/t_fixpix.x b/pkg/proto/t_fixpix.x new file mode 100644 index 00000000..21387794 --- /dev/null +++ b/pkg/proto/t_fixpix.x @@ -0,0 +1,154 @@ +include <error.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> + + +# T_FIXPIX -- Interpolate over bad columns and lines. + +procedure t_fixpix () + +int ilist # List of images +int mlist # List of masks +int linterp # Mask code for line interpolation +int cinterp # Mask code for column interpolation +bool verbose # Verbose output? +int fd # List pixels? + +int i, nc, nl +long v[IM_MAXDIM] +pointer sp, imname, pmname, str1, str2, im, pmim, pm, fp, buf, tmp + +bool clgetb(), pm_linenotempty() +int imtopenp(), imtgetim(), imtlen(), clgeti(), imaccf(), imstati() +long clktime() +pointer immap(), yt_pmmap(), xt_fpinit() +pointer xt_fps(), xt_fpi(), xt_fpl(), xt_fpr(), xt_fpd() +pointer impl2s(), impl2i(), impl2l(), impl2r(), impl2d() +errchk immap, yt_pmmap, xt_fpinit + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (pmname, SZ_FNAME, TY_CHAR) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + # Get task parameters + ilist = imtopenp ("images") + mlist = imtopenp ("masks") + linterp = clgeti ("linterp") + cinterp = clgeti ("cinterp") + verbose = clgetb ("verbose") + if (verbose && clgetb ("pixels")) + fd = STDOUT + else + fd = NULL + + i = imtlen (mlist) + if (i == 0 || (i > 1 && i != imtlen (ilist))) { + call imtclose (ilist) + call imtclose (mlist) + call sfree (sp) + call error (1, "Image and mask lists are incompatible") + } + if (!IS_INDEFI(linterp) && !IS_INDEFI(cinterp) && + linterp>0 && linterp==cinterp) { + call imtclose (ilist) + call imtclose (mlist) + call sfree (sp) + call error (1, "Interpolation codes are the same") + } + + # Fix the pixels. + while (imtgetim (ilist, Memc[imname], SZ_FNAME) != EOF) { + if (imtgetim (mlist, Memc[pmname], SZ_FNAME) == EOF) { + call imtrew (mlist) + if (imtgetim (mlist, Memc[pmname], SZ_FNAME) == EOF) + call error (1, "Error in mask list") + } + iferr { + im = NULL + pmim = NULL + fp = NULL + tmp = immap (Memc[imname], READ_WRITE, 0) + im = tmp + tmp = yt_pmmap (Memc[pmname], im, Memc[pmname], SZ_FNAME); + pmim = tmp + pm = imstati (pmim, IM_PMDES) + + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + tmp= xt_fpinit (pm, linterp, cinterp) + fp = tmp + + if (verbose || fd != NULL) { + call printf ("FIXPIX: image %s with mask %s\n") + call pargstr (Memc[imname]) + call pargstr (Memc[pmname]) + call flush (STDOUT) + } + + call amovkl (long(1), v, IM_MAXDIM) + if (fp != NULL) { + do i = 1, nl { + v[2] = i + if (!pm_linenotempty (pm, v)) + next + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + tmp = xt_fps (fp, im, i, fd) + buf = impl2s (im, i) + call amovs (Mems[tmp], Mems[buf], nc) + case TY_INT: + tmp = xt_fpi (fp, im, i, fd) + buf = impl2i (im, i) + call amovi (Memi[tmp], Memi[buf], nc) + case TY_USHORT, TY_LONG: + tmp = xt_fpl (fp, im, i, fd) + buf = impl2l (im, i) + call amovl (Meml[tmp], Meml[buf], nc) + case TY_REAL, TY_COMPLEX: + tmp = xt_fpr (fp, im, i, fd) + buf = impl2r (im, i) + call amovr (Memr[tmp], Memr[buf], nc) + case TY_DOUBLE: + tmp = xt_fpd (fp, im, i, fd) + buf = impl2d (im, i) + call amovd (Memd[tmp], Memd[buf], nc) + } + } + } + + # Add log to header. + call cnvdate (clktime(0), Memc[str2], SZ_LINE) + call sprintf (Memc[str1], SZ_LINE, "%s Bad pixel file is %s") + call pargstr (Memc[str2]) + call pargstr (Memc[pmname]) + if (imaccf (im, "FIXPIX") == NO) + call imastr (im, "FIXPIX", Memc[str1]) + else { + do i = 2, 99 { + call sprintf (Memc[str2], SZ_LINE, "FIXPIX%02d") + call pargi (i) + if (imaccf (im, Memc[str2]) == NO) { + call imastr (im, Memc[str2], Memc[str1]) + break + } + } + } + } then + call erract (EA_WARN) + + if (fp != NULL) + call xt_fpfree (fp) + if (pmim != NULL) + call xt_pmunmap (pmim) + if (im != NULL) + call imunmap (im) + } + + call imtclose (ilist) + call imtclose (mlist) + call sfree (sp) +end diff --git a/pkg/proto/t_hfix.x b/pkg/proto/t_hfix.x new file mode 100644 index 00000000..fb75b2e2 --- /dev/null +++ b/pkg/proto/t_hfix.x @@ -0,0 +1,140 @@ +include <error.h> +include <imio.h> +include <imhdr.h> +include <ctype.h> + +define IS_FITS (IS_DIGIT($1)||IS_UPPER($1)||($1=='-')||($1=='_')) + +# T_HFIX -- Fix image headers +# +# Fix image headers using a user supplied command. +# This task is a prototype which directly accesses the user header block +# and uses CLCMDW. + +procedure t_hfix () + +int images # List of images to be fixed +pointer cmd # Fix command +bool update # Update image header + +int mode, reclen +pointer sp, image, efile, ecmd, eline +pointer im, ua, fd, hd, ip, jp, kp + +int imtopenp(), imtgetim(), stridxs(), open(), stropen() +int getline(), gstrcpy() +bool clgetb() +pointer immap() +errchk open, clcmdw + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (cmd,SZ_LINE, TY_CHAR) + call salloc (efile, SZ_FNAME, TY_CHAR) + call salloc (ecmd, SZ_LINE, TY_CHAR) + call salloc (eline, SZ_LINE, TY_CHAR) + + # Get task parameters and set update mode + images = imtopenp ("images") + call clgstr ("command", Memc[cmd], SZ_LINE) + update = clgetb ("update") + if (update) + mode = READ_WRITE + else + mode = READ_ONLY + + # Fix the image headers. + while (imtgetim (images, Memc[image], SZ_FNAME) != EOF) { + iferr (im = immap (Memc[image], mode, NULL)) { + call erract (EA_WARN) + next + } + + # Determine header blocking + ua = IM_USERAREA(im) + reclen = stridxs ("\n", Memc[ua]) - 1 + if (IM_UABLOCKED(im) < 0) { + if (reclen == 80) + IM_UABLOCKED(im) = YES + else + IM_UABLOCKED(im) = NO + } + + # Create a temporary file and copy the user area into it + call mktemp ("tmp", Memc[efile], SZ_FNAME) + fd = open (Memc[efile], NEW_FILE, TEXT_FILE) + hd = stropen (Memc[ua], ARB, READ_ONLY) + call fcopyo (hd, fd) + call close (fd) + call close (hd) + + # Expand the user command + jp = ecmd + for (ip=cmd; Memc[ip]!=EOS; ip=ip+1) { + if (Memc[ip] == '$') { + if (Memc[ip+1] == 'i') { + for (kp=image; Memc[kp]!=EOS; kp=kp+1) { + Memc[jp] = Memc[kp] + jp = jp + 1 + } + ip = ip + 5 + } else { + for (kp=efile; Memc[kp]!=EOS; kp=kp+1) { + Memc[jp] = Memc[kp] + jp = jp + 1 + } + ip = ip + 5 + } + } else { + Memc[jp] = Memc[ip] + jp = jp + 1 + } + } + Memc[jp] = EOS + + iferr { + # Fix the header with the user command + call clcmdw (Memc[ecmd]) + + if (update) { + # Copy the fixed header back into the user area, reblocking + # where necessary. Skip non-FITS lines. + + kp = ua + fd = open (Memc[efile], READ_ONLY, TEXT_FILE) + while (getline (fd, Memc[eline]) != EOF) { + for (ip=eline; IS_WHITE(Memc[ip]); ip=ip+1) + ; + for (jp=ip; IS_FITS(Memc[jp]); jp=jp+1) + ; + for (; jp<ip+8 && Memc[jp]==' '; jp=jp+1) + ; + if (jp<ip+8 && Memc[jp] != EOS && Memc[jp] != '\n') + next + if (Memc[jp] == '=' && Memc[jp+1] != ' ') + next + for (; jp<ip+80 && Memc[jp]!=EOS && Memc[jp]!='\n'; + jp=jp+1) + ; + if (IM_UABLOCKED(im) == YES) + for (; jp<ip+reclen; jp=jp+1) + Memc[jp] = ' ' + Memc[jp] = '\n' + Memc[jp+1] = EOS + kp = kp + gstrcpy(Memc[ip], Memc[kp], SZ_LINE) + } + Memc[kp] = EOS + + call close (fd) + } + call delete (Memc[efile]) + } then + call erract (EA_WARN) + + call imunmap (im) + } + + call imtclose (images) + call sfree (sp) +end diff --git a/pkg/proto/t_imcntr.x b/pkg/proto/t_imcntr.x new file mode 100644 index 00000000..ac611d7f --- /dev/null +++ b/pkg/proto/t_imcntr.x @@ -0,0 +1,198 @@ +include <imhdr.h> + + +# T_IMCNTR -- Find the center of a star image given approximate coords. Uses +# Mountain Photometry Code Algorithm as outlined in Stellar Magnitudes from +# Digital Images. + +procedure t_imcntr() + +char ifile[SZ_FNAME] +int infile, nfiles + +real xinit, yinit, xcntr, ycntr +int cboxsize +pointer im + +int imtopenp (), imtlen(), imtgetim() +int clgeti() +real clgetr() +pointer immap() + +begin + # Get file names + infile = imtopenp ("input") + nfiles = imtlen (infile) + + # Get x and y initial + xinit = clgetr ("x_init") + yinit = clgetr ("y_init") + + # Get box size to use + cboxsize = clgeti ("cboxsize") + + # Loop over all images + while (imtgetim (infile, ifile, SZ_FNAME) != EOF) { + iferr (im = immap (ifile, READ_ONLY, 0)) { + call eprintf ("[%s] not found\n") + call pargstr (ifile) + next + } + + call mpc_cntr (im, xinit, yinit, cboxsize, xcntr, ycntr) + + call printf ("[%s] x: %8.3f y: %8.3f\n") + call pargstr (ifile) + call pargr (xcntr) + call pargr (ycntr) + + call imunmap (im) + } + + call imtclose (infile) +end + + +# MPC_CNTR -- Compute star center using MPC algorithm. + +procedure mpc_cntr (im, xstart, ystart, boxsize, xcntr, ycntr) + +pointer im +real xstart, ystart +int boxsize +real xcntr, ycntr + +int x1, x2, y1, y2, half_box +int ncols, nrows, nx, ny, try +real xinit, yinit +pointer bufptr, sp, x_vect, y_vect +int imgs2r() + +begin + half_box = (boxsize - 1) / 2 + xinit = xstart + yinit = ystart + + # Mark region to extract - use box size + ncols = IM_LEN (im, 1) + nrows = IM_LEN (im, 2) + try = 0 + + repeat { + x1 = amax1 (xinit - half_box, 1.0) +0.5 + x2 = amin1 (xinit + half_box, real(ncols)) +0.5 + y1 = amax1 (yinit - half_box, 1.0) +0.5 + y2 = amin1 (yinit + half_box, real(nrows)) +0.5 + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + + # Extract region around center + bufptr = imgs2r (im, x1, x2, y1, y2) + + # Collapse to two 1-D arrays + call smark (sp) + call salloc (x_vect, nx, TY_REAL) + call salloc (y_vect, ny, TY_REAL) + + call aclrr (Memr[x_vect], nx) + call aclrr (Memr[y_vect], ny) + + # Sum all rows + call mpc_rowsum (Memr[bufptr], Memr[x_vect], nx, ny) + + # Sum all columns + call mpc_colsum (Memr[bufptr], Memr[y_vect], nx, ny) + + # Find centers + call mpc_getcenter (Memr[x_vect], nx, xcntr) + call mpc_getcenter (Memr[y_vect], ny, ycntr) + call sfree (sp) + + # Check for INDEF centers. + if (IS_INDEFR(xcntr) || IS_INDEFR(ycntr)) { + xcntr = xinit + ycntr = yinit + break + } + + # Add in offsets + xcntr = xcntr + x1 + ycntr = ycntr + y1 + + try = try + 1 + if (try == 1) { + if ((abs(xcntr-xinit) > 1.0) || (abs(ycntr-yinit) > 1.0)) { + xinit = xcntr + yinit = ycntr + } + } else + break + } +end + + +# ROWSUM -- Sum all rows in a raster + +procedure mpc_rowsum (v, row, nx, ny) + +int nx, ny +real v[nx,ny] +real row[ARB] + +int i, j + +begin + do i = 1, ny + do j = 1, nx + row[j] = row[j] + v[j,i] +end + + +# COLSUM -- Sum all columns in a raster. + +procedure mpc_colsum (v, col, nx, ny) + +int nx, ny +real v[nx,ny] +real col[ARB] + +int i, j + +begin + do i = 1, ny + do j = 1, nx + col[j] = col[j] + v[i,j] +end + + +# GETCENTER -- Compute center of gravity of array. + +procedure mpc_getcenter (v, nv, vc) + +real v[ARB] +int nv +real vc + +int i +real sum1, sum2, sigma, cont + +begin + # Assume continuum level is at endpoints + # Compute first moment + sum1 = 0.0 + sum2 = 0.0 + + call aavgr (v, nv, cont, sigma) + + do i = 1, nv + if (v[i] > cont) { + sum1 = sum1 + (i-1) * (v[i] - cont) + sum2 = sum2 + (v[i] - cont) + } + + # Determine center + if (sum2 == 0.0) + vc = INDEFR + else + vc = sum1 / sum2 +end diff --git a/pkg/proto/t_imext.x b/pkg/proto/t_imext.x new file mode 100644 index 00000000..7400a57c --- /dev/null +++ b/pkg/proto/t_imext.x @@ -0,0 +1,93 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define OUTPUTS "|none|list|file|" +define NONE 1 # No output +define LIST 2 # List output +define FILE 3 # File output + +define SZ_LIST 10240 # Size of expanded list +define SZ_LISTOUT 255 # Size of output list + + +# T_IMEXTENSIONS -- Expand a template of FITS files into a list of image +# extensions on the standard output and record the number image extensions +# in a parameter. + +procedure t_imextensions() + +pointer input # List of ME file names +int output # Output list (none|list|file) +pointer index # Range list of extension indexes +pointer extname # Pattern for extension names +pointer extver # Range list of extension versions +int lindex # List index number? +int lname # List extension name? +int lver # List extension version? +pointer ikparams # Image kernel parameters + +pointer sp, image, listout +int list, nimages, fd +int clgwrd(), btoi(), xt_imextns(), imtgetim(), imtlen(), stropen() +bool clgetb() +errchk stropen, fprintf, strclose + +begin + call smark (sp) + call salloc (input, SZ_LINE, TY_CHAR) + call salloc (index, SZ_LINE, TY_CHAR) + call salloc (extname, SZ_LINE, TY_CHAR) + call salloc (extver, SZ_LINE, TY_CHAR) + call salloc (ikparams, SZ_LINE, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + + # Task parameters + call clgstr ("input", Memc[input], SZ_LINE) + output = clgwrd ("output", Memc[image], SZ_FNAME, OUTPUTS) + call clgstr ("index", Memc[index], SZ_LINE) + call clgstr ("extname", Memc[extname], SZ_LINE) + call clgstr ("extver", Memc[extver], SZ_LINE) + lindex = btoi (clgetb ("lindex")) + lname = btoi (clgetb ("lname")) + lver = btoi (clgetb ("lver")) + call clgstr ("ikparams", Memc[ikparams], SZ_LINE) + + # Get the list. + list = xt_imextns (Memc[input], Memc[index], Memc[extname], + Memc[extver], lindex, lname, lver, Memc[ikparams], YES) + + # Format the output and set the number of images. + switch (output) { + case LIST: + call salloc (listout, SZ_LISTOUT, TY_CHAR) + iferr { + fd = stropen (Memc[listout], SZ_LISTOUT, WRITE_ONLY) + nimages = 0 + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + nimages = nimages + 1 + if (nimages == 1) { + call fprintf (fd, "%s") + call pargstr (Memc[image]) + } else { + call fprintf (fd, ",%s") + call pargstr (Memc[image]) + } + } + call strclose (fd) + call printf ("%s\n") + call pargstr (Memc[listout]) + } then { + call imtclose (list) + call sfree (sp) + call error (1, "Output list format is too long") + } + case FILE: + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + call printf ("%s\n") + call pargstr (Memc[image]) + } + } + call clputi ("nimages", imtlen (list)) + + call imtclose (list) + call sfree (sp) +end diff --git a/pkg/proto/t_imscale.x b/pkg/proto/t_imscale.x new file mode 100644 index 00000000..1a6f655b --- /dev/null +++ b/pkg/proto/t_imscale.x @@ -0,0 +1,151 @@ +include <mach.h> +include <imhdr.h> + +# T_IMSCALE -- Scale an image. +# +# Compute the image mean between the upper and lower limits and +# scale the image to a new mean. The output image is of pixel type real. + +procedure t_imscale () + +char input[SZ_FNAME] # Input image +char output[SZ_FNAME] # Output image +real mean # Output mean +real lower # Lower limit for mean +real upper # Upper limit for mean +bool verbose # Verbose output? + +int i +long line_in[IM_MAXDIM], line_out[IM_MAXDIM] +real mean_in, scale +pointer in, out, data_in, data_out + +int imgnlr(), impnlr() +real clgetr(), image_mean() +bool clgetb() +pointer immap() + +begin + # Access images and set parameters. + call clgstr ("input", input, SZ_FNAME) + in = immap (input, READ_WRITE, 0) + call clgstr ("output", output, SZ_FNAME) + out = immap (output, NEW_COPY, in) + mean = clgetr ("mean") + lower = clgetr ("lower") + if (IS_INDEFR (lower)) + lower = -MAX_REAL + upper = clgetr ("upper") + if (IS_INDEFR (upper)) + upper = MAX_REAL + verbose = clgetb ("verbose") + + # Set output pixel type to TY_REAL. + IM_PIXTYPE(out) = TY_REAL + + # Find the image mean and rescaling. + mean_in = image_mean (in, lower, upper) + scale = mean / mean_in + + # Create the output image. + call amovkl (long(1), line_in, IM_MAXDIM) + call amovkl (long(1), line_out, IM_MAXDIM) + + # Loop through the image lines and rescale. + while (impnlr (out, data_out, line_out) != EOF) { + i = imgnlr (in, data_in, line_in) + call amulkr (Memr[data_in], scale, Memr[data_out], IM_LEN(in, 1)) + } + + if (verbose) { + call printf ("Task imscale:\n") + call printf (" Lower = %g\n") + call pargr (lower) + call printf (" Upper = %g\n") + call pargr (upper) + call printf (" %s: Mean = %g\n") + call pargstr (input) + call pargr (mean_in) + call printf (" Scale = %g\n") + call pargr (scale) + call printf (" %s: Mean = %g\n") + call pargstr (output) + call pargr (mean) + } + + # Finish up + call imunmap (in) + call imunmap (out) +end + + +# IMAGE_MEAN -- Determine the mean value of an image between lower and upper. +# +# The algorithm here is a straight image average. In future this +# should be optimized with subsampling. + +real procedure image_mean (im, lower, upper) + +pointer im # IMIO descriptor +real lower # Low cutoff +real upper # High cutoff + +int i, npix +long line[IM_MAXDIM] +real sum +pointer data, data_end + +int imgnls(), imgnli(), imgnll(), imgnlr() + +begin + sum = 0. + npix = 0 + call amovkl (long(1), line, IM_MAXDIM) + + # Loop through the image lines to compute the mean. + # Optimize IMIO for the image datatype. + switch (IM_PIXTYPE (im)) { + case TY_SHORT: + while (imgnls (im, data, line) != EOF) { + data_end = data + IM_LEN(im, 1) - 1 + do i = data, data_end { + if ((Mems[i] < lower) || (Mems[i] > upper)) + next + sum = sum + Mems[i] + npix = npix + 1 + } + } + case TY_INT: + while (imgnli (im, data, line) != EOF) { + data_end = data + IM_LEN(im, 1) - 1 + do i = data, data_end { + if ((Memi[i] < lower) || (Memi[i] > upper)) + next + sum = sum + Memi[i] + npix = npix + 1 + } + } + case TY_LONG: + while (imgnll (im, data, line) != EOF) { + data_end = data + IM_LEN(im, 1) - 1 + do i = data, data_end { + if ((Meml[i] < lower) || (Meml[i] > upper)) + next + sum = sum + Meml[i] + npix = npix + 1 + } + } + default: + while (imgnlr (im, data, line) != EOF) { + data_end = data + IM_LEN(im, 1) - 1 + do i = data, data_end { + if ((Memr[i] < lower) || (Memr[i] > upper)) + next + sum = sum + Memr[i] + npix = npix + 1 + } + } + } + + return (sum / npix) +end diff --git a/pkg/proto/t_joinlines.x b/pkg/proto/t_joinlines.x new file mode 100644 index 00000000..1dd886c1 --- /dev/null +++ b/pkg/proto/t_joinlines.x @@ -0,0 +1,139 @@ +# T_JOINLINES -- Join text files line by line. + +procedure t_joinlines () + +int list # List of input files +int out # Output file descriptor +pointer delim # Delimiter string +pointer missing # Missing string +int maxchars # Maximum characters per line +bool shortest # Stop of shortest file? +bool verbose # Verbose warnings? + +char c +pointer sp, fname, fds +int i, j, in +int nfiles, nlines, neof, nchars, ntruncate, nlong, ndelim, nmissing +int fntopnb(), clplen(), clgfil(), clgeti(), open(), strlen() +char getc() +bool clgetb() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (delim, SZ_FNAME, TY_CHAR) + call salloc (missing, SZ_LINE, TY_CHAR) + + # Task parameters + + # This stuff is provided for backwards compatibility. + # It would be better to just use an "input" parameter. + call clgstr ("list1", Memc[fname], SZ_FNAME) + if (clgeti ("$nargs") == 2) { + call clgstr ("list2", Memc[delim], SZ_FNAME) + call strcat (",", Memc[fname], SZ_FNAME) + call strcat (Memc[delim], Memc[fname], SZ_FNAME) + } + list = fntopnb (Memc[fname], NO) + +# list = clpopnu ("input") + call clgstr ("output", Memc[fname], SZ_FNAME) + call clgstr ("delim", Memc[delim], SZ_FNAME) + call clgstr ("missing", Memc[missing], SZ_LINE) + maxchars = clgeti ("maxchars") - 1 + shortest = clgetb ("shortest") + verbose = clgetb ("verbose") + + # Open files. Quit on an error. + out = open (Memc[fname], APPEND, TEXT_FILE) + nfiles = clplen (list) + call malloc (fds, nfiles, TY_INT) + do i = 1, nfiles { + j = clgfil (list, Memc[fname], SZ_FNAME) + Memi[fds+i-1] = open (Memc[fname], READ_ONLY, TEXT_FILE) + } + call clpcls (list) + + # Join the input lines. First read a character from each file + # to determine if we are at the EOF and take appropriate action + # if one or more EOFs are found. + + ndelim = strlen (Memc[delim]) + nmissing = strlen (Memc[missing]) + ntruncate = 0 + nlong = 0 + for (nlines = 1; ; nlines = nlines + 1) { + nchars = 0 + neof = 0 + do i = 1, nfiles { + in = Memi[fds+i-1] + if (getc (in, c) == EOF) + neof = neof + 1 + else + call ungetc (in, c) + } + if (neof == nfiles || (shortest && neof > 0)) + break + + do i = 1, nfiles { + in = Memi[fds+i-1] + repeat { + if (getc (in, c) == EOF) { + do j = 1, nmissing { + if (nchars < maxchars) + call putc (out, Memc[missing+j-1]) + nchars = nchars + 1 + } + break + } else if (c == '\n') + break + if (nchars < maxchars) + call putc (out, c) + nchars = nchars + 1 + } + + # Add the delimiter and new line. Count the delimiter also. + if (i < nfiles) { + do j = 1, ndelim { + if (nchars < maxchars) + call putc (out, Memc[delim+j-1]) + nchars = nchars + 1 + } + } else { + call fprintf (out, "\n") + break + } + } + + # Accumulate warnings about line lengths. + if (nchars > maxchars) + ntruncate = ntruncate + 1 + if (min (nchars, maxchars + 1) > SZ_LINE) + nlong = nlong + 1 + } + + # Finish up. + if (verbose) { + if (ntruncate > 0) { + call eprintf ("WARNING: %d lines truncated at %d characters\n") + call pargi (ntruncate) + call pargi (maxchars + 1) + } + if (nlong > 0) { + call eprintf ( + "WARNING: %d lines exceed IRAF limit of %d characters\n") + call pargi (nlong) + call pargi (SZ_LINE) + } + if (neof < nfiles) { + call eprintf ("WARNING: %d/%d files completed\n") + call pargi (neof) + call pargi (nfiles) + } + } + + call close (out) + do i = 1, nfiles + call close (Memi[fds+i-1]) + call sfree (sp) +end diff --git a/pkg/proto/t_mask2text.x b/pkg/proto/t_mask2text.x new file mode 100644 index 00000000..11449102 --- /dev/null +++ b/pkg/proto/t_mask2text.x @@ -0,0 +1,118 @@ +include <imhdr.h> + + +define SZ_REGION 4 # Size of region structure +define C1 Memi[$1] # Minimum column +define C2 Memi[$1+1] # Maximum column +define L1 Memi[$1+2] # Minimum line +define L2 Memi[$1+3] # Maximum line + +# T_TEXT2MASK -- Create a text file description (FIXPIX) from a mask. + +procedure t_mask2text () + +pointer mask # Pixel mask +pointer text # Text file + +int i, fd, nc, nl, c1, c2, l, nalloc, nregions +pointer sp, regions, p, pmatch, im, bp + +pointer immap(), imgl2s() +int open() +errchk immap, open + +begin + call smark (sp) + call salloc (text, SZ_FNAME, TY_CHAR) + call salloc (mask, SZ_FNAME, TY_CHAR) + + # Get task parameters. + call clgstr ("mask", Memc[mask], SZ_FNAME) + call clgstr ("text", Memc[text], SZ_FNAME) + + # Open the files and abort on an error. + im = immap (Memc[mask], READ_ONLY, 0) + fd = open (Memc[text], NEW_FILE, TEXT_FILE) + + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + nalloc = 0 + nregions = 0 + do l = 1, nl { + bp = imgl2s (im, l) - 1 + for (c1=1; c1<=nc && Mems[bp+c1]==0; c1=c1+1) + ; + while (c1 <= nc) { + for (c2=c1+1; c2<=nc && Mems[bp+c2]!=0; c2=c2+1) + ; + c2 = c2 - 1 + pmatch = NULL + for (i=0; i<nregions; i=i+1) { + p = Memi[regions+i] + if (c1 <= C2(p) && c2 >= C1(p)) { + if (pmatch == NULL) { + L2(p) = l + C1(p) = min (C1(p), c1) + C2(p) = max (C2(p), c2) + pmatch = p + } else { + L1(pmatch) = min (L1(pmatch), L1(p)) + C1(pmatch) = min (C1(pmatch), C1(p)) + C2(pmatch) = max (C2(pmatch), C2(p)) + Memi[regions+i] = Memi[regions+nregions-1] + Memi[regions+nregions-1] = p + nregions = nregions - 1 + i = i - 1 + } + } + } + if (pmatch == NULL) { + if (nregions == nalloc) { + nalloc = nregions + 1 + if (nalloc == 1) + call malloc (regions, nalloc, TY_STRUCT) + else + call realloc (regions, nalloc, TY_STRUCT) + call salloc (Memi[regions+nregions], SZ_REGION, + TY_STRUCT) + } + p = Memi[regions+nregions] + L1(p) = l + L2(p) = l + C1(p) = c1 + C2(p) = c2 + nregions = nregions + 1 + } + for (c1=c2+1; c1<=nc && Mems[bp+c1]==0; c1=c1+1) + ; + } + for (i=0; i<nregions; i=i+1) { + p = Memi[regions+i] + if (L2(p) != l) { + call fprintf (fd, "%4d %4d %4d %4d\n") + call pargi (C1(p)) + call pargi (C2(p)) + call pargi (L1(p)) + call pargi (L2(p)) + Memi[regions+i] = Memi[regions+nregions-1] + Memi[regions+nregions-1] = p + nregions = nregions - 1 + i = i - 1 + } + } + } + for (i=0; i<nregions; i=i+1) { + p = Memi[regions+i] + call fprintf (fd, "%4d %4d %4d %4d\n") + call pargi (C1(p)) + call pargi (C2(p)) + call pargi (L1(p)) + call pargi (L2(p)) + } + + call close (fd) + call imunmap (im) + call mfree (regions, TY_POINTER) + call sfree (sp) +end diff --git a/pkg/proto/t_mkglbhdr.x b/pkg/proto/t_mkglbhdr.x new file mode 100644 index 00000000..7840403b --- /dev/null +++ b/pkg/proto/t_mkglbhdr.x @@ -0,0 +1,167 @@ +include <error.h> +include <imhdr.h> + +# T_MKGLBHDR -- Make a global header from common image and reference keywords. + +procedure t_mkglbhdr () + +pointer input # Input image list +char oname[SZ_FNAME] # Output global image +char rname[SZ_FNAME] # Reference image +pointer exclude # Exclusion keyword list + +int i +char iname[SZ_FNAME], key[8] +pointer im, refim, recs, ptr, ptr1 + +bool matchcard() +int clpopnu(), clgfil(), imtgetim(), strncmp(), nowhite() +pointer imtopenp(), immap() + +errchk immap + +begin + # Get parameters. + input = imtopenp ("input") + call clgstr ("output", oname, SZ_FNAME) + call clgstr ("reference", rname, SZ_FNAME) + exclude = clpopnu ("exclude") + + # Use the first image in the input list if no reference is specified. + if (nowhite (rname, rname, SZ_FNAME) == 0) + i = imtgetim (input, rname, SZ_FNAME) + + iferr { + im = NULL; refim = NULL; recs = NULL + + # Make list of reference cards. + ptr = immap (rname, READ_ONLY, 0); refim = ptr + ptr = IM_USERAREA(refim) + do i = 0, ARB { + if (Memc[ptr] == EOS) + break + if (i == 0) + call malloc (recs, 1000, TY_POINTER) + else if (mod (i, 1000) == 0) + call realloc (recs, i+1000, TY_POINTER) + #Memc[ptr+80] = EOS + Memi[recs+i] = ptr + ptr = ptr + 81 + } + Memi[recs+i] = EOF + + # Exclude specified keywords. + while (clgfil (exclude, iname, SZ_FNAME) != EOF) { + call sprintf (key, 8, "%-8.8s") + call pargstr (iname) + call strupr (key) + for (i=0; Memi[recs+i]!=EOF; i=i+1) { + ptr = Memi[recs+i] + if (ptr == NULL) + next + if (Memc[ptr] == ' ') + next + if (strncmp (key, Memc[ptr], 8) == 0) + Memi[recs+i] = NULL + } + } + + # Loop through input images eliminating reference cards. + while (imtgetim (input, iname, SZ_FNAME) != EOF) { + ptr = immap (iname, READ_ONLY, 0); im = ptr + ptr = IM_USERAREA(im) + for (i=0; Memi[recs+i]!=EOF; i=i+1) { + ptr = Memi[recs+i] + if (ptr == NULL) + next + if (Memc[ptr] == ' ') + next + if (!matchcard (Memc[IM_USERAREA(im)], Memc[ptr])) + Memi[recs+i] = NULL + } + call imunmap (im) + } + + # Eliminate multiple blank lines. + for (i=0; Memi[recs+i]!=EOF; i=i+1) { + ptr1 = Memi[recs+i] + if (ptr == NULL) + next + if (Memc[ptr] != ' ') + break + Memi[recs+i] = NULL + } + ptr1 = ptr + for (; Memi[recs+i]!=EOF; i=i+1) { + ptr = Memi[recs+i] + if (ptr == NULL) + next + if (Memc[ptr] == ' ' && Memc[ptr1] == ' ') + Memi[recs+i] = NULL + else + ptr1 = ptr + } + + # Write the output global header. + ptr = immap (oname, NEW_COPY, refim); im = ptr + IM_PIXTYPE(im) = TY_SHORT + IM_NDIM(im) = 0 + ptr1 = IM_USERAREA(im) + for (i=0; Memi[recs+i]!=EOF; i=i+1) { + ptr = Memi[recs+i] + if (ptr == NULL) + next + call strcpy (Memc[ptr], Memc[ptr1], 81) + ptr1 = ptr1 + 81 + } + Memc[ptr1] = EOS + call imunmap (im) + + } then + call erract (EA_WARN) + + + # Finish up. + if (im != NULL) + call imunmap (im) + if (refim != NULL) + call imunmap (refim) + call mfree (recs, TY_POINTER) + + call clpcls (exclude) + call imtclose (input) +end + + +# MATCHCARD -- Match a card given by pat to a string which is a user area. +# This is a simple version of gstrmatch. + +bool procedure matchcard (str, pat) + +char str[ARB] # String to search +char pat[ARB] # String to match +char ch, pch +int i, ip, pp + +begin + do ip = 1, ARB { + if (str[ip] == EOS) + break + + i = ip + for (pp=1; pp < 81; pp=pp+1) { + pch = pat[pp] + ch = str[i] + i = i + 1 + if (pch != ch) + break + } + + if (pp == 81) + return (true) + else if (str[i] == EOS) + break + } + + return (false) +end diff --git a/pkg/proto/t_suntoiraf.x b/pkg/proto/t_suntoiraf.x new file mode 100644 index 00000000..df0046df --- /dev/null +++ b/pkg/proto/t_suntoiraf.x @@ -0,0 +1,268 @@ +# SUNTOIRAF -- Convert 8-bit Sun rasterfile to IRAF image. + +include <imhdr.h> +include <error.h> +include <mach.h> + +# These comments and defines are from /usr/include/rasterfile.h. We +# should probably recode this using Sun interface routines, but not yet. + +# NOTES: +# Each line of the image is rounded out to a multiple of 16 bits. +# This corresponds to the rounding convention used by the memory pixrect +# package (/usr/include/pixrect/memvar.h) of the SunWindows system. +# The ras_encoding field (always set to 0 by Sun's supported software) +# was renamed to ras_length in release 2.0. As a result, rasterfiles +# of type 0 generated by the old software claim to have 0 length; for +# compatibility, code reading rasterfiles must be prepared to compute the +# true length from the width, height, and depth fields. + +define RAS_HEADER_LEN 8 + +define RAS_MAGIC_NUM Memi[$1] # rasterfile magic number +define RAS_WIDTH Memi[$1+1] # width (pixels) of image +define RAS_HEIGHT Memi[$1+2] # height (pixels) of image +define RAS_DEPTH Memi[$1+3] # depth (1, 8, or 24 bits) of pixel +define RAS_LENGTH Memi[$1+4] # length (bytes) of image +define RAS_TYPE Memi[$1+5] # type of file; see RT_* below +define RAS_MAPTYPE Memi[$1+6] # type of colormap; see RMT_* below +define RAS_MAPLENGTH Memi[$1+7] # length (bytes) of following map + +define RAS_MAGIC 059A66A95X + +# supported RAS_TYPES +define RT_OLD 0 # Raw pixrect image in 68000 byte order +define RT_STANDARD 1 # Raw pixrect image in 68000 byte order +define RT_BYTE_ENCODED 2 # Run-length compression of bytes +define RT_FORMAT_RGB 3 # XRGB or RGB instead of XBGR or BGR +define RT_FORMAT_TIFF 4 # tiff <-> standard rasterfile +define RT_FORMAT_IFF 5 # iff (TAAC format) <-> standard rasterfile +define RT_EXPERIMENTAL 0xffff # Reserved for testing + +# supported RAS_MAPTYPES +define RMT_NONE 0 # ras_maplength is expected to be 0 +define RMT_EQUAL_RGB 1 # red[ras_maplength/3],green[],blue[] +define RMT_RAW 2 # Sun registered, not supported, ras_maptype + + +# NTSC weights for converting color pixels to grayscale +define RED_WT .299 +define GREEN_WT .587 +define BLUE_WT .114 + +define BADVALUE 0 # row value for bad read + + +procedure t_suntoiraf () + +int infile, fd, fdtmp, i, krow, nlut, nchars, junk, nread +pointer fname, image, buf, im, imtmp, pix, sp, sp1, hdr, lut +bool apply_lut, delete_file, verbose, listonly, yflip + +int clpopni(), clgfil(), open(), strcmp(), fnroot(), fnextn(), read() +pointer immap(), impl2s() +bool clgetb() + +errchk open, read, immap + +begin + call smark (sp) + call salloc (hdr, RAS_HEADER_LEN, TY_INT) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (buf, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_LINE, TY_CHAR) + + infile = clpopni ("names") # Get the raster/image names. + apply_lut = clgetb ("apply_lut")# Apply the raster lut? + delete_file = clgetb ("delete") # Delete rasterfile after making image? + verbose = clgetb ("verbose") # Verbose output? + listonly = clgetb ("listonly") # Only list the rasterfile headers? + yflip = clgetb ("yflip") # Flip the image top to bottom? + + fd = NULL + im = NULL + + # Loop over all images + while (clgfil (infile, Memc[fname], SZ_FNAME) != EOF) { + iferr { + fdtmp = open (Memc[fname], READ_ONLY, BINARY_FILE); fd = fdtmp + nread = read (fd, Memi[hdr], RAS_HEADER_LEN * SZ_INT) + + if (RAS_MAGIC_NUM(hdr) != RAS_MAGIC) + call error (0, "not a rasterfile") + + # correct for an old peculiarity + if (RAS_TYPE(hdr) == RT_OLD && RAS_LENGTH(hdr) == 0) + RAS_LENGTH(hdr) = RAS_WIDTH(hdr) * RAS_HEIGHT(hdr) + + if (verbose || listonly) { + call printf ("\n%s is %dx%d pixels by %d bits deep.\n") + call pargstr (Memc[fname]) + call pargi (RAS_WIDTH(hdr)) + call pargi (RAS_HEIGHT(hdr)) + call pargi (RAS_DEPTH(hdr)) + + call printf (" LENGTH=%d, MAPLENGTH=%d, total=%d bytes.\n") + call pargi (RAS_LENGTH(hdr)) + call pargi (RAS_MAPLENGTH(hdr)) + call pargi (RAS_LENGTH(hdr) + RAS_MAPLENGTH(hdr) + 32) + + call printf (" TYPE=%s, MAP_TYPE=%s.\n") + + switch (RAS_TYPE(hdr)) { + case RT_OLD: + call pargstr ("OLD") + case RT_STANDARD: + call pargstr ("STANDARD") + case RT_BYTE_ENCODED: + call pargstr ("BYTE_ENCODED") + case RT_FORMAT_RGB: + call pargstr ("FORMAT_RGB") + case RT_FORMAT_TIFF: + call pargstr ("FORMAT_TIFF") + case RT_FORMAT_IFF: + call pargstr ("FORMAT_IFF") + default: + call pargstr ("EXPERIMENTAL (or unknown)") + } + + switch (RAS_MAPTYPE(hdr)) { + case RMT_NONE: + call pargstr ("NONE") + case RMT_EQUAL_RGB: + call pargstr ("EQUAL_RGB") + case RMT_RAW: + call pargstr ("RAW") + default: + call pargstr ("unknown") + } + } + + if (! listonly) { + if (RAS_DEPTH(hdr) != 8) + call error (0, "unsupported number of bits/pixel") + + if (RAS_TYPE(hdr) != RT_STANDARD && RAS_TYPE(hdr) != RT_OLD) + call error (0, "unsupported rasterfile type") + + if (RAS_MAPTYPE(hdr) != RMT_NONE && + RAS_MAPTYPE(hdr) != RMT_EQUAL_RGB) + call error (0, "unsupported rasterfile type") + + junk = fnextn (Memc[fname], Memc[buf], SZ_FNAME) + + # remove any `.ras', catch this in calling script + if (strcmp (Memc[buf], "ras") != 0) { + call sprintf (Memc[image], SZ_LINE, "%s") + call pargstr (Memc[fname]) + } else { + junk = fnroot (Memc[fname], Memc[buf], SZ_FNAME) + call sprintf (Memc[image], SZ_LINE, "%s") + call pargstr (Memc[buf]) + } + + imtmp = immap (Memc[image], NEW_IMAGE, 0); im = imtmp + + IM_NDIM (im) = 2 + IM_LEN (im, 1) = RAS_WIDTH(hdr) + IM_LEN (im, 2) = RAS_HEIGHT(hdr) + IM_PIXTYPE (im) = TY_SHORT + } + + } then { + call erract (EA_WARN) + call eprintf ("Error while translating %s\n") + call pargstr (Memc[fname]) + + if (im != NULL) + call imunmap (im) + if (fd != NULL) + call close (fd) + next + } + + if (listonly) { + call close (fd) + next + } + + if (verbose) { + call printf (" %s --> %s (%dx%d)\n") + call pargstr (Memc[fname]) + call pargstr (Memc[image]) + call pargi (RAS_WIDTH(hdr)) + call pargi (RAS_HEIGHT(hdr)) + call flush (STDOUT) + } + + call smark (sp1) + call salloc (pix, RAS_WIDTH(hdr), TY_SHORT) + + # Extract the Sun raster LUT + if (RAS_MAPLENGTH(hdr) > 0) { + call salloc (lut, RAS_MAPLENGTH(hdr), TY_SHORT) + + # assumes that MAPLENGTH is even (for SZB_CHAR=2) + nread = read (fd, Mems[lut], RAS_MAPLENGTH(hdr) / SZB_CHAR) + call achtbs (Mems[lut], Mems[lut], RAS_MAPLENGTH(hdr)) + + nlut = RAS_MAPLENGTH(hdr) / 3 + } + + # round up to account for 16 bit line blocking + nchars = RAS_WIDTH(hdr) / SZB_CHAR + mod (RAS_WIDTH(hdr), SZB_CHAR) + + # Access pixels and write them out for each row + do i = 1, RAS_HEIGHT(hdr) { + ifnoerr (nread = read (fd, Mems[pix], nchars)) { + call achtbs (Mems[pix], Mems[pix], RAS_WIDTH(hdr)) + if (apply_lut && RAS_MAPLENGTH(hdr) > 0) + call si_lut (Mems[pix], RAS_WIDTH(hdr), Mems[lut], nlut) + } else { + call amovks (BADVALUE, Mems[pix], RAS_WIDTH(hdr)) + call eprintf ("Problem reading row %d in %s.\n") + call pargi (i) + call pargstr (Memc[fname]) + } + + # rasterfile is upside down + if (yflip) + krow = RAS_HEIGHT(hdr)-i+1 + else + krow = i + + call amovs (Mems[pix], Mems[impl2s (im, krow)], RAS_WIDTH(hdr)) + } + + call imunmap (im) + call close (fd) + if (delete_file) + call delete (Memc[fname]) + call sfree (sp1) + } + + call sfree (sp) +end + + +# SI_LUT -- apply the rasterfile lookup table to each row of the raster. + +procedure si_lut (data, ndata, lut, nlut) + +short data[ARB] #U data array +int ndata #I size of the data array +short lut[nlut,3] #I RGB lookup tables +int nlut #I size of the lookup table + +int idata, idx, i + +begin + do i = 1, ndata { + idata = int (data[i]) + 1 + idx = min (max (idata, 1), nlut) + + data[i] = RED_WT * lut[idx,1] + + GREEN_WT * lut[idx,2] + + BLUE_WT * lut[idx,3] + } +end diff --git a/pkg/proto/t_text2mask.x b/pkg/proto/t_text2mask.x new file mode 100644 index 00000000..6679b3dc --- /dev/null +++ b/pkg/proto/t_text2mask.x @@ -0,0 +1,102 @@ +include <imhdr.h> + + +# T_TEXT2MASK -- Create a pixel mask from a text file. +# The text file consists of rectangular regions. The mask values may +# be set to identify rectangles which are square, narrower along lines, +# and narrower along columns. + +procedure t_text2mask () + +pointer text # Text file +pointer mask # Pixel mask +int nc # Number of columns +int nl # Number of lines +short linterp # Mask value for narrow line rectangles +short cinterp # Mask value for narrow column rectangles +short square # Mask value for squares +short pixel # Mask value for single pixel + +short val +int i, fd, nc1, nl1, c1, c2, l1, l2 +pointer sp, pm + +pointer immap(), impl2s(), imps2s() +int clgeti(), nowhite(), strmatch(), open(), fscan(), nscan() +errchk open, immap + +begin + call smark (sp) + call salloc (text, SZ_FNAME, TY_CHAR) + call salloc (mask, SZ_FNAME, TY_CHAR) + + # Get task parameters. + call clgstr ("mask", Memc[mask], SZ_FNAME) + call clgstr ("text", Memc[text], SZ_FNAME) + nc = clgeti ("ncols") + nl = clgeti ("nlines") + linterp = clgeti ("linterp") + cinterp = clgeti ("cinterp") + square = clgeti ("square") + pixel = clgeti ("pixel") + + # Force a pixel text format and extension. + i = nowhite (Memc[mask], Memc[mask], SZ_FNAME) + if (!strmatch (Memc[mask], ".pl$") > 0) + call strcat (".pl", Memc[mask], SZ_FNAME) + + # Open the files and abort on an error. + fd = open (Memc[text], READ_ONLY, TEXT_FILE) + pm = immap (Memc[mask], NEW_IMAGE, 0) + + # Set the output image. + IM_LEN(pm,1) = nc + IM_LEN(pm,2) = nl + call sprintf (IM_TITLE(pm), SZ_IMTITLE, "Pixel mask from file %s") + call pargstr (Memc[text]) + + # Set the good pixel values. + val = 0 + do i = 1, nl + call amovks (val, Mems[impl2s(pm,i)], nc) + + # Set the bad pixel values. + while (fscan (fd) != EOF) { + call gargi (c1) + call gargi (c2) + call gargi (l1) + call gargi (l2) + if (nscan() != 4) { + if (nscan() == 2) { + l1 = c2 + c2 = c1 + l2 = l1 + } else + next + } + + c1 = max (1, c1) + c2 = min (nc, c2) + l1 = max (1, l1) + l2 = min (nl, l2) + nc1 = c2 - c1 + 1 + nl1 = l2 - l1 + 1 + if (nc1 < 1 || nl1 < 1) + next + + # Select mask value based on shape of rectangle. + if (nc1 < nl1) + val = linterp + else if (nc1 > nl1) + val = cinterp + else if (nc1 == 1) + val = pixel + else + val = square + call amovks (val, Mems[imps2s(pm,c1,c2,l1,l2)], nc1*nl1) + } + + # Finish up. + call imunmap (pm) + call close (fd) +end diff --git a/pkg/proto/text2mask.par b/pkg/proto/text2mask.par new file mode 100644 index 00000000..4f8b8938 --- /dev/null +++ b/pkg/proto/text2mask.par @@ -0,0 +1,8 @@ +text,f,a,,,,Text file description of mask regions +mask,f,a,,,,Mask image name +ncols,i,a,,1,,Number of columns in mask +nlines,i,a,,1,,Number of lines in mask +linterp,i,h,1,1,,Mask code for rectangles narrower along lines +cinterp,i,h,2,1,,Mask code for rectangles narrower along columns +square,i,h,3,1,,Mask code for squares +pixel,i,h,4,1,,Mask code for single pixels diff --git a/pkg/proto/vol/README b/pkg/proto/vol/README new file mode 100644 index 00000000..b92c2da6 --- /dev/null +++ b/pkg/proto/vol/README @@ -0,0 +1,26 @@ +The VOLumes package is a possibly temporary collection of tasks related to +manipulating and viewing 3d or in some cases 4d "volume" images, and a few +other things. + +IMJOIN joins sets of N-dimensional images together along a specified axis. +IM3DTRAN performs 3d image transposes; if appropriate [*,-*,*] type image +sections are given as input, it also accomplishes rotates. Tasks such as +these may later be integrated into a standard IRAF package. + +PVOL projects through volume images, casting rays onto a set of output +2d images distributed along a great circle around the volume image. When +the output images are displayed or recorded onto video and played back, +the volume image appears to rotate. Various translucency and opacity +algorithms are employed. + +I2SUN is a temporary task for converting IRAF images into Sun rasterfiles, +primarily to take advantage of a Sun-specific MOVIE utility for viewing +digital movies on a workstation screen; it will no longer be necessary when +the IRAF image display servers can display movies. + +# Not currently distributed: +#VIDRECORD is an NOAO-specific IRAF script that is used to display successive +#images from template or datacube on a display device connected to a recorder. +#The recorder is assumed to be connected via rs-232 to a port on some IRAF node. +#Other sites may wish to modify the associated host-level task that sends the +#device-control commands to the rs-232 port. diff --git a/pkg/proto/vol/README.install b/pkg/proto/vol/README.install new file mode 100644 index 00000000..c3f23147 --- /dev/null +++ b/pkg/proto/vol/README.install @@ -0,0 +1,107 @@ + + Installation Instructions for the VOL Addon Package + +The volume-images package, VOL, is being distributed separately +from the IRAF V2.8 distribution. This package is being made available for +user testing on a user-beware basis. The installation instructions +that follow assume that you have copied the tar format VOL archive onto +your host machine. The method you use to copy the file (or remotely access +the tar file) is OS dependent and is not discussed in this document. If your +IRAF system has been stripped of the IRAF libraries ('mkpkg stripall') you +will not be able to build the VOL executable as described here. You must +either reload the required libraries or request a binary distribution +of VOL for your operating system. If you have any questions, please send +electronic mail to the IRAF project at + +Internet (ARPAnet, MILnet, NSFnet, etc.) iraf@noao.edu +BITnet iraf@noao.edu * +SPAN/HEPnet (DECnet) noao::iraf or 5355::iraf +UUCP/Usenet {arizona,decvax,ncar}!noao!iraf + uunet!noao.edu!iraf +* = through a user-specified gateway + + [IRAF Hotline: (602) 323-4160] + +For discussion of algorithms or ongoing bug fixes etc., contact the author, +Steve Rooke, at 602-325-9399 (or rooke@noao.edu or 5355::rooke). + +This package is being distributed as an external package making use of the +layered software enhancements in IRAF V2.8. + +[1] This discussion assumes you intend to install VOL as an independent + external layered package. You may choose to merge it into your custom + "local" package instead, but would need to edit several files not + discussed herein. + +[2] Log into the CL from the IRAF installation account. This insures you + have the proper permissions and the files will have the proper owner. + + Create a directory for vol, preferably external to the IRAF directory + tree to simplify future IRAF updates, then set an IRAF environment + variable to point to it. + + UNIX example: + cl> reset vol /local/iraftest/vol/ + VMS example: + cl> reset vol usr\$1:[localiraf.vol] + +[3] Change directory to vol and unpack the tar archive. You must + load the softools package before executing rtar. Note that the <ARCHIVE> + name must be given with the appropriate path name at the host OS level, + or may be specified as a tape device if that is how you received the + package. + + cl> cd vol + cl> softools + so> rtar -xrf <ARCHIVE> # Read the archive + so> cd vol # Change to VOL subdirectory + +[4] When the archive has been unpacked, build the VOL package executable: + + 1) Delete any bin directory symbolic links you find + 2) Create a directory called bin.ARCH where ARCH is something + like "f68881", "ffpa", "sparc", or "vax"; see your IRAF + installation guide. + 3) Then issue the following commands: + + so> mkpkg ARCH + so> mkpkg -p vol update >& spool & + + The first command sets the bin directory to be properly configured + and the second recompiles the package. For Sun multiple architecture + support, please refer to the "Sun/IRAF Site Manager's Guide". + +[5] The spool file(s) should be reviewed upon completion to make sure + there were no errors. When you are confident the installation was + successful, delete the spool file (and the archive file if you wish). + +[6] Still logged in as iraf, edit the one file in the core iraf system + that is necessary to install an external layered package: + + so> cd hlib + so> edit extern.pkg + + UNIX example, leaving out other external packages: + reset vol = /local/iraftest/vol/ + task vol.pkg = vol$vol.cl + + reset helpdb = "lib$helpdb.mip\ + [ ... other packages ... ] + ,vol$lib/helpdb.mip\ + " + VMS example, leaving out other external packages: + reset vol = usr\$2:[localiraf.vol] + task vol.pkg = vol$vol.cl + + reset helpdb = "lib$helpdb.mip\ + ,vol$lib/helpdb.mip\ + " + +[7] Finally, build the help database. Still logged in as iraf: + + so> mkhelpdb vol$lib/root.hd vol$lib/helpdb.mip + +That's it ... you should be ready to go. If you have any questions or +problems, please do not hesitate to send email to iraf@noao.edu or call the +IRAF HOTLINE at 602-323-4160 or the author at 602-325-9399. + diff --git a/pkg/proto/vol/Revisions b/pkg/proto/vol/Revisions new file mode 100644 index 00000000..c3e53369 --- /dev/null +++ b/pkg/proto/vol/Revisions @@ -0,0 +1,12 @@ +.help revisions Sep89 vol +.nf +vol$src/vtransmit.gx + Was attempting to calculate opacity factor even when mode did not + include opacity (task default parameters include INDEFs). Generated + a floating exception in iraf 2.8 not present before. (7/5/89 SRo) + +==== +V2.8 +==== + +.endhelp diff --git a/pkg/proto/vol/lib/helpdb.mip b/pkg/proto/vol/lib/helpdb.mip Binary files differnew file mode 100644 index 00000000..18d59be5 --- /dev/null +++ b/pkg/proto/vol/lib/helpdb.mip diff --git a/pkg/proto/vol/lib/mkpkg.inc b/pkg/proto/vol/lib/mkpkg.inc new file mode 100644 index 00000000..de1341ab --- /dev/null +++ b/pkg/proto/vol/lib/mkpkg.inc @@ -0,0 +1,7 @@ +# Global MKPKG definitions for the VOL package. + +$set XFLAGS = "$(XFLAGS) -p vol" + +# Special file lists, not needed at present + +#$include "vol$lib/mkpkg.sf.SUN3" diff --git a/pkg/proto/vol/lib/root.hd b/pkg/proto/vol/lib/root.hd new file mode 100644 index 00000000..db09387f --- /dev/null +++ b/pkg/proto/vol/lib/root.hd @@ -0,0 +1,5 @@ +# Root help directory for the VOL packages. This dummy package is necessary +# in order to have `vol' appear as a module in some package, so that the user +# can type "help vol" (with the `vol' given as a task). + +_vol pkg = vol$lib/rootvol.hd diff --git a/pkg/proto/vol/lib/rootvol.hd b/pkg/proto/vol/lib/rootvol.hd new file mode 100644 index 00000000..ceba8059 --- /dev/null +++ b/pkg/proto/vol/lib/rootvol.hd @@ -0,0 +1,8 @@ +# Root task entry for the VOL package help tree. Defines `vol' +# as both a task and a package in the vol help database. + +vol men = vol$vol.men, + hlp = vol$vol.men, + sys = vol$vol.hlp, + pkg = vol$vol.hd, + src = vol$vol.cl diff --git a/pkg/proto/vol/lib/strip.vol b/pkg/proto/vol/lib/strip.vol new file mode 100644 index 00000000..12157035 --- /dev/null +++ b/pkg/proto/vol/lib/strip.vol @@ -0,0 +1,12 @@ +# STRIP.VOL -- Rmfiles command script, used to strip the VOL directory +# of all files not required for ordinary runtime use of the system. + +src -allbut .hlp .hd .men .cl .par .key .dat .mip + +# Sun/IRAF only. +# --------------- +-file bin.f68881/OBJS.arc +-file bin.ffpa/OBJS.arc +-file bin.sparc/OBJS.arc +-file bin.generic/OBJS.arc +-file bin.pg/OBJS.arc diff --git a/pkg/proto/vol/lib/zzsetenv.def b/pkg/proto/vol/lib/zzsetenv.def new file mode 100644 index 00000000..637e5015 --- /dev/null +++ b/pkg/proto/vol/lib/zzsetenv.def @@ -0,0 +1,7 @@ +# Global environment definitions for the VOL package. + +set vollib = "vol$lib/" +set volsrc = "vol$src/" +set volbin = "vol$bin(arch)/" + +keep diff --git a/pkg/proto/vol/mkpkg b/pkg/proto/vol/mkpkg new file mode 100644 index 00000000..bcd5e283 --- /dev/null +++ b/pkg/proto/vol/mkpkg @@ -0,0 +1,21 @@ +# MKPKG file for the VOL Package + +$call update +$exit + +update: + $call update@src + + $ifeq (HOSTID, vms) $purge [...] $endif + ; + +relink: + $call relink@src + + $ifeq (HOSTID, vms) $purge [...] $endif + ; + +install: + $call install@src + ; + diff --git a/pkg/proto/vol/src/doc/concept.hlp b/pkg/proto/vol/src/doc/concept.hlp new file mode 100644 index 00000000..26a814b9 --- /dev/null +++ b/pkg/proto/vol/src/doc/concept.hlp @@ -0,0 +1,177 @@ +.help volumes + +[OUT OF DATE (Jan 89); this is an original pre-design document] + +.ce +Conceptual Model for 2D Projections of Rotating 3D Images + +Consider the problem of visualizing a volume containing emissive and +absorptive material. If we had genuine 3D display tools, we could imagine +something like a translucent 3D image display that we could hold in our +hand, peer into, and rotate around at will to study the spatial distribution +of materials inside the volume. + +Lacking a 3D display device, we can resort to 2D projections of the interior +of the volume. In order to render absorptive material, we need a light +source behind the volume; this light gets attenuated by absorption as it +passes through the volume toward the projection plane. In the general case +light emitted within the volume contributes positively to the projected +light intensity, but it also gets attenuated by absorbing material between +it and the projection plane. At this point the projection plane has a range +of intensities representing the combined absorption and emission of material +along columns through the volume. But looking at a single 2D projection, +there would be no way to determine how deep in the original volume a particular +emitting or absorbing region lay. One way around this is to cause the volume +to rotate, making a series of 2D projections. Playing the projections back +as a movie gives the appearance of seeing inside a translucent rotating +volume. + +Modelling the full physics of light transmission, absorption, refraction, +etc. with arbitrary projective geometries would be quite computationally +intensive and could rival many supercomputer simulations. However, it is +possible to constrain the model such that an effective display can be +generated allowing the viewer to grasp the essential nature of the spatial +relationships among the volume data in reasonable computational time. This +is called volume visualization, which can include a range of display +techniques approximating the actual physics to varying extents. There is +some debate whether visualization problems can best be attacked by simplified +direct physical models or by different models, such as ones that might better +enhance the \fBperception\fR of depth. We will stick with direct physical +models here, though simplified for computer performance reasons. + +For computational purposes we will constrain the projection to be orthogonal, +i.e. the light source is at infinity, so the projection rays are all parallel. +With the light source at infinity behind the volume (a datacube), we need not +model reflection at all. We will also ignore refraction (and certainly +diffraction effects). + +We can now determine a pixel intensity on the output plane by starting +at the rear of the column of voxels (volume elements) that project from +the datacube onto that pixel. At each successive voxel along that column +we will attenuate the light we started with by absorption, and add to it +any light added by emission. If we consider emission (voxel intensity) +alone, the projection would just be the sum of the contributing intensities. +Absorption alone would simply decrease the remaining transmitted light +proportionally to the opacity of each of the voxels along the column. +Since we are combining the effects of absorption and emission, the ratio +of the intensity of the original incident light to that of the interior +voxels is important, so we will need a beginning intensity. + +The opacities have a physical meaning in the model. However, we are more +interested here in visualizing the volume interior than in treating it as +a pure physical model, so we add an opacity transformation function. This +allows us to generate different views of the volume interior without having +to modify all the raw opacity values in the datacube. For maximum flexibility +we would like to be able to modify the opacity function interactively, e.g. +with a mouse, but this would amount to computing the projections in real +time and is not likely at present. + +.nf + +Let: i = projected intensity before considering the current + voxel + i' = intensity of light after passing through the current + voxel + I0 = initial light intensity (background iillumination + before encountering the volume) + Vo = opacity at the current voxel, range 0:1 with + 0=transparent, 1=opaque + Vi = intensity at the current voxel + f(Vo) = function of the opacity at the current voxel, + normalized to the range 0:1 + g(Vi) = function of the voxel's intensity, normalized + to the range 0:1 + +Then: i' = i * (1 - f(Vo)) + g(Vi) + [initial i = Imax, then iterate over all voxels in path] + +.fi + +We want to choose the opacity and intensity transformation functions in such +a way that we can easily control the appearance of the final projection. +In particular, we want to be able to adjust both the opacity and intensity +functions to best reveal the interior details of the volume during a +rotation sequence. For example, we might want to eliminate absorption +"noise" so that we can see through it to details of more interest, so we +need a lower opacity cutoff. Likewise, we would want an upper opacity +cutoff above which all voxels would appear opaque. We will need the same +control over intensity. + +.nf +Let: o1 = lower voxel opacity cutoff + o2 = upper voxel opacity cutoff + t1 = lower transmitted intensity cutoff + t2 = upper transmitted intensity cutoff + i1 = lower voxel intensity cutoff + i2 = upper voxel intensity cutoff + Imax = output intensity maximum for int transform function +.fi + +Now all we need is the form of the opacity and intensity functions between +their input cutoffs. A linear model would seem to be useful, perhaps with +logarithmic and exponential options later to enhance the lower or upper +end of the range. f(Vo) is constrained to run between 0 and 1, because +after being subtracted from 1.0 it is the intensity attenuation factor +for the current voxel. + +.nf + + Opacity Transformation Function f(Vo): + + { Vo < o1 : 0.0 } + { } + { o1 <= Vo < o2 : (t2 - (Vo - o1)(t2 - t1)) } + { ( --------- ) } + f(Vo) = { ( (o2 - o1) ) } + { ------------------------- } + { I0 } + { } + { o2 <= Vo : 1.0 } + + +backg. int. I0-| + | + t2-|------ Transmitted Intensity + | ` as function of opacity + | ` (ignoring independent +i * (1 - f(Vo))-|..............` voxel intensity contri- + | . ` bution) + | . ` + | . ` + t1-| . | + | . | + +____________________________________________ + | | | + o1 Vo o2 + Voxel Opacity + + ------------------------------------------------------------ + + Intensity Transformation Function g(Vi): + + { Vi < i1 : 0.0 + { + { i1 <= Vi < i2 : (Vi - i1) * Imax + { --------- + g(Vi) = { (i2 - i1) + { + { i2 <= Vi : Imax + { + { + { + + + | + | + Imax-| --------------------- + | / + g(Vi)-|................./ + | / . + | / . + | / . + 0.0 +___________________________________________ + | | | + i1 Vi i2 + Voxel Intensity +.fi + diff --git a/pkg/proto/vol/src/doc/i2sun.hlp b/pkg/proto/vol/src/doc/i2sun.hlp new file mode 100644 index 00000000..70448d64 --- /dev/null +++ b/pkg/proto/vol/src/doc/i2sun.hlp @@ -0,0 +1,152 @@ +.help i2sun Oct88 local +.ih +NAME +i2sun -- convert IRAF images to Sun rasterfiles +.ih +USAGE +i2sun input output z1 z2 +.ih +PARAMETERS +.ls input +Input image template, @file, n-dimensional image, or combination. +.le +.ls output +Root template for output images, e.g. "home$ras/frame.%d". +.le +.ls clutfile +Previously saved Sun rasterfile (e.g. output from IMTOOL), containing the +color/greyscale lookup table information to be passed along to each output +frame. Standard ones can be saved and used with any number of images (e.g. +"pseudo.ras"). +.le +.ls z1 = INDEF, z2 = INDEF +Minimum and maximum pixel/voxel intensities to scale to full output +color/greyscale range. Both are required parameters, and will apply to all +images in the sequence. +.le +.ls ztrans = "linear" +Intensity transformation on input data (linear|log|none|user). +If "user", you must also specify \fIulutfile\fR. +.le +.ls ulutfile +Name of text file containing the look up table when \fIztrans\fR = user. +The table should contain two columns per line; column 1 contains the +intensity, column 2 the desired greyscale output. +.le +.ls xsize = INDEF, ysize = INDEF +If specified, these will be the dimensions of all output Sun rasterfiles +in pixels. The default will be the same size as the input images (which +could vary, though this would create a jittery movie). +.le +.ls xmag = 1.0, ymag = 1.0 +Another way to specify output rasterfile dimensions. These are the +magnification factors to apply to the input image dimensions. +.le +.ls order = 1 +Order of the interpolator to be used for spatially interpolating the image. +The current choices are 0 for pixel replication, and 1 for bilinear +interpolation. +.le +.ls sliceaxis = 3 +Image axis from which to cut multiple slices when input image dimension is +greater than 2. Only x-y sections are allowed, so \fIsliceaxis\fR must +be 3 or greater. +.le +.ls swap = no +Swap rasterfile bytes on output? Used when rasterfiles are being written +to a computer with opposite byte-swapping from that of the home computer +(e.g. between VAX and Sun). +.le + + +.ih +DESCRIPTION + +Given a series of IRAF images, an intensity transformation, and a file +containing color/greyscale lookup table information, produces one 2d image +in Sun rasterfile format for each 2D IRAF image. This is a temporary task +usually used as a step in creating filmloops for playback by a Sun Movie +program. + +The input images may be specified as an image template ("zoom*.imh"), +an "@" file ("@movie.list"), or as an n-dimensional image from which to +create multiple 2d rasterfiles. If any images in a list are nD images, +all 2d sections from the specified \fIsliceaxis\fR will be written out +(default = band or z axis). At present, only x-y sections may be made, +i.e. the slice axis must be axis 3 or higher. + +The minimum and maximum pixel/voxel intensities, z1 and z2, must be specified +as it would be not only inefficient to calculate the full zrange of +each image in a sequence, but would also make very jumpy movies. +Between input intensities z1 and z2, the pixel intensities may be transformed +according to the \fIztrans\fR parameter: "linear", "log10", "none", +or "user". + +When \fIztrans\fR = "user", a look up table of intensity values and their +corresponding greyscale levels is read from the file specified by the +\fIulutfile\fR parameter. From this information, a piecewise linear +look up table containing 4096 discrete values is composed. The text +format table contains two columns per line; column 1 contains the +intensity, column 2 the desired greyscale output. The greyscale values +specified by the user must match those available on the output device. +Task \fIshowcap\fR can be used to determine the range of acceptable +greyscale levels. + +A color table file (\fIclutfile\fR) may be produced on a Sun workstation from +IMTOOL (see IMTOOL manual page, R_RASTERFILE parameter and Imcopy function). +This file may be specified to I2SUN as the \fIclutfile\fR parameter. +Likewise, any rasterfiles previously created with +I2SUN may be used as input clutfiles. + +The output rasterfile dimensions may be larger or smaller than the input +images (see parameters \fIxsize\fR and \fIysize\fR, or \fIxmag\fR and +\fIymag\fR). The parameter \fIorder\fR controls the mode of interpolation; +0=pixel replication, 1=bilinear. + +If the output rasterfiles are being sent to a computer with opposite +byte-swapping characteristics, set \fIswap\fR = yes (e.g., when running +I2SUN on a VAX, with output to a Sun). + + +.ih +EXAMPLES + +.nf +1. Produce a series of Sun rasterfiles in tmp$mydir/movie/, + using a pseudocolor color table file saved earlier, with + input greylevels scaled between 10 and 100. + + cl> i2sun nzoom*.imh tmp$mydir/movie/frame.%d \ + home$colors/pseudo.ras 10 100 + +2. Make a movie through the z, or band, axis of a datacube. + + cl> i2sun cube tmp$cubemovie/frame.%d 1 256 + +3. Make a movie through the 4th, or hyper-axis of a datacube, + holding image band 10 constant. + + cl> i2sun hypercube[*,*,10,*] tmp$movie/frame.%d 1 256 \ + sliceaxis=4 + +4. Run I2SUN on a VAX, with output to a Sun. + + cl> i2sun @imlist sunnode!home$ras/frame.%d 1 256 swap+ + +.fi + +.ih +TIMINGS +49 seconds (1 sec/frame) to produce 50 100*100 rasterfiles from a +100*100*50 datacube with no magnification, on a diskless Sun-3/110 +using NFS to Eagle disks on a lightly loaded Sun-3/160 fileserver +(load factor < 1.5). +5 minutes for the same with a magnification factor of 2 in both x and y, +bilinear interpolation. +20 minutes for the same with a magnification factor of 5 in both x and y. +.ih +BUGS +.ih +SEE ALSO +display, imtool, volumes.pvol +.endhelp diff --git a/pkg/proto/vol/src/doc/im3dtran.hlp b/pkg/proto/vol/src/doc/im3dtran.hlp new file mode 100644 index 00000000..75fd85fe --- /dev/null +++ b/pkg/proto/vol/src/doc/im3dtran.hlp @@ -0,0 +1,85 @@ +.help im3dtran Jan89 volumes +.ih +NAME +im3dtran -- 3d image transpose, any axis to any other axis +.ih +USAGE +im3dtran input output +.ih +PARAMETERS +.ls input +Input 3d image (datacube). +.le +.ls output +Transposed datacube. +.le +.ls len_blk = 128 +Size in pixels of linear internal subraster. IM3DTRAN will try to transpose +a subraster up to len_blk cubed at one time. Runtime is much faster with +larger \fBlen_blk\fR, but the task may run out of memory. +.le +.ls new_x = 3 +New x axis = old axis (1=x, 2=y, 3=z). Default (3) replaces new x with old z. +.le +.ls new_y = 2 +New y axis = old axis. Default (2) is identity. +.le +.ls new_z = 1 +New z axis = old axis. Default (1) replaces new z with old x. +.le + +.ih +DESCRIPTION + +IM3DTRAN is very similar to IMAGES.IMTRANSPOSE, except that it can accomplish +3d image transposes. In 3 dimensions, it is necessary to specify which old +axes map to the new axes. In all cases, IM3DTRAN maps old axis element 1 to +new axis element 1, i.e. it does not flip axes, just transposes them. + +If one wants to use IM3DTRAN to rotate a datacube 90 degrees in any direction, +it is necessary to use a combination of flip and transpose (just like in the +2d case). For example, let the original datacube be visualized with its +origin at the lower left front when seen by the viewer, with the abscissa +being the x axis (dim1), ordinate the y axis (dim2), and depth being the +z axis (dim3), z increasing away from the viewer or into the datacube [this +is a left-handed coordinate system]. One then wants to rotate the datacube +by 90 degrees clockwise about the y axis when viewed from +y (the "top"); +this means the old z axis becomes the new x axis, and the old x axis becomes +the new z axis, while new y remains old y. In this case the axis that must +be flipped prior to transposition is the \fBx axis\fR; see Example 1. + +The parameter \fBlen_blk\fR controls how much memory is used during the +transpose operation. \fBlen_blk\fR elements are used in each axis at a +time, or a cube len_blk elements on a side. If \fBlen_blk\fR is too large, +the task will abort with an "out of memory" error. If it is too small, +the task can take a very long time to run. The maximum size of len_blk +depends on how much memory is available at the time IM3DTRAN is run, +and the size and datatype of the image to be transposed. + +.ih +EXAMPLES + +.nf +1. For an input datacube with columns = x = abscissa, lines = y = ordinate, + and bands = z = depth increasing away from viewer, and with the image + origin at the lower left front, rotate datacube 90 degrees clockwise + around the y axis when viewed from +y (top): + + cl> im3dtran input[-*,*,*] output 3 2 1 + +.fi + +.ih +TIMINGS + +[Not available yet] + +.ih +BUGS + +[Not available yet] + +.ih +SEE ALSO +pvol i2sun +.endhelp diff --git a/pkg/proto/vol/src/doc/imjoin.hlp b/pkg/proto/vol/src/doc/imjoin.hlp new file mode 100644 index 00000000..6d7a59a1 --- /dev/null +++ b/pkg/proto/vol/src/doc/imjoin.hlp @@ -0,0 +1,76 @@ +.help imjoin Jan89 images +.ih +NAME +imjoin -- join input images into output image along specified axis +.ih +USAGE +imjoin input output +.ih +PARAMETERS +.ls input +Input images or @file +.le +.ls output +Output joined image +.le +.ls joindim = 1 +Image dimension along which the input images will be joined. +.le +.ls outtype = "" +Output image datatype. If not specified, defaults to highest precedence +input image datatype. +.le + +.ih +DESCRIPTION + +IMJOIN concatenates a set of input images into a single output image, +in a specified dimension only. For example, it can join a set of one +dimensional images into a single, long one dimensional image, or a +set of one dimensional images into a single two dimensional image. +IMJOIN may be used to piece together datacubes into larger +datacubes, either in x, y, or z; likewise with higher dimensional images. + +For joining a set of 1 or 2 dimensional images in both x and y at the same +time, see IMMOSAIC. For stacking images of any dimension into an image +of the next higher dimension, see IMSTACK. Although IMJOIN can also +stack a set of images into a single higher dimensional image, IMSTACK +is more efficient for that operation. In most cases, IMJOIN must keep +all input images open at the same time, while IMSTACK does not (there may +be limitations on the number of files that can be kept open at one time). +Use IMJOIN primarily when joining a set of images along any dimension that +is not the next higher one from that of the input images. + +.ih +EXAMPLES + +.nf +1. Join a list of one dimensional spectra into a single long image. + + cl> imjoin @inlist output 1 + +2. Join three datacubes along the z direction. + + cl> imjoin c1,c2,c3 fullxcube 3 + +.fi + +.ih +TIMINGS + +Join 10 5000 column type short spectra into one 50000 column image: +6 seconds on a diskless Sun-3. + +Join 2 512*512 images: 28 seconds on diskless Sun-3. Join 2 50*50*50 +datacubes in x, y, or z: 15 seconds. + +.ih +BUGS + +There may be limitations on the number of input images that can be handled +in one execution on some systems. + +.ih +SEE ALSO +immosaic, imstack, imslice +.endhelp diff --git a/pkg/proto/vol/src/doc/proj.hlp b/pkg/proto/vol/src/doc/proj.hlp new file mode 100644 index 00000000..f0ed8a3e --- /dev/null +++ b/pkg/proto/vol/src/doc/proj.hlp @@ -0,0 +1,139 @@ +.help volumes Jan89 "Volume Rotation-Projection Algorithm" + +.ce +Volume Rotation-Projection Algorithm +.ce +January 1989 + +.sh +Introduction + +See help for VOLUMES and PVOL for general information. Here we describe +the volume projection algorithm used in PVOL. + +.sh +Algorithms for Collecting Object Voxels that Project onto Image Plane + +PVOL is a task for making successive projections through a 3d image onto +2d images placed along a great circle around an input datacube, with varying +degrees of translucency. The technique of viewing successive projections +around the input datacube causes interior features to appear to "orbit" +the axis of datacube rotation; the apparent orbital radii generate the +illusion of seeing in three dimensions. We limit ourselves to parallel rather +than perspective projections as the computations are simpler and the resulting +images preserve distance ratios. + +When we are considering orthogonal projections only, the 3D problem becomes +a 2D problem geometrically, collapsed into a plane at right angles to the +datacube rotation axis. Otherwise a full 3D solution would be needed. +To keep things straight, I will use "object voxel" +to represent voxels from the input volume image and "image pixel" to represent +output pixels in the projection plane. + +In addition to the projections being parallel, we also want them centered +and the projection plane perpendicular to the projection rays (we always want +to be looking toward the center of the volume regardless of the rotation angle). +Thus we will always orient the center of the projection plane perpendicular +to the ray passing through the center of the volume for the given rotation +angle. + +Methods in the literature include back-to-front (BTF) and front-to-back (FTB) +traversals, digital differential analyzer (DDA) techniques, and octree +encoding. Because of the nature of our light-transmission algorithm, we +must choose a BTF approach. For standard ray-tracing applications, involving +discrete objects within the volume image space, octree techniques can be +the most efficient, depending on the ratio of filled to un-filled space and +number of objects. However, for arbitrary voxel images (no explicit geometric +surfaces included, so every voxel must be examined) simpler techniques are +considered more efficient. There are basically two approaches: +[1] image-plane order: build up the output image one line at a time by +computing all contributing voxels, and +[2] volume-image order: traverse the voxels one line at a time, building +up the output image in successive overlapping sheets. + +The image-plane order approach is similar to rasterizing a line segment, namely +the projection ray through the lattice of voxels. Examples are the incremental +algorithm discussed in Foley and Van Dam (p. 432), implemented with +modifications in the IRAF SGI kernel, and Bresenham's algorithm, outlined in +the same place. Both methods can be extended to include information from +extra surrounding voxels, similar to anti-aliasing problems, and this may +be necessary for effective volume projections, especially of small spatial +resolution volumes. This approach may not necessarily be the most efficient +if the volume image cannot be held in memory and must be accessed randomly +from disk. Initially, we will code this algorithm only for the case where the +rotation is around the X axis of the volume and the viewing direction is +perpendicular to that axis. + +[Discussion of various algorithms for determining which set of voxels gets +included along a given projection ray follows. After this was coded, it +became apparent that runtime was largely dominated by the voxel memory +accesses after the voxel lists have been prepared. Consequently, the +incremental algorithm is all that is now used.] + +The straightforward incremental algorithm would be the simplest to implement, +though not the most efficient. Bresenham's algorithm, extended to include +information from fractionally pierced neighboring voxels, would be more +efficient as it need not use any real variables, and therefore does not +require rounding. Both these methods choose a single ray at a time hitting +the projection plane, and proceed along that ray, determining which voxels +contribute, and their weights, which are proportional to the path length +of the ray through the object voxels. By proceeding from back to front, we are +guaranteed that each contributing voxel from the volume succeeds any previous +one arriving at the current output pixel. Thus, we can use the output +pixel to store the results of any previous light transmission and absorption +operation, and feed that value back in to combine with the properties of +the next contributing volume voxel. This method fills up the image plane +in line-sequential order. Of course, we determine the list of object voxels +contributing to a given line of image pixels only once per rotation. + +In the volume-image order approach the input voxels are traversed line by line +in any correct BTF order; they can always be accessed band by band if that is +the disk storage order. This method fills up the image plane in successive +sheets, continually updating the image pixels previously written as it goes. +Determining which image pixel should be hit by the current object voxel +requires a transformation matrix. However, the information in the matrix can +be pre-multiplied with all possible values of voxel coordinates and stored in +a lookup table, resulting in much more efficient code than a straightforward +matrix multiplication for each object voxel (Frieder, Gordon, and Reynolds, +IEEE CG&A, Jan 1985, p. 52-60). Due to the significantly increased +computation time, this approach should only be used when datacube projections +are desired along any arbitrary 3D orientation. + +In the current implementation only rotations by PVOL around the image X +axis are allowed. If rotation is desired about either Y or Z, it is easy +to first rotate the input image, then run PVOL around the new X axis. +See D3TRANSPOSE [IMTRANS3D?] for help in rotating datacubes. + +.sh +Memory Management + +Now we know how to construct a list of indices of input voxels in +BTF order that impinge upon a given pixel in the projection plane. +The original PVOL prototype used line-oriented image i/o to access +the datacube. Profiles showed 90% of task execution time spent in +OS-level reads. Various other approaches were investigated, which +determined that actual voxel-value i/o was the most important factor +in performance. Since "in-core" i/o is the fastest, the problem became +one of getting as much of the input datacube into main memory as possible. + +A task maximum working set size parameter was added, and code for attempting +to grab this much memory, then cascading down to a reasonable amount if +the requested amount was too much (had adverse effects on PVOL or other +processes). Given a fixed amount of available memory smaller than that +required to hold the entire datacube in memory, the fastest way is to +volume-project through successive groups of YZ slices. A single YZ slice +of the datacube is sufficient for projecting any and all great-circle +orientations (360 degrees around the X axis). The more YZ slices that +can be held in memory, the better. If there is room for N YZ slices at +a time, and there are COLUMNS voxels in the X direction, then all volume +rotations must be made in each of (COLUMNS/N) passes. + +This approach sped things up by about a factor of 20 over random +line-oriented i/o. For very large datacubes (order of 500 voxels on +a side) there are on the order of 10 passes required when the task +working set is in the 10Mb range. Clearly available memory and/or super +fast disk i/o, dominates volume rotations. A general purpose workstation +with enough main memory can apparently approach the speed of the specialized +processors usually used in volume rendering. + + diff --git a/pkg/proto/vol/src/doc/pvol.hlp b/pkg/proto/vol/src/doc/pvol.hlp new file mode 100644 index 00000000..30ae4f38 --- /dev/null +++ b/pkg/proto/vol/src/doc/pvol.hlp @@ -0,0 +1,398 @@ +.help pvol Jan89 volumes +.ih +NAME +pvol -- project rotations of a volume datacube onto series of 2d images +.ih +USAGE +pvol input output +.ih +PARAMETERS +.ls input +Input 3d or 4d image (datacube). +.le +.ls output +Output datacube, one image band per rotation (type real only). +.le +.ls nframes = (360 / \fBdegrees\fR) +Number of frames to generate, 1 per rotation. +.le +.ls degrees = 10 +Number of degrees to rotate datacube for each successive projection. +.le +.ls theta0 = 0.0 +Initial projection angle for rotation sequence by \fBdegrees\fR increments. +Measured counterclockwise from +x axis when looking back toward the image +origin. +.le +.ls ptype = 2 +Projection type; +1 = opacity: attenuation along projection column by voxel opacity value. +2 = average voxel intensity along projection column. +3 = sum of voxel intensities. +4 = proportional distance weighting: voxel intensity +along projection column weighted by (curvoxel / voxels_in_column) +**\fBdispower\fR. +5 = mod(n): same as proportional distance weighting, but use only voxel values +which match mod(normalized_voxel * 100) = \fBmodn\fR. +6 = use last voxel value within cutoffs only. +.le +.ls imin, imax = INDEF +Input voxel intensity ranges within which to apply intensity transformation. +Defaults to input image min and max if not specified (see comments below). +.le +.ls omin, omax = INDEF +Input voxel opacity ranges within which to apply opacity transformation. +Defaults to input image min and max if not specified (see comments below). +.le +.ls amin, amax = 0.0, 1.0 +Attenuation factor minimum and maximum for ptype=1 (opacity). Voxel values +<= omin map to attenuation factor amin, >= omax map to attenuation amax. +.le +.ls izero = 1.0 +Initial background iillumination intensity when \fBptype\fR = 1 (opacity). +This intensity will be attenuated consecutively by (transformed voxel_value * +\fBoscale\fR) +along the projection column toward the projection plane. +.le +.ls oscale = 1.0 +Voxel opacity scale factor. Multiplied by voxel value before attenuating +remaining light along projection column for \fBptype\fR = 1. +.le +.ls opacelem = 1 +Opacity element in 4th dimension of input image. When input image is 4d, +and there are two elements in the 4th dimension, the \fBopacelem\fR element +will be treated as opacity and the other will be considered intensity. +.le +.ls dispower = 2.0 +Inverse distance weighting power for \fBptype\fR = 4,5. Voxel intensities will +be multiplied by (voxel position in column / voxels in column) ** +\fBdispower\fR before being summed into the output projection pixel. +.le +.ls discutoff = no +When distance weighting, measure the distance within that set of projecting +voxels that lies between the intensity cutoffs rather than from +the edges of the datacube. Usually results in faster run times and is +appropriate when the interior of a well-defined object is of interest +rather than its placement inside the datacube. +.le +.ls modn = 10 +For ptype=5, only voxel values satisfying mod (int (voxval * 100.0)) = +\fBmodn\fR will be proportional distance-weighted and summed into +projection pixel. Useful for viewing volume interiors with high contrast +voxel values (like solid objects in an otherwise empty datacube). +.le +.ls vecx = 1.0 +Rotation axis X vector. Part of the specification of a three-dimensional +orientation vector around which the datacube will appear to rotate when +viewed from the front. PROTOTYPE only supports rotations around the x axis. +.le +.ls vecy, vecz = 0.0 +Rotation axis Y and Z vectors. In prototype, must be zero. +.le +.ls title = "" +Output datacube title for rotation sequence. +.le +.ls maxws = 2000000 +Maximum workingset size in chars (usually 2 bytes). Decrease if machine +performance degrades noticeably during a run. Increase if the machine has +lots of memory and PVOL does not affect other processes. +.le +.ls abs = no +If yes, take absolute value of voxel before applying any transformation. +.le +.ls verbose = yes +Report memory usage, progress around the rotation, and more detail on +errors if yes. +.le + + +.ih +DESCRIPTION + +PVOL is used for visualizing the interiors of three-dimensional images. +Opacity and intensity information is used to construct projected 2d images +approximating an "xray" view through the original "solid", with varying +amounts of apparent translucency. Playing the resulting 2d images back +rapidly as a filmloop generates the impression of a rotating translucent +datacube inside of which you can view much of the original information with +the illusion of seeing it in 3 dimensions. + +Given an input datacube plus rotation and projection parameters, PVOL +produces a series of projected 2d images written out as another datacube. +Rotation parameters control the number of frames to project, their +angular separation, and the 3 vectors comprising the axis of rotation. +In the prototype, only one rotation axis is allowed, counterclockwise +about the X-axis when viewed facing the origin from +X (however, the user +is viewing the datacube from -Z, and so sees the datacube rotating toward +him/her). When off-axis rotations are added, the view angle will still be +from the front of the datacube. +Non-orthogonal rotations in the prototype will have to be accomplished by +first rotating the input datacube appropriately with other tools. + +Projection parameters +provide control over the appearance of the projected images. They may be +tuned to visually enhance the apparent placement of interior regions in three +dimensions during the rotation sequence. Frames from the output datacube +may be viewed individually on standard image display devices, may be +played back rapidly with filmloop tools, or may be recorded to video as +smooth, rotating volumes. [At present the only filmloop tool available to us +is MOVIE on Sun workstations, which requires preprocessing the datacube +output from this task with another task called I2SUN]. + +Sequences where the volume's rotation axis is the same as the viewing or +projection axis are little more useful than a block average of the datacube, +as hidden regions never rotate into view. Volume rotations about the cube's +X-axis (viewed from the front, or -Z) are the fastest and the only type +implemented in the prototype. + +The \fBptype\fR parameter provides control over the type of projection. +There are three main types of projection: opacity, intensity, and both +together. If the +input datacube is 4-dimensional, with two elements in the 4th dimension, +both opacity and intensity information will be used -- first the remaining +light along the projection will be attenuated by the opacity function, then +the new voxel's intensity contribution added, according to \fBptype\fR. Before +the projection function is applied, the raw voxel intensity or opacity is +clipped and scaled by transformation functions under control of task +parameters. +.PP +The image MIN and MAX must be present in the input image header, or they +will default to 0.0 and 1.0 and a warning will be issued (run IMAGES.MINMAX +with \fBupdate\fR=yes to set them if not already present). +If intensity information is being used, \fBimin\fR and \fBimax\fR +must be specified, or they will default to the image min and max. +First we consider the intensity/opacity transformation functions, then we +discuss how the transformed value contributes to the final projected image. + +.nf + Intensity transformation: + + if (voxval < imin) + newval = imin + else if (imin <= voxval && voxval < imax) + newval = im_min + (im_max-im_min) * (voxval-imin)/(imax-imin) + else + newval = imax + + Opacity transformation (0.0 <= attenuation <= 1.0): + if (voxval < omin) # let maximum amount of light through + attenuation = amax + else if (omin <= voxval && voxval < omax) + attenuation = amin + (amax-amin) * (voxval*oscale - omin) / + (omax-omin) + else # let minimum amount of light through + attenuation = amin + +.fi + +The intensity class of projections includes \fBptype\fR = 2, 3, 4, 5, and 6. +The default, \fBptype\fR 2, results in the AVERAGE transformed intensity along +the projection column, while type 3 yields the SUM of transformed intensities. + +Type 4, PROPORTIONAL DISTANCE WEIGHTING, is used in conjunction with the +\fBdispower\fR parameter to weight the transformed voxel intensities by +their inverse proportional depth along the projection column. +If \fBdiscutoff\fR is no, the default, the distance will be that portion of +the datacube intersected by the projection ray, measured starting at the +rear (far side from the projection plane). If \fBdiscutoff\fR is yes, +the distance will be measured between the first and last voxels that fell +between the cutoffs \fBimin\fR and \fBimax\fR. +This projection generates a kind +of depth cueing often useful in determining visually during filmloop playback +which portions of the rotating image are in the foreground and which in the +background (and how far). The distance weighting is accomplished as follows, +where voxposition and totvoxels are determined according to \fBdiscutoff\fR: + +.nf + \fBptype\fR = 4 (distance weighting): + newval = newval * (voxposition / voxelsincolumn) ** \fBdispower\fR +.fi + +\fBptype\fR = 5, MODULAR PROPORTIONAL DISTANCE WEIGHTING, is useful for better +seeing into the interiors of high-contrast datacubes. Rather than using each +voxel value along the projection column, only certain voxel values contribute, +based on the \fBmodn\fR parameter (sometimes it is necessary to artificially +"thin out" the data to see far enough into or through it). + +.nf + \fBptype\fR = 5 (modular distance weighting): + if (mod (int (newval/val_range * 100)) = \fBmodn\fR) + use newval as in normal distance weighting + else + ignore newval +.fi + +\fBptype\fR = 6 results in only the LAST transformed voxel intensity that +is between the \fBimin\fR and \fBimax\fR cutoffs being used. This corresponds +to seeing only the outer surface of datacube interior regions between the +cutoffs (though since not every projection ray will pass through voxels +right on the cutoff boundary, this will not necessarily result in a three +dimensional intensity contour of an interior object; i.e. the intensities +of those outer voxels can vary). + +OPACITY information can be used in viewing the interiors of 3d images, unlike +in 2d images. For \fBptype=1\fR parallel rays of light may be pictured +shining through the datacube toward the projection plane, along the normal +to that plane. The voxel values in this +case are considered to represent a degree of opacity, and a column of light +will be attenuated by each voxel according to a function of its opacity value +as the ray proceeds through the volume. The \fBizero\fR parameter provides +the initial incident "light" intensity before any attenuation. The +amount of remaining light after projection through the datacube is very +sensitive to the voxel opacities and the number of voxels in each projection +column. Consequently, the \fBoscale\fR parameter is supplied to enable +adjusting the relative attenuation in a single step while scouting for +the right opacity transformation function to generate the desired effect +during playback rotation. Given the amount of attenuation +as determined in the opacity transformation function above, for each +contributing voxel along the projection column: + +.nf + projection pixel = projection pixel * attenuation +.fi + +If the input image is 4-dimensional, with 2 elements in the 4th dimension, +voxel intensities will be added after attenuation +to contribute to the total projected pixel value (like a cloud +with both absorption and emission). For +purposes of visualization only, it is not necessary that the voxel value +represent a physically real opacity; any data value may be treated as +attenuating an imaginary xray passing through the solid in order to help +image the volume in three apparent dimensions. + +For all of the projection types, once the modified intensity +has been determined, it contributes to the output pixel onto which the +current, arbitrarily-oriented column of voxels projects. To summarize: + +.nf + 1 OPACITY: + proj_pix = proj_pix * attenuation + 2 AVERAGE: + proj_pix = proj_pix + newval / nvox + 3 SUM: + proj_pix = proj_pix + newval + 4 INVDISPOW: + proj_pix = proj_pix + newval * (vox/voxincol)**dispow + 5 MOD: + if mod (int (newval/val_range * 100.0)) = \fBmodn\fR + proj_pix = proj_pix + newval * (vox/voxincol)**dispow + 6 LASTONLY: + if (\fBimin\fR < newval && newval <= \fBimax\fR) + proj_pix = newval + +.fi + +.ih +PERFORMANCE AND SIZE CONSTRAINTS + +Projections through 3d images inherently require large amounts of memory, +or else the tasks will spend all their time thrashing with I/O. In volume +rotations about the X-axis, each output pixel is derived by projecting at +an arbitrary angle through a YZ slice of the input image. Because of otherwise +excessive thrashing, PVOL requires sufficient memory for at least one YZ +slice. The more YZ slices that will fit into memory at one time, the better, +because I/O is more efficient the larger the chunk of the image that can +be read at one time. It is best if the entire image will fit into memory, +as the output image (all rotations) will not have to be reread for each +successive chunk of YZ slices. Available memory is that actually allocable +by PVOL for the slices plus one line of the output image. On a workstation +there will usually be considerably less memory available for PVOL than +the amount physically in the machine if running in a window environment. +Examples of the number of YZ slices that will fit based on image size and +available memory follow; image datatype is assumed to be REAL -- multiply +number of YZ slices by 2 for SHORT images. + +.nf + Usable Memory Image Size Approx YZ Slices + ------------------------------------------------ + 1 Mb 64*64*64 64 (whole image) + 1 Mb 512*512*512 1 + 4 Mb 101*101*101 101 (whole image) + 4 Mb 1024*1024*1024 1 + 8 Mb 128*128*128 128 (whole image) + 8 Mb 1448*1448*1448 1 + 16 Mb 161*161*161 161 (whole image) + 16 Mb 2048*2048*2048 1 + 32 Mb 203*203*203 203 (whole image) + 32 Mb 2896*2896*2896 1 + 64 Mb 256*256*256 256 (whole image) + 128 Mb 322*322*322 322 (whole image) + 512 Mb 512*512*512 512 (whole image) +.fi + +PVOL checks to see how much memory it can grab, then actually allocates +somewhat less than this (otherwise you wouldn't be able to do anything +except run IRAF tasks already loaded in the process cache until PVOL +finishes). With \fBverbose\fR on, the task reports memory usage figures. +On some machines the system will continue to allocate more memory for a +task even above that reported by PVOL. This can be a problem if you fire +up PVOL from a workstation (even with lots of windows already open); +after you log out, the system may grab that extra memory you were using, +and not even let you back in later. This is why the \fBmaxws\fR +parameter is supplied -- lower it if this type of behavior is experienced. + +.ih +EXAMPLES + +.nf +1. Produce 36 rotation projections (one every 10 degrees) around the + x-axis of a datacube, viewed from the front (negative z + direction). Assume that the single-valued input voxel values + are intensities, and that the image header contains MIN and MAX. + + cl> pvol input output + +2. Generate 180 frames, one every two degrees. + + cl> pvol input output nframes=180 degrees=2 + +3. Use inverse proportional distance cubed weighting in two + subsampled projections for a quick look. Distance-weight + only between projection voxels falling within the specified + cutoffs (0.1 to 1.0). + + cl> pvol input[*:4,*:4,*:4] output nfr=2 deg=90 ptype=4 \ + dispower=3 discutoff+ imin=.1 imax=1.0 + +4. Project through a 4d image containing opacity information in + element 2 of the 4th axis and intensity in element 1. Scale + the voxel opacities by 0.1 to allow more light through. Use + the SUM of the voxel intensity values (which will be attenuated + by subsequent opacities), with no distance weighting. + + cl> pvol input output ptype=3 opacelem=2 + +.fi + +.ih +TIMINGS + +1min 12sec cpu on an unloaded Sun-4 to produce +36 rotation increments around a 50*50*50 datacube with \fBptype\fR=2 +(uses less than 1 Mb of memory for image data); 46sec for \fBptype\fR=1; +2min 19sec for \fBptype\fR=4. + +4min 32sec cpu on an unloaded Sun-3 with 8 Mb memory to do 36 steps around a +50*50*50 datacube with \fBptype\fR=2 (also uses less than 1 Mb); +3min 20sec for \fBptype\fR=1; 10min 51sec for \fBptype\fR=4. + +17hr 20 min cpu on a Sun-4 to do 36 rotation steps around a 450*450*450 +datacube with \fBptype\fR=4. + +.ih +BUGS + +Maximizing memory usage without adversely impacting other functions can be +tricky. Adverse effects may result from using too high a \fBmaxws\fR. + +Cannot rotate around arbitrary axis yet. + +Lacks shading algorithm. + +Needs easier user interface to adjust translucency parameters (e.g. with +mouse when workstations become fast enough to do this in real time). + +.ih +SEE ALSO +i2sun, im3dtran, im3dstack +.endhelp diff --git a/pkg/proto/vol/src/doc/volumes.hlp b/pkg/proto/vol/src/doc/volumes.hlp new file mode 100644 index 00000000..4ebb4aeb --- /dev/null +++ b/pkg/proto/vol/src/doc/volumes.hlp @@ -0,0 +1,56 @@ +.help volumes Jan89 "Volumes Package" + +***** NOTE: This is just a suggested package organization and will +***** definitely NOT be the final one chosen. + +.ce +Volume or 3d Image Applications in IRAF +.ce +January 1989 + +.sh +Introduction + +The Volumes package collects tasks related to manipulating and displaying +volume images (3d images, or datacubes). Although all IRAF images can be +multidimensional (currently up to 7 dimensions), not all applications tasks +are equipped to handle images of dimension greater than 2. Examples of +tasks that are so equipped are IMARITH, IMSTATISTICS, BLKAVG, and DISPLAY +for looking at arbitrary 2d sections of higher dimensional images. + +Volumes applications include tasks for manipulating the orientation of +a 3d image, joining 3d images, projections of datacube contents +onto 2d images, and tasks related to viewing a datacube or its projections +as a movie. + +.ih +Datacube Manipulation Tasks + +D3TRANSPOSE 3d transpose, any axis to any other axis +IMJOIN join 2 or more 3d images together along specified axis +IMCOPY +BLKAVG +IMSLICE + +.ih +Datacube Generation Tasks + +BINTOIM [not in VOLUMES; probably still PROTO after upgrade to 3d?] +POINTOIM convert n-dimensional point data into volumes in datacube +MANDEL4 4d Mandelbrot set generator + +.ih +Volume Projection Tasks + +PVOL project volume contents onto series of 2d images +SLICEVOL* "cubetool" -- slice off faces of datacube rendered from + arbitrary angle w/translucency + +.ih +Movie-Related Tasks + +IMTOSUN convert datacube or list of 2d images into Sun rasterfiles +IMTOVID (script) record set of 2d images onto panasonic video recorder +CUBETOVID (script) record sliced from databube onto video recorder + +* = [not yet implemented] diff --git a/pkg/proto/vol/src/i2sun.par b/pkg/proto/vol/src/i2sun.par new file mode 100644 index 00000000..d28d887c --- /dev/null +++ b/pkg/proto/vol/src/i2sun.par @@ -0,0 +1,14 @@ +input,s,a,,,,Input image template or 3d image +output,s,a,,,,Output rasterfile template +z1,r,a,,,,Minimum greylevel to be displayed +z2,r,a,,,,Maximum greylevel to be displayed +clutfile,f,h,"",,,Input rasterfile containing color lookup table +ztrans,s,h,linear,,,Greylevel transformation (linear|log|none|user) +ulutfile,f,h,"",,,File containing user defined look up table +xsize,i,h,INDEF,1,,Output rasterfile horizontal size +ysize,i,h,INDEF,1,,Output rasterfile vertical size +xmag,r,h,1.,,,Output rasterfile horizontal magnification +ymag,r,h,1.,,,Output rasterfile vertical magnification +order,i,h,1,0,1,"Spatial interpolator order; 0=replic., 1=linear" +sliceaxis,i,h,3,,,"Slice a 3d or higher image through this axis" +swap,b,h,no,,,"Swap bytes in output rasterfiles?" diff --git a/pkg/proto/vol/src/i2sun/cnvimage.x b/pkg/proto/vol/src/i2sun/cnvimage.x new file mode 100644 index 00000000..59bd4655 --- /dev/null +++ b/pkg/proto/vol/src/i2sun/cnvimage.x @@ -0,0 +1,142 @@ +include <imhdr.h> +include <mach.h> +include "i2sun.h" + + +# CNV_IMAGE -- Read each line of the input image, apply ztransform, convert +# to rasterfile form, and write to rasterfile. + +procedure cnv_image (im, slice, tr, uptr, rfd) +pointer im # input image +int slice # current slice if n>2 image +pointer tr # spatial & greyscale transform structure +pointer uptr # pointer to user-specified transfer lut +pointer rfd # output rasterfile + +real z1, z2, rz1, rz2 +int ztrans, row, xblk, yblk, ocols, olines +real px1, px2, py1, py2 # image coords in fractional image pixels +pointer sp, si, bufptr, out, rtemp, packed +short z1_s, z2_s, rz1_s, rz2_s +bool unitary_greyscale_transformation + +bool fp_equalr() +pointer siglns(), siglnr(), sigln_setup() +errchk siglns(), siglnr(), sigln_setup() + +begin + # Set up for scaled image input. + px1 = 1 + px2 = IM_LEN(im,COL) + py1 = 1 + py2 = IM_LEN(im,LINE) + ocols = TR_XE(tr) - TR_XS(tr) + 1 + olines = TR_YE(tr) - TR_YS(tr) + 1 + + # Round odd-numbered numbers of columns up due to restrictions on + # IRAF binary byte i/o (number of bytes of image data must match + # that specified in rasterfile header). + if (mod (ocols, 2) == 1) + ocols = ocols + 1 + + xblk = INDEFI + yblk = INDEFI + si = sigln_setup (im, px1,px2,ocols,xblk, py1,py2,olines,yblk, + TR_ORDER(tr)) + + # Type short pixels are treated as a special case to minimize vector + # operations for such images (which are common). If unity mapping is + # employed the data is simply copied, i.e., floor ceiling constraints + # are not applied. This is very fast and will produce a contoured + # image on the display which will be adequate for some applications. + + z1 = TR_Z1(tr) + z2 = TR_Z2(tr) + ztrans = TR_ZTRANS(tr) + rz1 = COLORSTART + rz2 = COLOREND + if (ztrans == Z_UNITARY) { + unitary_greyscale_transformation = true + } else if (ztrans == Z_LINEAR) { + unitary_greyscale_transformation = + ((fp_equalr(z1,rz1) && fp_equalr(z2,rz2)) || fp_equalr(z1,z2)) + } else + unitary_greyscale_transformation = false + + if (IM_PIXTYPE(im) == TY_SHORT && ztrans != Z_LOG) { + + call smark (sp) + call salloc (out, ocols, TY_SHORT) + call salloc (packed, ocols, TY_CHAR) + z1_s = z1; z2_s = z2 + + for (row=olines; row >= 1; row=row-1) { + bufptr = siglns (si, row, TR_SLICEAXIS(tr), slice) + + if (unitary_greyscale_transformation) { + call amovs (Mems[bufptr], Mems[out], ocols) + } else if (ztrans == Z_USER) { + rz1_s = U_Z1; rz2_s = U_Z2 + call amaps (Mems[bufptr], Mems[out], ocols, z1_s, z2_s, + rz1_s, rz2_s) + call aluts (Mems[out], Mems[out], ocols, Mems[uptr]) + } else { + rz1_s = rz1; rz2_s = rz2 + call amaps (Mems[bufptr], Mems[out], ocols, z1_s, z2_s, + rz1_s, rz2_s) + } + + # Pack to unsigned byte and write to file. + call achtsc (Mems[out], Memc[packed], ocols) + call chrpak (Memc[packed], 1, Memc[packed], 1, ocols) + call write (rfd, Memc[packed], ocols / SZB_CHAR) + } + call sfree (sp) + + } else if (ztrans == Z_USER) { + call smark (sp) + call salloc (rtemp, ocols, TY_REAL) + call salloc (out, ocols, TY_SHORT) + call salloc (packed, ocols, TY_CHAR) + + for (row=olines; row >= 1; row=row-1) { + bufptr = siglnr (si, row, TR_SLICEAXIS(tr), slice) + call amapr (Memr[bufptr], Memr[rtemp], ocols, z1, z2, + real(U_Z1), real(U_Z2)) + call achtrs (Memr[rtemp], Mems[out], ocols) + call aluts (Mems[out], Mems[out], ocols, Mems[uptr]) + call achtsc (Mems[out], Memc[packed], ocols) + call chrpak (Memc[packed], 1, Memc[packed], 1, ocols) + call write (rfd, Memc[packed], ocols / SZB_CHAR) + } + call sfree (sp) + + } else { + call smark (sp) + call salloc (rtemp, ocols, TY_REAL) + call salloc (packed, ocols, TY_CHAR) + + for (row=olines; row >= 1; row=row-1) { + bufptr = siglnr (si, row, TR_SLICEAXIS(tr), slice) + + if (unitary_greyscale_transformation) { + call amovr (Memr[bufptr], Memr[rtemp], ocols) + } else if (ztrans == Z_LOG) { + call amapr (Memr[bufptr], Memr[rtemp], ocols, + z1, z2, 1.0, 10.0 ** MAXLOG) + call alogr (Memr[rtemp], Memr[rtemp], ocols) + call amapr (Memr[rtemp], Memr[rtemp], ocols, + 1.0, real(MAXLOG), rz1, rz2) + } else + call amapr (Memr[bufptr], Memr[rtemp], ocols, z1, z2, + rz1, rz2) + call achtrc (Memr[rtemp], Memc[packed], ocols) + call chrpak (Memc[packed], 1, Memc[packed], 1, ocols) + call write (rfd, Memc[packed], ocols / SZB_CHAR) + } + call sfree (sp) + } + + call sigln_free (si) +end + diff --git a/pkg/proto/vol/src/i2sun/i2sun.h b/pkg/proto/vol/src/i2sun/i2sun.h new file mode 100644 index 00000000..73f2ea3f --- /dev/null +++ b/pkg/proto/vol/src/i2sun/i2sun.h @@ -0,0 +1,46 @@ +# I2SUNRAS.H -- Include file for IRAF to Sun rasterfile program i2sunras. + +define COL 1 +define LINE 2 +define BAND 3 +define Z_LINEAR 1 # linear ztransform +define Z_LOG 2 # log ztransform +define Z_UNITARY 3 # no ztransform +define Z_USER 4 # user-specified transform +define U_MAXPTS 4096 # max user-specified lut pairs (DISPLAY) +define U_Z1 0 # base user-specified transfer val +define U_Z2 4095 # upper user-specified transfer val +define MAXLOG 3 # if log, map to 1:10**MAXLOG b4 log10 +define DSP_MIN 0 # minimum display pixel value +define DSP_MAX 255 # maximum display pixel value +define RAS_HDR_INTS 8 # SunOS4.0 and earlier +define RMT_NONE 0 # SunOS4.0 and earlier +define RMT_EQUAL_RGB 1 # SunOS4.0 and earlier +define RMT_STANDARD 1 # SunOS4.0 and earlier +define RAS_MAGIC 1504078485 # SunOS4.0 and earlier +define NGREY 256 # SunOS4.0 and earlier, 8bit fb +define COLORSTART 1 # IMTOOL +define COLOREND 200 # IMTOOL +define COLORRANGE 200 # IMTOOL +define WHITE (NGREY-1) # IMTOOL +define BLACK 0 # IMTOOL +define NBITS_FB 8 +define wrapup_ 91 + +# Spatial and greyscale transformation structure. +define LEN_TR 20 +define TR_ZTRANS Memi[$1] # Greyscale transformation. +define TR_Z1 Memr[P2R($1+1)] # Minimum data z-value +define TR_Z2 Memr[P2R($1+2)] # Maximum data z-value +define TR_XSIZE Memi[$1+3] # Output rasterfile size in x +define TR_YSIZE Memi[$1+4] # Output rasterfile size in y +define TR_XMAG Memr[P2R($1+5)] # Magnification factor in x +define TR_YMAG Memr[P2R($1+6)] # Magnification factor in y +define TR_ORDER Memi[$1+7] # Interpolation order +define TR_XS Memi[$1+8] # Starting output x pixel index +define TR_XE Memi[$1+9] # Ending output x pixel index +define TR_YS Memi[$1+10] # Starting output y pixel index +define TR_YE Memi[$1+11] # Ending output y pixel index +define TR_SLICEAXIS Memi[$1+12] # Slice or frame axis when ndim>2 +define TR_SWAPBYTES Memb[$1+13] # Swap output bytes? +# # Reserved space diff --git a/pkg/proto/vol/src/i2sun/mkpkg b/pkg/proto/vol/src/i2sun/mkpkg new file mode 100644 index 00000000..b1a8c4f4 --- /dev/null +++ b/pkg/proto/vol/src/i2sun/mkpkg @@ -0,0 +1,27 @@ +# Library for the I2SUN task. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + t_i2sun.x <imhdr.h> <ctype.h> i2sun.h + trulut.x <error.h> <ctype.h> i2sun.h + trsetup.x <imhdr.h> i2sun.h + cnvimage.x <imhdr.h> i2sun.h + sigln.x <error.h> <imhdr.h> + ; + +dbx: + $set XFLAGS = "-c -g -F -q" + $set LFLAGS = "-g -q" + $omake x_i2sun.x + $omake t_i2sun.x + $omake trulut.x + $omake trsetup.x + $omake cnvimage.x + $omake sigln.x + $link x_i2sun.o t_i2sun.o trulut.o trsetup.o cnvimage.o sigln.o \ + -o xx_i2sun.e + ; diff --git a/pkg/proto/vol/src/i2sun/sigln.x b/pkg/proto/vol/src/i2sun/sigln.x new file mode 100644 index 00000000..9d763b3f --- /dev/null +++ b/pkg/proto/vol/src/i2sun/sigln.x @@ -0,0 +1,783 @@ +include <imhdr.h> +include <error.h> + +.help sigl2, sigl2_setup +.nf ___________________________________________________________________________ +SIGLN -- Get a line from a spatially scaled image of any dimensionality. +This procedure works like the regular IMIO get line procedure, but rescales +the input image in 1 or two axes upon input (for a resulting 2d output image). +If the magnification +ratio required is greater than 0 and less than 2 then linear interpolation is +used to resample the image. If the magnification ratio is greater than or +equal to 2 then the image is block averaged by the smallest factor which +reduces the magnification to the range 0-2 and then interpolated back up to +the desired size. In some cases this will smooth the data slightly, but the +operation is efficient and avoids aliasing effects. + + si = sigln_setup (im, x1,x2,nx,xblk, y1,y2,ny,yblk, order) + sigln_free (si) + ptr = sigln[sr] (si, linenumber) + +SIGLN_SETUP must be called to set up the transformations after mapping the +image and before performing any scaled i/o to the image. SIGLN_FREE must be +called when finished to return buffer space. +.endhelp ______________________________________________________________________ + +# Scaled image descriptor for 2-dim images + +define SI_LEN 16 +define SI_MAXDIM 2 # 2 dimensions of spatial scaling +define SI_NBUFS 3 # nbuffers used by SIGLN + +define SI_IM Memi[$1] # pointer to input image header +define SI_GRID Memi[$1+1+$2-1] # pointer to array of X coords +define SI_NPIX Memi[$1+3+$2-1] # number of X coords +define SI_BAVG Memi[$1+5+$2-1] # X block averaging factor +define SI_INTERP Memi[$1+7+$2-1] # interpolate X axis +define SI_BUF Memi[$1+9+$2-1] # line buffers +define SI_ORDER Memi[$1+12] # interpolator order, 0 or 1 +define SI_TYBUF Memi[$1+13] # buffer type +define SI_XOFF Memi[$1+14] # offset in input image to first X +define SI_INIT Memi[$1+15] # YES until first i/o is done + +define OUTBUF SI_BUF($1,3) + +define SI_TOL (1E-5) # close to a pixel +define INTVAL (abs ($1 - nint($1)) < SI_TOL) +define SWAPI {tempi=$2;$2=$1;$1=tempi} +define SWAPP {tempp=$2;$2=$1;$1=tempp} +define NOTSET (-9999) + +# SIGLN_SETUP -- Set up the spatial transformation for SIGLN[SR]. Compute +# the block averaging factors (1 if no block averaging is required) and +# the sampling grid points, i.e., pixel coordinates of the output pixels in +# the input image. + +pointer procedure sigln_setup (im, px1,px2,nx,xblk, py1,py2,ny,yblk, order) + +pointer im # the input image +real px1, px2 # range in X to be sampled on an even grid +int nx # number of output pixels in X +int xblk # blocking factor in x +real py1, py2 # range in Y to be sampled on an even grid +int ny # number of output pixels in Y +int yblk # blocking factor in y +int order # interpolator order (0=replicate, 1=linear) + +int npix, noldpix, nbavpix, i, j +int npts[SI_MAXDIM] # number of output points for axis +int blksize[SI_MAXDIM] # block averaging factor (npix per block) +real tau[SI_MAXDIM] # tau = p(i+1) - p(i) in fractional pixels +real p1[SI_MAXDIM] # starting pixel coords in each axis +real p2[SI_MAXDIM] # ending pixel coords in each axis +real scalar, start +pointer si, gp + +begin + iferr (call calloc (si, SI_LEN, TY_STRUCT)) + call erract (EA_FATAL) + + SI_IM(si) = im + SI_NPIX(si,1) = nx + SI_NPIX(si,2) = ny + SI_ORDER(si) = order + SI_INIT(si) = YES + + p1[1] = px1 # X = index 1 + p2[1] = px2 + npts[1] = nx + blksize[1] = xblk + + p1[2] = py1 # Y = index 2 + p2[2] = py2 + npts[2] = ny + blksize[2] = yblk + + # Compute block averaging factors if not defined. + # If there is only one pixel then the block average is the average + # between the first and last point. + + do i = 1, SI_MAXDIM { + if ((blksize[i] >= 1) && (blksize[i] != INDEFI)) { + if (npts[i] == 1) + tau[i] = 0. + else + tau[i] = (p2[i] - p1[i]) / (npts[i] - 1) + } else { + if (npts[i] == 1) { + tau[i] = 0. + blksize[i] = int (p2[i] - p1[i] + 1) + } else { + tau[i] = (p2[i] - p1[i]) / (npts[i] - 1) + if (tau[i] >= 2.0) { + + # If nx or ny is not an integral multiple of the block + # averaging factor, noldpix is the next larger number + # which is an integral multiple. When the image is + # block averaged pixels will be replicated as necessary + # to fill the last block out to this size. + + blksize[i] = int (tau[i]) + npix = p2[i] - p1[i] + 1 + noldpix = (npix+blksize[i]-1) / blksize[i] * blksize[i] + nbavpix = noldpix / blksize[i] + scalar = real (nbavpix - 1) / real (noldpix - 1) + p1[i] = (p1[i] - 1.0) * scalar + 1.0 + p2[i] = (p2[i] - 1.0) * scalar + 1.0 + tau[i] = (p2[i] - p1[i]) / (npts[i] - 1) + } else + blksize[i] = 1 + } + } + } + + SI_BAVG(si,1) = blksize[1] + SI_BAVG(si,2) = blksize[2] + + if (IS_INDEFI (xblk)) + xblk = blksize[1] + if (IS_INDEFI (yblk)) + yblk = blksize[2] + + # Allocate and initialize the grid arrays, specifying the X and Y + # coordinates of each pixel in the output image, in units of pixels + # in the input (possibly block averaged) image. + + do i = 1, SI_MAXDIM { + # The X coordinate is special. We do not want to read entire + # input image lines if only a range of input X values are needed. + # Since the X grid vector passed to ALUI (the interpolator) must + # contain explicit offsets into the vector being interpolated, + # we must generate interpolator grid points starting near 1.0. + # The X origin, used to read the block averaged input line, is + # given by XOFF. + + if (i == 1) { + SI_XOFF(si) = int (p1[i]) + start = p1[1] - int (p1[i]) + 1.0 + } else + start = p1[i] + + # Do the axes need to be interpolated? + if (INTVAL(start) && INTVAL(tau[i])) + SI_INTERP(si,i) = NO + else + SI_INTERP(si,i) = YES + + # Allocate grid buffer and set the grid points. + iferr (call malloc (gp, npts[i], TY_REAL)) + call erract (EA_FATAL) + SI_GRID(si,i) = gp + if (SI_ORDER(si) <= 0) { + do j = 0, npts[i]-1 + Memr[gp+j] = int (start + (j * tau[i]) + 0.5) + } else { + do j = 0, npts[i]-1 + Memr[gp+j] = start + (j * tau[i]) + } + } + + return (si) +end + + +# SIGLN_FREE -- Free storage associated with an image opened for scaled +# input. This does not close and unmap the image. + +procedure sigln_free (si) + +pointer si +int i + +begin + # Free SIGLN buffers. + do i = 1, SI_NBUFS + if (SI_BUF(si,i) != NULL) + call mfree (SI_BUF(si,i), SI_TYBUF(si)) + + # Free GRID buffers. + do i = 1, SI_MAXDIM + if (SI_GRID(si,i) != NULL) + call mfree (SI_GRID(si,i), TY_REAL) + + call mfree (si, TY_STRUCT) +end + + +# SIGLNS -- Get a line of type short from a scaled image. Block averaging is +# done by a subprocedure; this procedure gets a line from a possibly block +# averaged image and if necessary interpolates it to the grid points of the +# output line. + +pointer procedure siglns (si, lineno, slice_axis, slice) + +pointer si # pointer to SI descriptor +int lineno +int slice_axis # axis from which to slice section for ndim>2 images +int slice # current slice index + +pointer rawline, tempp, gp +int i, buf_y[2], new_y[2], tempi, curbuf, altbuf +int npix, nblks_y, ybavg, x1, x2 +real x, y, weight_1, weight_2 +pointer si_blkavgs() +errchk si_blkavgs + +begin + npix = SI_NPIX(si,1) + + # Determine the range of X (in pixels on the block averaged input image) + # required for the interpolator. + + gp = SI_GRID(si,1) + x1 = SI_XOFF(si) + x = Memr[gp+npix-1] + x2 = x1 + int(x) + if (INTVAL(x)) + x2 = x2 - 1 + x2 = max (x1 + 1, x2) + + gp = SI_GRID(si,2) + y = Memr[gp+lineno-1] + + # The following is an optimization provided for the case when it is + # not necessary to interpolate in either X or Y. Block averaging is + # permitted. + + if (SI_INTERP(si,1) == NO && SI_INTERP(si,2) == NO) + return (si_blkavgs (SI_IM(si), x1, x2, int(y), + SI_BAVG(si,1), SI_BAVG(si,2), slice_axis, slice)) + + # If we are interpolating in Y two buffers are required, one for each + # of the two input image lines required to interpolate in Y. The lines + # stored in these buffers are interpolated in X to the output grid but + # not in Y. Both buffers are not required if we are not interpolating + # in Y, but we use them anyhow to simplify the code. + + if (SI_INIT(si) == YES) { + do i = 1, 2 { + if (SI_BUF(si,i) != NULL) + call mfree (SI_BUF(si,i), SI_TYBUF(si)) + call malloc (SI_BUF(si,i), npix, TY_SHORT) + SI_TYBUF(si) = TY_SHORT + buf_y[i] = NOTSET + } + if (OUTBUF(si) != NULL) + call mfree (OUTBUF(si), SI_TYBUF(si)) + call malloc (OUTBUF(si), npix, TY_SHORT) + SI_INIT(si) = NO + } + + # If the Y value of the new line is not in range of the contents of the + # current line buffers, refill one or both buffers. To refill we must + # read a (possibly block averaged) input line and interpolate it onto + # the X grid. The X and Y values herein are in the coordinate system + # of the (possibly block averaged) input image. + + new_y[1] = int(y) + new_y[2] = int(y) + 1 + + # Get the pair of lines whose integral Y values form an interval + # containing the fractional Y value of the output line. Sometimes the + # desired line will happen to be in the other buffer already, in which + # case we just have to swap buffers. Often the new line will be the + # current line, in which case nothing is done. This latter case occurs + # frequently when the magnification ratio is large. + + curbuf = 1 + altbuf = 2 + + do i = 1, 2 { + if (new_y[i] == buf_y[i]) { + ; + } else if (new_y[i] == buf_y[altbuf]) { + SWAPP (SI_BUF(si,1), SI_BUF(si,2)) + SWAPI (buf_y[1], buf_y[2]) + + } else { + # Get line and interpolate onto output grid. If interpolation + # is not required merely copy data out. This code is set up + # to always use two buffers; in effect, there is one buffer of + # look ahead, even when Y[i] is integral. This means that we + # will go out of bounds by one line at the top of the image. + # This is handled by copying the last line. + + ybavg = SI_BAVG(si,2) + nblks_y = (IM_LEN (SI_IM(si), 2) + ybavg-1) / ybavg + if (new_y[i] <= nblks_y) + rawline = si_blkavgs (SI_IM(si), x1, x2, new_y[i], + SI_BAVG(si,1), SI_BAVG(si,2), slice_axis, slice) + + if (SI_INTERP(si,1) == NO) { + call amovs (Mems[rawline], Mems[SI_BUF(si,i)], npix) + } else if (SI_ORDER(si) <= 0) { + call si_samples (Mems[rawline], Mems[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } else { + call aluis (Mems[rawline], Mems[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } + + buf_y[i] = new_y[i] + } + + SWAPI (altbuf, curbuf) + } + + # We now have two line buffers straddling the output Y value, + # interpolated to the X grid of the output line. To complete the + # bilinear interpolation operation we take a weighted sum of the two + # lines. If the range from buf_y[1] to buf_y[2] is repeatedly + # interpolated in Y no additional i/o occurs and the linear + # interpolation operation (ALUI) does not have to be repeated (only the + # weighted sum is required). If the distance of Y from one of the + # buffers is zero then we do not even have to take a weighted sum. + # This is not unusual because we may be called with a magnification + # of 1.0 in Y. + + weight_1 = 1.0 - (y - buf_y[1]) + weight_2 = 1.0 - weight_1 + + if (weight_1 < SI_TOL) + return (SI_BUF(si,2)) + else if (weight_2 < SI_TOL || SI_ORDER(si) <= 0) + return (SI_BUF(si,1)) + else { + call awsus (Mems[SI_BUF(si,1)], Mems[SI_BUF(si,2)], + Mems[OUTBUF(si)], npix, weight_1, weight_2) + return (OUTBUF(si)) + } +end + + +# SI_BLKAVGS -- Get a line from a block averaged image of type short. +# For example, block averaging by a factor of 2 means that pixels 1 and 2 +# are averaged to produce the first output pixel, 3 and 4 are averaged to +# produce the second output pixel, and so on. If the length of an axis +# is not an integral multiple of the block size then the last pixel in the +# last block will be replicated to fill out the block; the average is still +# defined even if a block is not full. + +pointer procedure si_blkavgs (im, x1, x2, y, xbavg, ybavg, slice_axis, slice) + +pointer im # input image +int x1, x2 # range of x blocks to be read +int y # y block to be read +int xbavg, ybavg # X and Y block averaging factors +int slice_axis # slice dimension if ndim>2 image +int slice # slice if ndim>2 image + +short temp_s +int nblks_x, nblks_y, ncols, nlines, xoff, i, j +int first_line, nlines_in_sum, npix, nfull_blks, count +long vs[IM_MAXDIM], ve[IM_MAXDIM] +real sum +pointer sp, a, b +pointer imgs2s(), imgs3s(), imggss() +errchk imgs2s, imgs3s, imggss + +begin + call smark (sp) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + xoff = (x1 - 1) * xbavg + 1 + npix = min (ncols, xoff + (x2 - x1 + 1) * xbavg - 1) + + if ((xbavg < 1) || (ybavg < 1)) + call error (1, "si_blkavg: illegal block size") + else if (x1 < 1 || x2 > ncols) + call error (2, "si_blkavg: column index out of bounds") + else if ((xbavg == 1) && (ybavg == 1)) + if (IM_NDIM(im) == 2) + return (imgs2s (im, xoff, xoff + npix - 1, y, y)) + else if (IM_NDIM(im) == 3) + return (imgs3s (im, xoff, xoff + npix - 1, y, y, slice, slice)) + else { + call amovkl (long(1), vs, IM_MAXDIM) + call amovkl (long(1), ve, IM_MAXDIM) + vs[1] = xoff + ve[1] = xoff + npix - 1 + vs[2] = y + ve[2] = y + vs[slice_axis] = slice + ve[slice_axis] = slice + return (imggss (im, vs, ve, 2)) + } + + nblks_x = (npix + xbavg-1) / xbavg + nblks_y = (nlines + ybavg-1) / ybavg + + if (y < 1 || y > nblks_y) + call error (2, "si_blkavg: block number out of range") + + call salloc (b, nblks_x, TY_SHORT) + + if (ybavg > 1) { + call aclrs (Mems[b], nblks_x) + nlines_in_sum = 0 + } + + # Read and accumulate all input lines in the block. + first_line = (y - 1) * ybavg + 1 + + do i = first_line, min (nlines, first_line + ybavg - 1) { + # Get line from input image. + if (IM_NDIM(im) == 2) + a = imgs2s (im, xoff, xoff + npix - 1, i, i) + else if (IM_NDIM(im) == 3) + a = imgs3s (im, xoff, xoff + npix - 1, i, i, slice, slice) + else { + call amovkl (long(1), vs, IM_MAXDIM) + call amovkl (long(1), ve, IM_MAXDIM) + vs[1] = xoff + ve[1] = xoff + npix - 1 + vs[2] = i + ve[2] = i + vs[slice_axis] = slice + ve[slice_axis] = slice + return (imggss (im, vs, ve, 2)) + } + + # Block average line in X. + if (xbavg > 1) { + # First block average only the full blocks. + nfull_blks = npix / xbavg + call abavs (Mems[a], Mems[a], nfull_blks, xbavg) + + # Now average the final partial block, if any. + if (nfull_blks < nblks_x) { + sum = 0.0 + count = 0 + do j = nfull_blks * xbavg + 1, npix { + sum = sum + Mems[a+j-1] + count = count + 1 + } + Mems[a+nblks_x-1] = sum / count + } + } + + # Add line into block sum. Keep track of number of lines in sum + # so that we can compute block average later. + if (ybavg > 1) { + call aadds (Mems[a], Mems[b], Mems[b], nblks_x) + nlines_in_sum = nlines_in_sum + 1 + } + } + + # Compute the block average in Y from the sum of all lines block + # averaged in X. Overwrite buffer A, the buffer returned by IMIO. + # This is kosher because the block averaged line is never longer + # than an input line. + + if (ybavg > 1) { + temp_s = nlines_in_sum + call adivks (Mems[b], temp_s, Mems[a], nblks_x) + } + + call sfree (sp) + return (a) +end + + +# SI_SAMPLES -- Resample a line via nearest neighbor, rather than linear +# interpolation (ALUI). The calling sequence is the same as for ALUIS. + +procedure si_samples (a, b, x, npix) + +short a[ARB], b[ARB] # input, output data arrays +real x[ARB] # sample grid +int npix, i + +begin + do i = 1, npix + b[i] = a[int(x[i])] +end + + +# SIGLNR -- Get a line of type real from a scaled image. Block averaging is +# done by a subprocedure; this procedure gets a line from a possibly block +# averaged image and if necessary interpolates it to the grid points of the +# output line. + +pointer procedure siglnr (si, lineno, slice_axis, slice) + +pointer si # pointer to SI descriptor +int lineno +int slice_axis # axis from which to slice section if ndim>2 +int slice # current slice index + +pointer rawline, tempp, gp +int i, buf_y[2], new_y[2], tempi, curbuf, altbuf +int npix, nblks_y, ybavg, x1, x2 +real x, y, weight_1, weight_2 +pointer si_blkavgr() +errchk si_blkavgr + +begin + npix = SI_NPIX(si,1) + + # Deterine the range of X (in pixels on the block averaged input image) + # required for the interpolator. + + gp = SI_GRID(si,1) + x1 = SI_XOFF(si) + x = Memr[gp+npix-1] + x2 = x1 + int(x) + if (INTVAL(x)) + x2 = x2 - 1 + x2 = max (x1 + 1, x2) + + gp = SI_GRID(si,2) + y = Memr[gp+lineno-1] + + # The following is an optimization provided for the case when it is + # not necessary to interpolate in either X or Y. Block averaging is + # permitted. + + if (SI_INTERP(si,1) == NO && SI_INTERP(si,2) == NO) + return (si_blkavgr (SI_IM(si), x1, x2, int(y), + SI_BAVG(si,1), SI_BAVG(si,2), slice_axis, slice)) + + # If we are interpolating in Y two buffers are required, one for each + # of the two input image lines required to interpolate in Y. The lines + # stored in these buffers are interpolated in X to the output grid but + # not in Y. Both buffers are not required if we are not interpolating + # in Y, but we use them anyhow to simplify the code. + + if (SI_INIT(si) == YES) { + do i = 1, 2 { + if (SI_BUF(si,i) != NULL) + call mfree (SI_BUF(si,i), SI_TYBUF(si)) + call malloc (SI_BUF(si,i), npix, TY_REAL) + SI_TYBUF(si) = TY_REAL + buf_y[i] = NOTSET + } + if (OUTBUF(si) != NULL) + call mfree (OUTBUF(si), SI_TYBUF(si)) + call malloc (OUTBUF(si), npix, TY_REAL) + SI_INIT(si) = NO + } + + # If the Y value of the new line is not in range of the contents of the + # current line buffers, refill one or both buffers. To refill we must + # read a (possibly block averaged) input line and interpolate it onto + # the X grid. The X and Y values herein are in the coordinate system + # of the (possibly block averaged) input image. + + new_y[1] = int(y) + new_y[2] = int(y) + 1 + + # Get the pair of lines whose integral Y values form an interval + # containing the fractional Y value of the output line. Sometimes the + # desired line will happen to be in the other buffer already, in which + # case we just have to swap buffers. Often the new line will be the + # current line, in which case nothing is done. This latter case occurs + # frequently when the magnification ratio is large. + + curbuf = 1 + altbuf = 2 + + do i = 1, 2 { + if (new_y[i] == buf_y[i]) { + ; + } else if (new_y[i] == buf_y[altbuf]) { + SWAPP (SI_BUF(si,1), SI_BUF(si,2)) + SWAPI (buf_y[1], buf_y[2]) + + } else { + # Get line and interpolate onto output grid. If interpolation + # is not required merely copy data out. This code is set up + # to always use two buffers; in effect, there is one buffer of + # look ahead, even when Y[i] is integral. This means that we + # will go out of bounds by one line at the top of the image. + # This is handled by copying the last line. + + ybavg = SI_BAVG(si,2) + nblks_y = (IM_LEN (SI_IM(si), 2) + ybavg-1) / ybavg + if (new_y[i] <= nblks_y) + rawline = si_blkavgr (SI_IM(si), x1, x2, new_y[i], + SI_BAVG(si,1), SI_BAVG(si,2), slice_axis, slice) + + if (SI_INTERP(si,1) == NO) { + call amovr (Memr[rawline], Memr[SI_BUF(si,i)], npix) + } else if (SI_ORDER(si) <= 0) { + call si_sampler (Memr[rawline], Memr[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } else { + call aluir (Memr[rawline], Memr[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } + + buf_y[i] = new_y[i] + } + + SWAPI (altbuf, curbuf) + } + + # We now have two line buffers straddling the output Y value, + # interpolated to the X grid of the output line. To complete the + # bilinear interpolation operation we take a weighted sum of the two + # lines. If the range from buf_y[1] to buf_y[2] is repeatedly + # interpolated in Y no additional i/o occurs and the linear + # interpolation operation (ALUI) does not have to be repeated (only the + # weighted sum is required). If the distance of Y from one of the + # buffers is zero then we do not even have to take a weighted sum. + # This is not unusual because we may be called with a magnification + # of 1.0 in Y. + + weight_1 = 1.0 - (y - buf_y[1]) + weight_2 = 1.0 - weight_1 + + if (weight_1 < SI_TOL) + return (SI_BUF(si,2)) + else if (weight_2 < SI_TOL || SI_ORDER(si) <= 0) + return (SI_BUF(si,1)) + else { + call awsur (Memr[SI_BUF(si,1)], Memr[SI_BUF(si,2)], + Memr[OUTBUF(si)], npix, weight_1, weight_2) + return (OUTBUF(si)) + } +end + + +# SI_BLKAVGR -- Get a line from a block averaged image of type short. +# For example, block averaging by a factor of 2 means that pixels 1 and 2 +# are averaged to produce the first output pixel, 3 and 4 are averaged to +# produce the second output pixel, and so on. If the length of an axis +# is not an integral multiple of the block size then the last pixel in the +# last block will be replicated to fill out the block; the average is still +# defined even if a block is not full. + +pointer procedure si_blkavgr (im, x1, x2, y, xbavg, ybavg, slice_axis, slice) + +pointer im # input image +int x1, x2 # range of x blocks to be read +int y # y block to be read +int xbavg, ybavg # X and Y block averaging factors +int slice_axis # axis from which to slice section if ndim>2 +int slice # current slice + +int nblks_x, nblks_y, ncols, nlines, xoff, i, j +int first_line, nlines_in_sum, npix, nfull_blks, count +long vs[IM_MAXDIM], ve[IM_MAXDIM] +real sum +pointer sp, a, b +pointer imgs2r(), imgs3r(), imggsr() +errchk imgs2r, imgs3r, imggsr() + +begin + call smark (sp) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + xoff = (x1 - 1) * xbavg + 1 + npix = min (ncols, xoff + (x2 - x1 + 1) * xbavg - 1) + + if ((xbavg < 1) || (ybavg < 1)) + call error (1, "si_blkavg: illegal block size") + else if (x1 < 1 || x2 > ncols) + call error (2, "si_blkavg: column index out of bounds") + else if ((xbavg == 1) && (ybavg == 1)) + if (IM_NDIM(im) == 2) + return (imgs2r (im, xoff, xoff + npix - 1, y, y)) + else if (IM_NDIM(im) == 3) + return (imgs3r (im, xoff, xoff + npix - 1, y, y, slice, slice)) + else { + call amovkl (long(1), vs, IM_MAXDIM) + call amovkl (long(1), ve, IM_MAXDIM) + vs[1] = xoff + ve[1] = xoff + npix - 1 + vs[2] = y + ve[2] = y + vs[slice_axis] = slice + ve[slice_axis] = slice + return (imggsr (im, vs, ve, 2)) + } + + nblks_x = (npix + xbavg-1) / xbavg + nblks_y = (nlines + ybavg-1) / ybavg + + if (y < 1 || y > nblks_y) + call error (2, "si_blkavg: block number out of range") + + call salloc (b, nblks_x, TY_REAL) + + if (ybavg > 1) { + call aclrr (Memr[b], nblks_x) + nlines_in_sum = 0 + } + + # Read and accumulate all input lines in the block. + first_line = (y - 1) * ybavg + 1 + + do i = first_line, min (nlines, first_line + ybavg - 1) { + # Get line from input image. + if (IM_NDIM(im) == 2) + a = imgs2r (im, xoff, xoff + npix - 1, i, i) + else if (IM_NDIM(im) == 3) + a = imgs3r (im, xoff, xoff + npix - 1, i, i, slice, slice) + else { + call amovkl (long(1), vs, IM_MAXDIM) + call amovkl (long(1), ve, IM_MAXDIM) + vs[1] = xoff + ve[1] = xoff + npix - 1 + vs[2] = i + ve[2] = i + vs[slice_axis] = slice + ve[slice_axis] = slice + return (imggsr (im, vs, ve, 2)) + } + + # Block average line in X. + if (xbavg > 1) { + # First block average only the full blocks. + nfull_blks = npix / xbavg + call abavr (Memr[a], Memr[a], nfull_blks, xbavg) + + # Now average the final partial block, if any. + if (nfull_blks < nblks_x) { + sum = 0.0 + count = 0 + do j = nfull_blks * xbavg + 1, npix { + sum = sum + Memr[a+j-1] + count = count + 1 + } + Memr[a+nblks_x-1] = sum / count + } + } + + # Add line into block sum. Keep track of number of lines in sum + # so that we can compute block average later. + if (ybavg > 1) { + call aaddr (Memr[a], Memr[b], Memr[b], nblks_x) + nlines_in_sum = nlines_in_sum + 1 + } + } + + # Compute the block average in Y from the sum of all lines block + # averaged in X. Overwrite buffer A, the buffer returned by IMIO. + # This is kosher because the block averaged line is never longer + # than an input line. + + if (ybavg > 1) + call adivkr (Memr[b], real(nlines_in_sum), Memr[a], nblks_x) + + call sfree (sp) + return (a) +end + + +# SI_SAMPLER -- Resample a line via nearest neighbor, rather than linear +# interpolation (ALUI). The calling sequence is the same as for ALUIR. + +procedure si_sampler (a, b, x, npix) + +real a[ARB], b[ARB] # input, output data arrays +real x[ARB] # sample grid +int npix, i + +begin + do i = 1, npix + b[i] = a[int(x[i])] +end diff --git a/pkg/proto/vol/src/i2sun/t_i2sun.x b/pkg/proto/vol/src/i2sun/t_i2sun.x new file mode 100644 index 00000000..ab8119b7 --- /dev/null +++ b/pkg/proto/vol/src/i2sun/t_i2sun.x @@ -0,0 +1,240 @@ +include <imhdr.h> +include <ctype.h> +include <mach.h> +include "i2sun.h" + + +# I2SUN -- IRAF to Sun Rasterfile: convert either a list of IRAF images +# or all slices from a specified axis of a dimension>2 image into a series +# of Sun rasterfiles. This format-specific task is primarily used to make +# movies in the absence of a portable movie/filmloop utility, if a +# Sun-specific movie task is available. +# ** The format of the output Sun rasterfiles is hard-coded into this task, +# ** and thus could diverge from a future Sun format; we do not want to link +# ** with Sun libraries, as this task should be runnable on other machines. + +procedure t_i2sun + +pointer sp, tr, input, im, rfnames, clutfile, transform, cur_rf +pointer ulutfile, ulut, colormap, pk_colormap, lut +int list, lfd, rfd, nslices, stat, nimages +int rheader[RAS_HDR_INTS], ras_maptype, ras_maplength, frame, slice, i, j +short lut1, lut2 +bool use_clut, make_map + +pointer immap() +int open(), access(), clgeti(), imtopenp(), imtlen(), imtgetim(), read() +real clgetr() +bool streq(), clgetb() + +errchk open() + +begin + call smark (sp) + call salloc (tr, LEN_TR, TY_STRUCT) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (rfnames, SZ_FNAME, TY_CHAR) + call salloc (clutfile, SZ_FNAME, TY_CHAR) + call salloc (cur_rf, SZ_FNAME, TY_CHAR) + call salloc (transform, SZ_LINE, TY_CHAR) + call salloc (pk_colormap, NGREY*3, TY_CHAR) + call salloc (colormap, NGREY*3, TY_SHORT) + lut = NULL + im = NULL + + # Input parameters. + list = imtopenp ("input") + call clgstr ("output", Memc[rfnames], SZ_FNAME) + call clgstr ("clutfile", Memc[clutfile], SZ_FNAME) + call clgstr ("ztrans", Memc[transform], SZ_LINE) + TR_Z1(tr) = clgetr ("z1") + TR_Z2(tr) = clgetr ("z2") + TR_ZTRANS(tr) = Z_LINEAR + if (streq (Memc[transform], "log")) + TR_ZTRANS(tr) = Z_LOG + else if (streq (Memc[transform], "none")) + TR_ZTRANS(tr) = Z_UNITARY + else if (streq (Memc[transform], "user")) { + + # Get user-specified transfer lookup table. + TR_ZTRANS(tr) = Z_USER + call salloc (ulutfile, SZ_FNAME, TY_CHAR) + call clgstr ("ulutfile", Memc[ulutfile], SZ_FNAME) + + # Borrowed from DISPLAY; mallocs storage for ulut: + call tr_ulut (Memc[ulutfile], TR_Z1(tr), TR_Z2(tr), ulut) + } + TR_XSIZE(tr) = clgeti ("xsize") + TR_YSIZE(tr) = clgeti ("ysize") + TR_ORDER(tr) = clgeti ("order") + TR_XMAG(tr) = clgetr ("xmag") + TR_YMAG(tr) = clgetr ("ymag") + + # Get input image axes to map to output frames. At present we + # can only traverse one slice axis. + TR_SLICEAXIS(tr) = clgeti ("sliceaxis") + + # Swap bytes in output rasterfile? (useful when I2SUN run on VAX etc.) + TR_SWAPBYTES(tr) = clgetb ("swap") + + # Check if there are no images. + nimages = imtlen (list) + if (nimages == 0) { + call eprintf (0, "No input images to convert") + goto wrapup_ + } + + # Open color lookup table file (an existing Sun rasterfile at present) + if (access (Memc[clutfile], READ_ONLY, BINARY_FILE) == YES) { + lfd = open (Memc[clutfile], READ_ONLY, BINARY_FILE) + use_clut = true + } else + use_clut = false + + # Read color lookup table. + make_map = false + if (use_clut) { + # Only the color table is used from the rasterfile; ignore all else. + stat = read (lfd, rheader, RAS_HDR_INTS * SZB_CHAR) + if (stat != RAS_HDR_INTS * SZB_CHAR) { + call eprintf ("Error reading header from file `%s'\n") + call pargstr (Memc[clutfile]) + goto wrapup_ + } + if (rheader[1] != RAS_MAGIC) { + call eprintf ("File `%s' not a valid Sun rasterfile\n") + call pargstr (Memc[clutfile]) + goto wrapup_ + } + ras_maptype = rheader[7] + ras_maplength = rheader[8] + if (ras_maptype != RMT_NONE && ras_maplength > 0) { + stat = read (lfd, Memc[colormap], ras_maplength / SZB_CHAR) + if (stat != ras_maplength / SZB_CHAR) { + call eprintf ("Error reading colormap from %s\n") + call pargstr (Memc[clutfile]) + goto wrapup_ + } + # Colormap was already packed on disk. + call achtsc (Mems[colormap], Memc[pk_colormap], ras_maplength) + } else { + make_map = true + call eprintf ("Invalid colormap in %s; using greyscale\n") + call pargstr (Memc[clutfile]) + } + } else + make_map = true + + if (make_map) { + # Construct a greyscale colormap of same range as IMTOOL. + ras_maptype = RMT_EQUAL_RGB + ras_maplength = NGREY * 3 + do i = 1, 3 { + Mems[colormap+(i-1)*NGREY] = WHITE + do j = COLORSTART+1, COLOREND + Mems[colormap+j-1+(i-1)*NGREY] = j * (WHITE+1) / + NGREY + Mems[colormap+COLOREND-1+1+(i-1)*NGREY] = WHITE + do j = COLOREND+2, NGREY + Mems[colormap+j-1+(i-1)*NGREY] = BLACK + } + call achtsc (Mems[colormap], Memc[pk_colormap], ras_maplength) + + # Pack to byte stream. + call chrpak (Memc[pk_colormap], 1, Memc[pk_colormap], 1, + ras_maplength) + } + + # For each IRAF image or band, construct and dispose of a rasterfile. + frame = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + im = immap (Memc[input], READ_ONLY, 0) + if (IM_NDIM(im) > 2 && TR_SLICEAXIS(tr) > IM_NDIM(im)) { + call eprintf ("Specified slice axis invalid for image %s\n") + call pargstr (Memc[input]) + goto wrapup_ + } + nslices = IM_LEN(im, TR_SLICEAXIS(tr)) + if (nslices < 1) + nslices = 1 + + # Set up spatial transformation (technically, could be different + # for each input image). + call tr_setup (im, tr) + + # We assume that if any n>2 images are present, the user wants + # all bands dumped out. + do slice = 1, nslices { + + # Construct next rasterfile name and open file; works in + # 'append' mode, next higher available frame number. + call sprintf (Memc[cur_rf], SZ_FNAME, Memc[rfnames]) + call pargi (frame) + while (access (Memc[cur_rf], READ_ONLY, BINARY_FILE) == YES) { + frame = frame + 1 + call sprintf (Memc[cur_rf], SZ_FNAME, Memc[rfnames]) + call pargi (frame) + } + iferr (rfd = open (Memc[cur_rf], NEW_FILE, BINARY_FILE)) { + call eprintf ("Cannot open output rasterfile `%s'\n") + call pargstr (Memc[cur_rf]) + goto wrapup_ + } + frame = frame + 1 + + # Write header to rasterfile: + rheader[1] = RAS_MAGIC + rheader[2] = TR_XE(tr) - TR_XS(tr) + 1 + rheader[3] = TR_YE(tr) - TR_YS(tr) + 1 + rheader[4] = NBITS_FB + rheader[5] = rheader[2] * rheader[3] + rheader[6] = RMT_STANDARD + rheader[7] = ras_maptype + rheader[8] = ras_maplength + if (TR_SWAPBYTES(tr)) + call bswap4 (rheader, 1, rheader, 1, RAS_HDR_INTS*4) + call write (rfd, rheader, RAS_HDR_INTS * SZB_CHAR) + + # Write colormap to rasterfile. + call write (rfd, Memc[pk_colormap], ras_maplength / SZB_CHAR) + + # Verify user-specified transfer function parameters. + if (TR_ZTRANS(tr) == Z_USER) { + call alims (Mems[ulut], U_MAXPTS, lut1, lut2) + if (lut2 < short(DSP_MIN) || lut1 > short(DSP_MAX)) { + call eprintf ("User specified greyscales <> range\n") + call eprintf ("ulut1=%D, dmin=%D; ulut2=%D, dmax=%D\n") + call pargi (lut1) + call pargi (DSP_MIN) + call pargi (lut2) + call pargi (DSP_MAX) + } + if (!IS_INDEF(TR_Z1(tr)) && !IS_INDEF(TR_Z2(tr)) && + TR_Z2(tr) < IM_MIN(im) || TR_Z1(tr) > IM_MAX(im)) { + call eprintf ("User specified intensities <> range\n") + call eprintf ("z1=%g, im_min=%g; z2=%g, im_max=%g\n") + call pargr (TR_Z1(tr)) + call pargr (IM_MIN(im)) + call pargr (TR_Z2(tr)) + call pargr (IM_MAX(im)) + call eprintf ("continuing anyway.\n") + } + } + + # Read image pixels and write to rasterfile. + call cnv_image (im, slice, tr, ulut, rfd) + + call close (rfd) + } + call imunmap (im) + } + +wrapup_ + if (im != NULL) + call imunmap(im) + call imtclose (list) + call close (rfd) + call sfree (sp) + if (ulut != NULL) + call mfree (ulut, TY_SHORT) +end diff --git a/pkg/proto/vol/src/i2sun/trsetup.x b/pkg/proto/vol/src/i2sun/trsetup.x new file mode 100644 index 00000000..1b14afb2 --- /dev/null +++ b/pkg/proto/vol/src/i2sun/trsetup.x @@ -0,0 +1,32 @@ +include <imhdr.h> +include "i2sun.h" + + +# TR_SETUP -- Set up spatial transformation parameters. + +procedure tr_setup (im, tr) + +pointer im # An input image descriptor +pointer tr # Transformation structure + +int ncols, nlines + +begin + ncols = IM_LEN(im,COL) + nlines = IM_LEN(im,LINE) + + # Determine output raster dimensions. + TR_XS(tr) = 1 + TR_XE(tr) = ncols + if (!IS_INDEFI(TR_XSIZE(tr))) + TR_XE(tr) = max (1, TR_XSIZE(tr)) + else if (TR_XMAG(tr) != 1.0) + TR_XE(tr) = max (1, ncols * int(TR_XMAG(tr))) + + TR_YS(tr) = 1 + TR_YE(tr) = nlines + if (!IS_INDEFI(TR_YSIZE(tr))) + TR_YE(tr) = max (1, TR_YSIZE(tr)) + else if (TR_YMAG(tr) != 1.0) + TR_YE(tr) = max (1, nlines * int(TR_YMAG(tr))) +end diff --git a/pkg/proto/vol/src/i2sun/trulut.x b/pkg/proto/vol/src/i2sun/trulut.x new file mode 100644 index 00000000..4787b9b3 --- /dev/null +++ b/pkg/proto/vol/src/i2sun/trulut.x @@ -0,0 +1,128 @@ +include <error.h> +include <ctype.h> +include "i2sun.h" + +# TR_ULUT -- Generates a look up table from data supplied by user. The +# data is read from a two column text file of intensity, greyscale values. +# The input data are sorted, then mapped to the x range [0-4095]. A +# piecewise linear look up table of 4096 values is then constructed from +# the (x,y) pairs given. A pointer to the look up table, as well as the z1 +# and z2 intensity endpoints, is returned. + +procedure tr_ulut (fname, z1, z2, lut) + +char fname[SZ_FNAME] # Name of file with intensity, greyscale values +real z1 # Intensity mapped to minimum gs value +real z2 # Intensity mapped to maximum gs value +pointer lut # Look up table - pointer is returned + +pointer sp, x, y +int nvalues, i, j, x1, x2, y1 +real delta_gs, delta_xv, slope +errchk ds_rlut, ds_sort, malloc + +begin + call smark (sp) + call salloc (x, U_MAXPTS, TY_REAL) + call salloc (y, U_MAXPTS, TY_REAL) + + # Read intensities and greyscales from the user's input file. The + # intensity range is then mapped into a standard range and the + # values sorted. + + call ds_rlut (fname, Memr[x], Memr[y], nvalues) + call alimr (Memr[x], nvalues, z1, z2) + call amapr (Memr[x], Memr[x], nvalues, z1, z2, real(U_Z1), real(U_Z2)) + call ds_sort (Memr[x], Memr[y], nvalues) + + # Fill lut in straight line segments - piecewise linear + call malloc (lut, U_MAXPTS, TY_SHORT) + do i = 1, nvalues-1 { + delta_gs = Memr[y+i] - Memr[y+i-1] + delta_xv = Memr[x+i] - Memr[x+i-1] + slope = delta_gs / delta_xv + x1 = int (Memr[x+i-1]) + x2 = int (Memr[x+i]) + y1 = int (Memr[y+i-1]) + do j = x1, x2 + Mems[lut+j] = y1 + slope * (j-x1) + } + Mems[lut+U_MAXPTS-1] = y1 + (slope * U_Z2) + + call sfree (sp) +end + + +# DS_RLUT -- Read text file of x, y, values. + +procedure ds_rlut (utab, x, y, nvalues) + +char utab[SZ_FNAME] # Name of list file +real x[U_MAXPTS] # Array of x values, filled on return +real y[U_MAXPTS] # Array of y values, filled on return +int nvalues # Number of values in x, y vectors - returned + +int n, fd +pointer sp, lbuf, ip +real xval, yval +int getline(), open() +errchk open, sscan, getline, salloc + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + iferr (fd = open (utab, READ_ONLY, TEXT_FILE)) + call error (1, "Error opening user lookup table") + + n = 0 + while (getline (fd, Memc[lbuf]) != EOF) { + # Skip comment lines and blank lines. + if (Memc[lbuf] == '#') + next + for (ip=lbuf; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '\n' || Memc[ip] == EOS) + next + + # Decode the points to be plotted. + call sscan (Memc[ip]) + call gargr (xval) + call gargr (yval) + + n = n + 1 + if (n > U_MAXPTS) + call error (2, + "Intensity transformation table cannot exceed 4096 values") + + x[n] = xval + y[n] = yval + } + + nvalues = n + call close (fd) + call sfree (sp) +end + + +# DS_SORT -- Bubble sort of paired arrays. + +procedure ds_sort (xvals, yvals, nvals) + +real xvals[nvals] # Array of x values +real yvals[nvals] # Array of y values +int nvals # Number of values in each array + +int i, j +real temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + for (i=nvals; i > 1; i=i-1) + for (j=1; j < i; j=j+1) + if (xvals[j] > xvals[j+1]) { + # Out of order; exchange y values + swap (xvals[j], xvals[j+1]) + swap (yvals[j], yvals[j+1]) + } +end diff --git a/pkg/proto/vol/src/i2sun/x_i2sun.x b/pkg/proto/vol/src/i2sun/x_i2sun.x new file mode 100644 index 00000000..20a36169 --- /dev/null +++ b/pkg/proto/vol/src/i2sun/x_i2sun.x @@ -0,0 +1,4 @@ +# X_I2SUN -- Task statement for I2SUN, used only for debugging (normally task +# resides in X_PVOL.E. + +task i2sun = t_i2sun diff --git a/pkg/proto/vol/src/im3dtran.par b/pkg/proto/vol/src/im3dtran.par new file mode 100644 index 00000000..3c24953b --- /dev/null +++ b/pkg/proto/vol/src/im3dtran.par @@ -0,0 +1,6 @@ +input,s,a,,,,Input 3d image (datacube) +output,s,a,,,,Output 3d image +new_x,i,a,3,1,3,"New x axis = old axis (1=x, 2=y, 3=z)" +new_y,i,a,2,1,3,"New y axis = old axis (1=x, 2=y, 3=z)" +new_z,i,a,1,1,3,"New z axis = old axis (1=x, 2=y, 3=z)" +len_blk,i,h,128,,,Size in pixels of internal subraster diff --git a/pkg/proto/vol/src/im3dtran/mkpkg b/pkg/proto/vol/src/im3dtran/mkpkg new file mode 100644 index 00000000..19b0b52d --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/mkpkg @@ -0,0 +1,52 @@ +# Library for the 3DTRANSPOSE task. + +$checkout libpkg.a /u2/rooke/vol/ +$update libpkg.a +$checkin libpkg.a /u2/rooke/vol/ +$exit + +tfiles: + $ifolder (txyz3.x, txyz3.gx) + $generic -k txyz3.gx -o txyz3.x $endif + $ifolder (txzy3.x, txzy3.gx) + $generic -k txzy3.gx -o txzy3.x $endif + $ifolder (tyxz3.x, tyxz3.gx) + $generic -k tyxz3.gx -o tyxz3.x $endif + $ifolder (tyzx3.x, tyzx3.gx) + $generic -k tyzx3.gx -o tyzx3.x $endif + $ifolder (tzxy3.x, tzxy3.gx) + $generic -k tzxy3.gx -o tzxy3.x $endif + $ifolder (tzyx3.x, tzyx3.gx) + $generic -k tzyx3.gx -o tzyx3.x $endif + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call tfiles $endif + + t_im3dtran.x <imhdr.h> + txyz3.x + txzy3.x + tyxz3.x + tyzx3.x + tzxy3.x + tzyx3.x + ; + +dbx: + $set XFLAGS = "-c -g -F -q" + $set LFLAGS = "-g -q" + $set LIBS = "-lxtools" + + $ifeq (USE_GENERIC, yes) $call tfiles $endif + + $omake x_im3dtran.x + $omake t_im3dtran.x + $omake txyz3.x + $omake txzy3.x + $omake tyxz3.x + $omake tyzx3.x + $omake tzxy3.x + $omake tzyx3.x + $link x_im3dtran.o t_im3dtran.o txyz3.o txzy3.o tyxz3.o tyzx3.o \ + tzxy3.o tzyx3.o $(LIBS) -o xx_im3dtran.e + ; diff --git a/pkg/proto/vol/src/im3dtran/t_im3dtran.x b/pkg/proto/vol/src/im3dtran/t_im3dtran.x new file mode 100644 index 00000000..a77c0703 --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/t_im3dtran.x @@ -0,0 +1,307 @@ +include <imhdr.h> +include <error.h> + +define XYZ 1 # xyz -> xyz (identity) +define XZY 2 # xyz -> xzy +define YXZ 3 # xyz -> yxz +define YZX 4 # xyz -> yzx +define ZXY 5 # xyz -> zxy +define ZYX 6 # xyz -> zyx + + +# T_IM3DTRAN -- Transpose 3d images. +# +# The input and output images are given by image template lists. The +# number of output images must match the number of input 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 transpose +# is performed to a temporary file which then replaces the input image. + +procedure t_im3dtran () + +char imtlist1[SZ_LINE] # Input image list +char imtlist2[SZ_LINE] # Output image list +int len_blk # 1D length of transpose block + +char image1[SZ_FNAME] # Input image name +char image2[SZ_FNAME] # Output image name +char imtemp[SZ_FNAME] # Temporary file + +int list1, list2, new_ax[3], which3d +pointer im1, im2 + +int clgeti(), imtopen(), imtgetim(), imtlen(), whichtran() +pointer immap() + +begin + # Get input and output image template lists, the size of the transpose + # block, and the transpose mapping. + + call clgstr ("input", imtlist1, SZ_LINE) + call clgstr ("output", imtlist2, SZ_LINE) + len_blk = clgeti ("len_blk") + new_ax[1] = clgeti ("new_x") + new_ax[2] = clgeti ("new_y") + new_ax[3] = clgeti ("new_z") + + # Determine the type of 3d transpose. + which3d = whichtran (new_ax) + if (which3d <= 0) + call error (0, "Invalid mapping of new_x, new_y, new_z") + + # 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 (1, "Number of input and output images not the same") + } + + # Do each set of input/output images. + + while ((imtgetim (list1, image1, SZ_FNAME) != EOF) && + (imtgetim (list2, image2, SZ_FNAME) != EOF)) { + + call xt_mkimtemp (image1, image2, imtemp, SZ_FNAME) + + im1 = immap (image1, READ_ONLY, 0) + im2 = immap (image2, NEW_COPY, im1) + + # Do the transpose. + call im3dtranspose (im1, im2, len_blk, which3d, new_ax) + + # Unmap the input and output images. + call imunmap (im1) + call imunmap (im2) + + call xt_delimtemp (image2, imtemp) + } + + call imtclose (list1) + call imtclose (list2) +end + + +# IM3DTRANSPOSE -- Transpose an image. +# +# Divide the image into square blocks of size len_blk by len_blk. +# Transpose each block with a generic array transpose operator. + +procedure im3dtranspose (im_in, im_out, len_blk, which3d, new_ax) + +pointer im_in # Input image descriptor +pointer im_out # Output image descriptor +int len_blk # 1D length of transpose block +int which3d # Parameterized transpose order +int new_ax[3] # Map old axis[index] to new value + +int x1, x2, nx +int y1, y2, ny +int z1, z2, nz +pointer buf_in, buf_out + +pointer imgs3s(), imps3s(), imgs3i(), imps3i(), imgs3l(), imps3l() +pointer imgs3r(), imps3r(), imgs3d(), imps3d(), imgs3x(), imps3x() + +begin + # Output image is a copy of input image with dims transposed. + + IM_LEN (im_out, 1) = IM_LEN (im_in, new_ax[1]) + IM_LEN (im_out, 2) = IM_LEN (im_in, new_ax[2]) + IM_LEN (im_out, 3) = IM_LEN (im_in, new_ax[3]) + + # Break the input image into blocks of at most (len_blk)**3 . + + do x1 = 1, IM_LEN (im_in, 1), len_blk { + x2 = x1 + len_blk - 1 + if (x2 > IM_LEN(im_in, 1)) + x2 = IM_LEN(im_in, 1) + nx = x2 - x1 + 1 + + do y1 = 1, IM_LEN (im_in, 2), len_blk { + y2 = y1 + len_blk - 1 + if (y2 > IM_LEN(im_in, 2)) + y2 = IM_LEN(im_in, 2) + ny = y2 - y1 + 1 + + do z1 = 1, IM_LEN (im_in, 3), len_blk { + z2 = z1 + len_blk - 1 + if (z2 > IM_LEN(im_in, 3)) + z2 = IM_LEN(im_in, 3) + nz = z2 - z1 + 1 + + # Switch on the pixel type to optimize IMIO. + + switch (IM_PIXTYPE (im_in)) { + case TY_SHORT: + buf_in = imgs3s (im_in, x1, x2, y1, y2, z1, z2) + switch (which3d) { + case XYZ: + buf_out = imps3s (im_out, x1, x2, y1, y2, z1, z2) + call txyz3s (Mems[buf_in], Mems[buf_out], nx,ny,nz) + case XZY: + buf_out = imps3s (im_out, x1, x2, z1, z2, y1, y2) + call txzy3s (Mems[buf_in], Mems[buf_out], nx,ny,nz) + case YXZ: + buf_out = imps3s (im_out, y1, y2, x1, x2, z1, z2) + call tyxz3s (Mems[buf_in], Mems[buf_out], nx,ny,nz) + case YZX: + buf_out = imps3s (im_out, y1, y2, z1, z2, x1, x2) + call tyzx3s (Mems[buf_in], Mems[buf_out], nx,ny,nz) + case ZXY: + buf_out = imps3s (im_out, z1, z2, x1, x2, y1, y2) + call tzxy3s (Mems[buf_in], Mems[buf_out], nx,ny,nz) + case ZYX: + buf_out = imps3s (im_out, z1, z2, y1, y2, x1, x2) + call tzyx3s (Mems[buf_in], Mems[buf_out], nx,ny,nz) + } + case TY_INT: + buf_in = imgs3i (im_in, x1, x2, y1, y2, z1, z2) + switch (which3d) { + case XYZ: + buf_out = imps3i (im_out, x1, x2, y1, y2, z1, z2) + call txyz3i (Memi[buf_in], Memi[buf_out], nx,ny,nz) + case XZY: + buf_out = imps3i (im_out, x1, x2, z1, z2, y1, y2) + call txzy3i (Memi[buf_in], Memi[buf_out], nx,ny,nz) + case YXZ: + buf_out = imps3i (im_out, y1, y2, x1, x2, z1, z2) + call tyxz3i (Memi[buf_in], Memi[buf_out], nx,ny,nz) + case YZX: + buf_out = imps3i (im_out, y1, y2, z1, z2, x1, x2) + call tyzx3i (Memi[buf_in], Memi[buf_out], nx,ny,nz) + case ZXY: + buf_out = imps3i (im_out, z1, z2, x1, x2, y1, y2) + call tzxy3i (Memi[buf_in], Memi[buf_out], nx,ny,nz) + case ZYX: + buf_out = imps3i (im_out, z1, z2, y1, y2, x1, x2) + call tzyx3i (Memi[buf_in], Memi[buf_out], nx,ny,nz) + } + case TY_LONG: + buf_in = imgs3l (im_in, x1, x2, y1, y2, z1, z2) + switch (which3d) { + case XYZ: + buf_out = imps3l (im_out, x1, x2, y1, y2, z1, z2) + call txyz3l (Meml[buf_in], Meml[buf_out], nx,ny,nz) + case XZY: + buf_out = imps3l (im_out, x1, x2, z1, z2, y1, y2) + call txzy3l (Meml[buf_in], Meml[buf_out], nx,ny,nz) + case YXZ: + buf_out = imps3l (im_out, y1, y2, x1, x2, z1, z2) + call tyxz3l (Meml[buf_in], Meml[buf_out], nx,ny,nz) + case YZX: + buf_out = imps3l (im_out, y1, y2, z1, z2, x1, x2) + call tyzx3l (Meml[buf_in], Meml[buf_out], nx,ny,nz) + case ZXY: + buf_out = imps3l (im_out, z1, z2, x1, x2, y1, y2) + call tzxy3l (Meml[buf_in], Meml[buf_out], nx,ny,nz) + case ZYX: + buf_out = imps3l (im_out, z1, z2, y1, y2, x1, x2) + call tzyx3l (Meml[buf_in], Meml[buf_out], nx,ny,nz) + } + case TY_REAL: + buf_in = imgs3r (im_in, x1, x2, y1, y2, z1, z2) + switch (which3d) { + case XYZ: + buf_out = imps3r (im_out, x1, x2, y1, y2, z1, z2) + call txyz3r (Memr[buf_in], Memr[buf_out], nx,ny,nz) + case XZY: + buf_out = imps3r (im_out, x1, x2, z1, z2, y1, y2) + call txzy3r (Memr[buf_in], Memr[buf_out], nx,ny,nz) + case YXZ: + buf_out = imps3r (im_out, y1, y2, x1, x2, z1, z2) + call tyxz3r (Memr[buf_in], Memr[buf_out], nx,ny,nz) + case YZX: + buf_out = imps3r (im_out, y1, y2, z1, z2, x1, x2) + call tyzx3r (Memr[buf_in], Memr[buf_out], nx,ny,nz) + case ZXY: + buf_out = imps3r (im_out, z1, z2, x1, x2, y1, y2) + call tzxy3r (Memr[buf_in], Memr[buf_out], nx,ny,nz) + case ZYX: + buf_out = imps3r (im_out, z1, z2, y1, y2, x1, x2) + call tzyx3r (Memr[buf_in], Memr[buf_out], nx,ny,nz) + } + case TY_DOUBLE: + buf_in = imgs3d (im_in, x1, x2, y1, y2, z1, z2) + switch (which3d) { + case XYZ: + buf_out = imps3d (im_out, x1, x2, y1, y2, z1, z2) + call txyz3d (Memd[buf_in], Memd[buf_out], nx,ny,nz) + case XZY: + buf_out = imps3d (im_out, x1, x2, z1, z2, y1, y2) + call txzy3d (Memd[buf_in], Memd[buf_out], nx,ny,nz) + case YXZ: + buf_out = imps3d (im_out, y1, y2, x1, x2, z1, z2) + call tyxz3d (Memd[buf_in], Memd[buf_out], nx,ny,nz) + case YZX: + buf_out = imps3d (im_out, y1, y2, z1, z2, x1, x2) + call tyzx3d (Memd[buf_in], Memd[buf_out], nx,ny,nz) + case ZXY: + buf_out = imps3d (im_out, z1, z2, x1, x2, y1, y2) + call tzxy3d (Memd[buf_in], Memd[buf_out], nx,ny,nz) + case ZYX: + buf_out = imps3d (im_out, z1, z2, y1, y2, x1, x2) + call tzyx3d (Memd[buf_in], Memd[buf_out], nx,ny,nz) + } + case TY_COMPLEX: + buf_in = imgs3x (im_in, x1, x2, y1, y2, z1, z2) + switch (which3d) { + case XYZ: + buf_out = imps3x (im_out, x1, x2, y1, y2, z1, z2) + call txyz3x (Memx[buf_in], Memx[buf_out], nx,ny,nz) + case XZY: + buf_out = imps3x (im_out, x1, x2, z1, z2, y1, y2) + call txzy3x (Memx[buf_in], Memx[buf_out], nx,ny,nz) + case YXZ: + buf_out = imps3x (im_out, y1, y2, x1, x2, z1, z2) + call tyxz3x (Memx[buf_in], Memx[buf_out], nx,ny,nz) + case YZX: + buf_out = imps3x (im_out, y1, y2, z1, z2, x1, x2) + call tyzx3x (Memx[buf_in], Memx[buf_out], nx,ny,nz) + case ZXY: + buf_out = imps3x (im_out, z1, z2, x1, x2, y1, y2) + call tzxy3x (Memx[buf_in], Memx[buf_out], nx,ny,nz) + case ZYX: + buf_out = imps3x (im_out, z1, z2, y1, y2, x1, x2) + call tzyx3x (Memx[buf_in], Memx[buf_out], nx,ny,nz) + } + default: + call error (3, "unknown pixel type") + } + } + } + } +end + + +# WHICHTRAN -- Return transpose type. + +int procedure whichtran (new_ax) +int new_ax[3] + +int which + +begin + which = 0 + + if (new_ax[1] == 1) { + if (new_ax[2] == 2) + which = XYZ + else if (new_ax[2] == 3) + which = XZY + } else if (new_ax[1] == 2) { + if (new_ax[2] == 1) + which = YXZ + else if (new_ax[2] == 3) + which = YZX + } else if (new_ax[1] == 3) { + if (new_ax[2] == 1) + which = ZXY + else if (new_ax[2] == 2) + which = ZYX + } + + return (which) +end diff --git a/pkg/proto/vol/src/im3dtran/txyz3.gx b/pkg/proto/vol/src/im3dtran/txyz3.gx new file mode 100644 index 00000000..619734a1 --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/txyz3.gx @@ -0,0 +1,18 @@ +$for (silrdx) + +# TXYZ3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txyz3$t (a, b, nx, ny, nz) + +PIXEL a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, z, y] +end + +$endfor diff --git a/pkg/proto/vol/src/im3dtran/txyz3.x b/pkg/proto/vol/src/im3dtran/txyz3.x new file mode 100644 index 00000000..1cc8ca92 --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/txyz3.x @@ -0,0 +1,103 @@ + + +# TXYZ3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txyz3s (a, b, nx, ny, nz) + +short a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, z, y] +end + + + +# TXYZ3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txyz3i (a, b, nx, ny, nz) + +int a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, z, y] +end + + + +# TXYZ3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txyz3l (a, b, nx, ny, nz) + +long a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, z, y] +end + + + +# TXYZ3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txyz3r (a, b, nx, ny, nz) + +real a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, z, y] +end + + + +# TXYZ3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txyz3d (a, b, nx, ny, nz) + +double a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, z, y] +end + + + +# TXYZ3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txyz3x (a, b, nx, ny, nz) + +complex a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, z, y] +end + + diff --git a/pkg/proto/vol/src/im3dtran/txzy3.gx b/pkg/proto/vol/src/im3dtran/txzy3.gx new file mode 100644 index 00000000..a6d18e4a --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/txzy3.gx @@ -0,0 +1,18 @@ +$for (silrdx) + +# TXZY3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txzy3$t (a, b, nx, ny, nz) + +PIXEL a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, y, z] +end + +$endfor diff --git a/pkg/proto/vol/src/im3dtran/txzy3.x b/pkg/proto/vol/src/im3dtran/txzy3.x new file mode 100644 index 00000000..ad6096bf --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/txzy3.x @@ -0,0 +1,103 @@ + + +# TXZY3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txzy3s (a, b, nx, ny, nz) + +short a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, y, z] +end + + + +# TXZY3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txzy3i (a, b, nx, ny, nz) + +int a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, y, z] +end + + + +# TXZY3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txzy3l (a, b, nx, ny, nz) + +long a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, y, z] +end + + + +# TXZY3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txzy3r (a, b, nx, ny, nz) + +real a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, y, z] +end + + + +# TXZY3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txzy3d (a, b, nx, ny, nz) + +double a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, y, z] +end + + + +# TXZY3 -- Generic 3d transpose, x->x, y->z, z->y. The arrays need not be +# identical. + +procedure txzy3x (a, b, nx, ny, nz) + +complex a[nx, ny, nz], b[nx, nz, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[x, z, y] = a[x, y, z] +end + + diff --git a/pkg/proto/vol/src/im3dtran/tyxz3.gx b/pkg/proto/vol/src/im3dtran/tyxz3.gx new file mode 100644 index 00000000..75c2244f --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/tyxz3.gx @@ -0,0 +1,18 @@ +$for (silrdx) + +# TYXZ3 -- Generic 3d transpose, x->y, y->x, z->z. The arrays need not be +# identical. + +procedure tyxz3$t (a, b, nx, ny, nz) + +PIXEL a[nx, ny, nz], b[ny, nx, nz] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, x, z] = a[x, y, z] +end + +$endfor diff --git a/pkg/proto/vol/src/im3dtran/tyxz3.x b/pkg/proto/vol/src/im3dtran/tyxz3.x new file mode 100644 index 00000000..166ae8de --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/tyxz3.x @@ -0,0 +1,103 @@ + + +# TYXZ3 -- Generic 3d transpose, x->y, y->x, z->z. The arrays need not be +# identical. + +procedure tyxz3s (a, b, nx, ny, nz) + +short a[nx, ny, nz], b[ny, nx, nz] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, x, z] = a[x, y, z] +end + + + +# TYXZ3 -- Generic 3d transpose, x->y, y->x, z->z. The arrays need not be +# identical. + +procedure tyxz3i (a, b, nx, ny, nz) + +int a[nx, ny, nz], b[ny, nx, nz] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, x, z] = a[x, y, z] +end + + + +# TYXZ3 -- Generic 3d transpose, x->y, y->x, z->z. The arrays need not be +# identical. + +procedure tyxz3l (a, b, nx, ny, nz) + +long a[nx, ny, nz], b[ny, nx, nz] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, x, z] = a[x, y, z] +end + + + +# TYXZ3 -- Generic 3d transpose, x->y, y->x, z->z. The arrays need not be +# identical. + +procedure tyxz3r (a, b, nx, ny, nz) + +real a[nx, ny, nz], b[ny, nx, nz] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, x, z] = a[x, y, z] +end + + + +# TYXZ3 -- Generic 3d transpose, x->y, y->x, z->z. The arrays need not be +# identical. + +procedure tyxz3d (a, b, nx, ny, nz) + +double a[nx, ny, nz], b[ny, nx, nz] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, x, z] = a[x, y, z] +end + + + +# TYXZ3 -- Generic 3d transpose, x->y, y->x, z->z. The arrays need not be +# identical. + +procedure tyxz3x (a, b, nx, ny, nz) + +complex a[nx, ny, nz], b[ny, nx, nz] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, x, z] = a[x, y, z] +end + + diff --git a/pkg/proto/vol/src/im3dtran/tyzx3.gx b/pkg/proto/vol/src/im3dtran/tyzx3.gx new file mode 100644 index 00000000..108910aa --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/tyzx3.gx @@ -0,0 +1,18 @@ +$for (silrdx) + +# TYZX3 -- Generic 3d transpose, x->y, y->z, z->x. The arrays need not be +# identical. + +procedure tyzx3$t (a, b, nx, ny, nz) + +PIXEL a[nx, ny, nz], b[ny, nz, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, z, x] = a[x, y, z] +end + +$endfor diff --git a/pkg/proto/vol/src/im3dtran/tyzx3.x b/pkg/proto/vol/src/im3dtran/tyzx3.x new file mode 100644 index 00000000..6b05e748 --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/tyzx3.x @@ -0,0 +1,103 @@ + + +# TYZX3 -- Generic 3d transpose, x->y, y->z, z->x. The arrays need not be +# identical. + +procedure tyzx3s (a, b, nx, ny, nz) + +short a[nx, ny, nz], b[ny, nz, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, z, x] = a[x, y, z] +end + + + +# TYZX3 -- Generic 3d transpose, x->y, y->z, z->x. The arrays need not be +# identical. + +procedure tyzx3i (a, b, nx, ny, nz) + +int a[nx, ny, nz], b[ny, nz, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, z, x] = a[x, y, z] +end + + + +# TYZX3 -- Generic 3d transpose, x->y, y->z, z->x. The arrays need not be +# identical. + +procedure tyzx3l (a, b, nx, ny, nz) + +long a[nx, ny, nz], b[ny, nz, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, z, x] = a[x, y, z] +end + + + +# TYZX3 -- Generic 3d transpose, x->y, y->z, z->x. The arrays need not be +# identical. + +procedure tyzx3r (a, b, nx, ny, nz) + +real a[nx, ny, nz], b[ny, nz, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, z, x] = a[x, y, z] +end + + + +# TYZX3 -- Generic 3d transpose, x->y, y->z, z->x. The arrays need not be +# identical. + +procedure tyzx3d (a, b, nx, ny, nz) + +double a[nx, ny, nz], b[ny, nz, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, z, x] = a[x, y, z] +end + + + +# TYZX3 -- Generic 3d transpose, x->y, y->z, z->x. The arrays need not be +# identical. + +procedure tyzx3x (a, b, nx, ny, nz) + +complex a[nx, ny, nz], b[ny, nz, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[y, z, x] = a[x, y, z] +end + + diff --git a/pkg/proto/vol/src/im3dtran/tzxy3.gx b/pkg/proto/vol/src/im3dtran/tzxy3.gx new file mode 100644 index 00000000..3fbed0b5 --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/tzxy3.gx @@ -0,0 +1,18 @@ +$for (silrdx) + +# TZXY3 -- Generic 3d transpose, x->z, y->x, z->y. The arrays need not be +# identical. + +procedure tzxy3$t (a, b, nx, ny, nz) + +PIXEL a[nx, ny, nz], b[nz, nx, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, x, y] = a[x, y, z] +end + +$endfor diff --git a/pkg/proto/vol/src/im3dtran/tzxy3.x b/pkg/proto/vol/src/im3dtran/tzxy3.x new file mode 100644 index 00000000..d3b30f31 --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/tzxy3.x @@ -0,0 +1,103 @@ + + +# TZXY3 -- Generic 3d transpose, x->z, y->x, z->y. The arrays need not be +# identical. + +procedure tzxy3s (a, b, nx, ny, nz) + +short a[nx, ny, nz], b[nz, nx, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, x, y] = a[x, y, z] +end + + + +# TZXY3 -- Generic 3d transpose, x->z, y->x, z->y. The arrays need not be +# identical. + +procedure tzxy3i (a, b, nx, ny, nz) + +int a[nx, ny, nz], b[nz, nx, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, x, y] = a[x, y, z] +end + + + +# TZXY3 -- Generic 3d transpose, x->z, y->x, z->y. The arrays need not be +# identical. + +procedure tzxy3l (a, b, nx, ny, nz) + +long a[nx, ny, nz], b[nz, nx, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, x, y] = a[x, y, z] +end + + + +# TZXY3 -- Generic 3d transpose, x->z, y->x, z->y. The arrays need not be +# identical. + +procedure tzxy3r (a, b, nx, ny, nz) + +real a[nx, ny, nz], b[nz, nx, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, x, y] = a[x, y, z] +end + + + +# TZXY3 -- Generic 3d transpose, x->z, y->x, z->y. The arrays need not be +# identical. + +procedure tzxy3d (a, b, nx, ny, nz) + +double a[nx, ny, nz], b[nz, nx, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, x, y] = a[x, y, z] +end + + + +# TZXY3 -- Generic 3d transpose, x->z, y->x, z->y. The arrays need not be +# identical. + +procedure tzxy3x (a, b, nx, ny, nz) + +complex a[nx, ny, nz], b[nz, nx, ny] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, x, y] = a[x, y, z] +end + + diff --git a/pkg/proto/vol/src/im3dtran/tzyx3.gx b/pkg/proto/vol/src/im3dtran/tzyx3.gx new file mode 100644 index 00000000..61d32e6d --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/tzyx3.gx @@ -0,0 +1,18 @@ +$for (silrdx) + +# TZYX3 -- Generic 3d transpose, x->z, y->y, z->x. The arrays need not be +# identical. + +procedure tzyx3$t (a, b, nx, ny, nz) + +PIXEL a[nx, ny, nz], b[nz, ny, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, y, x] = a[x, y, z] +end + +$endfor diff --git a/pkg/proto/vol/src/im3dtran/tzyx3.x b/pkg/proto/vol/src/im3dtran/tzyx3.x new file mode 100644 index 00000000..8cc4c877 --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/tzyx3.x @@ -0,0 +1,103 @@ + + +# TZYX3 -- Generic 3d transpose, x->z, y->y, z->x. The arrays need not be +# identical. + +procedure tzyx3s (a, b, nx, ny, nz) + +short a[nx, ny, nz], b[nz, ny, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, y, x] = a[x, y, z] +end + + + +# TZYX3 -- Generic 3d transpose, x->z, y->y, z->x. The arrays need not be +# identical. + +procedure tzyx3i (a, b, nx, ny, nz) + +int a[nx, ny, nz], b[nz, ny, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, y, x] = a[x, y, z] +end + + + +# TZYX3 -- Generic 3d transpose, x->z, y->y, z->x. The arrays need not be +# identical. + +procedure tzyx3l (a, b, nx, ny, nz) + +long a[nx, ny, nz], b[nz, ny, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, y, x] = a[x, y, z] +end + + + +# TZYX3 -- Generic 3d transpose, x->z, y->y, z->x. The arrays need not be +# identical. + +procedure tzyx3r (a, b, nx, ny, nz) + +real a[nx, ny, nz], b[nz, ny, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, y, x] = a[x, y, z] +end + + + +# TZYX3 -- Generic 3d transpose, x->z, y->y, z->x. The arrays need not be +# identical. + +procedure tzyx3d (a, b, nx, ny, nz) + +double a[nx, ny, nz], b[nz, ny, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, y, x] = a[x, y, z] +end + + + +# TZYX3 -- Generic 3d transpose, x->z, y->y, z->x. The arrays need not be +# identical. + +procedure tzyx3x (a, b, nx, ny, nz) + +complex a[nx, ny, nz], b[nz, ny, nx] +int nx, ny, nz, x, y, z + +begin + do x = 1, nx + do y = 1, ny + do z = 1, nz + b[z, y, x] = a[x, y, z] +end + + diff --git a/pkg/proto/vol/src/im3dtran/x_im3dtran.x b/pkg/proto/vol/src/im3dtran/x_im3dtran.x new file mode 100644 index 00000000..b1610b21 --- /dev/null +++ b/pkg/proto/vol/src/im3dtran/x_im3dtran.x @@ -0,0 +1,4 @@ +# X_IM3DTRANS.X -- Task statement for IM3DTRANSPOSE. Used only for debugging +# (see entry 'dbx:' in mkpkg). + +task im3dtrans = t_im3dtrans diff --git a/pkg/proto/vol/src/imjoin.gx b/pkg/proto/vol/src/imjoin.gx new file mode 100644 index 00000000..04d2cc93 --- /dev/null +++ b/pkg/proto/vol/src/imjoin.gx @@ -0,0 +1,86 @@ +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 up to 7 (NOT necessarily IM_MAXDIM!). + +$for (silrdx) +procedure imjoin$t (inptr, nimages, out, joindim, outtype) +pointer inptr[nimages] # Input IMIO pointers +int nimages # Number of input images +pointer out # Output IMIO pointer +int joindim # Dimension along which to join images +int outtype # Output datatype + +pointer in, inbuf, outbuf, sp, vin +int stat, image, cum_len, line, band, dim4, dim5, dim6, dim7 +long vout[IM_MAXDIM] + +pointer imgnl$t() +pointer impnl$t() + +begin + call smark (sp) + call salloc (vin, nimages, TY_INT) + + call amovkl (long(1), 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 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 imdescriptors open. + + switch (joindim) { + case 1: # join columns + do band = 1, IM_LEN(out,3) + do line = 1, IM_LEN(out,2) { + stat = impnl$t (out, outbuf, 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 + do band = 1, IM_LEN(out,3) + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnl$t (out, outbuf, vout) + stat = imgnl$t (in, inbuf, Meml[VPTR(vin,image)]) + call amov$t (Mem$t[inbuf], Mem$t[outbuf], IM_LEN(in,1)) + } + } + case 3,4,5,6,7: # join bands or higher + do image = 1, nimages { + in = inptr[image] + do dim7 = 1, IM_LEN(in,7) + do dim6 = 1, IM_LEN(in,6) + do dim5 = 1, IM_LEN(in,5) + do dim4 = 1, IM_LEN(in,4) + do band = 1, IM_LEN(in,3) + do line = 1, IM_LEN(in,2) { + stat = impnl$t (out, outbuf, vout) + stat = imgnl$t (in, inbuf, + Meml[VPTR(vin,image)]) + call amov$t (Mem$t[inbuf], + Mem$t[outbuf], IM_LEN(in,1)) + } + # Unmap last image to free resources. + call imunmap (in) + } + } + + call sfree (sp) +end + +$endfor diff --git a/pkg/proto/vol/src/imjoin.par b/pkg/proto/vol/src/imjoin.par new file mode 100644 index 00000000..3acb6e02 --- /dev/null +++ b/pkg/proto/vol/src/imjoin.par @@ -0,0 +1,4 @@ +input,s,a,,,,"Input images or @file" +output,s,a,,,,"Output joined image" +joindim,i,h,1,1,7,"Splice dimension (1=x, 2=y, 3=z, ...)" +outtype,s,h,"",,,"Output datatype (defaults to highest intype)" diff --git a/pkg/proto/vol/src/imjoin.x b/pkg/proto/vol/src/imjoin.x new file mode 100644 index 00000000..77ce47f3 --- /dev/null +++ b/pkg/proto/vol/src/imjoin.x @@ -0,0 +1,471 @@ +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 up to 7 (NOT necessarily IM_MAXDIM!). + + +procedure imjoins (inptr, nimages, out, joindim, outtype) +pointer inptr[nimages] # Input IMIO pointers +int nimages # Number of input images +pointer out # Output IMIO pointer +int joindim # Dimension along which to join images +int outtype # Output datatype + +pointer in, inbuf, outbuf, sp, vin +int stat, image, cum_len, line, band, dim4, dim5, dim6, dim7 +long vout[IM_MAXDIM] + +pointer imgnls() +pointer impnls() + +begin + call smark (sp) + call salloc (vin, nimages, TY_INT) + + call amovkl (long(1), 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 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 imdescriptors open. + + switch (joindim) { + case 1: # join columns + do band = 1, IM_LEN(out,3) + do line = 1, IM_LEN(out,2) { + stat = impnls (out, outbuf, 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 + do band = 1, IM_LEN(out,3) + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnls (out, outbuf, vout) + stat = imgnls (in, inbuf, Meml[VPTR(vin,image)]) + call amovs (Mems[inbuf], Mems[outbuf], IM_LEN(in,1)) + } + } + case 3,4,5,6,7: # join bands or higher + do image = 1, nimages { + in = inptr[image] + do dim7 = 1, IM_LEN(in,7) + do dim6 = 1, IM_LEN(in,6) + do dim5 = 1, IM_LEN(in,5) + do dim4 = 1, IM_LEN(in,4) + do band = 1, IM_LEN(in,3) + do line = 1, IM_LEN(in,2) { + stat = impnls (out, outbuf, vout) + stat = imgnls (in, inbuf, + Meml[VPTR(vin,image)]) + call amovs (Mems[inbuf], + Mems[outbuf], IM_LEN(in,1)) + } + # Unmap last image to free resources. + call imunmap (in) + } + } + + call sfree (sp) +end + + +procedure imjoini (inptr, nimages, out, joindim, outtype) +pointer inptr[nimages] # Input IMIO pointers +int nimages # Number of input images +pointer out # Output IMIO pointer +int joindim # Dimension along which to join images +int outtype # Output datatype + +pointer in, inbuf, outbuf, sp, vin +int stat, image, cum_len, line, band, dim4, dim5, dim6, dim7 +long vout[IM_MAXDIM] + +pointer imgnli() +pointer impnli() + +begin + call smark (sp) + call salloc (vin, nimages, TY_INT) + + call amovkl (long(1), 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 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 imdescriptors open. + + switch (joindim) { + case 1: # join columns + do band = 1, IM_LEN(out,3) + do line = 1, IM_LEN(out,2) { + stat = impnli (out, outbuf, 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 + do band = 1, IM_LEN(out,3) + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnli (out, outbuf, vout) + stat = imgnli (in, inbuf, Meml[VPTR(vin,image)]) + call amovi (Memi[inbuf], Memi[outbuf], IM_LEN(in,1)) + } + } + case 3,4,5,6,7: # join bands or higher + do image = 1, nimages { + in = inptr[image] + do dim7 = 1, IM_LEN(in,7) + do dim6 = 1, IM_LEN(in,6) + do dim5 = 1, IM_LEN(in,5) + do dim4 = 1, IM_LEN(in,4) + do band = 1, IM_LEN(in,3) + do line = 1, IM_LEN(in,2) { + stat = impnli (out, outbuf, vout) + stat = imgnli (in, inbuf, + Meml[VPTR(vin,image)]) + call amovi (Memi[inbuf], + Memi[outbuf], IM_LEN(in,1)) + } + # Unmap last image to free resources. + call imunmap (in) + } + } + + call sfree (sp) +end + + +procedure imjoinl (inptr, nimages, out, joindim, outtype) +pointer inptr[nimages] # Input IMIO pointers +int nimages # Number of input images +pointer out # Output IMIO pointer +int joindim # Dimension along which to join images +int outtype # Output datatype + +pointer in, inbuf, outbuf, sp, vin +int stat, image, cum_len, line, band, dim4, dim5, dim6, dim7 +long vout[IM_MAXDIM] + +pointer imgnll() +pointer impnll() + +begin + call smark (sp) + call salloc (vin, nimages, TY_INT) + + call amovkl (long(1), 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 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 imdescriptors open. + + switch (joindim) { + case 1: # join columns + do band = 1, IM_LEN(out,3) + do line = 1, IM_LEN(out,2) { + stat = impnll (out, outbuf, 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 + do band = 1, IM_LEN(out,3) + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnll (out, outbuf, vout) + stat = imgnll (in, inbuf, Meml[VPTR(vin,image)]) + call amovl (Meml[inbuf], Meml[outbuf], IM_LEN(in,1)) + } + } + case 3,4,5,6,7: # join bands or higher + do image = 1, nimages { + in = inptr[image] + do dim7 = 1, IM_LEN(in,7) + do dim6 = 1, IM_LEN(in,6) + do dim5 = 1, IM_LEN(in,5) + do dim4 = 1, IM_LEN(in,4) + do band = 1, IM_LEN(in,3) + do line = 1, IM_LEN(in,2) { + stat = impnll (out, outbuf, vout) + stat = imgnll (in, inbuf, + Meml[VPTR(vin,image)]) + call amovl (Meml[inbuf], + Meml[outbuf], IM_LEN(in,1)) + } + # Unmap last image to free resources. + call imunmap (in) + } + } + + call sfree (sp) +end + + +procedure imjoinr (inptr, nimages, out, joindim, outtype) +pointer inptr[nimages] # Input IMIO pointers +int nimages # Number of input images +pointer out # Output IMIO pointer +int joindim # Dimension along which to join images +int outtype # Output datatype + +pointer in, inbuf, outbuf, sp, vin +int stat, image, cum_len, line, band, dim4, dim5, dim6, dim7 +long vout[IM_MAXDIM] + +pointer imgnlr() +pointer impnlr() + +begin + call smark (sp) + call salloc (vin, nimages, TY_INT) + + call amovkl (long(1), 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 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 imdescriptors open. + + switch (joindim) { + case 1: # join columns + do band = 1, IM_LEN(out,3) + do line = 1, IM_LEN(out,2) { + stat = impnlr (out, outbuf, 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 + do band = 1, IM_LEN(out,3) + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnlr (out, outbuf, vout) + stat = imgnlr (in, inbuf, Meml[VPTR(vin,image)]) + call amovr (Memr[inbuf], Memr[outbuf], IM_LEN(in,1)) + } + } + case 3,4,5,6,7: # join bands or higher + do image = 1, nimages { + in = inptr[image] + do dim7 = 1, IM_LEN(in,7) + do dim6 = 1, IM_LEN(in,6) + do dim5 = 1, IM_LEN(in,5) + do dim4 = 1, IM_LEN(in,4) + do band = 1, IM_LEN(in,3) + do line = 1, IM_LEN(in,2) { + stat = impnlr (out, outbuf, vout) + stat = imgnlr (in, inbuf, + Meml[VPTR(vin,image)]) + call amovr (Memr[inbuf], + Memr[outbuf], IM_LEN(in,1)) + } + # Unmap last image to free resources. + call imunmap (in) + } + } + + call sfree (sp) +end + + +procedure imjoind (inptr, nimages, out, joindim, outtype) +pointer inptr[nimages] # Input IMIO pointers +int nimages # Number of input images +pointer out # Output IMIO pointer +int joindim # Dimension along which to join images +int outtype # Output datatype + +pointer in, inbuf, outbuf, sp, vin +int stat, image, cum_len, line, band, dim4, dim5, dim6, dim7 +long vout[IM_MAXDIM] + +pointer imgnld() +pointer impnld() + +begin + call smark (sp) + call salloc (vin, nimages, TY_INT) + + call amovkl (long(1), 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 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 imdescriptors open. + + switch (joindim) { + case 1: # join columns + do band = 1, IM_LEN(out,3) + do line = 1, IM_LEN(out,2) { + stat = impnld (out, outbuf, 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 + do band = 1, IM_LEN(out,3) + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnld (out, outbuf, vout) + stat = imgnld (in, inbuf, Meml[VPTR(vin,image)]) + call amovd (Memd[inbuf], Memd[outbuf], IM_LEN(in,1)) + } + } + case 3,4,5,6,7: # join bands or higher + do image = 1, nimages { + in = inptr[image] + do dim7 = 1, IM_LEN(in,7) + do dim6 = 1, IM_LEN(in,6) + do dim5 = 1, IM_LEN(in,5) + do dim4 = 1, IM_LEN(in,4) + do band = 1, IM_LEN(in,3) + do line = 1, IM_LEN(in,2) { + stat = impnld (out, outbuf, vout) + stat = imgnld (in, inbuf, + Meml[VPTR(vin,image)]) + call amovd (Memd[inbuf], + Memd[outbuf], IM_LEN(in,1)) + } + # Unmap last image to free resources. + call imunmap (in) + } + } + + call sfree (sp) +end + + +procedure imjoinx (inptr, nimages, out, joindim, outtype) +pointer inptr[nimages] # Input IMIO pointers +int nimages # Number of input images +pointer out # Output IMIO pointer +int joindim # Dimension along which to join images +int outtype # Output datatype + +pointer in, inbuf, outbuf, sp, vin +int stat, image, cum_len, line, band, dim4, dim5, dim6, dim7 +long vout[IM_MAXDIM] + +pointer imgnlx() +pointer impnlx() + +begin + call smark (sp) + call salloc (vin, nimages, TY_INT) + + call amovkl (long(1), 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 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 imdescriptors open. + + switch (joindim) { + case 1: # join columns + do band = 1, IM_LEN(out,3) + do line = 1, IM_LEN(out,2) { + stat = impnlx (out, outbuf, 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 + do band = 1, IM_LEN(out,3) + do image = 1, nimages { + in = inptr[image] + do line = 1, IM_LEN(in,2) { + stat = impnlx (out, outbuf, vout) + stat = imgnlx (in, inbuf, Meml[VPTR(vin,image)]) + call amovx (Memx[inbuf], Memx[outbuf], IM_LEN(in,1)) + } + } + case 3,4,5,6,7: # join bands or higher + do image = 1, nimages { + in = inptr[image] + do dim7 = 1, IM_LEN(in,7) + do dim6 = 1, IM_LEN(in,6) + do dim5 = 1, IM_LEN(in,5) + do dim4 = 1, IM_LEN(in,4) + do band = 1, IM_LEN(in,3) + do line = 1, IM_LEN(in,2) { + stat = impnlx (out, outbuf, vout) + stat = imgnlx (in, inbuf, + Meml[VPTR(vin,image)]) + call amovx (Memx[inbuf], + Memx[outbuf], IM_LEN(in,1)) + } + # Unmap last image to free resources. + call imunmap (in) + } + } + + call sfree (sp) +end + + diff --git a/pkg/proto/vol/src/imminmax.x b/pkg/proto/vol/src/imminmax.x new file mode 100644 index 00000000..dea537c6 --- /dev/null +++ b/pkg/proto/vol/src/imminmax.x @@ -0,0 +1,73 @@ +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/proto/vol/src/mkpkg b/pkg/proto/vol/src/mkpkg new file mode 100644 index 00000000..c0930db7 --- /dev/null +++ b/pkg/proto/vol/src/mkpkg @@ -0,0 +1,44 @@ +# Make the VOLUMES tasks. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $set LIBS = "-lxtools" + $update libpkg.a + $omake x_vol.x + $link x_vol.o libpkg.a $(LIBS) -o xx_vol.e + ; + +install: + $move xx_vol.e bin$x_vol.e + ; + +tfiles: + $ifolder (vtransmit.x, vtransmit.gx) + $generic -k vtransmit.gx -o vtransmit.x $endif + $ifolder (imjoin.x, imjoin.gx) + $generic -k imjoin.gx -o imjoin.x $endif + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call tfiles $endif + + t_pvol.x <ctype.h> <imhdr.h> pvol.h + vproject.x <math.h> <imhdr.h> pvol.h + vmatrix.x <imhdr.h> pvol.h + vtransmit.x <imhdr.h> pvol.h + vgetincr.x pvol.h + pv_gmem.x <imhdr.h> + t_imjoin.x <imhdr.h> <error.h> <syserr.h> + imjoin.x <imhdr.h> + imminmax.x <imhdr.h> + @im3dtran + @i2sun + ; + diff --git a/pkg/proto/vol/src/pv_gmem.x b/pkg/proto/vol/src/pv_gmem.x new file mode 100644 index 00000000..646baf47 --- /dev/null +++ b/pkg/proto/vol/src/pv_gmem.x @@ -0,0 +1,109 @@ +include <imhdr.h> + +# PV_GMEM -- Determine how much memory we can get and actually use for the +# volume rotation sequence. We only allocate actual memory temporarily in +# order to see how much is really available; IMIO will later take care of +# the actual io buffer allocation. + +define DECR_MEM 0.8 # decrement mem by magic factor + + +procedure pv_gmem (im1, im2, use_both, verbose, max_ws, len_x, oldsize) +pointer im1 # Input 3d image. +pointer im2 # Output projected image(s) +bool use_both # Use both opacity and intensity voxels +int verbose # Report memory usage? +int max_ws # Maximum working set to allocate +int len_x # (output) safe amount of memory to use +int oldsize # (output) old memory to be reset at termination + +int intype, outtype, reqmem, gotmem, needmem, maxsize +int yzslice_pix, yzreq +pointer buf_in +bool topped_out + +int begmem(), sizeof() +errchk begmem(), malloc() + +begin + # See how much memory we can get; if we cannot get whole input image + # into memory, do it in chunks of yz slices. + intype = IM_PIXTYPE(im1) + outtype = IM_PIXTYPE(im2) + reqmem = IM_LEN(im1,1) * IM_LEN(im1,2) * IM_LEN(im1,3) + reqmem = reqmem * sizeof (intype) + if (use_both) + reqmem = 2 * reqmem + + # Add output buffer. + reqmem = reqmem + IM_LEN(im2,1) * sizeof (outtype) + + # Decrease to max_ws (a task parameter in CHAR units). + reqmem = min (reqmem, max_ws) + + repeat { + iferr (gotmem = begmem (reqmem, oldsize, maxsize)) { + reqmem = reqmem * DECR_MEM + if (verbose == YES) { + call eprintf ("ERR gotmem=begmem(); retrying at size %d\n") + call pargi (reqmem) + } + } else { + if (verbose == YES) { + call eprintf ("gotmem=%d, oldsize=%d, maxsize=%d\n") + call pargi (gotmem) + call pargi (oldsize) + call pargi (maxsize) + } + break + } + } + + # Make sure it is really available, and if not, decrement to largest + # number of yz slices possible. + needmem = gotmem + yzslice_pix = IM_LEN(im1,2) * IM_LEN(im1,3) + yzreq = yzslice_pix * sizeof(intype) + if (yzreq - IM_LEN(im1,1) * sizeof(TY_REAL) > needmem) { + call eprintf ("Not enough memory for 1 yz slice of input image\n") + call error (0, "Out of memory") + } + topped_out = false + repeat { + iferr (call malloc (buf_in, needmem, intype)) { + needmem = needmem - yzreq + if (needmem < yzreq) { + call eprintf ("Had to decrease memory too much") + call error (0, "Memory allocation error (yzslice_pix)") + } + topped_out = true + } else { + call mfree (buf_in, intype) + break + } + } + + # Experiments show that horrible things happen if we actually use + # this much memory. Decrease by magic factor. + if (topped_out) { + call fixmem (max (needmem, oldsize)) + if (verbose == YES) { + call eprintf ("Had to decrease memory for malloc().") + call eprintf (" Working set now %d\n") + call pargi (needmem) + } + needmem = needmem * DECR_MEM + if (verbose == YES) { + call eprintf ("Remaining memory for image buffers = %d\n") + call pargi (needmem) + } + } + if (needmem < yzreq) { + call eprintf ("Not enough memory for 1 yz slice of input image\n") + call error (0, "Out of memory") + } + + # We return the number of columns to gulp from the input image at one + # time and oldmem so the task can release its memory on completion. + len_x = needmem / yzreq +end diff --git a/pkg/proto/vol/src/pvol.h b/pkg/proto/vol/src/pvol.h new file mode 100644 index 00000000..e232e8b1 --- /dev/null +++ b/pkg/proto/vol/src/pvol.h @@ -0,0 +1,58 @@ +# PVOL.H -- PVOL definitions. + +define COL 1 # image column index +define LINE 2 # image line index +define BAND 3 # image band index +define DIS (sqrt (($1)*($1) + ($2)*($2))) +define DRADIAN (57.295779513082320877D0) +define DDEGTORAD (double($1)/DRADIAN) +define DRADTODEG (double($1)*DRADIAN) +define DPI 3.1415926535897932385D0 +define DTWOPI 6.2831853071795864769D0 +define DHALFPI 1.5707963267948966192D0 +define DTHREEPIOVER2 (1.5D0 * DPI) +define DEF_IMIN (0.0) +define DEF_IMAX (1.0) + +define ALG_INCREM 1 # incremental dda proj. algor. +define ALG_BRESEN 2 # bresenham dda proj. algor. +define ALG_MATRIX 3 # rotation matrix prol. algor. +define P_ATTENUATE 1 # attenuate by voxval (opacity) +define P_AVERAGE 2 # average projected intensities +define P_SUM 3 # sum voxel intensities +define P_INVDISPOW 4 # wt int. by inverse dis power +define P_MODN 5 # use only f(ndecades) voxels +define P_LASTONLY 6 # use only last voxval > cutoff + +# Volume rotation descriptor +define LEN_VP 30 + +# Projection geometry elements: +define P_ALGORITHM Memi[$1] # Projection algorithm +define DEGREES Memr[P2R($1+1)] # Degrees per rotation increment +define NFRAMES Memi[$1+2] # Number of rotation increments +define VECX Memr[P2R($1+3)] # Rotation axis X vector +define VECY Memr[P2R($1+4)] # Rotation axis Y vector +define VECZ Memr[P2R($1+5)] # Rotation axis Z vector +define INIT_THETA Memr[P2R($1+6)] # Initial rotation angle +define MAX_WS Memi[$1+7] # Maximum working set size +# reserved space + +# Light transmission elements: +define OPACELEM Memi[$1+10] # Opacity element in 4th dimen +define PTYPE Memi[$1+11] # Projection type, voxel val 1 +define OMIN Memr[P2R($1+12)] # Voxel opacity minimum +define OMAX Memr[P2R($1+13)] # Voxel opacity maximum +define OSCALE Memr[P2R($1+14)] # Opacity scale factor +define AMIN Memr[P2R($1+15)] # Attenuation factor minimum +define AMAX Memr[P2R($1+16)] # Attenuation factor maximum +define VIMIN Memr[P2R($1+17)] # Voxel intensity minimum +define VIMAX Memr[P2R($1+18)] # Voxel intensity maximum +define IZERO Memr[P2R($1+19)] # Background illumination +define DISPOWER Memr[P2R($1+20)] # Distance weighting power +define MODN Memi[$1+21] # Use vox w/ (mod(val*100,modn)) +define IIMIN Memr[P2R($1+22)] # Input intensity minimum +define IIMAX Memr[P2R($1+23)] # Input intensity maximum +define VERBOSE Memi[$1+24] # Write verbose output? +define DISCUTOFF Memi[$1+25] # Measure distance w/in cutoffs +# reserved space diff --git a/pkg/proto/vol/src/pvol.par b/pkg/proto/vol/src/pvol.par new file mode 100644 index 00000000..3fbc38ba --- /dev/null +++ b/pkg/proto/vol/src/pvol.par @@ -0,0 +1,25 @@ +input,s,a,,,,"Input 3d or 4d image" +output,s,a,,,,"Output datacube" +nframes,i,h,INDEF,1,,"Number of rotation frames to compute" +degrees,r,h,10.0,,,"Degrees per rotation increment" +theta0,r,h,0.0,,,"Initial rotation angle (ccw from +X)" +ptype,i,h,2,1,6,"Projection (1=opc 2=av 3=sum 4=invd 5=mod 6=lst)" +imin,r,h,INDEF,,,"Voxel intensity minimum cutoff" +imax,r,h,INDEF,,,"Voxel intensity maximum cutoff" +omin,r,h,INDEF,,,"Voxel opacity minimum cutoff (ptype=1)" +omax,r,h,INDEF,,,"Voxel opacity maximum cutoff (ptype=1)" +amin,r,h,0.0,0.0,1.0,"Minimum attenuation factor (ptype=1)" +amax,r,h,1.0,0.0,1.0,"Maximum attenuation factor (ptype=1)" +izero,r,h,1.0,,,"Initial intensity (background illumination, ptype=1)" +oscale,r,h,1.0,,,"Voxel opacity scale factor (ptype=1)" +opacelem,i,h,1,1,2,"4th dim. opacity element (other=intensity)" +dispower,r,h,2.0,,,"Inverse distance weighting power (ptype=4,5)" +discutoff,b,h,n,,,"Measure distance from 1st vox inside cutoff" +modn,i,h,10,1,100,"Mod(n) for ptype=6; used for high-contrast input" +vecx,r,h,1.0,-1.0,1.0,"Rotation axis X vector (right hand rule)" +vecy,r,h,0.0,-1.0,1.0,"Rotation axis Y vector" +vecz,r,h,0.0,-1.0,1.0,"Rotation axis Z vector" +title,s,h,"",,,"Title for rotation sequence" +maxws,i,h,2000000,256000,,"Max workingset size in CHARS (2 bytes usually)" +abs,b,h,no,,,"Take absolute value of pixels?" +verbose,b,h,yes,,,"Verbose? (report progress, memory usage)" diff --git a/pkg/proto/vol/src/t_imjoin.x b/pkg/proto/vol/src/t_imjoin.x new file mode 100644 index 00000000..70708571 --- /dev/null +++ b/pkg/proto/vol/src/t_imjoin.x @@ -0,0 +1,190 @@ +include <imhdr.h> +include <error.h> +include <syserr.h> + +define DEFBUFSIZE 65536 # default IMIO buffer size +define FUDGE 0.8 # fudge factor + + +# T_IMJOIN -- Task driver for imjoin: up to IM_MAXDIM image join, along +# any one specified axis, from multiple input images. The set of input +# images need have the same number of dimensions and elements per dimension +# ONLY along the axes not being joined. Datatype will be converted to +# highest precedence type if not all the same. + +procedure t_imjoin() + +int list # List of input images +pointer output # Output image +char outtype # Output datatype + +int i, j, nimages, intype, ndim, joindim, outdtype, nelems[IM_MAXDIM] +int bufsize, maxsize, memory, oldsize +pointer sp, in, out, im, im1, input + +int imtopenp(), imtlen(), imtgetim(), clgeti() +int ty_max(), sizeof(), begmem(), errcode() +char clgetc() +pointer immap() +errchk immap +define retry_ 99 + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + + # Get the parameters. Some parameters are obtained later. + list = imtopenp ("input") + call clgstr ("output", Memc[output], SZ_FNAME) + joindim = clgeti ("joindim") + outtype = clgetc ("outtype") + + # Check if there are no images. + nimages = imtlen (list) + if (nimages == 0) { + call imtclose (list) + call sfree (sp) + call error (0, "No input images to join") + } + call salloc (in, nimages, TY_POINTER) + + # Map the input images. + bufsize = 0 +retry_ + 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 datatype of the output image. + im = Memi[in] + intype = IM_PIXTYPE(im) + ndim = max (IM_NDIM(im), joindim) + do j = 1, ndim + nelems[j] = IM_LEN(im,j) + + do i = 2, nimages { + im1 = Memi[in+i-1] + ndim = max (ndim, IM_NDIM(im1)) + do j = 1, ndim { + if (j == joindim) + nelems[j] = nelems[j] + IM_LEN(im1,j) + else { + if (IM_LEN(im1,j) != nelems[j]) { + call eprintf ("Image %d different size in dimen %d\n") + call pargi (i) + call pargi (IM_LEN(im1,j)) + call error (1, "Non-joindim image sizes must match") + } + } + } + intype = ty_max (intype, IM_PIXTYPE(im1)) + } + + # Open the output image and set its pixel datatype. + # If outtype was not specified (the default), set it to intype. + + out = immap (Memc[output], NEW_COPY, Memi[in]) + switch (outtype) { + case 's': + outdtype = TY_SHORT + case 'i': + outdtype = TY_INT + case 'l': + outdtype = TY_LONG + case 'r': + outdtype = TY_REAL + case 'd': + outdtype = TY_DOUBLE + case 'x': + outdtype = TY_COMPLEX + default: + outdtype = intype + } + IM_PIXTYPE(out) = outdtype + + # Set output image dimensionality and axis lengths. + 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 (intype) + 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 joindim. If an out of memory error occurs + # close all images and files, divide the IMIO buffer size in half + # and try again. + iferr { + switch (intype) { + case TY_SHORT: + call imjoins (Memi[in], nimages, out, joindim, outdtype) + case TY_INT: + call imjoini (Memi[in], nimages, out, joindim, outdtype) + case TY_LONG: + call imjoinl (Memi[in], nimages, out, joindim, outdtype) + case TY_REAL: + call imjoinr (Memi[in], nimages, out, joindim, outdtype) + case TY_DOUBLE: + call imjoind (Memi[in], nimages, out, joindim, outdtype) + case TY_COMPLEX: + call imjoinx (Memi[in], nimages, out, joindim, outdtype) + } + } 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) + } + } + + # Unmap all the images and restore memory. + call imunmap (out) + do i = 1, nimages + if (joindim < 3) + call imunmap (Memi[in+i-1]) + + call sfree (sp) + call fixmem (oldsize) +end + + +# TY_MAX -- Return the datatype of highest precedence. + +int procedure ty_max (type1, type2) + +int type1, type2 # Datatypes + +int i, j, order[7] +data order/TY_SHORT,TY_INT,TY_LONG,TY_REAL,TY_DOUBLE,TY_COMPLEX,TY_REAL/ + +begin + for (i=1; (i<=6) && (type1!=order[i]); i=i+1) + ; + for (j=1; (j<=6) && (type2!=order[j]); j=j+1) + ; + return (order[max(i,j)]) +end diff --git a/pkg/proto/vol/src/t_pvol.x b/pkg/proto/vol/src/t_pvol.x new file mode 100644 index 00000000..251012c5 --- /dev/null +++ b/pkg/proto/vol/src/t_pvol.x @@ -0,0 +1,284 @@ +include <ctype.h> +include <imhdr.h> +include <time.h> +include "pvol.h" + +define iwrapup_ 91 +define mwrapup_ 92 + + +# PVOL -- Project Volume. Given an input datacube, produce a series of +# frames representing projections at stepped rotations around the cube, +# using voxel intensity and/or opacity information. This is a form of +# volume rendering. + +procedure t_pvol + +pointer input, output, sp, tmpstr, vp, timestr, im1, im2 +long clock1, clock2, elapclock, cpu1, cpu2, elapcpu +bool need_lims, use_both +real tmpmin, tmpmax + +pointer immap() +int clgeti(), clktime(), cputime() +bool clgetb() +real clgetr() + +begin + call smark (sp) + call salloc (tmpstr, SZ_LINE, TY_CHAR) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (timestr, SZ_FNAME, TY_CHAR) + + # Allocate storage for volume projection descriptor. + call malloc (vp, LEN_VP, TY_STRUCT) + + # Input parameters. + if (clgetb ("verbose")) + VERBOSE(vp) = YES + else + VERBOSE(vp) = NO + call clgstr ("input", Memc[input], SZ_FNAME) + call clgstr ("output", Memc[output], SZ_FNAME) + + # Geometric projection parameters: + DEGREES(vp) = clgetr ("degrees") + INIT_THETA(vp) = clgetr ("theta0") + NFRAMES(vp) = clgeti ("nframes") + if (IS_INDEFI(NFRAMES(vp)) && !IS_INDEFR(DEGREES(vp))) + NFRAMES(vp) = int (360.0 / DEGREES(vp)) + else if (IS_INDEFR(DEGREES(vp)) && !IS_INDEFI(NFRAMES(vp))) + DEGREES(vp) = 360.0 / NFRAMES(vp) + else if (IS_INDEFR(DEGREES(vp)) && IS_INDEFI(NFRAMES(vp))) { + NFRAMES(vp) = 36 + DEGREES(vp) = 10.0 + } + PTYPE(vp) = clgeti ("ptype") + VIMIN(vp) = clgetr ("imin") + VIMAX(vp) = clgetr ("imax") + IZERO(vp) = clgetr ("izero") + OSCALE(vp) = clgetr ("oscale") + OMIN(vp) = clgetr ("omin") + OMAX(vp) = clgetr ("omax") + AMIN(vp) = clgetr ("amin") + AMAX(vp) = clgetr ("amax") + DISCUTOFF(vp) = NO + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) { + DISPOWER(vp) = clgetr ("dispower") + if (clgetb ("discutoff")) + DISCUTOFF(vp) = YES + } + if (PTYPE(vp) == P_MODN) + MODN(vp) = clgeti ("modn") + VECX(vp) = clgetr ("vecx") + VECY(vp) = clgetr ("vecy") + VECZ(vp) = clgetr ("vecz") + + MAX_WS(vp) = clgeti ("maxws") + + # In prototype, the incremental algorithm is only implemented for + # rotations about the X axis, counterclockwise when viewed from +X + # looking back toward the origin. + + if (!(VECX(vp) == +1.0 && VECY(vp) == 0.0 && VECZ(vp) == 0.0)) { + call eprintf ("ERROR: Only +X axis rotations supported with") + call eprintf (" incremental alg. at present\n") + call error (0, "Unsupported feature") + } + + # Open images. + im1 = immap (Memc[input], READ_ONLY, 0) + im2 = immap (Memc[output], NEW_IMAGE, 0) + call clgstr ("title", IM_TITLE(im1), SZ_IMTITLE) + + # If input image is 4d, with 2 elements in 4th dimension, one of them + # must be opacity and the other intensity. If someone wants to merge + # two or more sets of intensity data, they can make independent runs + # of PVOL and merge the outputs using RGB displays. + + use_both = false + OPACELEM(vp) = INDEFI + if (IM_NDIM(im1) == 4 && PTYPE(vp) != P_ATTENUATE) { + if (IM_LEN(im1,4) > 2) + call error (0, "Don't know how to handle 4d image w/ >2 elems") + else if (IM_LEN(im1,4) == 2) { + OPACELEM(vp) = clgeti ("opacelem") + if (PTYPE(vp) == P_LASTONLY) { + call eprintf ("Warning: cannot use ptype LASTONLY with ") + call eprintf ("combined opacity/intensity data.\n") + PTYPE(vp) = P_SUM + call eprintf (" resetting ptype = %d (SUM)\n") + call pargi (PTYPE(vp)) + } + use_both = true + if (VERBOSE(vp) == YES) + call eprintf ("4D image, using both opacity & intensity.\n") + } else + OPACELEM(vp) = INDEFI + } else if (IM_NDIM(im1) > 4) + call error (0, "Don't know how to handle > 4d image") + + # Determine voxel intensity minimum & maximum for all intensity + # transformations. Both a specified intensity min & max and an + # image min & max are required in the intensity transformation step + # function: if image min & max are up to date in the image header, + # they will be used for image min & max; and if task parameters + # imin, imax are NOT supplied, they will be set equal to image min + # & max. Likewise, if image min & max are not present, but + # task params imin,imax are, the image min & max will be set to + # imin,imax for duration of PVOL execution. If neither are supplied, + # the image min & max will be calculated but not updated (might not + # have write access, user might not want them updated); however, if + # verbose is on, the user will be warned to run MINMAX on the image + # in the future to save time. + + if (PTYPE(vp) == P_ATTENUATE || use_both) { + # Get opacity transformation function parameters. + if (IS_INDEFR(OMIN(vp))) + OMIN(vp) = IIMIN(vp) + if (IS_INDEFR(OMAX(vp))) + OMAX(vp) = IIMAX(vp) + if (OMAX(vp) - OMIN(vp) <= 0.0) { + call eprintf ("Error: Invalid omin / omax (%g : %g)\n") + call pargr (OMIN(vp)) + call pargr (OMAX(vp)) + goto iwrapup_ + } + } + + if (PTYPE(vp) != P_ATTENUATE || use_both) { + # Get intensity transformation function parameters & image minmax. + need_lims = false + if (IM_LIMTIME(im1) < IM_MTIME(im1)) + need_lims = true + else { + tmpmin = IM_MIN(im1) + tmpmax = IM_MAX(im1) + } + if (IS_INDEFR(VIMIN(vp))) { + if (need_lims) { + call imminmax (im1, tmpmin, tmpmax) + need_lims = false + if (VERBOSE(vp) == YES) { + call eprintf ("Must compute input image min & max...\n") + call eprintf ("NOTE: run MINMAX with force+ & update+") + call eprintf (" on input image in the future.\n") + } + } + IIMIN(vp) = tmpmin + VIMIN(vp) = IIMIN(vp) + } else { + if (need_lims) { + IIMIN(vp) = VIMIN(vp) + if (VERBOSE(vp) == YES) + call eprintf ("Image MIN not present; using IMIN\n") + } else + IIMIN(vp) = tmpmin + } + + if (IS_INDEFR(VIMAX(vp))) { + if (need_lims) { + call imminmax (im1, tmpmin, tmpmax) + if (VERBOSE(vp) == YES) { + call eprintf ("Must compute input image min & max...\n") + call eprintf ("NOTE: run MINMAX with force+ & update+") + call eprintf (" on input image in the future.\n") + } + } + IIMAX(vp) = tmpmax + VIMAX(vp) = IIMAX(vp) + } else { + if (need_lims) { + IIMAX(vp) = VIMAX(vp) + if (VERBOSE(vp) == YES) + call eprintf ("Image MAX not present; using IMAX\n") + } else + IIMAX(vp) = tmpmax + } + + if (VIMAX(vp) - VIMIN(vp) <= 0.0 && PTYPE(vp) != P_ATTENUATE) { + call eprintf ("Error: Invalid imin / imax (%g : %g)\n") + call pargr (VIMIN(vp)) + call pargr (VIMAX(vp)) + goto iwrapup_ + } + + } + + # Load the relevant output header parameters. + IM_PIXTYPE(im2) = TY_REAL + IM_NDIM(im2) = 3 + IM_LEN(im2,COL) = IM_LEN(im1,COL) + + # Store run parameters in output image header. + call imastr (im2, "V_OIMAGE", Memc[input]) + call imastr (im2, "V_OTITLE", IM_TITLE(im1)) + call imaddr (im2, "V_OLDMIN", IIMIN(vp)) + call imaddr (im2, "V_OLDMAX", IIMAX(vp)) + call imaddr (im2, "V_DEGREES", DEGREES(vp)) + call imaddr (im2, "V_THETA0", INIT_THETA(vp)) + call sprintf (Memc[tmpstr], SZ_LINE, "x=%5.2f, y=%5.2f, z=%5.2f") + call pargr (VECX(vp)); call pargr (VECY(vp)); call pargr (VECZ(vp)) + call imastr (im2, "V_ROTVECT", Memc[tmpstr]) + call imaddi (im2, "V_PTYPE", PTYPE(vp)) + call sprintf (Memc[tmpstr], SZ_LINE, "%g : %g") + call pargr (VIMIN(vp)); call pargr (VIMAX(vp)) + call imastr (im2, "V_IMINMX", Memc[tmpstr]) + call imaddr (im2, "V_IZERO", IZERO(vp)) + call sprintf (Memc[tmpstr], SZ_LINE, "%g : %g") + call pargr (OMIN(vp)); call pargr (OMAX(vp)) + call imastr (im2, "V_OMINMX", Memc[tmpstr]) + call imaddr (im2, "V_OSCALE", OSCALE(vp)) + call sprintf (Memc[tmpstr], SZ_LINE, "%g : %g") + call pargr (AMIN(vp)); call pargr (AMAX(vp)) + call imastr (im2, "V_ATTEN", Memc[tmpstr]) + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) + call imaddr (im2, "V_DISPOW", DISPOWER(vp)) + call imaddb (im2, "V_DISCUT", (DISCUTOFF(vp) == YES)) + if (PTYPE(vp) == P_MODN) + call imaddi (im2, "V_MODN", MODN(vp)) + if (use_both) { + call imastr (im2, "V_BOTH", "4D: Both opacity and intensity used") + call imaddi (im2, "V_OPELEM", OPACELEM(vp)) + } + + # Initialize timers. + clock1 = clktime (long (0)) + call cnvtime (clock1, Memc[timestr], SZ_TIME) + cpu1 = cputime (long (0)) + + # Do all the work. + call vproject (im1, im2, vp, use_both) + + call sysid (Memc[tmpstr], SZ_LINE) + call imastr (im2, "P_SYSTEM", Memc[tmpstr]) + + clock2 = clktime (long (0)) + elapclock = (clock2 - clock1) + cpu2 = cputime (long (0)) + elapcpu = (cpu2 - cpu1) / 1000 + + call imastr (im2, "P_STIME", Memc[timestr]) + clock1 = clktime (long (0)) + call cnvtime (clock1, Memc[timestr], SZ_TIME) + call imastr (im2, "P_ETIME", Memc[timestr]) + call sprintf (Memc[tmpstr], SZ_LINE, + "Elapsed cpu = %02d %02s:%02s:%02s, clock = %02d %02s:%02s:%02s") + call pargi (elapcpu/86400) + call pargi (mod (elapcpu, 86400) / 3600) + call pargi (mod (elapcpu, 3600) / 60) + call pargi (mod (elapcpu, 60)) + call pargi (elapclock/86400) + call pargi (mod (elapclock, 86400) / 3600) + call pargi (mod (elapclock, 3600) / 60) + call pargi (mod (elapclock, 60)) + call imastr (im2, "P_ELAPSED", Memc[tmpstr]) + +iwrapup_ + call imunmap (im1) + call imunmap (im2) +mwrapup_ + call mfree (vp, TY_STRUCT) + call sfree (sp) +end diff --git a/pkg/proto/vol/src/vgetincr.x b/pkg/proto/vol/src/vgetincr.x new file mode 100644 index 00000000..c96ff2bb --- /dev/null +++ b/pkg/proto/vol/src/vgetincr.x @@ -0,0 +1,92 @@ +include "pvol.h" + + +# VGETINCREM -- Get list of input voxel band & line indices that contribute to +# current ray, using simple incremental digital differential analyzer. + +procedure vgetincrem (tx1,ty1, tx2,ty2, nx,ny, maxvox, nvox, xind, yind) +double tx1,ty1 # (in) starting coordinate of ray +double tx2,ty2 # (in) ending coordinate of ray +int nx,ny # (in) dimensions of working plane (1:nx, 1:ny) +int maxvox # (in) max dimension of output index arrays +int nvox # (out) count of indices for current ray +int xind[ARB] # (out) array of input voxel band indices +int yind[ARB] # (out) array of input voxel line indices + +real x1,y1, x2,y2, dy,dx, adx,ady, x,y, length +int i, tvox, xi, yi + +int vsign() + +begin + # Going between integer and floating point grid representations + # is tricky, especially for symmetrical rotation angles aligned with + # the grid nodes. Rounding from double to single precision here + # is the only way I could get things to work for all possible angles + # and grid dimensions. + + x1 = tx1 + y1 = ty1 + x2 = tx2 + y2 = ty2 + dx = x2 - x1 + dy = y2 - y1 + adx = abs (dx) + ady = abs (dy) + + # Approximate the line length. + if (adx >= ady) + length = adx + else + length = ady + tvox = int (length) + 1 + if (tvox > maxvox) + call error (0, "VGETINCREM: nvox > maxvox") + + # Select the larger of dx or dy to be one raster unit. + dx = dx / length + dy = dy / length + + # Round values; using vsign function makes this work in all quadrants. + x = x1 + 0.5 * vsign (dx) + y = y1 + 0.5 * vsign (dy) + + # Boundary-extend if coming FROM +x or +y and if rounding would not + # take us out of range. + if (dx == -1.0 || dy == -1.0) { + if (!((int(x-dx) <= 0 || int(x-dx) > nx) || + (int(y-dy) <= 0 || int(y-dy) > ny))) { + x = x - dx + y = y - dy + } + } + + # Fill in the integer grid coordinates. + nvox = 0 + do i = 1, tvox { + xi = nx - int(x) + 1 # yes, we want to truncate here + yi = int (y) + if (1 <= xi && xi <= nx && 1 <= yi && yi <= ny) { + nvox = nvox + 1 + xind[nvox] = xi + yind[nvox] = yi + } + x = x + dx + y = y + dy + } +end + + +# VSIGN -- Return -1, 0, +1 if val is <0, =0, >0. + +int procedure vsign (val) +real val + +begin + if (val < 0.0) + return (-1) + else if (val == 0.0) + return (0) + else + return (1) +end diff --git a/pkg/proto/vol/src/vmatrix.x b/pkg/proto/vol/src/vmatrix.x new file mode 100644 index 00000000..bfc01d63 --- /dev/null +++ b/pkg/proto/vol/src/vmatrix.x @@ -0,0 +1,31 @@ +include <imhdr.h> +include "pvol.h" + + +# VMATRIX -- Volume rotation, rotation matrix projection algorithm. +# Proceeds from origin at back of volume image toward front, writing +# output image lines in successive overlapping sheets. See "Back to +# Front Display of Voxel-Based Objects", G.Frieder, D.Gordon, R.Reynolds, +# IEEE Computer Graphics & Applications Jan. 85, p 52-60. + +procedure vmatrix (im1, im2, vp) +pointer im1 # Input volume image +pointer im2 # Output projection image +pointer vp # Volume projection descriptor + +real v, vx, vy, vz +real dcosa, dcosb, dcosc +#real t11,t21,t31, t12,t22,t32, t13,t23,t33 + +begin + vx = VECX(vp) + vy = VECY(vp) + vz = VECZ(vp) + v = sqrt (vx*vx + vy*vy + vz*vz) + dcosa = vx / v + dcosb = vy / v + dcosc = vz / v + + # ??????? +end + diff --git a/pkg/proto/vol/src/vproject.x b/pkg/proto/vol/src/vproject.x new file mode 100644 index 00000000..009f564d --- /dev/null +++ b/pkg/proto/vol/src/vproject.x @@ -0,0 +1,224 @@ +include <math.h> +include <imhdr.h> +include "pvol.h" + +define incr_ 91 + + +# VPROJECT -- Volume rotation, incremental projection algorithm. +# Routine attempts to hold as much of the input image in memory as possible. +# Constructs output image one complete line at a time, determining the +# contributing voxels for each ray by an incremental rasterizer-like algorithm. + +procedure vproject (im1, im2, vp, use_both) +pointer im1 # Input volume image +pointer im2 # Output projection image +pointer vp # Volume projection descriptor +bool use_both # Use both opacity and intensity from 4D image + +int plines, pcols, oline, oband, rot, nvox, oldsize +int pnx,pny, len_x, px1,px2, ix,iy,iz,ih, ndims +real phalf +double rx1,ry1,rx2,ry2, orx1,ory1,orx2,ory2, xc,yc, pdx,pdy, pstep_dx,pstep_dy +double astep, theta, theta0, uc_theta +pointer sp, vox_x,vox_y, optr, ioptr, buf_in +bool first_pass +long vs[3], ve[3], ivs[4], ive[4] + +pointer imggss(), imggsi(), imggsl(), imggsr(), imggsd(), imggsx() +pointer impgsr() + +begin + ix = IM_LEN(im1,1) + iy = IM_LEN(im1,2) + iz = IM_LEN(im1,3) + if (use_both) { + ih = 2 + ndims = 4 + } else { + ih = 1 + ndims = 3 + } + + # Set up coordinates for rotation by aligning the center of the working + # projection plane ("p-plane") with the center of the volume image. + + pnx = iz # volume image bands become p-plane X + pny = iy # volume image lines become p-plane Y + plines = int (DIS(double(pnx),double(pny))) + if (mod (plines, 2) == 0) + plines = plines + 1 + pcols = IM_LEN(im2,1) + phalf = (plines - 1) / 2 # distance from center to bottom pline + IM_LEN(im2,2) = plines + IM_LEN(im2,3) = NFRAMES(vp) + xc = 0.5 * (pnx + 1) + yc = 0.5 * (pny + 1) + + # Allocate index arrays for contributing voxels. + call smark (sp) + call salloc (vox_x, plines, TY_INT) + call salloc (vox_y, plines, TY_INT) + + astep = DDEGTORAD (DEGREES(vp)) # angular increment in radians + + # Determine how much memory we can use, and adjust working set. + call pv_gmem (im1, im2, use_both, VERBOSE(vp), MAX_WS(vp), len_x, + oldsize) + + # Read as much of the input image as possible into memory, in column + # blocks so we can project through all lines and bands in memory; we + # only want to read each voxel of the input image once. + + ivs[2] = 1 + ive[2] = iy + ivs[3] = 1 + ive[3] = iz + ivs[4] = 1 + ive[4] = 2 + first_pass = true + do px1 = 1, ix, len_x { + px2 = px1 + len_x - 1 + if (px2 > ix) + px2 = ix + if (VERBOSE(vp) == YES) { + call eprintf ("px1=%d, px2=%d, len_x=%d\n") + call pargi (px1); call pargi (px2); call pargi (px2-px1+1) + } + ivs[1] = px1 + ive[1] = px2 + switch (IM_PIXTYPE (im1)) { + case TY_SHORT: + buf_in = imggss (im1, ivs, ive, ndims) + case TY_INT: + buf_in = imggsi (im1, ivs, ive, ndims) + case TY_LONG: + buf_in = imggsl (im1, ivs, ive, ndims) + case TY_REAL: + buf_in = imggsr (im1, ivs, ive, ndims) + case TY_DOUBLE: + buf_in = imggsd (im1, ivs, ive, ndims) + case TY_COMPLEX: + buf_in = imggsx (im1, ivs, ive, ndims) + default: + call error (3, "unknown pixel type") + } + + # Invariant part of output image section: + vs[1] = 1 + ve[1] = pcols + + # Produce one output image band per rotation step around vol image. + theta0 = DDEGTORAD (INIT_THETA(vp)) + oband = 1 + do rot = 1, NFRAMES(vp) { + theta = theta0 + (rot - 1) * astep + uc_theta = theta # unit-circle for quadrant comparisons. + while (uc_theta >= DTWOPI) + uc_theta = uc_theta - DTWOPI + + # Determine line endpoints intersecting the image boundary for + # central projection line. + + orx1 = xc - phalf * cos (uc_theta) + orx2 = xc + phalf * cos (uc_theta) + ory1 = yc - phalf * sin (uc_theta) + ory2 = yc + phalf * sin (uc_theta) + + # Offset central projection line to hit the bottom image line of + # the projection plane (won't necessarily pass through image). + + pdx = phalf * sin (uc_theta) + pdy = phalf * cos (uc_theta) + pstep_dx = sin (uc_theta) + pstep_dy = cos (uc_theta) + orx1 = orx1 + pdx + ory1 = ory1 - pdy + orx2 = orx2 + pdx + ory2 = ory2 - pdy + rx1 = orx1 + ry1 = ory1 + rx2 = orx2 + ry2 = ory2 + + do oline = 1, plines { + + # Get voxel indices in p-plane contributing to central ray. + call vgetincrem (rx1,ry1, rx2,ry2, pnx,pny,plines, nvox, + Memi[vox_x], Memi[vox_y]) + + # Initialize output line. + vs[2] = oline + ve[2] = oline + vs[3] = oband + ve[3] = oband + + # If first pass through output image, initialize output + # pixels. Otherwise, we must read existing part of output + # image into output buffer. + + if (first_pass) { + optr = impgsr (im2, vs, ve, 3) + + # If opacity model, initialize output to incident int. + if (PTYPE(vp) == P_ATTENUATE) + call amovkr (IZERO(vp), Memr[optr], pcols) + else + call aclrr (Memr[optr], pcols) + } else { + ioptr = imggsr (im2, vs, ve, 3) + optr = impgsr (im2, vs, ve, 3) + call amovr (Memr[ioptr], Memr[optr], pcols) + } + + # Project each contributing voxel into output image line. + if (nvox > 0) + switch (IM_PIXTYPE (im1)) { + case TY_SHORT: + call vtransmits (Mems[buf_in], (px2-px1+1),iy,iz,ih, + px1,px2, Memi[vox_y], Memi[vox_x], nvox, + Memr[optr], vp) + case TY_INT: + call vtransmiti (Memi[buf_in], (px2-px1+1),iy,iz,ih, + px1,px2, Memi[vox_y], Memi[vox_x], nvox, + Memr[optr], vp) + case TY_LONG: + call vtransmitl (Meml[buf_in], (px2-px1+1),iy,iz,ih, + px1,px2, Memi[vox_y], Memi[vox_x], nvox, + Memr[optr], vp) + case TY_REAL: + call vtransmitr (Memr[buf_in], (px2-px1+1),iy,iz,ih, + px1,px2, Memi[vox_y], Memi[vox_x], nvox, + Memr[optr], vp) + case TY_DOUBLE: + call vtransmitd (Memd[buf_in], (px2-px1+1),iy,iz,ih, + px1,px2, Memi[vox_y], Memi[vox_x], nvox, + Memr[optr], vp) + case TY_COMPLEX: + call vtransmitx (Memx[buf_in], (px2-px1+1),iy,iz,ih, + px1,px2, Memi[vox_y], Memi[vox_x], nvox, + Memr[optr], vp) + } + + # Offset endpoints for next projection line. + rx1 = orx1 - oline * pstep_dx + ry1 = ory1 + oline * pstep_dy + rx2 = orx2 - oline * pstep_dx + ry2 = ory2 + oline * pstep_dy + } + + # Set up for next rotation. + oband = oband + 1 + if (VERBOSE(vp) == YES) { + call eprintf ("...end of rotation %d, theta %7.2f\n") + call pargi (rot); call pargd (DRADTODEG(theta)) + } + } + + first_pass = false + call imflush (im2) + } + + call sfree (sp) + call fixmem (oldsize) +end diff --git a/pkg/proto/vol/src/vtransmit.gx b/pkg/proto/vol/src/vtransmit.gx new file mode 100644 index 00000000..698d73d0 --- /dev/null +++ b/pkg/proto/vol/src/vtransmit.gx @@ -0,0 +1,146 @@ +include <imhdr.h> +include "pvol.h" + +$for (silrdx) + +# VTRANSMIT -- Compute the intensities of each output image pixel in the +# current line as a function of its existing intensity plus the emission +# and absorption from each contributing voxel. + +procedure vtransmit$t (inbuf,nx,ny,nz,nh, px1,px2, iline,iband,nvox, oline, vp) +PIXEL inbuf[nx,ny,nz,nh] # Input data buffer for current set of yz slices +int nx,ny,nz,nh # Dimensions of current input buffer +int px1,px2 # Range of columns in current yz slice set +int iline[nvox] # Input image lines for current projection ray +int iband[nvox] # Input image bands for current projection ray +int nvox # Number of voxels in current projection column +real oline[ARB] # output image line buffer +pointer vp # Volume projection descriptor + +bool use_both + +int i, vox, opelem, intelem, frontvox, backvox +real amin, amax, vox_op, vox_int, ival, attenuate, vimin, ifac, ofac, distwt + +begin + # Dereference most frequently used structure elements. + amin = AMIN(vp) + amax = AMAX(vp) + vimin = VIMIN(vp) + + intelem = 1 + opelem = OPACELEM(vp) + if (nh > 1) { + use_both = true + if (opelem == 1) + intelem = 2 + else if (IS_INDEFI(opelem)) + opelem = 2 + } else { + use_both = false + opelem = 1 + } + + + # Set up for opacity, intensity, or both. + ifac = (IIMAX(vp) - IIMIN(vp)) / (VIMAX(vp) - vimin) + if (PTYPE(vp) == P_ATTENUATE || use_both) + ofac = (amax - amin) / (OMAX(vp) - OMIN(vp)) + + # Since we are in memory anyway, it is more convenient to traverse + # the columns in the outer loop and the voxels from different bands + # and lines in the inner loop. This is necessary when distance + # weighting and the distance cutoff option is on (we need to know + # the range of usable voxels in a given column before projecting). + + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) + do i = px1, px2 { + if (DISCUTOFF(vp) == NO) { + frontvox = nvox + backvox = 1 + } else { + frontvox = 1 + backvox = nvox + do vox = 1, nvox { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox],intelem] + if (vimin <= vox_int && vox_int < VIMAX(vp)) { + frontvox = max (frontvox, vox) + backvox = min (backvox, vox) + } + } + } + if (frontvox - backvox < 0) + next + do vox = backvox, frontvox { + distwt = (real(vox-backvox+1) / + real(frontvox-backvox+1)) ** DISPOWER(vp) + + # Opacity transformation function. + if (use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_INVDISPOW) + oline[i] = oline[i] + ival * distwt + else if (mod (int (ival/(IIMAX(vp)-IIMIN(vp)) * 100.0), + MODN(vp)) == 0) + oline[i] = oline[i] + ival * distwt + } + } + else + do i = px1, px2 + do vox = 1, nvox { + # Opacity transformation function. + if (PTYPE(vp) == P_ATTENUATE || use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + if (PTYPE(vp) != P_ATTENUATE || use_both) { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_AVERAGE) + oline[i] = oline[i] + ival * 1.0 / real(nvox) + else if (PTYPE(vp) == P_SUM) + oline[i] = oline[i] + ival + else if (PTYPE(vp) == P_LASTONLY) + if (ival > 0.0) + oline[i] = ival + } + } +end + +$endfor diff --git a/pkg/proto/vol/src/vtransmit.x b/pkg/proto/vol/src/vtransmit.x new file mode 100644 index 00000000..99716a2d --- /dev/null +++ b/pkg/proto/vol/src/vtransmit.x @@ -0,0 +1,856 @@ +include <imhdr.h> +include "pvol.h" + + + +# VTRANSMIT -- Compute the intensities of each output image pixel in the +# current line as a function of its existing intensity plus the emission +# and absorption from each contributing voxel. + +procedure vtransmits (inbuf,nx,ny,nz,nh, px1,px2, iline,iband,nvox, oline, vp) +short inbuf[nx,ny,nz,nh] # Input data buffer for current set of yz slices +int nx,ny,nz,nh # Dimensions of current input buffer +int px1,px2 # Range of columns in current yz slice set +int iline[nvox] # Input image lines for current projection ray +int iband[nvox] # Input image bands for current projection ray +int nvox # Number of voxels in current projection column +real oline[ARB] # output image line buffer +pointer vp # Volume projection descriptor + +bool use_both + +int i, vox, opelem, intelem, frontvox, backvox +real amin, amax, vox_op, vox_int, ival, attenuate, vimin, ifac, ofac, distwt + +begin + # Dereference most frequently used structure elements. + amin = AMIN(vp) + amax = AMAX(vp) + vimin = VIMIN(vp) + + intelem = 1 + opelem = OPACELEM(vp) + if (nh > 1) { + use_both = true + if (opelem == 1) + intelem = 2 + else if (IS_INDEFI(opelem)) + opelem = 2 + } else { + use_both = false + opelem = 1 + } + + + # Set up for opacity, intensity, or both. + ifac = (IIMAX(vp) - IIMIN(vp)) / (VIMAX(vp) - vimin) + if (PTYPE(vp) == P_ATTENUATE || use_both) + ofac = (amax - amin) / (OMAX(vp) - OMIN(vp)) + + # Since we are in memory anyway, it is more convenient to traverse + # the columns in the outer loop and the voxels from different bands + # and lines in the inner loop. This is necessary when distance + # weighting and the distance cutoff option is on (we need to know + # the range of usable voxels in a given column before projecting). + + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) + do i = px1, px2 { + if (DISCUTOFF(vp) == NO) { + frontvox = nvox + backvox = 1 + } else { + frontvox = 1 + backvox = nvox + do vox = 1, nvox { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox],intelem] + if (vimin <= vox_int && vox_int < VIMAX(vp)) { + frontvox = max (frontvox, vox) + backvox = min (backvox, vox) + } + } + } + if (frontvox - backvox < 0) + next + do vox = backvox, frontvox { + distwt = (real(vox-backvox+1) / + real(frontvox-backvox+1)) ** DISPOWER(vp) + + # Opacity transformation function. + if (use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_INVDISPOW) + oline[i] = oline[i] + ival * distwt + else if (mod (int (ival/(IIMAX(vp)-IIMIN(vp)) * 100.0), + MODN(vp)) == 0) + oline[i] = oline[i] + ival * distwt + } + } + else + do i = px1, px2 + do vox = 1, nvox { + # Opacity transformation function. + if (PTYPE(vp) == P_ATTENUATE || use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + if (PTYPE(vp) != P_ATTENUATE || use_both) { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_AVERAGE) + oline[i] = oline[i] + ival * 1.0 / real(nvox) + else if (PTYPE(vp) == P_SUM) + oline[i] = oline[i] + ival + else if (PTYPE(vp) == P_LASTONLY) + if (ival > 0.0) + oline[i] = ival + } + } +end + + + +# VTRANSMIT -- Compute the intensities of each output image pixel in the +# current line as a function of its existing intensity plus the emission +# and absorption from each contributing voxel. + +procedure vtransmiti (inbuf,nx,ny,nz,nh, px1,px2, iline,iband,nvox, oline, vp) +int inbuf[nx,ny,nz,nh] # Input data buffer for current set of yz slices +int nx,ny,nz,nh # Dimensions of current input buffer +int px1,px2 # Range of columns in current yz slice set +int iline[nvox] # Input image lines for current projection ray +int iband[nvox] # Input image bands for current projection ray +int nvox # Number of voxels in current projection column +real oline[ARB] # output image line buffer +pointer vp # Volume projection descriptor + +bool use_both + +int i, vox, opelem, intelem, frontvox, backvox +real amin, amax, vox_op, vox_int, ival, attenuate, vimin, ifac, ofac, distwt + +begin + # Dereference most frequently used structure elements. + amin = AMIN(vp) + amax = AMAX(vp) + vimin = VIMIN(vp) + + intelem = 1 + opelem = OPACELEM(vp) + if (nh > 1) { + use_both = true + if (opelem == 1) + intelem = 2 + else if (IS_INDEFI(opelem)) + opelem = 2 + } else { + use_both = false + opelem = 1 + } + + + # Set up for opacity, intensity, or both. + ifac = (IIMAX(vp) - IIMIN(vp)) / (VIMAX(vp) - vimin) + if (PTYPE(vp) == P_ATTENUATE || use_both) + ofac = (amax - amin) / (OMAX(vp) - OMIN(vp)) + + # Since we are in memory anyway, it is more convenient to traverse + # the columns in the outer loop and the voxels from different bands + # and lines in the inner loop. This is necessary when distance + # weighting and the distance cutoff option is on (we need to know + # the range of usable voxels in a given column before projecting). + + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) + do i = px1, px2 { + if (DISCUTOFF(vp) == NO) { + frontvox = nvox + backvox = 1 + } else { + frontvox = 1 + backvox = nvox + do vox = 1, nvox { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox],intelem] + if (vimin <= vox_int && vox_int < VIMAX(vp)) { + frontvox = max (frontvox, vox) + backvox = min (backvox, vox) + } + } + } + if (frontvox - backvox < 0) + next + do vox = backvox, frontvox { + distwt = (real(vox-backvox+1) / + real(frontvox-backvox+1)) ** DISPOWER(vp) + + # Opacity transformation function. + if (use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_INVDISPOW) + oline[i] = oline[i] + ival * distwt + else if (mod (int (ival/(IIMAX(vp)-IIMIN(vp)) * 100.0), + MODN(vp)) == 0) + oline[i] = oline[i] + ival * distwt + } + } + else + do i = px1, px2 + do vox = 1, nvox { + # Opacity transformation function. + if (PTYPE(vp) == P_ATTENUATE || use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + if (PTYPE(vp) != P_ATTENUATE || use_both) { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_AVERAGE) + oline[i] = oline[i] + ival * 1.0 / real(nvox) + else if (PTYPE(vp) == P_SUM) + oline[i] = oline[i] + ival + else if (PTYPE(vp) == P_LASTONLY) + if (ival > 0.0) + oline[i] = ival + } + } +end + + + +# VTRANSMIT -- Compute the intensities of each output image pixel in the +# current line as a function of its existing intensity plus the emission +# and absorption from each contributing voxel. + +procedure vtransmitl (inbuf,nx,ny,nz,nh, px1,px2, iline,iband,nvox, oline, vp) +long inbuf[nx,ny,nz,nh] # Input data buffer for current set of yz slices +int nx,ny,nz,nh # Dimensions of current input buffer +int px1,px2 # Range of columns in current yz slice set +int iline[nvox] # Input image lines for current projection ray +int iband[nvox] # Input image bands for current projection ray +int nvox # Number of voxels in current projection column +real oline[ARB] # output image line buffer +pointer vp # Volume projection descriptor + +bool use_both + +int i, vox, opelem, intelem, frontvox, backvox +real amin, amax, vox_op, vox_int, ival, attenuate, vimin, ifac, ofac, distwt + +begin + # Dereference most frequently used structure elements. + amin = AMIN(vp) + amax = AMAX(vp) + vimin = VIMIN(vp) + + intelem = 1 + opelem = OPACELEM(vp) + if (nh > 1) { + use_both = true + if (opelem == 1) + intelem = 2 + else if (IS_INDEFI(opelem)) + opelem = 2 + } else { + use_both = false + opelem = 1 + } + + + # Set up for opacity, intensity, or both. + ifac = (IIMAX(vp) - IIMIN(vp)) / (VIMAX(vp) - vimin) + if (PTYPE(vp) == P_ATTENUATE || use_both) + ofac = (amax - amin) / (OMAX(vp) - OMIN(vp)) + + # Since we are in memory anyway, it is more convenient to traverse + # the columns in the outer loop and the voxels from different bands + # and lines in the inner loop. This is necessary when distance + # weighting and the distance cutoff option is on (we need to know + # the range of usable voxels in a given column before projecting). + + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) + do i = px1, px2 { + if (DISCUTOFF(vp) == NO) { + frontvox = nvox + backvox = 1 + } else { + frontvox = 1 + backvox = nvox + do vox = 1, nvox { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox],intelem] + if (vimin <= vox_int && vox_int < VIMAX(vp)) { + frontvox = max (frontvox, vox) + backvox = min (backvox, vox) + } + } + } + if (frontvox - backvox < 0) + next + do vox = backvox, frontvox { + distwt = (real(vox-backvox+1) / + real(frontvox-backvox+1)) ** DISPOWER(vp) + + # Opacity transformation function. + if (use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_INVDISPOW) + oline[i] = oline[i] + ival * distwt + else if (mod (int (ival/(IIMAX(vp)-IIMIN(vp)) * 100.0), + MODN(vp)) == 0) + oline[i] = oline[i] + ival * distwt + } + } + else + do i = px1, px2 + do vox = 1, nvox { + # Opacity transformation function. + if (PTYPE(vp) == P_ATTENUATE || use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + if (PTYPE(vp) != P_ATTENUATE || use_both) { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_AVERAGE) + oline[i] = oline[i] + ival * 1.0 / real(nvox) + else if (PTYPE(vp) == P_SUM) + oline[i] = oline[i] + ival + else if (PTYPE(vp) == P_LASTONLY) + if (ival > 0.0) + oline[i] = ival + } + } +end + + + +# VTRANSMIT -- Compute the intensities of each output image pixel in the +# current line as a function of its existing intensity plus the emission +# and absorption from each contributing voxel. + +procedure vtransmitr (inbuf,nx,ny,nz,nh, px1,px2, iline,iband,nvox, oline, vp) +real inbuf[nx,ny,nz,nh] # Input data buffer for current set of yz slices +int nx,ny,nz,nh # Dimensions of current input buffer +int px1,px2 # Range of columns in current yz slice set +int iline[nvox] # Input image lines for current projection ray +int iband[nvox] # Input image bands for current projection ray +int nvox # Number of voxels in current projection column +real oline[ARB] # output image line buffer +pointer vp # Volume projection descriptor + +bool use_both + +int i, vox, opelem, intelem, frontvox, backvox +real amin, amax, vox_op, vox_int, ival, attenuate, vimin, ifac, ofac, distwt + +begin + # Dereference most frequently used structure elements. + amin = AMIN(vp) + amax = AMAX(vp) + vimin = VIMIN(vp) + + intelem = 1 + opelem = OPACELEM(vp) + if (nh > 1) { + use_both = true + if (opelem == 1) + intelem = 2 + else if (IS_INDEFI(opelem)) + opelem = 2 + } else { + use_both = false + opelem = 1 + } + + + # Set up for opacity, intensity, or both. + ifac = (IIMAX(vp) - IIMIN(vp)) / (VIMAX(vp) - vimin) + if (PTYPE(vp) == P_ATTENUATE || use_both) + ofac = (amax - amin) / (OMAX(vp) - OMIN(vp)) + + # Since we are in memory anyway, it is more convenient to traverse + # the columns in the outer loop and the voxels from different bands + # and lines in the inner loop. This is necessary when distance + # weighting and the distance cutoff option is on (we need to know + # the range of usable voxels in a given column before projecting). + + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) + do i = px1, px2 { + if (DISCUTOFF(vp) == NO) { + frontvox = nvox + backvox = 1 + } else { + frontvox = 1 + backvox = nvox + do vox = 1, nvox { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox],intelem] + if (vimin <= vox_int && vox_int < VIMAX(vp)) { + frontvox = max (frontvox, vox) + backvox = min (backvox, vox) + } + } + } + if (frontvox - backvox < 0) + next + do vox = backvox, frontvox { + distwt = (real(vox-backvox+1) / + real(frontvox-backvox+1)) ** DISPOWER(vp) + + # Opacity transformation function. + if (use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_INVDISPOW) + oline[i] = oline[i] + ival * distwt + else if (mod (int (ival/(IIMAX(vp)-IIMIN(vp)) * 100.0), + MODN(vp)) == 0) + oline[i] = oline[i] + ival * distwt + } + } + else + do i = px1, px2 + do vox = 1, nvox { + # Opacity transformation function. + if (PTYPE(vp) == P_ATTENUATE || use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + if (PTYPE(vp) != P_ATTENUATE || use_both) { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_AVERAGE) + oline[i] = oline[i] + ival * 1.0 / real(nvox) + else if (PTYPE(vp) == P_SUM) + oline[i] = oline[i] + ival + else if (PTYPE(vp) == P_LASTONLY) + if (ival > 0.0) + oline[i] = ival + } + } +end + + + +# VTRANSMIT -- Compute the intensities of each output image pixel in the +# current line as a function of its existing intensity plus the emission +# and absorption from each contributing voxel. + +procedure vtransmitd (inbuf,nx,ny,nz,nh, px1,px2, iline,iband,nvox, oline, vp) +double inbuf[nx,ny,nz,nh] # Input data buffer for current set of yz slices +int nx,ny,nz,nh # Dimensions of current input buffer +int px1,px2 # Range of columns in current yz slice set +int iline[nvox] # Input image lines for current projection ray +int iband[nvox] # Input image bands for current projection ray +int nvox # Number of voxels in current projection column +real oline[ARB] # output image line buffer +pointer vp # Volume projection descriptor + +bool use_both + +int i, vox, opelem, intelem, frontvox, backvox +real amin, amax, vox_op, vox_int, ival, attenuate, vimin, ifac, ofac, distwt + +begin + # Dereference most frequently used structure elements. + amin = AMIN(vp) + amax = AMAX(vp) + vimin = VIMIN(vp) + + intelem = 1 + opelem = OPACELEM(vp) + if (nh > 1) { + use_both = true + if (opelem == 1) + intelem = 2 + else if (IS_INDEFI(opelem)) + opelem = 2 + } else { + use_both = false + opelem = 1 + } + + + # Set up for opacity, intensity, or both. + ifac = (IIMAX(vp) - IIMIN(vp)) / (VIMAX(vp) - vimin) + if (PTYPE(vp) == P_ATTENUATE || use_both) + ofac = (amax - amin) / (OMAX(vp) - OMIN(vp)) + + # Since we are in memory anyway, it is more convenient to traverse + # the columns in the outer loop and the voxels from different bands + # and lines in the inner loop. This is necessary when distance + # weighting and the distance cutoff option is on (we need to know + # the range of usable voxels in a given column before projecting). + + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) + do i = px1, px2 { + if (DISCUTOFF(vp) == NO) { + frontvox = nvox + backvox = 1 + } else { + frontvox = 1 + backvox = nvox + do vox = 1, nvox { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox],intelem] + if (vimin <= vox_int && vox_int < VIMAX(vp)) { + frontvox = max (frontvox, vox) + backvox = min (backvox, vox) + } + } + } + if (frontvox - backvox < 0) + next + do vox = backvox, frontvox { + distwt = (real(vox-backvox+1) / + real(frontvox-backvox+1)) ** DISPOWER(vp) + + # Opacity transformation function. + if (use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_INVDISPOW) + oline[i] = oline[i] + ival * distwt + else if (mod (int (ival/(IIMAX(vp)-IIMIN(vp)) * 100.0), + MODN(vp)) == 0) + oline[i] = oline[i] + ival * distwt + } + } + else + do i = px1, px2 + do vox = 1, nvox { + # Opacity transformation function. + if (PTYPE(vp) == P_ATTENUATE || use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + if (PTYPE(vp) != P_ATTENUATE || use_both) { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_AVERAGE) + oline[i] = oline[i] + ival * 1.0 / real(nvox) + else if (PTYPE(vp) == P_SUM) + oline[i] = oline[i] + ival + else if (PTYPE(vp) == P_LASTONLY) + if (ival > 0.0) + oline[i] = ival + } + } +end + + + +# VTRANSMIT -- Compute the intensities of each output image pixel in the +# current line as a function of its existing intensity plus the emission +# and absorption from each contributing voxel. + +procedure vtransmitx (inbuf,nx,ny,nz,nh, px1,px2, iline,iband,nvox, oline, vp) +complex inbuf[nx,ny,nz,nh] # Input data buffer for current set of yz slices +int nx,ny,nz,nh # Dimensions of current input buffer +int px1,px2 # Range of columns in current yz slice set +int iline[nvox] # Input image lines for current projection ray +int iband[nvox] # Input image bands for current projection ray +int nvox # Number of voxels in current projection column +real oline[ARB] # output image line buffer +pointer vp # Volume projection descriptor + +bool use_both + +int i, vox, opelem, intelem, frontvox, backvox +real amin, amax, vox_op, vox_int, ival, attenuate, vimin, ifac, ofac, distwt + +begin + # Dereference most frequently used structure elements. + amin = AMIN(vp) + amax = AMAX(vp) + vimin = VIMIN(vp) + + intelem = 1 + opelem = OPACELEM(vp) + if (nh > 1) { + use_both = true + if (opelem == 1) + intelem = 2 + else if (IS_INDEFI(opelem)) + opelem = 2 + } else { + use_both = false + opelem = 1 + } + + + # Set up for opacity, intensity, or both. + ifac = (IIMAX(vp) - IIMIN(vp)) / (VIMAX(vp) - vimin) + if (PTYPE(vp) == P_ATTENUATE || use_both) + ofac = (amax - amin) / (OMAX(vp) - OMIN(vp)) + + # Since we are in memory anyway, it is more convenient to traverse + # the columns in the outer loop and the voxels from different bands + # and lines in the inner loop. This is necessary when distance + # weighting and the distance cutoff option is on (we need to know + # the range of usable voxels in a given column before projecting). + + if (PTYPE(vp) == P_INVDISPOW || PTYPE(vp) == P_MODN) + do i = px1, px2 { + if (DISCUTOFF(vp) == NO) { + frontvox = nvox + backvox = 1 + } else { + frontvox = 1 + backvox = nvox + do vox = 1, nvox { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox],intelem] + if (vimin <= vox_int && vox_int < VIMAX(vp)) { + frontvox = max (frontvox, vox) + backvox = min (backvox, vox) + } + } + } + if (frontvox - backvox < 0) + next + do vox = backvox, frontvox { + distwt = (real(vox-backvox+1) / + real(frontvox-backvox+1)) ** DISPOWER(vp) + + # Opacity transformation function. + if (use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_INVDISPOW) + oline[i] = oline[i] + ival * distwt + else if (mod (int (ival/(IIMAX(vp)-IIMIN(vp)) * 100.0), + MODN(vp)) == 0) + oline[i] = oline[i] + ival * distwt + } + } + else + do i = px1, px2 + do vox = 1, nvox { + # Opacity transformation function. + if (PTYPE(vp) == P_ATTENUATE || use_both) { + vox_op = inbuf[(i-px1+1), iline[vox], iband[vox], + opelem] * OSCALE(vp) + if (vox_op < OMIN(vp)) + attenuate = amax + else if (OMIN(vp) <= vox_op && vox_op < OMAX(vp)) + attenuate = amax - (vox_op - OMIN(vp)) * ofac + else + attenuate = amin + oline[i] = oline[i] * attenuate + } + + # Intensity transformation function. + if (PTYPE(vp) != P_ATTENUATE || use_both) { + vox_int = inbuf[(i-px1+1),iline[vox],iband[vox], + intelem] + if (vox_int < vimin) + ival = IIMIN(vp) + else if (vimin <= vox_int && vox_int < VIMAX(vp)) + ival = IIMIN(vp) + (vox_int - vimin) * ifac + else + ival = IIMAX(vp) + + if (PTYPE(vp) == P_AVERAGE) + oline[i] = oline[i] + ival * 1.0 / real(nvox) + else if (PTYPE(vp) == P_SUM) + oline[i] = oline[i] + ival + else if (PTYPE(vp) == P_LASTONLY) + if (ival > 0.0) + oline[i] = ival + } + } +end + + diff --git a/pkg/proto/vol/src/x_vol.x b/pkg/proto/vol/src/x_vol.x new file mode 100644 index 00000000..0d44bccb --- /dev/null +++ b/pkg/proto/vol/src/x_vol.x @@ -0,0 +1,6 @@ +# X_VOL -- Volume projection and related tasks. + +task pvol = t_pvol, + i2sun = t_i2sun, + im3dtran = t_im3dtran, + imjoin = t_imjoin diff --git a/pkg/proto/vol/vol.cl b/pkg/proto/vol/vol.cl new file mode 100644 index 00000000..d3a6a5b1 --- /dev/null +++ b/pkg/proto/vol/vol.cl @@ -0,0 +1,22 @@ +#{ VOL -- Volume Images Package + +print(" ") +print("This package contains tasks for viewing and manipulating 3d images.") +print("It is a pre-release version, and does not reflect the ultimate") +print("partitioning of n-dimensional image tasks within IRAF") +print(" ") + +# Load some needed packages now +# (None are needed yet) # if images$tv not loaded, load for vidrecord. + +package vol + +task i2sun, + im3dtran, + imjoin, + pvol = "vol$src/x_vol.e" + +#task vidrecord = "vol$src/vidrecord.cl" + +clbye() + diff --git a/pkg/proto/vol/vol.hd b/pkg/proto/vol/vol.hd new file mode 100644 index 00000000..2dcd0e39 --- /dev/null +++ b/pkg/proto/vol/vol.hd @@ -0,0 +1,10 @@ +# Help directory for the VOL package + +$doc = "vol$src/doc/" +$im3dtran = "vol$src/im3dtran/" +$i2sun = "vol$src/i2sun/" + +i2sun hlp=doc$i2sun.hlp, src=i2sun$t_i2sun.x +im3dtran hlp=doc$im3dtran.hlp, src=im3dtran$t_im3dtran.x +imjoin hlp=doc$imjoin.hlp, src=vol$src/t_imjoin.x +pvol hlp=doc$pvol.hlp, src=vol$src/t_pvol.x diff --git a/pkg/proto/vol/vol.men b/pkg/proto/vol/vol.men new file mode 100644 index 00000000..4184f44e --- /dev/null +++ b/pkg/proto/vol/vol.men @@ -0,0 +1,4 @@ + i2sun - Convert IRAF images to Sun rasterfiles + im3dtran - 3d image transpose (used for rotates as well) + imjoin - N-dimensional image join along arbitrary axis + pvol - Project volume image (generates 'rotating' volume images) diff --git a/pkg/proto/vol/vol.par b/pkg/proto/vol/vol.par new file mode 100644 index 00000000..da7b65e6 --- /dev/null +++ b/pkg/proto/vol/vol.par @@ -0,0 +1,3 @@ +# VOL package parameter file + +version,s,h,"May89" diff --git a/pkg/proto/x_proto.x b/pkg/proto/x_proto.x new file mode 100644 index 00000000..805c35cd --- /dev/null +++ b/pkg/proto/x_proto.x @@ -0,0 +1,22 @@ +# Task declaration for the PROTO package. + +task binfil = t_binfil, + bscale = t_bscale, + epix = t_epix, + fields = t_fields, + fixpix = t_fixpix, + hfix = t_hfix, + imcntr = t_imcntr, + imextensions = t_imextensions, + imscale = t_imscale, + interp = t_interp, + irafil = t_irafil, + joinlines = t_joinlines, + mask2text = t_mask2text, + mkglbhdr = t_mkglbhdr, + mskexpr = t_mskexpr, + mskregions = t_mskregions, + suntoiraf = t_suntoiraf, + text2mask = t_text2mask, + mimstatistics = t_mimstatistics, + rskysub = t_rskysub |