diff options
Diffstat (limited to 'pkg/images/tv')
363 files changed, 47886 insertions, 0 deletions
diff --git a/pkg/images/tv/Revisions b/pkg/images/tv/Revisions new file mode 100644 index 00000000..51c49bd5 --- /dev/null +++ b/pkg/images/tv/Revisions @@ -0,0 +1,996 @@ +.help revisions Jun88 images.tv +.help revisions Nov93 nmisc +.nf + +tv/imedit/epstatistics.x + The 'x', 'y', and 'z' pointers were declared as TY_INT instead of TY_REAL + (5/4/13, MJF) + +imexamine/imexam.h + The coordinates arrays in the main structure were improperly indexed + with the P2R macro (2/10/11, MJF) + +imexamine/t_imexam.x + Removed some accidental code that was causing the frame number to + be prompted for. (12/4/08, MJF) + +display/t_display.x + The change of 8/16/07 results in the ocolors parameter being used + in place of the bpcolors parameter. + (8/26/08, Valdes) + +display/dspmmap.x + This was originally a copy of the code from xtools. This is now a + simple interface calling yt_mappm. This supports the new WCS + pixel mask matching. + (1/9/08, Valdes) + +============= +V2.12.4-V2.14 +============= + +doc/bpmedit.hlp +doc/imedit.hlp +imedit/bpmedit.cl +imedit/bpmedit.key +imedit/epcolon.x +imedit/epix.h +imedit/epmask.x +imedit/epreplace.gx +imedit/epreplace.x +imedit/epsetpars.x +imedit/imedit.key + Added new parameters to specify a range of values that may be modified. + This is mainly useful with bpmedit to selected mask values to be + modified. (11/16/07, Valdes) + + +display/maskcolor.x +display/t_display.x +display/ace.h +display/mkpkg +doc/display.hlp + The overlay colors may now be set with expressions as well as with + the earlier syntax. (8/16/07, Valdes) + + +imedit/bpmedit.cl + +doc/bpmedit.hlp + +./imedit/bpmedit.key + +tv.cl +tv.hd + A new script task for editing masks using imedit as the editing + engine was added. (8/9/07, Valdes) + +imedit/t_imedit.x +imedit/epgcur.x +./imedit/epreplace.gx + +./imedit/imedit.key + +doc/imedit.hlp +mkpkg +tv.cl + 1. A new option to do vector constant replacement was added. This is + particularly useful for editing bad pixel masks. + 2. New options '=', '<', and '>' to replace all pixels with values + ==, <=, or >= to the value at the cursor with the constant value + was added. This is useful for editing object masks. + 3. The '?' help page is now set by an environment variable rather than + hardcoded to a file in lib$src. The environment variable is + imedit_help and is set in tv.cl to point to the file in the + source directory. + (8/9/07, Valdes) + +pkg/images/tv/display/maskcolor.x + There was an error that failed to parse the color string as required. + (8/10/07, Valdes) + +pkg/images/tv/display/sigm2.x + Buffers were allocated as TY_SHORT but used and TY_INT. (8/9/07, Valdes) + +pkg/images/tv/display/t_display.x +pkg/images/tv/display/maskcolors.x +pkg/images/tv/display/sigl2.x +pkg/images/tv/display/sigm2.x +pkg/images/tv/doc/display.x + 1. Overlay masks are now read as integer to preserve dynamic range. + 2. Mapped color values less than 0 are transparent. + 3. A color name of transparent is allowed. + (4/10/07, Valdes) + +======= +V2.12.2 +======= + +pkg/images/tv/display/t_display.x + The image may be specified as a template provided it match only one + image. (9/11/03, Valdes) + +pkg/images/tv/imexamine/stfmeasure.x + The selection of a point to get a first estimation of the FWHM in + stf_fit did not check for the case of a zero value. This could cause + a floating divide by zero. (5/5/03, Valdes) + +pkg/images/tv/imexamine/stfmeasure.x + The subpixel evaluation involves fitting an image interpolator to a + subraster. To avoid attempting to evaluate a point outside the center + of the edge pixels, which is a requirement of the image interpolators, + the interpolator is fit to the full data raster and the evaluations + exclude the boundary pixels. (5/5/03, Valdes) + +pkg/images/tv/imexamine/iegnfr.x + The test for the number of frames needed to check imd_wcsver to avoid + trying to use more than four frames with DS9. (1/24/03, Valdes) + +pkg/images/tv/imexamine/t_imexam.x + Added some missing braces so that if a display is not used it doesn't + check for the number of frames to use. This is only cosmetic at this + time. (1/24/03, Valdes) + +======= +V2.12.1 +======= + +pkg/images/tv/doc/display.hlp + Clarified what "non-zero" means in the context of masks and images + used as masks. (7/29/02, Valdes) + +pkg/images/tv/display/t_display.x + Removed an unused extern declaration for ds_errfcn() which was causing + a link failure on the alpha (6/12/02, MJF) + +pkg/images/tv/tvmark/mktools.x +pkg/images/tv/tvmark/mkoutname.x + Fixed a bug in the default output image name code that would result in + hidden images with names like .snap.1, .snap.2, etc being written + if the display image name included a kernel or pixel section. + Davis (3/21/02) + +pkg/images/tv/display/t_display.x +pkg/images/tv/display/imdmapping.x + Added a check for the image name being "dev$pix" and if so prevented + this from being expanded to the full node!prefix pathname. Previously + the WCS would be written with a path like 'tucana!/iraf/iraf/dev/pix' + and would trigger an ambiguous image name error in clients like IMEXAM + which need to readback the image name with a WCS query. (3/4/02, MJF) + +pkg/images/tv/imexamine/iegimage.x + When imexmaine fails to map the image name returned by the display + server it uses the frame buffer. Previously there was no warning + message about failing to map the image. Now there is a warning. + This is only given once until there is no error or the error message + changes either by going to a new frame buffer or doing a new display. + (3/4/02, Valdes) + +pkg/images/tv/imexamine/iegimage.x +pkg/images/tv/imexamine/t_imexam.x + When the frame buffer is used as the image source (when the image name + in the display frame cannot be mapped) the final imunmap would + attempt to unmap the same descriptor twice. (3/1/02, Valdes) + +pkg/images/tv/imexamine/iegimage.x + The 'p' was not properly updated for the multiple WCS changes. + (2/26/02, Valdes) + +pkg/images/tv/imexamine/iegimage.x + The changes to support multiple WCS per frame involved keeping track of + the full WCS frame id (i.e. 101) rather than just the frame number. + There was a minor error in this bookkeeping when incrementing the + the next display frame to be used. (2/19/02, Valdes) + +pkg/images/tv/display/sigm2.x + The routine to compute the maximum value as the interpolated quantity + was incorrect because the size of the input and output arrays were + treated as the same when they are not. This is used for overlay + display which produced the symptom of horizontal lines. (2/5/02, Valdes) + +pkg/images/tv/display/dspmmap.x + Added the feature that the bad pixel mask or overlay mask may be + specified by a keyword value with the syntax !<keyword>. This is + important for multiextension files where various masks are set + as keywords. The new task OBJMASKS also writes the object mask name + that is created for an image in the header. Use of !objmask then + allows the object mask to be used for the bad pixel mask (to set + the scaling using only sky pixels) and for overlay. (2/5/02, Valdes) + +pkg/images/tv/imedit/epimcopy.x + Added a missing TY_USHORT branch to the image copy routines. + (10/10/01, LED) + +pkg/images/tv/display/imdgetwcs.x +pkg/images/tv/display/imdputwcs.x +pkg/images/tv/display/imdsetwcs.x + Modified to allow read/write of the additional mapping information + during WCS i/o. If the iis_version flag is non-zero and a valid mapping + exists, the set/put wcs routines will automatically format the WCS text + to include this information, otherwise it writes the old WCS text. If + iis_version is non-zero and a server query returns mapping information + this will be stored in the iis common for later retrieval by the + imd_getmapping() routine. (06/21/01, MJF) + +pkg/images/tv/display/imdwcsver.x + Removed 'frame' number argument form the procedure. The procedure + will now map frame one if no connection is already opened and query the + WCS. Returns non-zero if the server is capable of using the new mapping + structures. Required to be called explicitly by programs using mappings + to initialize the imd interface for this functionality. (06/21/01, MJF) + +pkg/images/tv/display/t_display.x + Removed earlier addition of ds_setwcs() function since this is now + handled by the standard imd_putwcs() interface. Mapping information + is set prior to the WCS write with imd_setmapping(). (06/21/01, MJF) + +pkg/images/tv/display/mkpkg + Updated dependencies (06/21/01, MJF) + +pkg/images/tv/display/imdmapping.x + + New routines imd_[sg]etmapping() allow a program to set the + mapping to be sent with the next imd_putwcs() call, or retrieve the + mapping info sent by the server with the last wcs query. The calls + are no-ops if the connected server doesn't know about the new + mappings, imd_getmapping() is an integer function which returns + non-zero if a valid mapping is available. A new imd_query_map() is + available to return the mapping information for a given WCS number. + The intent is that the mapping can be obtained for a wcs returned by a + cursor read, e.g. to get the image name associated with the mapping. + (6/21/01, MJF) + +pkg/images/tv/display/iis.com + Added new variables to the IIS common to hold the mapping + information for each WCS write. In order to preserve the imd interfaces + it was necessary to save the mappings in the common, along with a flag + indicating whether the connected server can use them. (06/21/01, MJF) + +pkg/images/tv/display/iisopn.x + Added initialization of the iis_version value at device open time + (6/21/01, MJF) + +pkg/images/tv/display/gwindow.h + Removed struct element W_WCSVER added earlier, no longer needed. + (6/21/01, MJF) + +pkg/images/tv/display/t_display.x + Replaced call to alogr with direct call to log10 to avoid having to + define and error function for the vops operator. (6/15/01, Valdes) + +pkg/images/tv/display/sigm2.x + Removed extra arguments in amaxr call. (6/15/01, Valdes) + +pkg/images/tv/display/dspmmap.x + Added missing arguments to mw_ctrand. (6/15/01, Valdes) + +pkg/images/tv/display/dspmmap.x + Fixed problems with ds_match. The new version is more robust and + correct. A bad pixel for the displayed image is the maximum of all + pixels in the pixel mask which fall within the display pixel. This + version still does not allow any relative rotations but does allow + non-integer offsets. (4/24/01, Valdes) + +pkg/images/tv/display/t_display.x +pkg/images/tv/display/imdgetwcs.x +pkg/images/tv/display/imdwcsver.x +pkg/images/tv/display/iis.h + Compatability fixes for the new WCS strings and "old" servers. The + WCS version query is now carried out with a read request using the old + WCS data size (320) to avoid blocked reads from old servers not sending + the 1024-char data. imd_getwcs() was modified to query the server for + the version before the actual wcs query and the request is made with the + appropriate size. In the case of a WCS query the IIS 'x' register is + used to signal that the new format is being used, the WCS version is + passed back if the 'y' register is non-zero. Neither of these registers + was used by the old protocol, the new ximtool checks these registers and + responds by using the correct WCS buffer size. (03/12/01, MJF) + +pkg/images/tv/display/t_display.x + Removed the code which stripped the path-prefix and section from + the image name displayed in the title string. This was originally + done to save space but confuses tasks like IMEXAM which rely on + this to map the image. (02/26/01, MJF) + +pkg/images/tv/display/iis.h + Somehow the SZ_WCSTEXT value got reset to 320, this was causing + a problem with TVMARK redrawing the display. Reset to 1024. + (02/26/01, MJF) + +pkg/images/tv/display/t_display.x + Changes to detect and use new WCS strings (12/04/00, MJF) + +pkg/images/tv/display/gwindow.h + Added struct element W_WCSVER (12/04/00, MJF) + +pkg/images/tv/display/iis.h + Added definitions for 16-frame support, increased the size of + the SZ_WCSTEXT to 1024 (12/04/00, MJF) + +pkg/images/tv/display/mkpkg +pkg/images/tv/display/imdwcsver.x + + Added a routine which does a WCS query with the X register set + to check whether the server can handle the new WCS strings. If + the reply is "version=<num>" we use the new stuff, otherwise it's + a no-op and we use the old format strings. (12/04/00, MJF) + +pkg/images/tv/display/t_display.x + Fixed an off-by-one error in WCS sent to the display when the display + buffer is smaller than the image. (9/5/00, Valdes) + +pkg/images/tv/imexamine/t_imexam.x +pkg/images/tv/imexamine/timexam.x + +pkg/images/tv/imexamine/iecolon.x +pkg/images/tv/imexamine/mkpkg +pkg/images/tv/imexamine.par +pkg/images/tv/doc/imexamine.hlp +lib/scr/imexamine.key + Added new key 't' to ouput an image section centered on the cursor. + (9/2/00, Valdes) + +pkg/images/tv/display/dspmmap.x + Masks were being copied internally in short which would truncate masks + having larger values. (5/16/00, Valdes) + +========= +V2.11.3p2 +========= + +pkg/images/tv/imedit/t_imedit.x +pkg/images/tv/imedit/epimcopy.x + Added some errchks. In particular, even though the output and working + images can be mapped without an error there could be an error in the + first I/O as when the imdir directory is not available/writeable. + (1/18/00, Valdes) + +pkg/images/tv/imedit/t_imedit.x + The use of a temporary image causes the output image type to be + set by "imtype" instead of any explicit extension. Changed to + use the xt_mkimtemp routine which tries to create a temporary image + of the desired output image type. (10/1/99, Valdes) + +pkg/images/tv/display/mkpkg +pkg/images/tv/wcslab/mkpkg +pkg/images/tv/imedit/mkpkg +pkg/images/tv/imexamine/mkpkg + Added some missing file dependencies and removed some unecessary ones + from the package mkpkg files. + (9/21/99 LED) + +pkg/images/tv/wcslab/wcslab.h + Added an entry for tnx to the list of supported projection types. + tnx image sometimes produced garbled plots, especially for ra ~0.0. + (9/17/99 LED) + +pkg/images/tv/wcslab/t_wcslab.x +pkg/images/tv/wcslab/wcslab.x + Fixed a couple of bugs in the wcslab task that were causing it to fail with + the message "ERROR: MWCS: coordinate system not defined (physical)" on the + Dec Alpha when the usewcs parameter was set to yes, and on Sun systems when + the input image was undefined. The problems were a bad call to the + routine mw_swtype in the routine wl_decode_ctype and a missing check + for the image = "" case. (8/28/99 LED) + +======= +V2.11.2 +======= + +images$tv/display/sigm2.x + An argument to sigm2_setup was being changed by the routine and this + changed argument was then incorrectly used by the calling program. + The argument was made input only. (6/15/99, Valdes) + +images$tv/imexamine/iepos.x + The output of the 'x' and 'y' keys was not being written to the log + file because of a typo. (5/7/99, Valdes) + +images$tv/display/t_display.x + Added checks for a data range of zero, or which rounds to zero for + short data, to avoid floating divide by zero errors. Rather than + resort to a unitary transformation in this case the requested + data range minimum is decreased by one and the maximum is increased + by one. (8/11/98, Valdes) + +images$tv/imexamine/stfmeasure.x + The logic in STF_FIT for determining the points to fit and the point + to use for the initial width estimate was faulty allowing some bad + cases to get through. (7/31/98, Valdes) + +images$tv/imedit/epix.h +images$tv/imedit/t_imedit.x +images$tv/imedit/epcolon.x +images$tv/doc/imedit.hlp + The temporary editing buffer image was made into a unique temporary + image rather than the fixed name of "epixbuf". (6/30/98, Valdes) + +======= +V2.11.1 +======= + +images$tv/imexamine/iepos.x + Added missing argument in fprintf call. (8/29/97, Valdes) + +images$tv/display/dspmmap.x + There was a bug in the code which gives "Warning: PLIO: reference out + of bounds on mask". This was introduced with the changes to allow + masks and images to have different binning. (8/21/97, Valdes) + +images$tv/imexamine/ieqrimexam.x + +images$tv/imexamine/t_imexam.x +images$tv/imexamine/iegcur.x +images$tv/imexamine/iecolon.x +images$tv/doc/imexamine.hlp +lib/scr/imexamine.key + Added two new keystrokes, ',' and '.', that do what 'a' and 'r' do + except they don't do the enclosed flux and direct FWHM measurements nor + iterate on the fitting radius. Also the output format is the same as + the previous version of IMEXAM. (6/12/97, Valdes) + +images$tv/imexamine/stfmeasure.x + 1. The background is now set to zero if there are no background points. + 2. Fixed an error recovery bug (attempting to free a pointer which + was not set). + (6/11/97, Valdes) + +images$tv/imexamine/ierimexam.x + The background widths needed to be passed to the PSF measuring routines + even if the background is turned off for the fitting in the 'a' and 'r' + keys. (6/11/97, Valdes) + +images$tv/doc/display.hlp + Added some more information about the colors. (5/30/97, Valdes) + +images$tv/display/dspmmap.x + Improved to allow different binning between masks and images. + (5/21/97, Valdes) + +images$tv/display/zscale.x + Fixed to work with 1D images. (5/21/97, Valdes) + +images$tv/display/zscale.x +images$tv/display/dspmmap.x + 1. Now works with higher dimensional images (displays the first band) + and with image sections. + 2. Now ignores error when the image has an unknown WCS type. The + WCS is mapped to determine the physical coordinate transformation + for use with masks but this failed when someone imported an image + with the CAR projection type. (4/30/97, Valdes) + +images$tv/doc/imexamine.hlp + Reversed the order of the version and task in the revisions section. + (4/22/97, Valdes) + +images$tv/tvmark/mkmark.x + Made sure that object the label was set to "" in the call to the + mk_onemark procedure inside the a keystroke command. The lack + of initialization was causing tvmark to fail when the coordinates + file did not exist at task startup time and the label parameter + was set to "yes". (4/17, LED) + +images$tv/imedit/epgsfit.x + The earlier change failed to setup the x/y arrays for the surface fitting. + This was fixed. (4/15/97, Valdes) + +images$tv/imexamine/iejimexam.x +images$tv/imexamine/iecolon.x +images$tv/kimexam.par + +images$tv/doc/imexamine.hlp +images$tv/tv.cl + Added a pset for the 'k' key rather than sharing with the 'j' key. This + was confusing to users since it was the only key without it's own pset. + Also there may be some reason to have the fitting parameters be + different along lines and columns. (4/11/97, Valdes) + +images$tv/imexamine/ierimexam.x +images$doc/imexamine.hlp + The log output for 'a' or 'r' has one line per measurement as in + previous versions. The standard output, however, uses two lines to + print nicely on 80 column windows. (4/1/97, Valdes) + +images$tv/rimexam.par +images$tv/doc/imexamine.hlp + Changed the zero point of the magnitude scale from 30.0 to 25.0. + (3/31/97, Davis) + +images$tv/display.par +images$tv/display/t_display.x +images$tv/display/zscale.x +images$tv/display/sigm2.x + +images$tv/display/maskcolor.x + +images$tv/display/dspmmap.x + +images$tv/display/display.h +images$tv/display/gwindow.h +images$tv/display/mkpkg +images$tv/doc/display.hlp + 1. Improved the structure of DISPLAY. + 2. Fixed coordinate system errors. + 3. Added parameters to display bad pixel masks and overlay masks. + 4. The z scaling sampling may use a pixel mask or image section. + 5. The z scaling excludes bad pixels. + (3/20/97, Valdes) + +images$tv/display/imdmapfr.x +images$tv/display/imdputwcs.x + + Added two routines to hide knowledge of the channel structure and + other details from the calling routines. (12/11/96, Valdes) + +images$tv/display/iishdr.x +images$tv/display/iisers.x + Replaces SPP int -> short assignments by calls to achtiu because of + overflow problems with some VMS fortran compilers. + (12/6/96, Valdes as reported by Zarate) + +images$tv/display/t_display.x + 1. Fixed numerous problems with the coordinate system. + 2. Fixed a bug in how ztrans=log was done. + (12/5/96, Valdes) + +images$tv/display/sigm2.x + + Added a version of the spatial interpolation routines that allows masks + to interpolate the input across bad pixels. (12/5/96, Valdes) + +images$tv/imedit/epgsfit.x +images$tv/imedit/epcolon.x +images$tv/doc/imedit.hlp +images$tv/imedit/imedit.par + Added a median background if the xorder or yorder is zero. + (11/22/96, Valdes) + +wcslab$t_wcslab.x +doc$wcslab.hlp + Added an "overplot" option to append to a plot but with a different + viewport. (11/06/96, Valdes) + +images$tv/imexamine/ierimexam.x + No change but the date got updated. (10/14/96, Valdes) + +images$tv/imexamine/stfmeasure.x + Fixed bug in evaluation of enclosed flux profile in which the scaled + radius was used for the gaussian subtraction stage instead of pixels. + This does not currently affect IMEXAM because the scale is fixed + at 1. (8/29/96, Valdes) + +images$tv/doc/imexamine.hlp + Removed reference to pset for kimexam. (5/31/96, Valdes) + +images$tv/imexamine/ierimexam.x +images$tv/imexamine/stfmeasure.x + Fixed incorrect datatype declaration "real np" -> "int np" in various + related places. (4/9/96, Valdes) + +images$tv/imedit/epsearch.x +images$tv/imedit/epgcur.x + 1. The search algorithm produced incorrect results if part of the aperture + was off the edge (negative image coordinates). + 2. The rounding was incorrect when part of the aperture was off the + edge (negative image coordinates). + 3. A floating operand error occurs when a key is given without + coordinates. + (3/26/96, Valdes) + +images$tv/imexamine/iecolon.x +images$tv/imexamine/starfocus.h +images$tv/imexamine/stfmeasure.x +images$tv/imexamine/ierimexam.x +images$tv/rimexam.par +images$doc/imexamine.hlp +lib$scr/imexamine.key + The radial profile fitting and width measurements now have an option to + use a Gaussian or Moffat profile model. The model is selected by a + new "fittype" parameter. A new "beta" parameter may be specified as + INDEF to be determined from the fit or have a fixed value. The Moffat + profile model does better in producing consistent FWHM values so + this is the default. There is also a new "iterations" parameter + to allow iteratively adjusting the fitting radius. + The STARFOCUS code used to compute other parameters was updated to + use a Moffat model and a new method for measuring the FWHM directly + from the radially average profile. (3/22/96, Valdes) + +images$tv/rimexam.par +images$tv/doc/imexamine.hlp + Changed the defaults to radius=5, buffer=5, width=5. A related change + is being made to STARFOCUS, PSFMEASURE, KPNOFOCUS to attempt to + produce similar values by default. (3/13/96, Valdes) + +images$tv/imexamine/iejimexam.x +images$tv/jimexam.par +images$tv/doc/imexamine.hlp + Bug 330: There were several errors in this which only show up when + using a world WCS. The parameter prompt and help now indicate the + initial sigma value is in pixels even when fitting in world + coordinates. (2/27/96, Valdes) + +images$tv/imexamine/iemw.x + The inverse WCS function was incorrect and is fixed. (2/27/96, Valdes) + +images$tv/imexamine/ierimexam.x +images$tv/imexamine/stfmeasure.x + +images$tv/imexamine/starfocus.h + +images$tv/imexamine/mkpkg +images$tv/doc/imexamine.hlp +lib$src/imexamine.key + New FWHM estimates based on the enclosed flux and a direct measurement + were added to the 'a' and 'r' keys. The weights for the Gaussian + fit were modified to reduce the influence of pixels outside the + half-maximum radius. The ? help and help page were revised to + described the new output and algorithms. (11/9/95+12/8/95+3/14/96, Valdes) + +images$tv/imedit/t_imedit.x +images$doc/imedit.hlp + The 'j', 'k', 'n', and 'u' keys were added to those recorded in the + logfile. (4/11/95, Valdes) + +images$doc/imexamine.hlp + Fixed a typo in the equation for ellipticity. (4/10/95, Valdes) + +images$tv/imexamine/iejimexam.x + Fixed a pointer addressing error found by Zarate. (2/16/95, Valdes) + +images$tv/imexamine/iecolon.x +images$tv/doc/imexamine.imh +lib$src/imexamine.key + 1. The "label" parameter was incorrectly attributed to the surface plot + instead of the contour plot. + 2. The "axes" parameter for the surface plot was missing in the code + though noted in the help. + 3. Updated the help and key file to show the label parameter belongs + to the e plot and to show the axes parameter. + (11/8/94, Valdes) + +images$tv/tvmark/mkmark.x + Replaced a seek to EOF call with a flush call in the the tvmark task add + object procedure. On SunOS systems the seek to EOF was apparently forcing + the flush while on Solaris systems it was not, resulting in the added + objects never being written to the coordinate file. + (10/3/94, Davis) + +images$tv/imexamine/ierimexam.x + World coordinates printed in the 'r' profile graph are now formated. + (8/2/94, Valdes) + +images$tv/wcslab/wcslab.x + Fixed an initialization bug in wcslab that was causing the axis labels + of the plot to be drawn incorrectly the first time wcslab was run. + This was only a bug under 2.10.3 + (26/7/94 Davis) + +images$tv/imexamine/iestatistics.x + Changed the statistics routine to compute quantities in double precision. + (3/10/93, Valdes) + +images$tv/imexamine/ierimexam.x +images$tv/doc/imexamine.hlp + The simple gaussian fitting was inadequate and gave biased answers. + Replaced this algorithm with NLFIT version. It is still just a two + parameter fit with the center and sky being determined and then fixed + as before. (3/2/93, Valdes) + +images$tv/wcslab/wcslab.h +images$tv/wcslab/wcs_desc.h +images$tv/wcslab/wcslab.x +images$tv/wcslab/wlwcslab.x + Removed a dependency on the file gio.h from the wcslab task. + (2/11/93 LED) + +images$tv/wcslab/wcs_desc.h +images$tv/wcslab/wcslab.h +images$tv/wcslab/wcslab.x +images$tv/wcslab/wlwcslab.x + Removed several dependences on the file gio.h which were no longer + required. There is still one remaining dependency. (2/11/93, Davis) + +images$tv/wcslab/wcslab.x + Fixed a bug in the axis mapping code in wcslab which was causing the + task to fail in some circumstances if the input image was a section + of a higher dimensioned parent image. (1/28/93, Davis) + +======= +V2.10.2 +======= + +images$imexamine/iejimexam.x + Changed aint to nint. (8/10/92, Valdes) + +images$imexamine/iegdata.x + For some reason (typo?) the test for out-of-bounds pixels was such that + a single column or line at the edge of the image was considered out of + bounds. The >= test was changed to >. (7/31/92, Valdes) + +======= +V2.10.1 +======= + +======= +V2.10.0 +======= + +======= +V2.10 +======= + +images$*imexam.par +images$imexamine/* +images$doc/imexamine.e + Made modifications to use coordinate formating in graphs and in + cursor readback. Also the WCS label will be used if label="wcslabel". + Two paramters were added to the main PSET, xformat and yformat. + (4/10/92, Valdes) + +images$tv/wcslab.x + Wcslab was failing if an image larger than the frame buffer was + displayed with fill=no. + (3/25/92, Davis) + +images$tv/imexamine/iemw.x + The logical coordinate of an excluded axis is 1 and not axval+1. + (3/9/92, Valdes) + +images$tv/wcslab/wlwcslab.x + Replaced the routine wl_unused_wcs which searched for an unused wcs + with some code to save and replace the current wcs. + + (2/18/92, Davis) + +images$tv/ + Moved all the .keys files from the noao$lib/scr/ and proto$tvmark/ + directories to the iraf$lib/scr/ directory. + + (1/29/92, Davis) + +images$tv/wcslab/ + Added the new task WCSLAB developed at ST by Jonathan Eisenhammer + and modified at NOAO to the TV package. + + (1/24/92, Davis) + +images$tv/ + + New version of the TV package created. + + The IMEDIT, IMEXAMINE, and TVMARK tasks were removed from the old + NOAO.PROTO package and added to the IMAGES.TV package. See below + for list of previous revisions to these tasks. + + The IIS dependent tasks BLINK, CV, CVL, ERASE, FRAME, LUMATCH, + MONOCHROME, PSEUDOCOLOR, RGB, WINDOW and ZOOM were removed from + the TV package and placed in the new subpackage TV.IIS. + + The directory structure of the IIS package was modified. + + (1/24/92, Davis) + +====================== +Package reorganization +====================== + +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$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$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$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) + +==== +V2.9 +==== + +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. + +==== +V2.8 +==== + +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/imexamine/iecolon.x + Valdes, Feb 16, 1990 + Fixed a mistake in the the datatype of a parg call. + +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/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. + +=========== +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/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. + +====================== +Package reorganization +====================== + +=========== +Release 2.2 +=========== +.endhelp diff --git a/pkg/images/tv/_dcontrol.par b/pkg/images/tv/_dcontrol.par new file mode 100644 index 00000000..451548c6 --- /dev/null +++ b/pkg/images/tv/_dcontrol.par @@ -0,0 +1,18 @@ +type,s,h,frame,,,"Display type (frame, rgb)" +map,s,h,mono,,,"Display map (mono, psuedo, 8color, cycle)" +red_frame,i,h,1,1,4,Red frame +green_frame,i,h,2,1,4,Green frame +blue_frame,i,h,3,1,4,Blue frame +frame,i,h,1,1,4,Display frame +alternate,s,h,0,,,Alternate frame or frames +erase,b,h,no,,,Erase display +window,b,h,no,,,Window display frame +rgb_window,b,h,no,,,Window RGB frames +cursor,b,h,no,,,Print cursor position +blink,b,h,no,,,Blink display frame with alternate frame +match,b,h,no,,,Match display frame window with alternate frame +roam,b,h,no,,,Roam display +zoom,i,h,2,1,4,Zoom factor +rate,r,h,1.,,,Blink rate (sec per frame) +coords,*imcur,h,,,,Coordinate list +device,s,h,"stdimage",,,Display device diff --git a/pkg/images/tv/cimexam.par b/pkg/images/tv/cimexam.par new file mode 100644 index 00000000..bbba22c8 --- /dev/null +++ b/pkg/images/tv/cimexam.par @@ -0,0 +1,22 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +xlabel,s,h,"wcslabel",,,"X-axis label" +ylabel,s,h,"Pixel Value",,,"Y-axis label" + +naverage,i,h,1,,,Number of columns to average +x1,r,h,INDEF,,,X-axis window limit +x2,r,h,INDEF,,,X-axis window limit +y1,r,h,INDEF,,,Y-axis window limit +y2,r,h,INDEF,,,Y-axis window limit +pointmode,b,h,no,,,plot points instead of lines? +marker,s,h,"plus",,,point marker character? +szmarker,r,h,1.,,,marker size +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +box,b,h,yes,,,draw box around periphery of window +ticklabels,b,h,yes,,,label tick marks +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values? diff --git a/pkg/images/tv/display.par b/pkg/images/tv/display.par new file mode 100644 index 00000000..04001e8c --- /dev/null +++ b/pkg/images/tv/display.par @@ -0,0 +1,30 @@ +# Parameter file for DISPLAY + +image,f,a,,,,image to be displayed +frame,i,a,1,1,4,frame to be written into +bpmask,f,h,"BPM",,,bad pixel mask +bpdisplay,s,h,"none","none|overlay|interpolate",,bad pixel display (none|overlay|interpolate) +bpcolors,s,h,"red",,,bad pixel colors +overlay,f,h,"",,,overlay mask +ocolors,s,h,"green",,,overlay colors +erase,b,h,yes,,,erase frame +border_erase,b,h,no,,,erase unfilled area of window +select_frame,b,h,yes,,,display frame being loaded +repeat,b,h,no,,,repeat previous display parameters +fill,b,h,no,,,scale image to fit display window +zscale,b,h,yes,,,display range of greylevels near median +contrast,r,h,0.25,,,contrast adjustment for zscale algorithm +zrange,b,h,yes,,,display full image intensity range +zmask,f,h,"",,,sample mask +nsample,i,h,1000,100,,maximum number of sample pixels to use +xcenter,r,h,0.5,0,1,display window horizontal center +ycenter,r,h,0.5,0,1,display window vertical center +xsize,r,h,1,0,1,display window horizontal size +ysize,r,h,1,0,1,display window vertical size +xmag,r,h,1.,,,display window horizontal magnification +ymag,r,h,1.,,,display window vertical magnification +order,i,h,0,0,1,"spatial interpolator order (0=replicate, 1=linear)" +z1,r,h,,,,minimum greylevel to be displayed +z2,r,h,,,,maximum greylevel to be displayed +ztrans,s,h,linear,,,greylevel transformation (linear|log|none|user) +lutfile,f,h,"",,,file containing user defined look up table diff --git a/pkg/images/tv/display/README b/pkg/images/tv/display/README new file mode 100644 index 00000000..f31a6aa4 --- /dev/null +++ b/pkg/images/tv/display/README @@ -0,0 +1,15 @@ +DISPLAY -- Prototype routines for loading and controlling the image display. +The lower level code is device dependent. + + display loads the display + dcontrol adjusts the display (frame select, window, etc.) + +The basic strategy is that the image display device is interfaced to IRAF +file i/o as a binary file. IMIO is then used to access the image or graphics +planes of the device as a disk resident imagefile would be referenced. +Each image plane of each image device is a separate "imagefile", and has a +distinct image header file in the directory "dev$". + +This package uses the ZFIOGD (binary graphics device) device driver, the +source for which is in host$gdev. It is this driver which implements physical +i/o to the device (actually, to the host system device driver for the device). diff --git a/pkg/images/tv/display/ace.h b/pkg/images/tv/display/ace.h new file mode 100755 index 00000000..4c4f40bf --- /dev/null +++ b/pkg/images/tv/display/ace.h @@ -0,0 +1,38 @@ +define NUMSTART 11 # First object number + +# Mask Flags. +define MASK_NUM 000777777B # Mask number +define MASK_GRW 001000000B # Grow pixel +define MASK_SPLIT 002000000B # Split flag +define MASK_BNDRY 004000000B # Boundary flag +define MASK_BP 010000000B # Bad pixel +define MASK_BPFLAG 020000000B # Bad pixel flag +define MASK_DARK 040000000B # Dark flag + +define MSETFLAG ori($1,$2) +define MUNSETFLAG andi($1,noti($2)) + +define MNUM (andi($1,MASK_NUM)) +define MNOTGRW (andi($1,MASK_GRW)==0) +define MGRW (andi($1,MASK_GRW)!=0) +define MNOTBP (andi($1,MASK_BP)==0) +define MBP (andi($1,MASK_BP)!=0) +define MNOTBPFLAG (andi($1,MASK_BPFLAG)==0) +define MBPFLAG (andi($1,MASK_BPFLAG)!=0) +define MNOTBNDRY (andi($1,MASK_BNDRY)==0) +define MBNDRY (andi($1,MASK_BNDRY)!=0) +define MNOTSPLIT (andi($1,MASK_SPLIT)==0) +define MSPLIT (andi($1,MASK_SPLIT)!=0) +define MNOTDARK (andi($1,MASK_DARK)==0) +define MDARK (andi($1,MASK_DARK)!=0) + +# Output object masks types. +define OM_TYPES "|boolean|numbers|colors|all|\ + |bboolean|bnumbers|bcolors|" +define OM_BOOL 1 # Boolean (0=sky, 1=object+bad+grow) +define OM_ONUM 2 # Object number only +define OM_COLORS 3 # Bad=1, Objects=2-9 +define OM_ALL 4 # All values +define OM_BBOOL 6 # Boolean (0=sky, 1=object+bad+grow) +define OM_BONUM 7 # Object number only +define OM_BCOLORS 8 # Bad=1, Objects=2-9 diff --git a/pkg/images/tv/display/display.h b/pkg/images/tv/display/display.h new file mode 100644 index 00000000..fa89a479 --- /dev/null +++ b/pkg/images/tv/display/display.h @@ -0,0 +1,42 @@ +# Display modes: + +define RGB 1 # True color mode +define FRAME 2 # Single frame mode + +# Color selections: + +define BLUE 1B # BLUE Select +define GREEN 2B # GREEN Select +define RED 4B # RED Select +define MONO 7B # RED + GREEN + BLUE + +# Size limiting parameters. + +define MAXCHAN 2 +define SAMPLE_SIZE 600 + +# If a logarithmic greyscale transformation is desired, the input range Z1:Z2 +# will be mapped into the range 1.0 to 10.0 ** MAXLOG before taking the log +# to the base 10. + +define MAXLOG 3 + +# The following parameter is used to compare display pixel coordinates for +# equality. It determines the maximum permissible magnification. The machine +# epsilon is not used because the computations are nontrivial and accumulation +# of error is a problem. + +define DS_TOL (1E-4) + +# These parameters are needed for user defined transfer functions. + +define U_MAXPTS 4096 +define U_Z1 0 +define U_Z2 4095 + +# BPDISPLAY options: + +define BPDISPLAY "|none|overlay|interpolate|" +define BPDNONE 1 # Ignore bad pixel mask +define BPDOVRLY 2 # Overlay bad pixels +define BPDINTERP 3 # Interpolate bad pixels diff --git a/pkg/images/tv/display/dsmap.x b/pkg/images/tv/display/dsmap.x new file mode 100644 index 00000000..4a5f7e9c --- /dev/null +++ b/pkg/images/tv/display/dsmap.x @@ -0,0 +1,33 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imset.h> +include <fset.h> + +# DSMAP -- Map the display, i.e., open the display device as an imagefile. + +pointer procedure dsmap (frame, mode, color, chan) + +int frame +int mode +int color +int chan[ARB] + +pointer ds +char device[SZ_FNAME] + +int imstati(), fstati(), envgets(), imdopen() +extern imdopen() +pointer imdmap() +errchk imdmap + +begin + if (envgets ("stdimage", device, SZ_FNAME) == 0) + call error (1, "variable `stdimage' not defined in environment") + + ds = imdmap (device, mode, imdopen) + chan[1] = fstati (imstati (ds, IM_PIXFD), F_CHANNEL) + chan[2] = color + + return (ds) +end diff --git a/pkg/images/tv/display/dspmmap.x b/pkg/images/tv/display/dspmmap.x new file mode 100644 index 00000000..e20689f1 --- /dev/null +++ b/pkg/images/tv/display/dspmmap.x @@ -0,0 +1,20 @@ +# DS_PMMAP -- Open a pixel mask READ_ONLY. + +pointer procedure ds_pmmap (pmname, refim) + +char pmname[ARB] #I Pixel mask name +pointer refim #I Reference image pointer + +pointer sp, mname +pointer im, yt_mappm() +errchk yt_mappm + +begin + call smark (sp) + call salloc (mname, SZ_FNAME, TY_CHAR) + + im = yt_mappm (pmname, refim, "pmmatch", Memc[mname], SZ_FNAME) + + call sfree (sp) + return (im) +end diff --git a/pkg/images/tv/display/dsulut.x b/pkg/images/tv/display/dsulut.x new file mode 100644 index 00000000..2069bd68 --- /dev/null +++ b/pkg/images/tv/display/dsulut.x @@ -0,0 +1,141 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <ctype.h> +include "display.h" + +# DS_ULUTALLOC -- 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. + +pointer procedure ds_ulutalloc (fname, z1, z2) + +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, sp, x, y +int nvalues, i, j, x1, x2, y1 +real delta_gs, delta_xv, slope +errchk ds_ulutread, ds_ulutsort, 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_ulutread (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_ulutsort (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) + return (lut) +end + + +# DS_ULUTFREE -- Free the lookup table allocated by DS_ULUT. + +procedure ds_ulutfree (lut) + +pointer lut + +begin + call mfree (lut, TY_SHORT) +end + + +# DS_ULUTREAD -- Read text file of x, y, values. + +procedure ds_ulutread (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_ULUTSORT -- Bubble sort of paired arrays. + +procedure ds_ulutsort (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/images/tv/display/findz.x b/pkg/images/tv/display/findz.x new file mode 100644 index 00000000..e1f0f73e --- /dev/null +++ b/pkg/images/tv/display/findz.x @@ -0,0 +1,62 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "iis.h" + +# FINDZ -- Estimate the range of greylevels Z1 to Z2 containing a specified +# fraction of the greylevels in the image. The technique is to sample the +# image at some interval, computing the values of the greylevels a fixed +# distance either side of the median. Since it is not necessary to compute +# the full histogram we do not need to know the image zmin, zmax in advance. +# Works for images of any dimensionality, size, or datatype. + +procedure findz (im, z1, z2, zfrac, maxcols, nsample_lines) + +pointer im +real z1, z2, zfrac +int maxcols, nsample_lines + +real rmin, rmax +real frac +int imin, imax, ncols, nlines +int i, n, step, sample_size, imlines + +pointer sp, buf +pointer imgl2r() +include "iis.com" + +begin + call smark (sp) + call salloc (buf, ncols, TY_REAL) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Try to include a constant number of pixels in the sample + # regardless of the image size. The entire image is used if we + # have a small image, and at least sample_lines lines are read + # if we have a large image. + + sample_size = iis_ydim * nsample_lines + imlines = min(nlines, max(nsample_lines, sample_size / ncols)) + step = nlines / (imlines + 1) + + frac = (1.0 - zfrac) / 2. + imin = frac * (ncols - 1) + imax = (1.0 - frac) * (ncols - 1) + rmin = 0.0 + rmax = 0.0 + n = 0 + + do i = 1 + step, nlines, max (1, step) { + call asrtr (Memr[imgl2r (im, i)], Memr[buf], ncols) + rmin = rmin + Memr[buf + imin] + rmax = rmax + Memr[buf + imax] + n = n + 1 + } + + z1 = rmin / n + z2 = rmax / n + + call sfree (sp) +end diff --git a/pkg/images/tv/display/gwindow.h b/pkg/images/tv/display/gwindow.h new file mode 100644 index 00000000..ae91e2ea --- /dev/null +++ b/pkg/images/tv/display/gwindow.h @@ -0,0 +1,49 @@ +# Window descriptor structure. + +define LEN_WDES (210+(W_MAXWC+1)*LEN_WC) +define LEN_WC 10 # 4=[XbXeYbYe]+2=tr_type[xy] +define W_MAXWC 5 # max world coord systems +define W_SZSTRING 99 # size of strings +define W_SZIMSECT W_SZSTRING # image section string + +define W_DEVICE Memi[$1] +define W_FRAME Memi[$1+1] # device frame number +define W_XRES Memi[$1+2] # device resolution, x +define W_YRES Memi[$1+3] # device resolution, y +define W_BPDISP Memi[$1+4] # bad pixel display option +define W_BPCOLORS Memi[$1+5] # overlay colors +define W_OCOLORS Memi[$1+6] # badpixel colors +define W_IMSECT Memc[P2C($1+10)] # image section +define W_OVRLY Memc[P2C($1+60)] # overlay mask +define W_BPM Memc[P2C($1+110)] # bad pixel mask +define W_ZPM Memc[P2C($1+160)] # Z scaling pixel mask +define W_WC ($1+$2*LEN_WC+210) # ptr to coord descriptor + +# Fields of the WC coordinate descriptor, a substructure of the window +# descriptor. "W_XB(W_WC(w,0))" is the XB field of wc 0 of window W. + +define W_XS Memr[P2R($1)] # starting X value +define W_XE Memr[P2R($1+1)] # ending X value +define W_XT Memi[$1+2] # X transformation type +define W_YS Memr[P2R($1+3)] # starting Y value +define W_YE Memr[P2R($1+4)] # ending Y value +define W_YT Memi[$1+5] # Y transformation type +define W_ZS Memr[P2R($1+6)] # starting Z value (greyscale) +define W_ZE Memr[P2R($1+7)] # ending Z value +define W_ZT Memi[$1+8] # Z transformation type +define W_UPTR Memi[$1+9] # LUT when ZT=USER + +# WC types. + +define W_NWIN 0 # Display window in NDC coordinates +define W_DWIN 1 # Display window in image pixel coordinates +define W_WWIN 2 # Display window in image world coordinates +define W_IPIX 3 # Image pixel coordinates (in pixels) +define W_DPIX 4 # Display pixel coordinates (in pixels) + +# Types of coordinate and greyscale transformations. + +define W_UNITARY 0 # values map without change +define W_LINEAR 1 # linear mapping +define W_LOG 2 # logarithmic mapping +define W_USER 3 # user specifies transformation diff --git a/pkg/images/tv/display/iis.com b/pkg/images/tv/display/iis.com new file mode 100644 index 00000000..8b367132 --- /dev/null +++ b/pkg/images/tv/display/iis.com @@ -0,0 +1,25 @@ +# Common for IIS display + +int iischan # the device channel used by FIO +int iisnopen # number of times the display has been opened +int iisframe # frame number at iisopn time (kludge). +int iis_xdim, iis_ydim # frame size, pixels +int iis_config # frame size configuration +int iis_server # device is actually a display server +bool packit # byte pack data for i/o +bool swap_bytes # byte swap the IIS header +short hdr[LEN_IISHDR] # header + +int iis_version # WCS version +int iis_valid # valid mapping info flag +char iis_region[SZ_FNAME] # region name +real iis_sx, iis_sy # source raster offset +int iis_snx, iis_sny # source raster size +int iis_dx, iis_dy # dest raster offset +int iis_dnx, iis_dny # dest raster size +char iis_objref[SZ_FNAME] # object reference + +common /iiscom/ iischan, iisnopen, iisframe, iis_xdim, iis_ydim, iis_config, + iis_server, packit, swap_bytes, hdr, iis_version, iis_valid, + iis_region, iis_sx, iis_sy, iis_snx, iis_sny, + iis_dx, iis_dy, iis_dnx, iis_dny, iis_objref diff --git a/pkg/images/tv/display/iis.h b/pkg/images/tv/display/iis.h new file mode 100644 index 00000000..bdd4f33a --- /dev/null +++ b/pkg/images/tv/display/iis.h @@ -0,0 +1,121 @@ +# This file contains the hardware definitions for the iis model 70/f +# at Kitt Peak. + +# Define header +define LEN_IISHDR 8 # Length of IIS header + +define XFERID $1[1] # transfer id +define THINGCT $1[2] # thing count +define SUBUNIT $1[3] # subuint select +define CHECKSUM $1[4] # check sum +define XREG $1[5] # x register +define YREG $1[6] # y register +define ZREG $1[7] # z register +define TREG $1[8] # t register + + +# Transfer ID definitions +define IREAD 100000B +define IWRITE 0B +define PACKED 40000B +define SAMPLE 40000B +define BYPASSIFM 20000B +define BYTE 10000B +define ADDWRITE 4000B +define ACCUM 2000B +define BLOCKXFER 1000B +define VRETRACE 400B +define MUX32 200B +define IMT800 100B # [IMTOOL SPECIAL] + +# Subunits +define REFRESH 1 +define LUT 2 +define OFM 3 +define IFM 4 +define FEEDBACK 5 +define SCROLL 6 +define VIDEOM 7 +define SUMPROC 8 +define GRAPHICS 9 +define CURSOR 10 +define ALU 11 +define ZOOM 12 +define IMCURSOR 20B +define WCS 21B + +# Command definitions +define COMMAND 100000B +define ADVXONTC 100000B # Advance x on thing count +define ADVXONYOV 40000B # Advance x on y overflow +define ADVYONXOV 100000B # Advance y on x overflow +define ADVYONTC 40000B # Advance y on thing count +define ERASE 100000B # Erase + +# 4 - Button Trackball +define PUSH 40000B +define BUTTONA 400B +define BUTTONB 1000B +define BUTTONC 2000B +define BUTTOND 4000B + +# Display channels +define CHAN1 1B +define CHAN2 2B +define CHAN3 4B +define CHAN4 10B +define CHAN5 20B +define CHAN6 40B +define CHAN7 100B +define CHAN8 200B +define CHAN9 400B +define CHAN10 1000B +define CHAN11 2000B +define CHAN12 4000B +define CHAN13 10000B +define CHAN14 20000B +define CHAN15 40000B +define CHAN16 100000B +define GRCHAN 100000B + +define LEN_IISFRAMES 16 +define IISFRAMES CHAN1, CHAN2, CHAN3, CHAN4, CHAN5, CHAN6, CHAN7, CHAN8, CHAN9, CHAN10, CHAN11, CHAN12, CHAN13, CHAN14, CHAN15, CHAN16 + +# Colors + +define BLUE 1B +define GREEN 2B +define RED 4B +define MONO 7B + +# Bit plane selections +define BITPL0 1B +define BITPL1 2B +define BITPL2 4B +define BITPL3 10B +define BITPL4 20B +define BITPL5 40B +define BITPL6 100B +define BITPL7 200B +define ALLBITPL 377B + +# IIS Sizes +define IIS_XDIM 512 +define IIS_YDIM 512 +define MCXSCALE 64 # metacode x scale +define MCYSCALE 64 # metacode y scale +define SZB_IISHDR 16 # size of IIS header in bytes +define SZB_IMCURVAL 160 # size of imcursor value buffer, bytes +define LEN_ZOOM 3 # zoom parameters +define LEN_CURSOR 3 # cursor parameters +define LEN_SPLIT 12 # split screen +define LEN_LUT 256 # look up table +define LEN_OFM 1024 # output function look up table +define SZ_OLD_WCSTEXT 320 # old max WCS text chars +define SZ_WCSTEXT 1024 # max WCS text chars + +# IIS Status Words +define IIS_FILSIZE (IIS_XDIM * IIS_YDIM * SZB_CHAR) +define IIS_BLKSIZE 1024 +define IIS_OPTBUFSIZE (IIS_XDIM * SZB_CHAR) +define IIS_MAXBUFSIZE 32768 diff --git a/pkg/images/tv/display/iisblk.x b/pkg/images/tv/display/iisblk.x new file mode 100644 index 00000000..1ff81d49 --- /dev/null +++ b/pkg/images/tv/display/iisblk.x @@ -0,0 +1,40 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISBLK -- Blink IIS display frames at millisecond time resolution. + +procedure iisblk (chan1, chan2, chan3, chan4, nframes, rate) + +int chan1[ARB] +int chan2[ARB] +int chan3[ARB] +int chan4[ARB] +int nframes +real rate + +int msec, status, xcur, ycur +int and() + +begin + status = 0 + msec = int (rate * 1000.) + + while (and (status, PUSH) == 0) { + call zwmsec (msec) + call iisrgb (chan1, chan1, chan1) + call zwmsec (msec) + call iisrgb (chan2, chan2, chan2) + if (nframes >= 3) { + call zwmsec (msec) + call iisrgb (chan3, chan3, chan3) + } + if (nframes == 4) { + call zwmsec (msec) + call iisrgb (chan4, chan4, chan4) + } + call iisrcr (status, xcur, ycur) + } +end diff --git a/pkg/images/tv/display/iiscls.x b/pkg/images/tv/display/iiscls.x new file mode 100644 index 00000000..71da6c35 --- /dev/null +++ b/pkg/images/tv/display/iiscls.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "zdisplay.h" +include "iis.h" + +# IISCLS -- Close IIS display. + +procedure iiscls (chan, status) + +int chan[ARB] +int status +include "iis.com" + +begin + if (iisnopen == 1) { + call zclsgd (iischan, status) + iisnopen = 0 + } else if (iisnopen > 1) { + iisnopen = iisnopen - 1 + } else + iisnopen = 0 +end diff --git a/pkg/images/tv/display/iisers.x b/pkg/images/tv/display/iisers.x new file mode 100644 index 00000000..de276a99 --- /dev/null +++ b/pkg/images/tv/display/iisers.x @@ -0,0 +1,28 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISERS -- Erase IIS frame. + +procedure iisers (chan) + +int chan[ARB] +short erase + +int status, tid +int iisflu(), andi() +include "iis.com" + +begin + call achtiu (andi (ERASE, 0177777B), erase, 1) + + # IMTOOL special - IIS frame bufrer configuration code. + tid = IWRITE+BYPASSIFM+BLOCKXFER + tid = tid + max (0, iis_config - 1) + + call iishdr (tid, 1, FEEDBACK, ADVXONTC, ADVYONXOV, iisflu(chan), + ALLBITPL) + call iisio (erase, SZB_CHAR, status) +end diff --git a/pkg/images/tv/display/iisflu.x b/pkg/images/tv/display/iisflu.x new file mode 100644 index 00000000..3fee9d63 --- /dev/null +++ b/pkg/images/tv/display/iisflu.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISFLU -- IIS frame look up table. + +int procedure iisflu (chan) + +int chan[ARB] +int frame +int iisframe[LEN_IISFRAMES] +data iisframe/IISFRAMES/ + +begin + frame = chan[1] - IIS_CHAN * DEVCODE + if (frame < 1) + return (iisframe[1]) + else if (frame > LEN_IISFRAMES) + return (GRCHAN) + else + return (iisframe[frame]) +end diff --git a/pkg/images/tv/display/iisgop.x b/pkg/images/tv/display/iisgop.x new file mode 100644 index 00000000..c33f21d2 --- /dev/null +++ b/pkg/images/tv/display/iisgop.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" + +# IISGOP -- Open IIS graphics display. + +procedure iisgop (frame, mode, chan) + +int frame, mode, chan[ARB] + +begin + call iisopn (frame + LEN_IISFRAMES, mode, chan) +end diff --git a/pkg/images/tv/display/iishdr.x b/pkg/images/tv/display/iishdr.x new file mode 100644 index 00000000..38ea733d --- /dev/null +++ b/pkg/images/tv/display/iishdr.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" +# IISHDR -- Form IIS header. + +procedure iishdr (id, count, subunit, x, y, z, t) + +int id, count, subunit, x, y, z, t +int i, sum +include "iis.com" + +begin + call achtiu (id, XFERID(hdr), 1) + call achtiu (count, THINGCT(hdr), 1) + call achtiu (subunit, SUBUNIT(hdr), 1) + call achtiu (x, XREG(hdr), 1) + call achtiu (y, YREG(hdr), 1) + call achtiu (z, ZREG(hdr), 1) + call achtiu (t, TREG(hdr), 1) + CHECKSUM(hdr) = 1 + + if (THINGCT(hdr) > 0) + THINGCT(hdr) = -THINGCT(hdr) + sum = 0 + for (i = 1; i <= LEN_IISHDR; i = i + 1) + sum = sum + hdr[i] + call achtiu (-sum, CHECKSUM(hdr), 1) +end diff --git a/pkg/images/tv/display/iisio.x b/pkg/images/tv/display/iisio.x new file mode 100644 index 00000000..ad3902ed --- /dev/null +++ b/pkg/images/tv/display/iisio.x @@ -0,0 +1,43 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "zdisplay.h" +include "iis.h" + +# IISIO -- Synchronous i/o to the IIS. + +procedure iisio (buf, nbytes, status) + +short buf[ARB] +int nbytes +int status + +int xferid +int and() +include "iis.com" + +begin + call iiswt (iischan, status) + xferid = XFERID(hdr) + + if (swap_bytes) + call bswap2 (hdr, 1, hdr, 1, SZB_IISHDR) + call zawrgd (iischan, hdr, SZB_IISHDR, 0) + call iiswt (iischan, status) + + if (and (xferid, IREAD) != 0) { + call zardgd (iischan, buf, nbytes, 0) + call iiswt (iischan, status) + if (swap_bytes && and(xferid,PACKED) == 0) + call bswap2 (buf, 1, buf, 1, nbytes) + } else { + if (swap_bytes && and(xferid,PACKED) == 0) + call bswap2 (buf, 1, buf, 1, nbytes) + call zawrgd (iischan, buf, nbytes, 0) + call iiswt (iischan, status) + } + + if (status <= 0) + status = EOF +end diff --git a/pkg/images/tv/display/iismtc.x b/pkg/images/tv/display/iismtc.x new file mode 100644 index 00000000..2d6eb2cf --- /dev/null +++ b/pkg/images/tv/display/iismtc.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISMTC -- Match channel lut to frame2. + +procedure iismtc (chan1, chan2) + +int chan1[ARB], chan2[ARB] +short lut[LEN_LUT] + +int iisflu() + +begin + if (iisflu (chan2) == GRCHAN) + return + call iisrlt (chan1, lut) + call iiswlt (chan2, lut) +end diff --git a/pkg/images/tv/display/iisofm.x b/pkg/images/tv/display/iisofm.x new file mode 100644 index 00000000..24259fd3 --- /dev/null +++ b/pkg/images/tv/display/iisofm.x @@ -0,0 +1,183 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <math.h> +include "zdisplay.h" +include "iis.h" + +# These procedures have been modified to limit the maximum output level. + +define NIN 256 # Number of input levels +define NOUT 1024 # Number of output levels + +# IISOFM -- Output color mapping. + +procedure iisofm (map) + +char map[ARB] # type of mapping + +int i +short lutr[LEN_OFM] +short lutg[LEN_OFM] +short lutb[LEN_OFM] + +begin + if (map[1] == 'm') { # MONO + do i = 1, LEN_OFM + lutr[i] = min ((i - 1) * NOUT / NIN, NOUT) + call iiswom (MONO, lutr) + return + } + + call aclrs (lutr, LEN_OFM) + call aclrs (lutg, LEN_OFM) + call aclrs (lutb, LEN_OFM) + + if (map[1] == 'l') { # LINEAR + call iislps (lutb, lutg, lutr) + + } else if (map[1] == '8') { # 8COLOR + do i = 33, 64 { + lutb[i] = NOUT - 1 + lutr[i] = NOUT - 1 + } + do i = 65, 96 + lutb[i] = NOUT - 1 + do i = 97, 128 { + lutb[i] = NOUT - 1 + lutg[i] = NOUT - 1 + } + do i = 129, 160 + lutg[i] = NOUT - 1 + do i = 161, 192 { + lutg[i] = NOUT - 1 + lutr[i] = NOUT - 1 + } + do i = 193, 224 + lutr[i] = NOUT - 1 + do i = 225, 256 { + lutr[i] = NOUT - 1 + lutg[i] = NOUT - 1 + lutb[i] = NOUT - 1 + } + do i = 257, LEN_OFM { + lutr[i] = NOUT - 1 + lutg[i] = NOUT - 1 + lutb[i] = NOUT - 1 + } + + } else if (map[1] == 'r') { # RANDOM + do i = 2, LEN_OFM, 8 { + lutr[i] = NOUT - 1 + lutb[i] = NOUT - 1 + } + do i = 3, LEN_OFM, 8 + lutb[i] = NOUT - 1 + do i = 4, LEN_OFM, 8 { + lutb[i] = NOUT - 1 + lutg[i] = NOUT - 1 + } + do i = 5, LEN_OFM, 8 + lutg[i] = NOUT - 1 + do i = 6, LEN_OFM, 8 { + lutg[i] = NOUT - 1 + lutr[i] = NOUT - 1 + } + do i = 7, LEN_OFM, 8 + lutr[i] = NOUT - 1 + do i = 8, LEN_OFM, 8 { + lutr[i] = NOUT - 1 + lutg[i] = NOUT - 1 + lutb[i] = NOUT - 1 + } + } + + call iiswom (RED, lutr) + call iiswom (GREEN, lutg) + call iiswom (BLUE, lutb) +end + + +# IISWOM -- Write output color look up table. + +procedure iiswom (color, lut) + +int color +short lut[ARB] +int status + +begin + call iishdr (IWRITE+VRETRACE, LEN_OFM, OFM, ADVXONTC, ADVYONXOV, + color, 0) + call iisio (lut, LEN_OFM * SZB_CHAR, status) +end + + +# IISROM -- Read color look up table. + +procedure iisrom (color, lut) + +int color +short lut[ARB] +int status + +begin + call iishdr (IREAD+VRETRACE, LEN_OFM, LUT, ADVXONTC, ADVYONXOV, + color, 0) + call iisio (lut, LEN_OFM * SZB_CHAR, status) +end + + +# Linear Pseudocolor Modelling code. + +define BCEN 64 +define GCEN 128 +define RCEN 196 + +# IISLPS -- Load the RGB luts for linear pseudocolor. + +procedure iislps (lutb, lutg, lutr) + +short lutb[ARB] # blue lut +short lutg[ARB] # green lut +short lutr[ARB] # red lut + +begin + # Set the mappings for the primary color bands. + call iislps_curve (lutb, NIN, BCEN, NOUT - 1, NIN/2) + call iislps_curve (lutg, NIN, GCEN, NOUT - 1, NIN/2) + call iislps_curve (lutr, NIN, RCEN, NOUT - 1, NIN/2) + + # Add one half band of white color at the right. + call iislps_curve (lutb, NIN, NIN, NOUT - 1, NIN/2) + call iislps_curve (lutg, NIN, NIN, NOUT - 1, NIN/2) + call iislps_curve (lutr, NIN, NIN, NOUT - 1, NIN/2) +end + + +# IISLPS_CURVE -- Compute the lookup table for a single color. + +procedure iislps_curve (y, npts, xc, height, width) + +short y[npts] # output curve +int npts # number of points +int xc # x center +int height, width + +int i +real dx, dy, hw + +begin + hw = width / 2.0 + dy = height / hw * 2.0 + + do i = 1, npts { + dx = abs (i - xc) + if (dx > hw) + ; + else if (dx > hw / 2.0) + y[i] = max (int(y[i]), min (height, int((hw - dx) * dy))) + else + y[i] = height + } +end diff --git a/pkg/images/tv/display/iisopn.x b/pkg/images/tv/display/iisopn.x new file mode 100644 index 00000000..a310e168 --- /dev/null +++ b/pkg/images/tv/display/iisopn.x @@ -0,0 +1,76 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "zdisplay.h" +include "iis.h" + +# ---------------------------------------------------------------------- +# MODIFIED VERSION OF IISOPN.X FOR IMTOOL -- DO NOT DELETE. +# Referenced by the Sun/IRAF special file list: see hlib$mkpkg.sf. +# ---------------------------------------------------------------------- + +# IISOPN -- Open IIS display. + +procedure iisopn (devinfo, mode, chan) + +char devinfo[ARB] # device info for zopen (packed) +int mode # access mode +int chan[ARB] # receives IIS descriptor + +int delim +char resource[SZ_FNAME] +char node[SZ_FNAME] +bool first_time +data first_time /true/ +int ki_gnode(), strncmp() +include "iis.com" +include "imd.com" +define quit_ 91 + +begin + if (first_time) { + iisnopen = 0 + iis_version = 0 + first_time = false + } + + # We permit multiple opens but only open the physical device once. + if (iisnopen == 0) { + call zopngd (devinfo, mode, iischan) + + # Initialize imd_gcur. + call strcpy (devinfo, imd_devinfo, SZ_LINE) + imd_mode = mode + imd_magic = -1 + } + + if (iischan != ERR) { + iisnopen = iisnopen + 1 + chan[1] = FRTOCHAN(iisframe) + + # The following code is DEVICE DEPENDENT (horrible kludge, but + # it simplifies things and this is throw away code). + + # Byte pack i/o if the device is on a remote node since the i/o + # bandwidth is the limiting factor; do not bytepack if on local + # node since cpu time is the limiting factor. + + call strupk (devinfo, resource, SZ_FNAME) + packit = (ki_gnode (resource, node, delim) != 0) + if (!packit) + packit = (strncmp (resource[delim+1], "imt", 3) == 0) + + # Enable byte swapping if the device is byte swapped but the + # local host is not (assumes that if there is an IIS it is on + # a byte swapped VAX - this should be done in graphcap instead). + + swap_bytes = (strncmp (resource[delim+1], "iis", 3) == 0 && + BYTE_SWAP2 == NO) + + # Initialize zoom. + call iiszm (1, 0, 0) + + } else + chan[1] = ERR +end diff --git a/pkg/images/tv/display/iispio.x b/pkg/images/tv/display/iispio.x new file mode 100644 index 00000000..81e2512d --- /dev/null +++ b/pkg/images/tv/display/iispio.x @@ -0,0 +1,97 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "zdisplay.h" +include "iis.h" + +# IISPIO -- Asynchronous pixel i/o to the IIS. + +procedure iispio (buf, nx, ny) + +short buf[nx,ny] # Cell array +int nx, ny # length, number of image lines + +pointer iobuf +bool first_time +int xferid, status, nbytes, szline, i +int and() +include "iis.com" +data first_time /true/ + +begin + if (first_time) { + if (packit) + i = IIS_MAXBUFSIZE + else + i = IIS_MAXBUFSIZE * (SZ_SHORT * SZB_CHAR) + call malloc (iobuf, i, TY_SHORT) + first_time = false + } + + # Wait for the last i/o transfer. + call iiswt (iischan, status) + if (status == ERR) + return + + # Disable interrupts while transmitting to or receiving data from + # the display, to avoid loss of synch on the datastream and resulting + # loss of communications with the device. + + call intr_disable() + xferid = XFERID(hdr) + + # Transmit the packet header. + if (swap_bytes) + call bswap2 (hdr, 1, hdr, 1, SZB_IISHDR) + call zawrgd (iischan, hdr, SZB_IISHDR, 0) + call iiswt (iischan, status) + if (status == ERR) { + call intr_enable() + return + } + + # Read or write the data block. + nbytes = ny * iis_xdim + szline = iis_xdim + + if (packit) + szline = szline / (SZ_SHORT * SZB_CHAR) + else + nbytes = nbytes * (SZ_SHORT * SZB_CHAR) + + # Transmit the data byte-packed to increase the i/o bandwith + # when using network i/o. + + if (and (xferid, IREAD) != 0) { + # Read from the IIS. + + call zardgd (iischan, Mems[iobuf], nbytes, 0) + call iiswt (iischan, status) + + # Unpack and line flip the packed data. + if (packit) { + do i = 0, ny-1 + call achtbs (Mems[iobuf+i*szline], buf[1,ny-i], iis_xdim) + } else { + do i = 0, ny-1 + call amovs (Mems[iobuf+i*szline], buf[1,ny-i], szline) + } + + } else { + # Write to the IIS. + + # Bytepack the image lines, doing a line flip in the process. + if (packit) { + do i = 0, ny-1 + call achtsb (buf[1,ny-i], Mems[iobuf+i*szline], iis_xdim) + } else { + do i = 0, ny-1 + call amovs (buf[1,ny-i], Mems[iobuf+i*szline], szline) + } + + call zawrgd (iischan, Mems[iobuf], nbytes, 0) + } + + call intr_enable() +end diff --git a/pkg/images/tv/display/iisrcr.x b/pkg/images/tv/display/iisrcr.x new file mode 100644 index 00000000..53119d06 --- /dev/null +++ b/pkg/images/tv/display/iisrcr.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +define DELAY 30 # milliseconds between cursor reads + + +# IISRCR -- Read cursor from display. Note that the position is 1 indexed. + +procedure iisrcr (status, xcur, ycur) + +int status, xcur, ycur +short cursor[LEN_CURSOR] +include "iis.com" + +begin + call iishdr(IREAD+VRETRACE, LEN_CURSOR, COMMAND+CURSOR, ADVXONTC, 0,0,0) + + call zwmsec (DELAY) + + call iisio (cursor, LEN_CURSOR * SZB_CHAR, status) + if (status <= 0) { + status = EOF + return + } + + status = cursor[1] + xcur = MCXSCALE * mod (cursor[2] + 31, iis_xdim) + ycur = MCYSCALE * mod (cursor[3] + 31, iis_ydim) +end diff --git a/pkg/images/tv/display/iisrd.x b/pkg/images/tv/display/iisrd.x new file mode 100644 index 00000000..3421a71f --- /dev/null +++ b/pkg/images/tv/display/iisrd.x @@ -0,0 +1,42 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISRD -- Read data from IIS. + +procedure iisrd (chan, buf, nbytes, offset) + +int chan[ARB] +short buf[ARB] +int nbytes +long offset + +long off1, off2 +int nchars, thing_count, tid, y1, y2, x +int or(), iisflu() +include "iis.com" + +begin + # Convert to chars and clip at the top of the display. + off1 = (offset - 1) / SZB_CHAR + 1 + off2 = min (iis_xdim * iis_ydim, (offset + nbytes - 1) / SZB_CHAR) + 1 + nchars = off2 - off1 + + x = 0 + y1 = (off1-1 ) / iis_xdim + y2 = (off2-1 - iis_xdim) / iis_xdim + y2 = max (y1, y2) + + if (packit) + tid = IREAD+PACKED + else + tid = IREAD + thing_count = nchars + + call iishdr (tid, thing_count, REFRESH, or(x,ADVXONTC), + or(iis_ydim-y2-1, ADVYONXOV), iisflu(chan), ALLBITPL) + + call iispio (buf, iis_xdim, y2 - y1 + 1) +end diff --git a/pkg/images/tv/display/iisrgb.x b/pkg/images/tv/display/iisrgb.x new file mode 100644 index 00000000..9dcc38cd --- /dev/null +++ b/pkg/images/tv/display/iisrgb.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISRGB -- Enable RGB display. + +procedure iisrgb (red_chan, green_chan, blue_chan) + +int red_chan[ARB], green_chan[ARB], blue_chan[ARB] + +int i, frm, status +short split[LEN_SPLIT] +int iisflu() + +begin + frm = iisflu (blue_chan) + do i = 1, 4 + split[i] = frm + + frm = iisflu (green_chan) + do i = 5, 8 + split[i] = frm + + frm = iisflu (red_chan) + do i = 9, 12 + split[i] = frm + + call iishdr (IWRITE+VRETRACE, LEN_SPLIT, COMMAND+LUT, ADVXONTC, 0, 0, 0) + call iisio (split, LEN_SPLIT * SZB_CHAR, status) +end diff --git a/pkg/images/tv/display/iissfr.x b/pkg/images/tv/display/iissfr.x new file mode 100644 index 00000000..f6e92013 --- /dev/null +++ b/pkg/images/tv/display/iissfr.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "iis.h" + +# IIS_SETFRAME -- Set the frame number for IISOPN. This is a kludge to pass +# this number to IISOPN via the iis common. + +procedure iis_setframe (frame) + +int frame +include "iis.com" + +begin + iisframe = frame +end diff --git a/pkg/images/tv/display/iisstt.x b/pkg/images/tv/display/iisstt.x new file mode 100644 index 00000000..86474d25 --- /dev/null +++ b/pkg/images/tv/display/iisstt.x @@ -0,0 +1,29 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <fio.h> +include "zdisplay.h" +include "iis.h" + +# IISSTT -- IIS status. +# [OBSOLETE - NO LONGER USED (see zsttim)] + +procedure iisstt (chan, what, lvalue) + +int chan[ARB], what +long lvalue + +begin + switch (what) { + case FSTT_FILSIZE: + lvalue = IIS_FILSIZE + case FSTT_BLKSIZE: + lvalue = IIS_BLKSIZE + case FSTT_OPTBUFSIZE: + lvalue = IIS_OPTBUFSIZE + case FSTT_MAXBUFSIZE: + lvalue = IIS_MAXBUFSIZE + default: + lvalue = ERR + } +end diff --git a/pkg/images/tv/display/iiswcr.x b/pkg/images/tv/display/iiswcr.x new file mode 100644 index 00000000..3970f230 --- /dev/null +++ b/pkg/images/tv/display/iiswcr.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISWCR -- Write cursor to display. Note that the position is 1 indexed. + +procedure iiswcr (status, xcur, ycur) + +int status, xcur, ycur +short cursor[LEN_CURSOR] +include "iis.com" + +begin + call iishdr (IWRITE+VRETRACE, 2, COMMAND+CURSOR, 1+ADVXONTC, 0,0,0) + cursor[2] = mod (xcur / MCXSCALE - 32, iis_xdim) + cursor[3] = mod (ycur / MCYSCALE - 32, iis_ydim) + call iisio (cursor[2], 2 * SZB_CHAR, status) +end diff --git a/pkg/images/tv/display/iiswnd.x b/pkg/images/tv/display/iiswnd.x new file mode 100644 index 00000000..e906cc1f --- /dev/null +++ b/pkg/images/tv/display/iiswnd.x @@ -0,0 +1,117 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISWND -- Window IIS display frame with the trackball. + +procedure iiswnd3 (chan1, chan2, chan3) + +int chan1[ARB], chan2[ARB], chan3[ARB] + +int i, j +real x, y +short lut[LEN_LUT] +int status, xcur, ycur, lutval +int iisflu(), and() + +begin + if (iisflu(chan1) == GRCHAN) + return + call iisrlt (chan1, lut) + + # Starting point at lut[2] because lut[1] is background + for (i=3; (i < 257) && (lut[i] == lut[2]); i=i+1) + ; + i = i - 1 + + for (j=255; (j > i) && (lut[j] == lut[256]); j=j-1) + ; + j = j + 1 + + if ((i == j) || (lut[i] == lut[j])) { + xcur = 256 + ycur = 384 + } else { + y = real (lut[j] - lut[i]) / (j - i) + xcur = 2 * (i - 1) - (2 * lut[i] - 256) / y + 1 + if (y > 1) + y = 2 - (1 / y) + if (y < -1) + y = -2 - (1 / y) + ycur = 128 * y + 256.5 + } + + xcur = xcur * MCXSCALE + ycur = ycur * MCYSCALE + call iiswcr (status, xcur, ycur) + status = 0 + + while (and (status, PUSH) == 0) { + call iisrcr (status, xcur, ycur) + if (status == EOF) + break + + xcur = xcur / MCXSCALE + ycur = ycur / MCYSCALE + x = xcur / 2 + y = (ycur - 255.5) / 128. + + if (y > 1) + y = 1. / (2 - y) + if (y < - 1) + y = -1. / (2 + y) + do i = 1, 256 { + lutval = y * (i - 1 - x) + 127.5 + lut[i] = max (0, min (255, lutval)) + } + + lut[1] = 0 # Make background black + if ((chan1[1] == chan2[1]) && (chan1[1] == chan3[1])) + call iiswlt (chan1, lut) + else { + call iiswlt (chan1, lut) + call iiswlt (chan2, lut) + call iiswlt (chan3, lut) + } + } +end + + +# IISWLT -- Write monochrome look up table. + +procedure iiswlt (chan, lut) + +int chan[ARB] +short lut[ARB] + +int status +int iisflu() + +begin + if (iisflu (chan) == GRCHAN) + return + call iishdr (IWRITE+VRETRACE, LEN_LUT, LUT, ADVXONTC, 0, chan[2], + iisflu (chan)) + call iisio (lut, LEN_LUT * SZB_CHAR, status) +end + + +# IISRLT -- Read monochrome look up table. + +procedure iisrlt (chan, lut) + +int chan[ARB] +short lut[ARB] + +int status +int iisflu() + +begin + if (iisflu (chan) == GRCHAN) + return + call iishdr (IREAD+VRETRACE, LEN_LUT, LUT, ADVXONTC, 0, 0, + iisflu (chan)) + call iisio (lut, LEN_LUT * SZB_CHAR, status) +end diff --git a/pkg/images/tv/display/iiswr.x b/pkg/images/tv/display/iiswr.x new file mode 100644 index 00000000..68a1a583 --- /dev/null +++ b/pkg/images/tv/display/iiswr.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISWR -- Write pixel data to IIS. Writes are limited to entire display lines. +# The data is line-flipped, causing the first line to be displayed at the bottom +# of the screen. + +procedure iiswr (chan, buf, nbytes, offset) + +int chan[ARB] # io channel +short buf[ARB] # pixels +int nbytes # length of pixel array in bytes +long offset # pixel offset in image display + +long off1, off2 +int nchars, thing_count, tid, y1, y2, x +int or(), iisflu() +include "iis.com" + +begin + # Convert to chars and clip at the top of the display. + off1 = (offset - 1) / SZB_CHAR + 1 + off2 = min (iis_xdim * iis_ydim, (offset + nbytes - 1) / SZB_CHAR) + 1 + nchars = off2 - off1 + + x = 0 + y1 = (off1-1 ) / iis_xdim + y2 = (off2-1 - iis_xdim) / iis_xdim + y2 = max (y1, y2) + +#call eprintf ("iiswr: %d bytes at %d, x=%d, y=[%d:%d]\n") +#call pargi(nbytes); call pargi(offset) +#call pargi(x); call pargi(y1); call pargi(y2) + + if (packit) + tid = IWRITE+BYPASSIFM+BLOCKXFER+BYTE+PACKED + else + tid = IWRITE+BYPASSIFM + thing_count = nchars + + call iishdr (tid, thing_count, REFRESH, or(x,ADVXONTC), + or(iis_ydim-y2-1, ADVYONXOV), iisflu(chan), ALLBITPL) + + call iispio (buf, iis_xdim, y2 - y1 + 1) +end diff --git a/pkg/images/tv/display/iiswt.x b/pkg/images/tv/display/iiswt.x new file mode 100644 index 00000000..ae18ebff --- /dev/null +++ b/pkg/images/tv/display/iiswt.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "zdisplay.h" +include "iis.h" + +# IISWT -- Wait for IIS display. + +procedure iiswt (chan, nbytes) + +int chan[ARB], nbytes +include "iis.com" + +begin + call zawtgd (iischan, nbytes) + if (packit) + nbytes = nbytes * (SZ_SHORT * SZB_CHAR) +end diff --git a/pkg/images/tv/display/iiszm.x b/pkg/images/tv/display/iiszm.x new file mode 100644 index 00000000..d207f47a --- /dev/null +++ b/pkg/images/tv/display/iiszm.x @@ -0,0 +1,38 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "zdisplay.h" +include "iis.h" + +# IISZM -- Zoom IIS window. + +procedure iiszm (zfactor, x, y) + +int zfactor, x, y +short zoom[LEN_ZOOM] +int status + +begin + call iishdr (IWRITE+VRETRACE, LEN_ZOOM, ZOOM, ADVXONTC, 0, 0, 0) + zoom[1] = zfactor - 1 + zoom[2] = x / MCXSCALE + zoom[3] = y / MCYSCALE + call iisio (zoom, LEN_ZOOM * SZB_CHAR, status) +end + + +# IISRM -- Roam IIS display. + +procedure iisrm (zfactor) + +int zfactor +int status, xcur, ycur +int and() + +begin + status = 0 + while (status != EOF && and (status, PUSH) == 0) { + call iisrcr (status, xcur, ycur) + call iiszm (zfactor, xcur, ycur) + } +end diff --git a/pkg/images/tv/display/imd.com b/pkg/images/tv/display/imd.com new file mode 100644 index 00000000..9738e89b --- /dev/null +++ b/pkg/images/tv/display/imd.com @@ -0,0 +1,7 @@ +# IMD.COM -- Common for the IMD routines. + +int imd_magic # set to -1 when initialized +int imd_mode # display access mode +char imd_devinfo[SZ_LINE] # device information for zopngd + +common /imdcom/ imd_magic, imd_mode, imd_devinfo diff --git a/pkg/images/tv/display/imdgcur.x b/pkg/images/tv/display/imdgcur.x new file mode 100644 index 00000000..0f8cf658 --- /dev/null +++ b/pkg/images/tv/display/imdgcur.x @@ -0,0 +1,37 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <knet.h> +include "iis.h" + +# IMD_GCUR -- This is functionally equivalent to CLGCUR and should be used in +# place of the latter routine in programs which directly map the display. +# Its function is to close off the display at a low level in order to free +# the display device for access by the CL process for the cursor read. + +int procedure imd_gcur (param, wx, wy, wcs, key, strval, maxch) + +char param[ARB] # parameter to be read [not used] +real wx, wy # cursor coordinates +int wcs # wcs to which coordinates belong +int key # keystroke value of cursor event +char strval[ARB] # string value, if any +int maxch + +int status +bool devopen +int clgcur() +include "iis.com" +include "imd.com" + +begin + devopen = (iisnopen > 0) + if (imd_magic == -1 && devopen) + call zclsgd (iischan, status) + + status = clgcur (param, wx, wy, wcs, key, strval, maxch) + + if (imd_magic == -1 && devopen) + call zopngd (imd_devinfo, imd_mode, iischan) + + return (status) +end diff --git a/pkg/images/tv/display/imdgetwcs.x b/pkg/images/tv/display/imdgetwcs.x new file mode 100644 index 00000000..57f432bc --- /dev/null +++ b/pkg/images/tv/display/imdgetwcs.x @@ -0,0 +1,188 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include "zdisplay.h" +include "iis.h" + +# IMD_GETWCS -- Get the saved WCS for the given frame of the given display +# device. (No great attempt at generality here). +# [INTERNAL ROUTINE - RESTRICTED USE]. +# +# Example: +# +# dev$pix - m51 B 600s +# 1. 0. 0. -1. 1. 512. 36. 320.0713 1 +# +# The file format is the image title, followed by a line specifying the +# coordinate transformation matrix (6 numbers: a b c d tx ty) and the +# greyscale transformation (z1 z2 zt). +# +# The procedure returns OK if the WCS for the frame is sucessfully accessed, +# or ERR if the WCS cannot be read. In the latter case the output WCS will +# be the default unitary WCS. + +int procedure imd_getwcs (frame, server, image, sz_image, title, sz_title, + a, b, c, d, tx, ty) + +int frame #I frame (wcs) number of current device +int server #I device is a display server +char image[ARB] #O image name +int sz_image #I max image name length +char title[ARB] #O image title string +int sz_title #I max image title length +real a, d #O x, y scale factors +real b, c #O cross terms (rotations) +real tx, ty #O x, y offsets + +char ch +int fd, chan, status, wcs_status, zt +real z1, z2 +pointer sp, dir, device, fname, wcstext +int envfind(), strncmp(), open(), fscan(), nscan(), stropen(), iisflu() + +include "iis.com" + +begin + call smark (sp) + call salloc (dir, SZ_PATHNAME, TY_CHAR) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (wcstext, SZ_WCSTEXT, TY_CHAR) + + wcs_status = OK + + # Retrieve the WCS text and open a file descriptor on it. + + if (server == YES) { + # Retrieve the WCS information from a display server. + chan = iisflu(FRTOCHAN(frame)) + + # Cannot use iisio here as the data is byte packed and cannot be + # swapped (while the header still has to be swapped). + + if (iis_version > 0) { + iis_valid = NO + call iishdr (IREAD+PACKED, SZ_WCSTEXT, WCS, 1, 0, chan, 0) + call iisio (Memc[wcstext], SZ_WCSTEXT, status) + if (status > 0) + call strupk (Memc[wcstext], Memc[wcstext], SZ_WCSTEXT) + + iferr (fd = stropen (Memc[wcstext], SZ_WCSTEXT, READ_ONLY)) + fd = NULL + + } else { + call iishdr (IREAD+PACKED, SZ_OLD_WCSTEXT, WCS, 0, 0, chan, 0) + call iisio (Memc[wcstext], SZ_OLD_WCSTEXT, status) + if (status > 0) + call strupk (Memc[wcstext], Memc[wcstext], SZ_OLD_WCSTEXT) + + iferr (fd = stropen (Memc[wcstext], SZ_OLD_WCSTEXT, READ_ONLY)) + fd = NULL + } + + } else { + # Construct the WCS filename, "dir$device_frame.wcs". (Copied from + # the make-WCS code in t_display.x). + + if (envfind ("wcsdir", Memc[dir], SZ_PATHNAME) <= 0) + if (envfind ("WCSDIR", Memc[dir], SZ_PATHNAME) <= 0) + if (envfind ("uparm", Memc[dir], SZ_PATHNAME) <= 0) + call strcpy ("tmp$", Memc[dir], SZ_PATHNAME) + + if (envfind ("stdimage", Memc[device], SZ_FNAME) <= 0) + call strcpy ("display", Memc[device], SZ_FNAME) + + # Get the WCS file filename. + call sprintf (Memc[fname], SZ_PATHNAME, "%s%s_%d.wcs") + call pargstr (Memc[dir]) + if (strncmp (Memc[device], "imt", 3) == 0) + call pargstr ("imtool") + else + call pargstr (Memc[device]) + call pargi (frame) + + if (sz_image > 0) + image[1] = EOS + if (sz_title > 0) + title[1] = EOS + + # Get the saved WCS. + iferr (fd = open (Memc[fname], READ_ONLY, TEXT_FILE)) + fd = NULL + } + + # Decode the WCS from the WCS text. + if (fd != NULL) { + image[1] = EOS + title[1] = EOS + + if (fscan (fd) != EOF) { + # Decode "image - title". + if (sz_image > 0) + call gargwrd (image, sz_image) + if (sz_title > 0) { + call gargwrd (title, sz_title) + repeat { + call gargc (ch) + } until (!IS_WHITE(ch)) + title[1] = ch + call gargstr (title[2], sz_title - 1) + } + + # Decode the WCS information. + if (fscan (fd) != EOF) { + call gargr (a) + call gargr (b) + call gargr (c) + call gargr (d) + call gargr (tx) + call gargr (ty) + call gargr (z1) + call gargr (z2) + call gargi (zt) + if (nscan() == 9) + wcs_status = OK + + if (iis_version > 0) { + if (fscan (fd) != EOF) { + call gargstr (iis_region, SZ_FNAME) + call gargr (iis_sx) + call gargr (iis_sy) + call gargi (iis_snx) + call gargi (iis_sny) + call gargi (iis_dx) + call gargi (iis_dy) + call gargi (iis_dnx) + call gargi (iis_dny) + } + if (nscan() == 9) { + if (fscan (fd) != EOF) + call gargstr (iis_objref, SZ_FNAME) + if (nscan() == 1) + iis_valid = YES + } else + iis_valid = NO + } else { + if (nscan() != 9) { + # Set up the unitary transformation if we + # cannot retrieve the real one. + a = 1.0 + b = 0.0 + c = 0.0 + d = 1.0 + tx = 1.0 + ty = 1.0 + wcs_status = ERR + } + } + } + } + } + + + if (fd != NULL) + call close (fd) + call sfree (sp) + + return (wcs_status) +end diff --git a/pkg/images/tv/display/imdmapfr.x b/pkg/images/tv/display/imdmapfr.x new file mode 100644 index 00000000..745febe2 --- /dev/null +++ b/pkg/images/tv/display/imdmapfr.x @@ -0,0 +1,108 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imset.h> +include <imhdr.h> +include <mach.h> +include <fset.h> +include "display.h" +include "iis.h" + +# IMD_MAPFRAME -- Open the given frame of the stdimage display device on an +# IMIO image descriptor. + +pointer procedure imd_mapframe (frame, mode, select_frame) + +int frame #I frame to be opened [1:N] +int mode #I access mode +int select_frame #I make frame the display frame + +pointer ds +int chan[MAXCHAN] +char device[SZ_FNAME] + +pointer imdmap() +extern imdopen() +int imstati(), fstati(), envgets() +errchk imdmap, imseti +include "iis.com" + +begin + if (envgets ("stdimage", device, SZ_FNAME) == 0) + call error (1, "variable `stdimage' not defined in environment") + + # Pass frame number into IIS code. + call iis_setframe (frame) + + # Map the frame onto an image descriptor. + ds = imdmap (device, mode, imdopen) + # call imseti (ds, IM_CLOSEFD, YES) + chan[1] = fstati (imstati (ds, IM_PIXFD), F_CHANNEL) + chan[2] = MONO + + # Pick up the frame size. + iis_xdim = IM_LEN(ds,1) + iis_ydim = IM_LEN(ds,2) + iis_config = IM_LEN(ds,3) + + # Optimize for sequential i/o. + call imseti (ds, IM_ADVICE, SEQUENTIAL) + + # Display frame being loaded? + if (select_frame == YES) + call zfrmim (chan) + + return (ds) +end + +# IMD_MAPFRAME1 -- Open the given frame of the stdimage display device on an +# IMIO image descriptor. +# This differs from imd_mapframe only in the addition of the erase option. + +pointer procedure imd_mapframe1 (frame, mode, select_frame, erase) + +int frame #I frame to be opened [1:N] +int mode #I access mode +int select_frame #I make frame the display frame +int erase #I erase frame + +pointer ds +int chan[MAXCHAN] +char device[SZ_FNAME] + +pointer imdmap() +extern imdopen() +int imstati(), fstati(), envgets() +errchk imdmap, imseti +include "iis.com" + +begin + if (envgets ("stdimage", device, SZ_FNAME) == 0) + call error (1, "variable `stdimage' not defined in environment") + + # Pass frame number into IIS code. + call iis_setframe (frame) + + # Map the frame onto an image descriptor. + ds = imdmap (device, mode, imdopen) + # call imseti (ds, IM_CLOSEFD, YES) + chan[1] = fstati (imstati (ds, IM_PIXFD), F_CHANNEL) + chan[2] = MONO + + # Pick up the frame size. + iis_xdim = IM_LEN(ds,1) + iis_ydim = IM_LEN(ds,2) + iis_config = IM_LEN(ds,3) + + # Optimize for sequential i/o. + call imseti (ds, IM_ADVICE, SEQUENTIAL) + + # Display frame being loaded? + if (select_frame == YES) + call zfrmim (chan) + + # Erase frame being loaded? + if (erase == YES) + call zersim (chan) + + return (ds) +end diff --git a/pkg/images/tv/display/imdmapping.x b/pkg/images/tv/display/imdmapping.x new file mode 100644 index 00000000..049bef1b --- /dev/null +++ b/pkg/images/tv/display/imdmapping.x @@ -0,0 +1,194 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include "iis.h" +include "zdisplay.h" + +.help imd_setmapping, imd_getmapping, imd_query_map +.nf ____________________________________________________________________________ + + Interface routines for setting and getting display server mappings. + + imd_setmapping (region, sx,sy,snx,sny, dx,dy,dnx,dny, objref) + status = imd_getmapping (region, sx,sy,snx,sny, dx,dy,dnx,dny, objref) + status = imd_query_map (wcs, region, sx,sy,snx,sny, dx,dy,dnx,dny, objref) + +The imd_setmapping() procedure should be called prior to an imd_putwcs() +if the mapping information is to be sent with the next WCS write. The +imd_getmapping() function returns a non-zero status if the last WCS query +returned valid mapping information during the read. Both routines depend +upon a previous call to imd_wcsver() (imdmapping.x) to initialize the common +to query the server for this new capability. The imd_query_map() function +returns a non-zero status if a valid mapping is available for the given WCS +number (e.g. the wcs number returned by a cursor read can be entered and +information such as the image name can be returned for the associated mapping). + +.endhelp _______________________________________________________________________ + + +# IMD_SETMAPPING -- Set the mapping information to be sent with the next +# SETWCS command. + +procedure imd_setmapping (reg, sx, sy, snx, sny, dx, dy, dnx, dny, objref) + +char reg[SZ_FNAME] #i region name +real sx, sy #i source raster +int snx, sny +int dx, dy #i destination raster +int dnx, dny +char objref[SZ_FNAME] #i object reference + +bool streq() + +include "iis.com" + +begin + call strcpy (reg, iis_region, SZ_FNAME) + iis_sx = sx + iis_sy = sy + iis_snx = snx + iis_sny = sny + iis_dx = dx + iis_dy = dy + iis_dnx = dnx + iis_dny = dny + + if (streq (objref, "dev$pix")) + call fpathname ("dev$pix.imh", iis_objref, SZ_FNAME) + else + call strcpy (objref, iis_objref, SZ_FNAME) + + iis_valid = YES +end + + +# IMD_GETMAPPING -- Get the mapping information returned with the last +# GETWCS command. + +int procedure imd_getmapping (reg, sx, sy, snx, sny, dx, dy, dnx, dny, objref) + +char reg[SZ_FNAME] #o region name +real sx, sy #o source raster +int snx, sny +int dx, dy #o destination raster +int dnx, dny +char objref[SZ_FNAME] #o object reference + +include "iis.com" + +begin + if (iis_valid == YES) { + call strcpy (iis_region, reg, SZ_FNAME) + sx = iis_sx + sy = iis_sy + snx = iis_snx + sny = iis_sny + dx = iis_dx + dy = iis_dy + dnx = iis_dnx + dny = iis_dny + call strcpy (iis_objref, objref, SZ_FNAME) + } + return (iis_valid) +end + + +# IMD_QUERY_MAP -- Return the mapping information in the server for the +# specified WCS number. + +int procedure imd_query_map (wcs, reg, sx,sy,snx,sny, dx,dy,dnx,dny, objref) + +int wcs #i WCS number of request +char reg[SZ_FNAME] #o region name +real sx, sy #o source raster +int snx, sny +int dx, dy #o destination raster +int dnx, dny +char objref[SZ_FNAME] #o object reference + +pointer sp, wcstext, ip, ds +int fd, frame, chan, status, wcs_status, nl + +int fscan(), stropen(), iisflu() +pointer imd_mapframe1() + +include "iis.com" +define done_ 91 + +begin + call smark (sp) + call salloc (wcstext, SZ_WCSTEXT, TY_CHAR) + call aclrc (Memc[wcstext], SZ_WCSTEXT) + + wcs_status = ERR + iis_valid = NO + frame = wcs / 100 + ds = NULL + + if (iis_version > 0) { + + # If the channel isn't currently open, map the frame temporarily + # so we get a valid read. + if (iisnopen == 0) + ds = imd_mapframe1 (frame, READ_ONLY, NO, NO) + + # Retrieve the WCS information from a display server. + chan = iisflu(FRTOCHAN(frame)) + + # Query the server using the X register to indicate this is + # a "new form" of the WCS query, and pass the requested WCS in + # the T register (which is normally zero). + + call iishdr (IREAD+PACKED, SZ_WCSTEXT, WCS, 1, 0, chan, wcs) + call iisio (Memc[wcstext], SZ_WCSTEXT, status) + if (status > 0) + call strupk (Memc[wcstext], Memc[wcstext], SZ_WCSTEXT) + else + goto done_ + + + # Skip the wcs part of the string, we only want the mapping. + nl = 0 + for (ip=wcstext ; Memc[ip] != NULL; ip=ip+1) { + if (Memc[ip] == '\n') + nl = nl + 1 + if (nl == 2) + break + } + ip = ip + 1 + + # Open the string for reading. + iferr (fd = stropen (Memc[ip], SZ_WCSTEXT, READ_ONLY)) + fd = NULL + + # Decode the Mapping from the WCS text. + if (fd != NULL) { + if (fscan (fd) != EOF) { + call gargwrd (reg, SZ_FNAME) + call gargr (sx) + call gargr (sy) + call gargi (snx) + call gargi (sny) + call gargi (dx) + call gargi (dy) + call gargi (dnx) + call gargi (dny) + + if (fscan (fd) != EOF) { + call gargstr (objref, SZ_FNAME) + wcs_status = OK + iis_valid = YES + } + } + } + + # Close any temporary connection to the server. + if (ds != NULL) + call imunmap (ds) + } + +done_ if (fd != NULL) + call close (fd) + call sfree (sp) + return (wcs_status) +end diff --git a/pkg/images/tv/display/imdopen.x b/pkg/images/tv/display/imdopen.x new file mode 100644 index 00000000..85950270 --- /dev/null +++ b/pkg/images/tv/display/imdopen.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <knet.h> + +# IMDOPEN -- Open the image display device as a binary file. + +int procedure imdopen (fname, access_mode) + +char fname[ARB] +int access_mode, fopnbf() +extern zopnim(), zclsim(), zardim(), zawrim(), zawtim(), zsttim() + +begin + return (fopnbf (fname, access_mode, + zopnim, zardim, zawrim, zawtim, zsttim, zclsim)) +end diff --git a/pkg/images/tv/display/imdputwcs.x b/pkg/images/tv/display/imdputwcs.x new file mode 100644 index 00000000..a7b55c8c --- /dev/null +++ b/pkg/images/tv/display/imdputwcs.x @@ -0,0 +1,139 @@ +include <imhdr.h> +include <error.h> +include <imset.h> +include <fset.h> +include "display.h" +include "iis.h" + + +# IMD_PUTWCS -- Write WCS. + +procedure imd_putwcs (ds, frame, str1, str2, a, b, c, d, tx, ty, z1, z2, ztr) +pointer ds #I IMIO descriptor for image display. +int frame #I Frame number for which WCS is to be set. +char str1[ARB] #I First title string (image name). +char str2[ARB] #I Second title string (image title). +real a, d #I x, y scale factors. +real b, c #I cross terms (rotations). +real tx, ty #I x, y offsets. +real z1, z2 #I min and maximum grey scale values. +int ztr #I greyscale transformation code. + +pointer sp, old_wcs, mapping, wcstext, dir, fname, ftemp, device +int wcsfile, server, chan[MAXCHAN] +int fstati(), imstati(), envfind(), open(), strncmp() + +include "iis.com" + +begin + call smark (sp) + call salloc (old_wcs, SZ_WCSTEXT, TY_CHAR) + call salloc (mapping, SZ_WCSTEXT, TY_CHAR) + call salloc (wcstext, SZ_WCSTEXT, TY_CHAR) + + # Format the WCS text. + call sprintf (Memc[old_wcs], SZ_WCSTEXT, + "%s - %s\n%g %g %g %g %g %g %g %g %d\n") + call pargstr (str1) + call pargstr (str2) + call pargr (a) + call pargr (b) + call pargr (c) + call pargr (d) + call pargr (tx) + call pargr (ty) + call pargr (z1) + call pargr (z2) + call pargi (ztr) + + # Add the mapping information if it's valid and we have a capable + # server. + if (iis_version > 0 && iis_valid == YES) { + call sprintf (Memc[mapping], SZ_WCSTEXT, + "%s %g %g %d %d %d %d %d %d\n%s\n") + call pargstr (iis_region) + call pargr (iis_sx) + call pargr (iis_sy) + call pargi (iis_snx) + call pargi (iis_sny) + call pargi (iis_dx) + call pargi (iis_dy) + call pargi (iis_dnx) + call pargi (iis_dny) + call pargstr (iis_objref) + + call sprintf (Memc[wcstext], SZ_WCSTEXT, "%s%s") + call pargstr (Memc[old_wcs]) + call pargstr (Memc[mapping]) + } else + call strcpy (Memc[old_wcs], Memc[wcstext], SZ_OLD_WCSTEXT) + + + # If we are writing to a display server (device has the logical + # cursor capability), output the WCS text via the datastream, + # else use a text file. The datastream set-WCS is also used to + # pass the frame buffer configuration to server devices. + + server = IM_LEN (ds, 4) + + if (server == YES) { + chan[1] = fstati (imstati (ds, IM_PIXFD), F_CHANNEL) + chan[2] = MONO + call imd_setwcs (chan, Memc[wcstext]) + + # Invalidate the mapping once it's been sent. + iis_valid = NO + + } else { + # Construct the WCS filename, "dir$device_frame.wcs". + call salloc (dir, SZ_PATHNAME, TY_CHAR) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (ftemp, SZ_PATHNAME, TY_CHAR) + call salloc (device, SZ_FNAME, TY_CHAR) + + if (envfind ("wcsdir", Memc[dir], SZ_PATHNAME) <= 0) + if (envfind ("WCSDIR", Memc[dir], SZ_PATHNAME) <= 0) + if (envfind ("uparm", Memc[dir], SZ_PATHNAME) <= 0) + call strcpy ("tmp$", Memc[dir], SZ_PATHNAME) + + if (envfind ("stdimage", Memc[device], SZ_FNAME) <= 0) + call strcpy ("display", Memc[device], SZ_FNAME) + + # Get a temporary file in the WCS directory. + call sprintf (Memc[ftemp], SZ_PATHNAME, "%swcs") + call pargstr (Memc[dir]) + call mktemp (Memc[ftemp], Memc[ftemp], SZ_PATHNAME) + + # Make the final WCS file filename. + call sprintf (Memc[fname], SZ_PATHNAME, "%s%s_%d.wcs") + call pargstr (Memc[dir]) + if (strncmp (Memc[device], "imt", 3) == 0) + call pargstr ("imtool") + else + call pargstr (Memc[device]) + call pargi (frame) + + # Update the WCS file. + iferr (wcsfile = open (Memc[ftemp], TEMP_FILE, TEXT_FILE)) + call erract (EA_WARN) + else { + # Now delete the old file, if any, and write the new one. + # To avoid process race conditions, create the new file as an + # atomic operation, first writing a new file and then renaming + # it to create the WCS file. + + iferr (call delete (Memc[fname])) + ; + + # Output the file version. + call putline (wcsfile, Memc[wcstext]) + call close (wcsfile) + + # Install the new file. + iferr (call rename (Memc[ftemp], Memc[fname])) + call erract (EA_WARN) + } + } + + call sfree (sp) +end diff --git a/pkg/images/tv/display/imdrcur.x b/pkg/images/tv/display/imdrcur.x new file mode 100644 index 00000000..34148b5b --- /dev/null +++ b/pkg/images/tv/display/imdrcur.x @@ -0,0 +1,117 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> + +# IMDRCUR -- Read the logical image cursor of the named image display device. +# opened with IMDOPEN). This is a high level cursor read, returning image +# pixel coordinates and relying upon the display server to use the keyboard or +# mouse to terminate the cursor read. Nonblocking reads and frame buffer +# coordinates are available as options. The user is expected to select the +# frame for which coordintes are to be returned; the frame number is returned +# in the encoded WCS. The cursor key is returned as the function value. + +int procedure imdrcur (device, x, y, wcs, key, strval, maxch, in_wcs, pause) + +char device[ARB] #I image display device +real x, y #O cursor coords given WCS +int wcs #O WCS of coordinates (frame*100+in_wcs) +int key #O keystroke which triggered cursor read +char strval[maxch] #O optional string value +int maxch #I max chars out +int in_wcs #I desired wcs: 0=frame, 1=image +int pause #I blocking cursor read? (YES|NO) + +char ch +int fd, op +pointer sp, curval, devname, tty, dd, ip + +bool streq() +pointer ttygdes() +int imdopen(), ttygets(), envgets(), nscan(), stg_getline() + +string eof "EOF\n" +string stdimage "stdimage" +errchk ttygdes, imdopen, imdrcuro + +begin + call smark (sp) + call salloc (devname, SZ_FNAME, TY_CHAR) + call salloc (curval, SZ_LINE, TY_CHAR) + call salloc (dd, SZ_LINE, TY_CHAR) + + # Get the logical device name. + if (streq (device, stdimage)) { + if (envgets (stdimage, Memc[devname], SZ_FNAME) <= 0) + call strcpy (device, Memc[devname], SZ_FNAME) + } else + call strcpy (device, Memc[devname], SZ_FNAME) + + # Get the DD kernel driver string for the device. + tty = ttygdes (Memc[devname]) + if (ttygets (tty, "DD", Memc[dd], SZ_LINE) <= 0) + call strcpy (Memc[devname], Memc[dd], SZ_FNAME) + + # Open the device and read the logical image cursor. + fd = imdopen (Memc[dd], READ_WRITE) + call imdrcuro (tty, Memc[curval], SZ_LINE, in_wcs, pause) + + # Decode the formatted cursor value string. + if (streq (Memc[curval], eof)) { + key = EOF + } else { + call sscan (Memc[curval]) + call gargr (x) + call gargr (y) + call gargi (wcs) + call gargc (ch) + call gargstr (Memc[curval], SZ_LINE) + + key = ch + if (nscan() < 4) + key = ERR + + ip = curval + if (nscan() < 5) + Memc[curval] = EOS + else { + while (IS_WHITE(Memc[ip]) || Memc[ip] == '\n') + ip = ip + 1 + } + } + + # In this implementation, string input for colon commands is via the + # terminal to avoid the complexities of character i/o to the display. + # Note that the lower level code can return the string value if it + # chooses to (must be a nonnull string). + + strval[1] = EOS + if (key == ':') { + # String value not already set by imdrcuro? + if (Memc[ip] == EOS) { + call stg_putline (STDOUT, ":") + if (stg_getline (STDIN, Memc[curval]) == EOF) + Memc[curval] = EOS + else + for (ip=curval; IS_WHITE (Memc[ip]); ip=ip+1) + ; + } + + # Copy to the output string argument. + op = 1 + while (Memc[ip] != '\n' && Memc[ip] != EOS) { + strval[op] = Memc[ip] + op = min (op + 1, maxch) + ip = ip + 1 + } + strval[op] = EOS + } + + # Map ctrl/d and ctrl/z onto EOF. + if (key == '\004' || key == '\032') + key = EOF + + call close (fd) + call ttycdes (tty) + + return (key) +end diff --git a/pkg/images/tv/display/imdrcuro.x b/pkg/images/tv/display/imdrcuro.x new file mode 100644 index 00000000..2296fd03 --- /dev/null +++ b/pkg/images/tv/display/imdrcuro.x @@ -0,0 +1,206 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <chars.h> +include <ctype.h> +include "zdisplay.h" +include "iis.h" + +define NEXT_FRAME '\006' +define PREV_FRAME '\022' +define TOGGLE_MARK '\015' + +# IMDRCURO -- Read the logical image cursor from an already opened image +# display device (opened with IMDOPEN). This is a high level cursor read, +# returning image pixel coordinates and relying upon the display server to use +# the keyboard or mouse to terminate the cursor read. Nonblocking reads and +# frame buffer coordinates are available as options. The cursor value is +# returned as an ascii string encoded as follows: +# +# wx wy wcs key [strval] +# +# where WX,WY are the cursor coordinates in the coordinate system defined by +# WCS (= framenumber*100 + wcs, wcs=0 for frame buffer coordinates, wcs=1 for +# image pixel coordinates, the default), KEY is the keystroke used to terminate +# the cursor read, and STRVAL is the string value of the cursor, if key=':' +# (a colon command). Nonprintable keys are returned as octal escapes. + +procedure imdrcuro (tty, outstr, maxch, wcs, pause) + +pointer tty #I graphcap descriptor for device +char outstr[maxch] #O formatted output cursor value +int maxch #I max chars out +int wcs #I desired wcs: 0=framecoords, 1=imagecoords +int pause #I blocking cursor read? (YES|NO) + +short cursor[3] +char key, str[1] +short split[LEN_SPLIT] +pointer sp, strval, imcurval +real a, b, c, d, tx, ty, wx, wy +int status, frame, tid, z, n, keystat, sx, sy, ip, chan, i + +bool mark_cursor +data mark_cursor /false/ + +bool ttygetb() +int rdukey(), ttygeti(), cctoc(), iisflu(), imd_getwcs() +define again_ 91 +include "iis.com" + +begin + call smark (sp) + call salloc (strval, SZ_LINE, TY_CHAR) + call salloc (imcurval, SZB_IMCURVAL, TY_CHAR) + + if (ttygetb (tty, "LC")) { + # Logical image cursor read; the display server supports the + # logical image cursor read as an atomic operation, via the + # logical subunit IMCURSOR (an IRAF special extension to the + # regular IIS datastream protocol). + + if (pause == NO) + tid = IREAD + SAMPLE + else + tid = IREAD + + call iishdr (tid, SZB_IMCURVAL, COMMAND+IMCURSOR, 0,0, wcs, 0) + + call iisio (Memc[imcurval], SZB_IMCURVAL, status) + if (status <= 0) + call strcpy ("EOF\n", outstr, maxch) + else + call strupk (Memc[imcurval], outstr, maxch) + + } else { + # IIS compatible cursor read. Implement the logical cursor read + # using only the primitive IIS cursor functions and the terminal + # driver, accessing the WCS file directly to get the coordinate + # transformation from IIS device coords to image pixel coords. + + # Pick up the frame size and configuration number. + iis_xdim = ttygeti (tty, "xr") + iis_ydim = ttygeti (tty, "yr") + iis_config = ttygeti (tty, "cn") +again_ + if (pause == YES) { + # Enable cursor blink to indicate cursor read in progress. + call iishdr (IWRITE+VRETRACE,1,COMMAND+CURSOR, ADVXONTC, 0,0,0) + cursor[1] = 57B + call iisio (cursor, SZ_SHORT * SZB_CHAR, status) + + # Wait for the user to type a key on the keyboard. The value + # is returned as a newline delimited string. + + keystat = rdukey (Memc[strval], SZ_LINE) + + } else { + Memc[strval] = '\n' + Memc[strval+1] = EOS + keystat = 1 + } + + # Sample the cursor position. + call iisrcr (status, sx, sy) + sx = sx / MCXSCALE + sy = sy / MCYSCALE + + # Determine which frame was being displayed. + call iishdr (IREAD, LEN_SPLIT, COMMAND+LUT, ADVXONTC, 0,0,0) + call iisio (split, LEN_SPLIT * SZB_CHAR, status) + + z = split[1] + if (z == 0) + z = 1 + for (n=1; and(z,1) == 0; z = z / 2) + n = n + 1 + frame = max(1, min(4, n)) + chan = FRTOCHAN(frame) + + if (pause == YES) { + # Turn off cursor blink. + call iishdr (IWRITE+VRETRACE,1,COMMAND+CURSOR, ADVXONTC, 0,0,0) + cursor[1] = 47B + call iisio (cursor, SZ_SHORT * SZB_CHAR, status) + } + + # Decode the trigger keystroke. + ip = 1 + if (cctoc (Memc[strval], ip, key) <= 0) + key = 0 + + # Check for the builtin pseudo "cursor mode" commands. + switch (key) { + case NEXT_FRAME: + # Display the next frame in sequence. + frame = frame + 1 + if (frame > 4) + frame = 1 + chan = IIS_CHAN * DEVCODE + frame + call iisrgb (chan, chan, chan) + goto again_ + case PREV_FRAME: + # Display the previous frame. + frame = frame - 1 + if (frame <= 0) + frame = 1 + chan = IIS_CHAN * DEVCODE + frame + call iisrgb (chan, chan, chan) + goto again_ + case TOGGLE_MARK: + # Toggle the mark cursor enable. + mark_cursor = !mark_cursor + goto again_ + } + + # Mark the cursor position by editing the frame buffer. + if (mark_cursor && keystat > 1 && key != '\004' && key != '\032') { + do i = 1, 3 + cursor[i] = 1 + call achtsb (cursor, cursor, 3) + + call iishdr (IWRITE+BYPASSIFM+PACKED+VRETRACE, 3, REFRESH, + or(sx-1,ADVXONTC), or(sy-1,ADVYONXOV), + iisflu(chan), ALLBITPL) + call iisio (cursor, 3, status) + + call iishdr (IWRITE+BYPASSIFM+PACKED+VRETRACE, 3, REFRESH, + or(sx-1,ADVXONTC), or(sy,ADVYONXOV), + iisflu(chan), ALLBITPL) + call iisio (cursor, 3, status) + + call iishdr (IWRITE+BYPASSIFM+PACKED+VRETRACE, 3, REFRESH, + or(sx-1,ADVXONTC), or(sy+1,ADVYONXOV), + iisflu(chan), ALLBITPL) + call iisio (cursor, 3, status) + } + + # Perform the transformation to image pixel coordinates. + if (wcs != 0) { + if (imd_getwcs (frame,NO, str,0,str,0, a,b,c,d,tx,ty) == ERR) { + call eprintf ("Warning: cannot retrieve WCS for frame %d\n") + call pargi (frame) + } + if (abs(a) > .001) + wx = sx * a + tx + if (abs(d) > .001) + wy = sy * d + ty + } else { + wx = sx + wy = sy + } + + # Format the output cursor value string. + if (keystat == EOF) + call strcpy ("EOF\n", outstr, maxch) + else { + call sprintf (outstr, maxch, "%.6g %.6g %d %s") + call pargr (wx) + call pargr (wy) + call pargi (frame * 100 + wcs) + call pargstr (Memc[strval]) + } + } + + call sfree (sp) +end diff --git a/pkg/images/tv/display/imdsetwcs.x b/pkg/images/tv/display/imdsetwcs.x new file mode 100644 index 00000000..98e8afdc --- /dev/null +++ b/pkg/images/tv/display/imdsetwcs.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <knet.h> +include <mach.h> +include "iis.h" + +# IMD_SETWCS -- Pass the WCS for the indicated reference frame to a display +# server. The frame buffer configuration is also passed. + +procedure imd_setwcs (chan, wcstext) + +int chan #I display channel code (frame) +char wcstext[ARB] #I wcs text + +pointer sp, pkwcs +int status, count +int strlen(), iisflu() +include "iis.com" + +begin + count = strlen (wcstext) + 1 + + call smark (sp) + call salloc (pkwcs, count, TY_CHAR) + call strpak (wcstext, Memc[pkwcs], count) + + call iishdr (IWRITE+PACKED, count, WCS, iis_version, 0, iisflu(chan), + max(0,iis_config-1)) + call iisio (Memc[pkwcs], count, status) + + call sfree (sp) +end diff --git a/pkg/images/tv/display/imdwcs.x b/pkg/images/tv/display/imdwcs.x new file mode 100644 index 00000000..66d6b4b5 --- /dev/null +++ b/pkg/images/tv/display/imdwcs.x @@ -0,0 +1,118 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +.help imdwcs +.nf ------------------------------------------------------------------------- +IMDWCS -- Simple interim WCS package for the display interface. This is a +restricted use interface which will be obsoleted by a future interface. + + iw = iw_open (ds, frame, imname, sz_imname, status) + iw_fb2im (iw, fb_x,fb_y, im_x,im_y) + iw_im2fb (iw, im_x,im_y, fb_x,fb_y) + iw_close (iw) + + +This facility uses the WCSDIR file mechanism to retrieve the WCS information +for a display frame. The display name is given by the current value of the +'stdimage' environment variable. Although the WCSDIR info supports a full +2D rotation matrix we recognize only scale and shift terms here. + +NOTE -- The frame buffer coordinates used here are defined in the coordinate +system of the DISPLAY program, IMD_MAPFRAME, etc., i.e., the origin is at the +lower left corner of the frame, and the system is one-indexed. The WCS file, +on the other hand, stores device frame buffer coordinates, which are zero +indexed with the origin at the upper left. +.endhelp -------------------------------------------------------------------- + +define LEN_IWDES 6 + +define IW_A Memr[P2R($1)] # x scale +define IW_B Memr[P2R($1+1)] # cross term (not used) +define IW_C Memr[P2R($1+2)] # cross term (not used) +define IW_D Memr[P2R($1+3)] # y scale +define IW_TX Memr[P2R($1+4)] # x shift +define IW_TY Memr[P2R($1+5)] # y shift + + +# IW_OPEN -- Retrieve the WCS information for the given frame of the stdimage +# display device. If the WCS for the frame cannot be accessed for any reason +# a unitary transformation is returned and wcs_status is set to ERR. Note that +# this is not a hard error, i.e., a valid descriptor is still returned. + +pointer procedure iw_open (ds, frame, imname, sz_imname, wcs_status) + +pointer ds #I display image descriptor +int frame #I frame number for which WCS is desired +char imname[ARB] #O receives name of image loaded into frame (if any) +int sz_imname #I max chars out to imname[]. +int wcs_status #O ERR if WCS cannot be accessed, OK otherwise + +pointer iw +int server +char junk[1] +int imd_getwcs() +errchk calloc + +begin + call calloc (iw, LEN_IWDES, TY_STRUCT) + + # Get the WCS. + server = IM_LEN(ds,4) + wcs_status = imd_getwcs (frame, server, imname, sz_imname, junk,0, + IW_A(iw), IW_B(iw), IW_C(iw), IW_D(iw), IW_TX(iw), IW_TY(iw)) + + # Avoid divide by zero problems if invalid WCS. + if (abs(IW_A(iw)) < .0001 || abs(IW_D(iw)) < .0001) { + + IW_A(iw) = 1.0; IW_D(iw) = 1.0 + IW_TX(iw) = 0.0; IW_TY(iw) = 0.0 + wcs_status = ERR + + } else { + # Convert hardware FB to display FB coordinates. + IW_TY(iw) = IW_TY(iw) + (IW_D(iw) * (IM_LEN(ds,2)-1)) + IW_D(iw) = -IW_D(iw) + } + + return (iw) +end + + +# IW_FB2IM -- Convert frame buffer coordinates to image pixel coordinates. + +procedure iw_fb2im (iw, fb_x,fb_y, im_x,im_y) + +pointer iw #I imd wcs descriptor +real fb_x,fb_y #I frame buffer X,Y coordinates +real im_x,im_y #O image pixel X,Y coordinates + +begin + im_x = (fb_x - 1) * IW_A(iw) + IW_TX(iw) + im_y = (fb_y - 1) * IW_D(iw) + IW_TY(iw) +end + + +# IW_IM2FB -- Convert image pixel coordinates to frame buffer coordinates. + +procedure iw_im2fb (iw, im_x,im_y, fb_x,fb_y) + +pointer iw #I imd wcs descriptor +real im_x,im_y #I image pixel X,Y coordinates +real fb_x,fb_y #O frame buffer X,Y coordinates + +begin + fb_x = (im_x - IW_TX(iw)) / IW_A(iw) + 1 + fb_y = (im_y - IW_TY(iw)) / IW_D(iw) + 1 +end + + +# IW_CLOSE -- Close the IW descriptor. + +procedure iw_close (iw) + +pointer iw #I imd wcs descriptor + +begin + call mfree (iw, TY_STRUCT) +end diff --git a/pkg/images/tv/display/imdwcsver.x b/pkg/images/tv/display/imdwcsver.x new file mode 100644 index 00000000..f8fd9a08 --- /dev/null +++ b/pkg/images/tv/display/imdwcsver.x @@ -0,0 +1,65 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "iis.h" +include "zdisplay.h" + +# IMD_WCSVER -- Query the server for the WCS version supported. A zero +# will be returned for the "old" wcs format used, otherwise the server +# will return a version identifier. + +int procedure imd_wcsver () + +pointer ds +int chan, status, frame, ip +char wcstext[SZ_OLD_WCSTEXT] + +int strncmp(), ctoi(), iisflu() +pointer imd_mapframe1() +bool envgetb() + +include "iis.com" + +begin + iis_valid = NO # initialize + + # Check the environment for a flag to disable the new WCS info. + if (envgetb ("disable_wcs_maps")) { + iis_version = 0 + return (iis_version) + } + + # Open a temporary connection to the server if needed. + ds = NULL + if (iisnopen == 0) + ds = imd_mapframe1 (1, READ_ONLY, NO, NO) + + # Send a WCS query with the X and Y register set. This tells a + # knowledgeable server to reply with a WCS version string, + # otherwise it is a no-op and we get the normal WCS response + # indicating the old format. + + frame = 1 + chan = iisflu (FRTOCHAN(frame)) + call aclrc (wcstext, SZ_OLD_WCSTEXT) + call iishdr (IREAD+PACKED, SZ_OLD_WCSTEXT, WCS, 1, 1, chan, 0) + call iisio (wcstext, SZ_OLD_WCSTEXT, status) + if (status > 0) + call strupk (wcstext, wcstext, SZ_OLD_WCSTEXT) + else { + iis_version = 0 + call imunmap (ds) + return (iis_version) + } + + # Decode the version from the WCS text. + if (strncmp (wcstext, "version=", 8) == 0) { + ip = 9 + status = ctoi (wcstext, ip, iis_version) + } else + iis_version = 0 + + + if (ds != NULL) + call imunmap (ds) + return (iis_version) +end diff --git a/pkg/images/tv/display/maskcolor.x b/pkg/images/tv/display/maskcolor.x new file mode 100644 index 00000000..aa78d77b --- /dev/null +++ b/pkg/images/tv/display/maskcolor.x @@ -0,0 +1,478 @@ +include <ctotok.h> +include <evvexpr.h> +include "ace.h" + +define COLORS "|black|white|red|green|blue|yellow|cyan|magenta|transparent|" +define DEFCOLOR 203 + + +# MASKCOLOR_MAP -- Create the mask colormap object. + +pointer procedure maskcolor_map (colorstring) + +char colorstring #I Color specification string +pointer colors #O Mask colormap object + +int i, j, ip, ncolors, token, lasttoken, maskval1, maskval2, color, offset +int strdic(), ctoi(), nowhite() +pointer sp, str, op + +int coltrans[9] +data coltrans/202,203,204,205,206,207,208,209,-1/ + +define err_ 10 + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # If the colorstring is an expression just save the string + # and set the number of colors to 0. + i = nowhite (colorstring, Memc[str], SZ_LINE) + if (Memc[str] == '(') { + call malloc (colors, SZ_LINE, TY_INT) + call malloc (op, LEN_OPERAND, TY_STRUCT) + Memi[colors] = 0 + Memi[colors+1] = op + call strcpy (colorstring, Memc[P2C(colors+2)], SZ_LINE) + O_TYPE(op) = TY_INT + O_VALP(op) = NULL + O_FLAGS(op) = O_FREEOP + # Check expression here. + return (colors) + } + + # Allocate memory for the colormap object. + call malloc (colors, 4*10, TY_INT) + + # Initialize + ncolors = 1 + maskval1 = INDEFI + maskval2 = INDEFI + color = DEFCOLOR + offset = NO + + Memi[colors] = ncolors + Memi[colors+2] = color + Memi[colors+3] = offset + + # Parse the color specification. + token = 0 + call sscan (colorstring) + repeat { + lasttoken = token + call gargtok (token, Memc[str], SZ_LINE) + switch (token) { + case TOK_IDENTIFIER: + call strlwr (Memc[str]) + i = strdic (Memc[str], Memc[str], SZ_LINE, COLORS) + if (i == 0) + goto err_ + color = coltrans[i] + case TOK_NUMBER: + if (lasttoken == TOK_NUMBER) { + if (Memc[str] != '-') + goto err_ + ip = 2 + if (ctoi (Memc[str], ip, maskval2) == 0) + goto err_ + } else { + if (Memc[str] == '+') { + offset = YES + ip = 2 + } else if (Memc[str] == '-') { + offset = YES + ip = 1 + } else + ip = 1 + if (ctoi (Memc[str], ip, color) == 0) + goto err_ + if (lasttoken != TOK_OPERATOR) + maskval2 = color + } + case TOK_OPERATOR: + if (Memc[str] != '=' || lasttoken != TOK_NUMBER) + goto err_ + maskval1 = min (color, maskval2) + maskval2 = max (color, maskval2) + + if (Memc[str+1] == '+') { + call gargtok (token, Memc[str+2], SZ_LINE) + offset = YES + ip = 3 + if (ctoi (Memc[str], ip, color) == 0) + goto err_ + } else if (Memc[str+1] == '-') { + call gargtok (token, Memc[str+2], SZ_LINE) + offset = YES + ip = 2 + if (ctoi (Memc[str], ip, color) == 0) + goto err_ + } + case TOK_PUNCTUATION, TOK_EOS: + if (Memc[str] != ',' && Memc[str] != EOS) + goto err_ + if (!IS_INDEFI(maskval1)) { + do i = 2, ncolors { + j = 4 * i - 4 + if (Memi[colors+j] == maskval1 && + Memi[colors+j+1] == maskval2) + break + } + if (i > ncolors) { + if (mod (ncolors, 10) == 0) + call realloc (colors, 4*(ncolors+10), TY_INT) + ncolors = ncolors + 1 + } + j = 4 * i - 4 + Memi[colors+j] = maskval1 + Memi[colors+j+1] = maskval2 + Memi[colors+j+2] = color + Memi[colors+j+3] = offset + } else { + Memi[colors+2] = color + Memi[colors+3] = offset + } + if (token == TOK_EOS) + break + maskval1 = INDEFI + maskval2 = INDEFI + offset = NO + default: + goto err_ + } + } + + Memi[colors] = ncolors + call sfree (sp) + return (colors) + +err_ + call mfree (colors, TY_INT) + call sfree (sp) + call error (1, "Error in color specifications") +end + + +# MASKCOLOR_FREE -- Free the mask color object. + +procedure maskcolor_free (colors) + +pointer colors #I Mask colormap object + +begin + if (Memi[colors] == 0) + call evvfree (Memi[colors+1]) + call mfree (colors, TY_INT) +end + + +# MASKCOLOR -- Return a color for a mask value. + +int procedure maskcolor (colors, maskval) + +pointer colors #I Mask colormap object +int maskval #I Mask value +int color #O Color value + +int i, j, offset + +begin + # If there is no color array return the mask value. + if (Memi[colors] == 0) + return (maskval) + + color = Memi[colors+2] + offset = Memi[colors+3] + do i = 2, Memi[colors] { + j = 4 * i - 4 + if (maskval >= Memi[colors+j] && maskval <= Memi[colors+j+1]) { + color = Memi[colors+j+2] + offset = Memi[colors+j+3] + break + } + } + + if (offset == YES) + color = maskval + color + return (color) +end + + +procedure maskexprn (colors, maskvals, nmaskvals) + +pointer colors #I Mask colormap object +pointer maskvals #O Pointer to mask values (TY_INT) +int nmaskvals #I Number of mask values + +int i +pointer op, o, evvexpr() +errchk evvexpr + +int locpr +extern maskoperand, maskfunc + +begin + if (Memi[colors] > 0) + return + + op = Memi[colors+1] + O_LEN(op) = nmaskvals + O_VALP(op) = maskvals + + o = evvexpr (Memc[P2C(colors+2)], locpr(maskoperand), op, + locpr(maskfunc), NULL, O_FREEOP) + + #call amovi (Memi[O_VALP(o)], Memi[maskvals], nmaskvals) + switch (O_TYPE(o)) { + case TY_SHORT: + do i = 0, O_LEN(o) { + if (Memi[maskvals+i] > 0) + Memi[maskvals+i] = max (0, Mems[O_VALP(o)+i]) + } + case TY_BOOL, TY_INT: + do i = 0, O_LEN(o) { + if (Memi[maskvals+i] > 0) + Memi[maskvals+i] = max (0, Memi[O_VALP(o)+i]) + } + case TY_REAL: + do i = 0, O_LEN(o) { + if (Memi[maskvals+i] > 0) + Memi[maskvals+i] = max (0, nint(Memr[O_VALP(o)+i])) + } + case TY_DOUBLE: + do i = 0, O_LEN(o) { + if (Memi[maskvals+i] > 0) + Memi[maskvals+i] = max (0, nint(Memd[O_VALP(o)+i])) + } + } + + call evvfree (o) +end + + +# MASKOPERAND -- Handle mask expression operands. + +procedure maskoperand (op, operand, o) + +pointer op #I Input operand pointer +char operand[ARB] #I Operand name +pointer o #O Operand object + +char str[10] +int i, coltrans[9], strdic() +data coltrans/202,203,204,205,206,207,208,209,-1/ + +begin + if (operand[1] == '$') { + call xvv_initop (o, O_LEN(op), O_TYPE(op)) + call amovi (Memi[O_VALP(op)], Memi[O_VALP(o)], O_LEN(op)) + return + } + + call strcpy (operand, str, 11) + call strlwr (str) + i = strdic (str, str, 11, COLORS) + if (i > 0) { + call xvv_initop (o, 0, TY_INT) + O_VALI(o) = coltrans[i] + return + } + + call xvv_error1 ("Unknown mask operand %s", operand) +end + + +define KEYWORDS "|acenum|colors|" + +define F_ACENUM 1 # acenum (maskcodes,[flags]) +define F_COLORS 2 # colors (maskcodes,[col1,col2,col3]) + +# MASKFUNC -- Special processing functions. + +procedure maskfunc (data, func, args, nargs, val) + +pointer data #I client data +char func[ARB] #I function to be called +pointer args[ARB] #I pointer to arglist descriptor +int nargs #I number of arguments +pointer val #O output operand (function value) + +char str[12] +int i, j, c1, c2, c3 +int iresult, optype, oplen, opcode, v_nargs +double dresult + +bool strne() +int strdic(), btoi(), andi() +errchk malloc + +begin + # Lookup the function name in the dictionary. An exact match is + # required (strdic permits abbreviations). Abort if the function + # is not known. + + opcode = strdic (func, str, 12, KEYWORDS) + if (strne (func, str)) + call xvv_error1 ("unknown function `%s' called", func) + + # Verify correct number of arguments. + switch (opcode) { + case F_ACENUM, F_COLORS: + v_nargs = -1 + default: + v_nargs = 1 + } + + if (v_nargs > 0 && nargs != v_nargs) + call xvv_error2 ("function `%s' requires %d arguments", + func, v_nargs) + else if (v_nargs < 0 && nargs < abs(v_nargs)) + call xvv_error2 ("function `%s' requires at least %d arguments", + func, abs(v_nargs)) + + # Group some common operations. + switch (opcode) { + case F_ACENUM: + # Check types of arguments. + if (O_TYPE(args[1]) != TY_INT) + call xvv_error1 ("error in argument types for function `%s'", + func) + if (nargs > 1) { + if (O_TYPE(args[2]) != TY_CHAR) + call xvv_error1 ( + "error in argument types for function `%s'", func) + } + optype = TY_INT + oplen = O_LEN(args[1]) + if (oplen > 0) + call malloc (iresult, oplen, TY_INT) + case F_COLORS: + # Check types of arguments. + do i = 1, nargs { + if (O_TYPE(args[i]) != TY_INT) + call xvv_error1 ("function `%s' requires integer arguments", + func) + } + optype = TY_INT + oplen = O_LEN(args[1]) + if (oplen > 0) + call malloc (iresult, oplen, TY_INT) + } + + # Evaluate the function. + switch (opcode) { + case F_ACENUM: + if (nargs == 1) + call strcpy ("BDEG", str, 12) + else + call strcpy (O_VALC(args[2]), str, 12) + call strupr (str) + c1 = 0; c2 = 0 + for (i=1; str[i]!=EOS; i=i+1) { + switch (str[i]) { + case 'B': + c1 = c1 + MASK_BP + case 'D': + c2 = c2 + MASK_GRW + MASK_SPLIT + case 'E': + c1 = c1 + MASK_BNDRY + case 'F': + c1 = c1 + MASK_BPFLAG + case 'G': + c1 = c1 + MASK_GRW + case 'S': + c1 = c1 + MASK_SPLIT + } + } + + if (oplen == 0) { + i = O_VALI(args[1]) + if (i > 10) { + if (andi(i,c1)!=0 && andi(i,c2)==0) + i = MNUM(i) + else + i = -1 + } else + i = 0 + iresult = i + } else { + do j = 0, oplen-1 { + i = Memi[O_VALP(args[1])+j] + if (i > 10) { + if (andi(i,c1)!=0) + i = MNUM(i) + else if (c2 != 0 && i <= MASK_NUM) + i = MNUM(i) + else + i = -1 + } else + i = 0 + Memi[iresult+j] = i + } + } + case F_COLORS: + c1 = 0; c2 = 204; c3 = 217 + if (nargs > 1) + c1 = O_VALI(args[2]) + if (nargs > 2) { + c2 = O_VALI(args[3]) + c3 = c2 + } + if (nargs > 3) + c3 = O_VALI(args[4]) + if (c3 < c2) { + i = c2; c2 = c3; c3 = i + } + c3 = c3 - c2 + 1 + + optype = TY_INT + oplen = O_LEN(args[1]) + if (oplen == 0) { + i = O_VALI(args[1]) + if (i == 0) + i = c1 + else if (i > 0) + i = c2 + mod (i-1, c3) + iresult = i + } else { + do j = 0, oplen-1 { + i = Memi[O_VALP(args[1])+j] + if (i == 0) + i = c1 + else if (i > 0) + i = c2 + mod (i-1, c3) + Memi[iresult+j] = i + } + } + } + + # Write the result to the output operand. Bool results are stored in + # iresult as an integer value, string results are stored in iresult as + # a pointer to the output string, and integer and real/double results + # are stored in iresult and dresult without any tricks. + + call xvv_initop (val, oplen, optype) + if (oplen == 0) { + switch (optype) { + case TY_BOOL: + O_VALI(val) = btoi (iresult != 0) + case TY_CHAR: + O_VALP(val) = iresult + case TY_INT: + O_VALI(val) = iresult + case TY_REAL: + O_VALR(val) = dresult + case TY_DOUBLE: + O_VALD(val) = dresult + } + } else { + O_VALP(val) = iresult + O_FLAGS(val) = O_FREEVAL + } + + # Free any storage used by the argument list operands. + do i = 1, nargs + call xvv_freeop (args[i]) + +end diff --git a/pkg/images/tv/display/maxmin.x b/pkg/images/tv/display/maxmin.x new file mode 100644 index 00000000..30f281f7 --- /dev/null +++ b/pkg/images/tv/display/maxmin.x @@ -0,0 +1,54 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imhdr.h> +include "iis.h" + +# MAXMIN -- Get the minimum and maximum pixel values of an image. If valid +# header values are available they are used, otherwise the image is sampled +# on an even grid and the min and max values of this sample are returned. + +procedure maxmin (im, zmin, zmax, nsample_lines) + +pointer im +real zmin, zmax # min and max intensity values +int nsample_lines # amount of image to sample + +int step, ncols, nlines, sample_size, imlines, i +real minval, maxval +pointer imgl2r() +include "iis.com" + +begin + # Only calculate minimum, maximum pixel values if the current + # values are unknown, or if the image was modified since the + # old values were computed. + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + if (IM_LIMTIME(im) >= IM_MTIME(im)) { + # Use min and max values in image header if they are up to date. + zmin = IM_MIN(im) + zmax = IM_MAX(im) + + } else { + zmin = MAX_REAL + zmax = -MAX_REAL + + # Try to include a constant number of pixels in the sample + # regardless of the image size. The entire image is used if we + # have a small image, and at least sample_lines lines are read + # if we have a large image. + + sample_size = iis_xdim * nsample_lines + imlines = min(nlines, max(nsample_lines, sample_size / ncols)) + step = nlines / (imlines + 1) + + do i = 1 + step, nlines, max (1, step) { + call alimr (Memr[imgl2r(im,i)], ncols, minval, maxval) + zmin = min (zmin, minval) + zmax = max (zmax, maxval) + } + } +end diff --git a/pkg/images/tv/display/mkpkg b/pkg/images/tv/display/mkpkg new file mode 100644 index 00000000..4d6d8885 --- /dev/null +++ b/pkg/images/tv/display/mkpkg @@ -0,0 +1,79 @@ +# Make the DISPLAY libraries. + +$checkout libds.a lib$ +$update libds.a +$checkin libds.a lib$ +$exit + +zzdebug: +zzdebug.e: + $omake zzdebug.x <imhdr.h> + $link zzdebug.o -lds -lstg -o zzdebug.e + ; + +libds.a: + dsmap.x <fset.h> <imset.h> <mach.h> + dspmmap.x <ctype.h> <error.h> <imhdr.h> <imset.h> <mach.h> \ + <pmset.h> + dsulut.x <ctype.h> display.h <error.h> + findz.x iis.com iis.h <imhdr.h> + iisblk.x iis.h <mach.h> zdisplay.h + iiscls.x iis.com iis.h <knet.h> <mach.h> zdisplay.h + iisers.x iis.com iis.h <mach.h> zdisplay.h + iisflu.x iis.h <mach.h> zdisplay.h + iisgop.x iis.h <mach.h> + iishdr.x iis.com iis.h <mach.h> zdisplay.h + iisio.x iis.com iis.h <knet.h> <mach.h> zdisplay.h + iismtc.x iis.h <mach.h> zdisplay.h + iisofm.x iis.h <mach.h> <math.h> zdisplay.h + iisopn.x iis.com iis.h imd.com <knet.h> <mach.h> zdisplay.h + iispio.x iis.com iis.h <knet.h> <mach.h> zdisplay.h + iisrcr.x iis.com iis.h <mach.h> zdisplay.h + iisrd.x iis.com iis.h <mach.h> zdisplay.h + iisrgb.x iis.h <mach.h> zdisplay.h + iissfr.x iis.com iis.h + iisstt.x <fio.h> iis.h <mach.h> zdisplay.h + iiswcr.x iis.com iis.h <mach.h> zdisplay.h + iiswnd.x iis.h <mach.h> zdisplay.h + iiswr.x iis.com iis.h <mach.h> zdisplay.h + iiswt.x iis.com iis.h <knet.h> <mach.h> zdisplay.h + iiszm.x iis.h <mach.h> zdisplay.h + imdgcur.x iis.com iis.h imd.com <knet.h> + imdgetwcs.x <ctype.h> iis.com iis.h zdisplay.h + imdmapfr.x display.h <fset.h> iis.com iis.h <imhdr.h> <imset.h> \ + <mach.h> + imdmapping.x <ctype.h> iis.com iis.h zdisplay.h + imdopen.x <knet.h> + imdputwcs.x display.h <error.h> <fset.h> iis.com iis.h <imhdr.h> \ + <imset.h> + imdrcuro.x <chars.h> <ctype.h> iis.com iis.h <mach.h> zdisplay.h + imdrcur.x <ctype.h> + imdsetwcs.x iis.com iis.h <knet.h> <mach.h> + imdwcsver.x iis.com iis.h zdisplay.h + imdwcs.x <imhdr.h> + maskcolor.x ace.h <ctotok.h> <evvexpr.h> + maxmin.x iis.com iis.h <imhdr.h> <mach.h> + sigl2.x <error.h> <imhdr.h> + sigm2.x <error.h> <imhdr.h> + t_dcontrol.x display.h <fset.h> iis.com iis.h zdisplay.h + t_display.x display.h <error.h> gwindow.h iis.h \ + <imhdr.h> <imset.h> <mach.h> <pmset.h> + zardim.x zdisplay.h + zawrim.x zdisplay.h + zawtim.x zdisplay.h + zblkim.x zdisplay.h + zclrim.x zdisplay.h + zclsim.x zdisplay.h + zersim.x zdisplay.h + zfrmim.x zdisplay.h + zmapim.x zdisplay.h + zmtcim.x zdisplay.h + zopnim.x zdisplay.h + zrcrim.x zdisplay.h + zrgbim.x zdisplay.h + zrmim.x zdisplay.h + zscale.x <ctype.h> <imhdr.h> <imio.h> <imset.h> <pmset.h> + zsttim.x <fio.h> iis.com iis.h <knet.h> + zwndim.x zdisplay.h + zzdebug.x <imhdr.h> + ; diff --git a/pkg/images/tv/display/sigl2.x b/pkg/images/tv/display/sigl2.x new file mode 100644 index 00000000..cbc465ec --- /dev/null +++ b/pkg/images/tv/display/sigl2.x @@ -0,0 +1,976 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> + +.help sigl2, sigl2_setup +.nf ___________________________________________________________________________ +SIGL2 -- Get a line from a spatially scaled 2-dimensional image. This procedure +works like the regular IMIO get line procedure, but rescales the input +2-dimensional image in either or both axes upon input. 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 = sigl2_setup (im, x1,x2,nx,xblk, y1,y2,ny,yblk, order) + sigl2_free (si) + ptr = sigl2[sr] (si, linenumber) + +SIGL2_SETUP must be called to set up the transformations after mapping the +image and before performing any scaled i/o to the image. SIGL2_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 # images of 2 dimensions supported +define SI_NBUFS 3 # nbuffers used by SIGL2 + +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) + +# SIGL2_SETUP -- Set up the spatial transformation for SIGL2[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 sigl2_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) && !IS_INDEFI (blksize[i])) { + 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 + + +# SIGL2_FREE -- Free storage associated with an image opened for scaled +# input. This does not close and unmap the image. + +procedure sigl2_free (si) + +pointer si +int i + +begin + # Free SIGL2 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 + + +# SIGL2S -- 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 sigl2s (si, lineno) + +pointer si # pointer to SI descriptor +int lineno + +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))) + + # 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)) + + 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) + +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 + +real sum +pointer sp, a, b +int nblks_x, nblks_y, ncols, nlines, xoff, i, j +int first_line, nlines_in_sum, npix, nfull_blks, count +pointer imgs2s() +errchk imgs2s + +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)) + return (imgs2s (im, xoff, xoff + npix - 1, y, y)) + + 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") + + if (ybavg > 1) { + call salloc (b, nblks_x, TY_LONG) + call aclrl (Meml[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. + a = imgs2s (im, xoff, xoff + npix - 1, i, i) + + # 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) { + do j = 0, nblks_x-1 + Meml[b+j] = Meml[b+j] + Mems[a+j] + 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) { + do i = 0, nblks_x-1 + Mems[a+i] = Meml[b+i] / real(nlines_in_sum) + } + + 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 + + +# SIGL2I -- Get a line of type int 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 sigl2i (si, lineno) + +pointer si # pointer to SI descriptor +int lineno + +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_blkavgi() +errchk si_blkavgi + +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_blkavgi (SI_IM(si), x1, x2, int(y), + SI_BAVG(si,1), SI_BAVG(si,2))) + + # 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_INT) + SI_TYBUF(si) = TY_INT + buf_y[i] = NOTSET + } + if (OUTBUF(si) != NULL) + call mfree (OUTBUF(si), SI_TYBUF(si)) + call malloc (OUTBUF(si), npix, TY_INT) + 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_blkavgi (SI_IM(si), x1, x2, new_y[i], + SI_BAVG(si,1), SI_BAVG(si,2)) + + if (SI_INTERP(si,1) == NO) { + call amovi (Memi[rawline], Memi[SI_BUF(si,i)], npix) + } else if (SI_ORDER(si) <= 0) { + call si_samplei (Memi[rawline], Memi[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } else { + call aluii (Memi[rawline], Memi[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 awsui (Memi[SI_BUF(si,1)], Memi[SI_BUF(si,2)], + Memi[OUTBUF(si)], npix, weight_1, weight_2) + return (OUTBUF(si)) + } +end + + +# SI_BLKAVGI -- Get a line from a block averaged image of type integer. +# 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_blkavgi (im, x1, x2, y, xbavg, ybavg) + +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 + +real sum +pointer sp, a, b +int nblks_x, nblks_y, ncols, nlines, xoff, i, j +int first_line, nlines_in_sum, npix, nfull_blks, count +pointer imgs2i() +errchk imgs2i + +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)) + return (imgs2i (im, xoff, xoff + npix - 1, y, y)) + + 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") + + if (ybavg > 1) { + call salloc (b, nblks_x, TY_LONG) + call aclrl (Meml[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. + a = imgs2i (im, xoff, xoff + npix - 1, i, i) + + # Block average line in X. + if (xbavg > 1) { + # First block average only the full blocks. + nfull_blks = npix / xbavg + call abavi (Memi[a], Memi[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 + Memi[a+j-1] + count = count + 1 + } + Memi[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) { + do j = 0, nblks_x-1 + Meml[b+j] = Meml[b+j] + Memi[a+j] + 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) { + do i = 0, nblks_x-1 + Memi[a+i] = Meml[b+i] / real(nlines_in_sum) + } + + call sfree (sp) + return (a) +end + + +# SI_SAMPLEI -- Resample a line via nearest neighbor, rather than linear +# interpolation (ALUI). The calling sequence is the same as for ALUII. + +procedure si_samplei (a, b, x, npix) + +int 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 + + +# SIGL2R -- 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 sigl2r (si, lineno) + +pointer si # pointer to SI descriptor +int lineno + +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))) + + # 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)) + + 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 real. +# 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) + +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 nblks_x, nblks_y, ncols, nlines, xoff, i, j +int first_line, nlines_in_sum, npix, nfull_blks, count +real sum +pointer sp, a, b +pointer imgs2r() +errchk imgs2r + +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)) + return (imgs2r (im, xoff, xoff + npix - 1, y, y)) + + 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. + a = imgs2r (im, xoff, xoff + npix - 1, i, i) + + # 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/images/tv/display/sigm2.x b/pkg/images/tv/display/sigm2.x new file mode 100644 index 00000000..41a3b5da --- /dev/null +++ b/pkg/images/tv/display/sigm2.x @@ -0,0 +1,1110 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> + +.help sigm2, sigm2_setup +.nf ___________________________________________________________________________ +SIGM2 -- Get a line from a spatially scaled 2-dimensional image. This procedure +works like the regular IMIO get line procedure, but rescales the input +2-dimensional image in either or both axes upon input. 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 = sigm2_setup (im,pm, x1,x2,nx,xblk, y1,y2,ny,yblk, order) + sigm2_free (si) + ptr = sigm2[sr] (si, linenumber) + +SIGM2_SETUP must be called to set up the transformations after mapping the +image and before performing any scaled i/o to the image. SIGM2_FREE must be +called when finished to return buffer space. + +The SIGM routines are like SIGL routines except for the addition of +interpolation over bad pixels and order=-1 takes the maximum rather +than the average when doing block averaging or interpolation. +.endhelp ______________________________________________________________________ + +# Scaled image descriptor for 2-dim images + +define SI_LEN 19 +define SI_MAXDIM 2 # images of 2 dimensions supported +define SI_NBUFS 3 # nbuffers used by SIGL2 + +define SI_IM Memi[$1] # pointer to input image header +define SI_FP Memi[$1+1] # pointer to fixpix structure +define SI_GRID Memi[$1+2+$2-1] # pointer to array of X coords +define SI_NPIX Memi[$1+4+$2-1] # number of X coords +define SI_BAVG Memi[$1+6+$2-1] # X block averaging factor +define SI_INTERP Memi[$1+8+$2-1] # interpolate X axis +define SI_BUF Memi[$1+10+$2-1]# line buffers +define SI_BUFY Memi[$1+13+$2-1]# Y values of buffers +define SI_ORDER Memi[$1+15] # interpolator order +define SI_TYBUF Memi[$1+16] # buffer type +define SI_XOFF Memi[$1+17] # offset in input image to first X +define SI_INIT Memi[$1+18] # 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) + +# SIGM2_SETUP -- Set up the spatial transformation for SIGL2[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 sigm2_setup (im, pm, px1,px2,nx,xblk, py1,py2,ny,yblk, order) + +pointer im # the input image +pointer pm # pixel mask +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, xt_fpinit() + +begin + iferr (call calloc (si, SI_LEN, TY_STRUCT)) + call erract (EA_FATAL) + + SI_IM(si) = im + SI_FP(si) = xt_fpinit (pm, 1, INDEFI) + 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) && !IS_INDEFI (blksize[i])) { + 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 + SI_TOL) + } 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] + SI_TOL) + 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] + SI_TOL) + start = p1[1] - int (p1[i] + SI_TOL) + 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 + SI_TOL) + } else { + do j = 0, npts[i]-1 + Memr[gp+j] = start + (j * tau[i]) + } + } + + return (si) +end + + +# SIGM2_FREE -- Free storage associated with an image opened for scaled +# input. This does not close and unmap the image. + +procedure sigm2_free (si) + +pointer si +int i + +begin + # Free fixpix structure. + call xt_fpfree (SI_FP(si)) + + # Free SIGM2 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 + + +# SIGM2S -- 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 sigm2s (si, lineno) + +pointer si # pointer to SI descriptor +int lineno + +pointer rawline, tempp, gp +int i, new_y[2], tempi, curbuf, altbuf +int nraw, npix, nblks_y, ybavg, x1, x2 +real x, y, weight_1, weight_2 +pointer si_blmavgs() +errchk si_blmavgs + +begin + nraw = IM_LEN(SI_IM(si),1) + 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_blmavgs (SI_IM(si), SI_FP(si), x1, x2, int(y), + SI_BAVG(si,1), SI_BAVG(si,2), SI_ORDER(si))) + + # 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 + SI_BUFY(si,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] == SI_BUFY(si,i)) { + ; + } else if (new_y[i] == SI_BUFY(si,altbuf)) { + SWAPP (SI_BUF(si,1), SI_BUF(si,2)) + SWAPI (SI_BUFY(si,1), SI_BUFY(si,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_blmavgs (SI_IM(si), SI_FP(si), x1, x2, + new_y[i], SI_BAVG(si,1), SI_BAVG(si,2), SI_ORDER(si)) + + 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 if (SI_ORDER(si) == -1) { + call si_maxs (Mems[rawline], nraw, + Memr[SI_GRID(si,1)], Mems[SI_BUF(si,i)], npix) + } else { + call aluis (Mems[rawline], Mems[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } + + SI_BUFY(si,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 SI_BUFY(si,1) to SI_BUFY(si,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 - SI_BUFY(si,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 if (SI_ORDER(si) == -1) { + call amaxs (Mems[SI_BUF(si,1)], Mems[SI_BUF(si,2)], + Mems[OUTBUF(si)], npix) + return (OUTBUF(si)) + } 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_BLMAVGS -- 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_blmavgs (im, fp, x1, x2, y, xbavg, ybavg, order) + +pointer im # input image +pointer fp # fixpix structure +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 order # averaging option + +real sum +short blkmax +pointer sp, a, b +int nblks_x, nblks_y, ncols, nlines, xoff, blk1, blk2, i, j, k +int first_line, nlines_in_sum, npix, nfull_blks, count +pointer xt_fps() +errchk xt_fps + +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) - xoff + 1 + + if ((xbavg < 1) || (ybavg < 1)) + call error (1, "si_blmavg: illegal block size") + else if (x1 < 1 || x2 > ncols) + call error (2, "si_blmavg: column index out of bounds") + else if ((xbavg == 1) && (ybavg == 1)) + return (xt_fps (fp, im, y, NULL) + xoff - 1) + + nblks_x = (npix + xbavg-1) / xbavg + nblks_y = (nlines + ybavg-1) / ybavg + + if (y < 1 || y > nblks_y) + call error (2, "si_blmavg: block number out of range") + + if (ybavg > 1) { + call salloc (b, nblks_x, TY_LONG) + call aclrl (Meml[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. + a = xt_fps (fp, im, i, NULL) + xoff - 1 + + # Block average line in X. + if (xbavg > 1) { + # First block average only the full blocks. + nfull_blks = npix / xbavg + if (order == -1) { + blk1 = a + do j = 1, nfull_blks { + blk2 = blk1 + xbavg + blkmax = Mems[blk1] + do k = blk1+1, blk2-1 + blkmax = max (blkmax, Mems[k]) + Mems[a+j-1] = blkmax + blk1 = blk2 + } + } else + call abavs (Mems[a], Mems[a], nfull_blks, xbavg) + + # Now average the final partial block, if any. + if (nfull_blks < nblks_x) { + if (order == -1) { + blkmax = Mems[blk1] + do k = blk1+1, a+npix-1 + blkmax = max (blkmax, Mems[k]) + Mems[a+j-1] = blkmax + } else { + 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) { + if (order == -1) { + do j = 0, nblks_x-1 + Meml[b+j] = max (Meml[b+j], long (Mems[a+j])) + } else { + do j = 0, nblks_x-1 + Meml[b+j] = Meml[b+j] + Mems[a+j] + 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) { + if (order == -1) { + do i = 0, nblks_x-1 + Mems[a+i] = Meml[b+i] + } else { + do i = 0, nblks_x-1 + Mems[a+i] = Meml[b+i] / real(nlines_in_sum) + } + } + + call sfree (sp) + return (a) +end + + +# SI_MAXS -- Resample a line via maximum value. + +procedure si_maxs (a, na, x, b, nb) + +short a[na] # input array +int na # input size +real x[nb] # sample grid +short b[nb] # output arrays +int nb # output size + +int i + +begin + do i = 1, nb + b[i] = max (a[int(x[i])], a[min(na,int(x[i]+1))]) +end + + +# SIGM2I -- 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 sigm2i (si, lineno) + +pointer si # pointer to SI descriptor +int lineno + +pointer rawline, tempp, gp +int i, new_y[2], tempi, curbuf, altbuf +int nraw, npix, nblks_y, ybavg, x1, x2 +real x, y, weight_1, weight_2 +pointer si_blmavgi() +errchk si_blmavgi + +begin + nraw = IM_LEN(SI_IM(si),1) + 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_blmavgi (SI_IM(si), SI_FP(si), x1, x2, int(y), + SI_BAVG(si,1), SI_BAVG(si,2), SI_ORDER(si))) + + # 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_INT) + SI_TYBUF(si) = TY_INT + SI_BUFY(si,i) = NOTSET + } + if (OUTBUF(si) != NULL) + call mfree (OUTBUF(si), SI_TYBUF(si)) + call malloc (OUTBUF(si), npix, TY_INT) + 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] == SI_BUFY(si,i)) { + ; + } else if (new_y[i] == SI_BUFY(si,altbuf)) { + SWAPP (SI_BUF(si,1), SI_BUF(si,2)) + SWAPI (SI_BUFY(si,1), SI_BUFY(si,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_blmavgi (SI_IM(si), SI_FP(si), x1, x2, + new_y[i], SI_BAVG(si,1), SI_BAVG(si,2), SI_ORDER(si)) + + if (SI_INTERP(si,1) == NO) { + call amovi (Memi[rawline], Memi[SI_BUF(si,i)], npix) + } else if (SI_ORDER(si) == 0) { + call si_samplei (Memi[rawline], Memi[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } else if (SI_ORDER(si) == -1) { + call si_maxi (Memi[rawline], nraw, + Memr[SI_GRID(si,1)], Memi[SI_BUF(si,i)], npix) + } else { + call aluii (Memi[rawline], Memi[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } + + SI_BUFY(si,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 SI_BUFY(si,1) to SI_BUFY(si,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 - SI_BUFY(si,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 if (SI_ORDER(si) == -1) { + call amaxi (Memi[SI_BUF(si,1)], Memi[SI_BUF(si,2)], + Memi[OUTBUF(si)], npix) + return (OUTBUF(si)) + } else { + call awsui (Memi[SI_BUF(si,1)], Memi[SI_BUF(si,2)], + Memi[OUTBUF(si)], npix, weight_1, weight_2) + return (OUTBUF(si)) + } +end + + +# SI_BLMAVGI -- Get a line from a block averaged image of type integer. +# 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_blmavgi (im, fp, x1, x2, y, xbavg, ybavg, order) + +pointer im # input image +pointer fp # fixpix structure +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 order # averaging option + +real sum +int blkmax +pointer sp, a, b +int nblks_x, nblks_y, ncols, nlines, xoff, blk1, blk2, i, j, k +int first_line, nlines_in_sum, npix, nfull_blks, count +pointer xt_fpi() +errchk xt_fpi + +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) - xoff + 1 + + if ((xbavg < 1) || (ybavg < 1)) + call error (1, "si_blmavg: illegal block size") + else if (x1 < 1 || x2 > ncols) + call error (2, "si_blmavg: column index out of bounds") + else if ((xbavg == 1) && (ybavg == 1)) + return (xt_fpi (fp, im, y, NULL) + xoff - 1) + + nblks_x = (npix + xbavg-1) / xbavg + nblks_y = (nlines + ybavg-1) / ybavg + + if (y < 1 || y > nblks_y) + call error (2, "si_blmavg: block number out of range") + + if (ybavg > 1) { + call salloc (b, nblks_x, TY_LONG) + call aclrl (Meml[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. + a = xt_fpi (fp, im, i, NULL) + xoff - 1 + + # Block average line in X. + if (xbavg > 1) { + # First block average only the full blocks. + nfull_blks = npix / xbavg + if (order == -1) { + blk1 = a + do j = 1, nfull_blks { + blk2 = blk1 + xbavg + blkmax = Memi[blk1] + do k = blk1+1, blk2-1 + blkmax = max (blkmax, Memi[k]) + Memi[a+j-1] = blkmax + blk1 = blk2 + } + } else + call abavi (Memi[a], Memi[a], nfull_blks, xbavg) + + # Now average the final partial block, if any. + if (nfull_blks < nblks_x) { + if (order == -1) { + blkmax = Memi[blk1] + do k = blk1+1, a+npix-1 + blkmax = max (blkmax, Memi[k]) + Memi[a+j-1] = blkmax + } else { + sum = 0.0 + count = 0 + do j = nfull_blks * xbavg + 1, npix { + sum = sum + Memi[a+j-1] + count = count + 1 + } + Memi[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) { + if (order == -1) { + do j = 0, nblks_x-1 + Meml[b+j] = max (Meml[b+j], long (Memi[a+j])) + } else { + do j = 0, nblks_x-1 + Meml[b+j] = Meml[b+j] + Memi[a+j] + 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) { + if (order == -1) { + do i = 0, nblks_x-1 + Memi[a+i] = Meml[b+i] + } else { + do i = 0, nblks_x-1 + Memi[a+i] = Meml[b+i] / real(nlines_in_sum) + } + } + + call sfree (sp) + return (a) +end + + +# SI_MAXI -- Resample a line via maximum value. + +procedure si_maxi (a, na, x, b, nb) + +int a[na] # input array +int na # input size +real x[nb] # sample grid +int b[nb] # output arrays +int nb # output size + +int i + +begin + do i = 1, nb + b[i] = max (a[int(x[i])], a[min(na,int(x[i]+1))]) +end + + +# SIGM2R -- 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 sigm2r (si, lineno) + +pointer si # pointer to SI descriptor +int lineno + +pointer rawline, tempp, gp +int i, new_y[2], tempi, curbuf, altbuf +int nraw, npix, nblks_y, ybavg, x1, x2 +real x, y, weight_1, weight_2 +pointer si_blmavgr() +errchk si_blmavgr + +begin + nraw = IM_LEN(SI_IM(si)) + 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_blmavgr (SI_IM(si), SI_FP(si), x1, x2, int(y), + SI_BAVG(si,1), SI_BAVG(si,2), SI_ORDER(si))) + + # 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 + SI_BUFY(si,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] == SI_BUFY(si,i)) { + ; + } else if (new_y[i] == SI_BUFY(si,altbuf)) { + SWAPP (SI_BUF(si,1), SI_BUF(si,2)) + SWAPI (SI_BUFY(si,1), SI_BUFY(si,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_blmavgr (SI_IM(si), SI_FP(si), x1, x2, + new_y[i], SI_BAVG(si,1), SI_BAVG(si,2), SI_ORDER(si)) + + 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 if (SI_ORDER(si) == -1) { + call si_maxr (Memr[rawline], nraw, + Memr[SI_GRID(si,1)], Memr[SI_BUF(si,i)], npix) + } else { + call aluir (Memr[rawline], Memr[SI_BUF(si,i)], + Memr[SI_GRID(si,1)], npix) + } + + SI_BUFY(si,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 SI_BUFY(si,1) to SI_BUFY(si,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 - SI_BUFY(si,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 if (SI_ORDER(si) == -1) { + call amaxr (Memr[SI_BUF(si,1)], Memr[SI_BUF(si,2)], + Memr[OUTBUF(si)], npix) + return (OUTBUF(si)) + } 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_BLMAVGR -- 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_blmavgr (im, fp, x1, x2, y, xbavg, ybavg, order) + +pointer im # input image +pointer fp # fixpix structure +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 order # averaging option + +int nblks_x, nblks_y, ncols, nlines, xoff, blk1, blk2, i, j, k +int first_line, nlines_in_sum, npix, nfull_blks, count +real sum, blkmax +pointer sp, a, b +pointer xt_fpr() +errchk xt_fpr + +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) - xoff + 1 + + if ((xbavg < 1) || (ybavg < 1)) + call error (1, "si_blmavg: illegal block size") + else if (x1 < 1 || x2 > ncols) + call error (2, "si_blmavg: column index out of bounds") + else if ((xbavg == 1) && (ybavg == 1)) + return (xt_fpr (fp, im, y, NULL) + xoff - 1) + + nblks_x = (npix + xbavg-1) / xbavg + nblks_y = (nlines + ybavg-1) / ybavg + + if (y < 1 || y > nblks_y) + call error (2, "si_blmavg: 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. + a = xt_fpr (fp, im, i, NULL) + xoff - 1 + + # Block average line in X. + if (xbavg > 1) { + # First block average only the full blocks. + nfull_blks = npix / xbavg + if (order == -1) { + blk1 = a + do j = 1, nfull_blks { + blk2 = blk1 + xbavg + blkmax = Memr[blk1] + do k = blk1+1, blk2-1 + blkmax = max (blkmax, Memr[k]) + Memr[a+j-1] = blkmax + blk1 = blk2 + } + } else + call abavr (Memr[a], Memr[a], nfull_blks, xbavg) + + # Now average the final partial block, if any. + if (nfull_blks < nblks_x) { + if (order == -1) { + blkmax = Memr[blk1] + do k = blk1+1, a+npix-1 + blkmax = max (blkmax, Memr[k]) + Memr[a+j-1] = blkmax + } else { + 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) { + if (order == -1) + call amaxr (Memr[a], Memr[b], Memr[b], nblks_x) + else { + 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) { + if (order == -1) + call amovr (Memr[b], Memr[a], nblks_x) + else + call adivkr (Memr[b], real(nlines_in_sum), Memr[a], nblks_x) + } + + call sfree (sp) + return (a) +end + + +# SI_MAXR -- Resample a line via maximum value. + +procedure si_maxr (a, na, x, b, nb) + +real a[na] # input array +int na # input size +real x[nb] # sample grid +real b[nb] # output arrays +int nb # output size + +int i + +begin + do i = 1, nb + b[i] = max (a[int(x[i])], a[min(na,int(x[i]+1))]) +end diff --git a/pkg/images/tv/display/t_dcontrol.x b/pkg/images/tv/display/t_dcontrol.x new file mode 100644 index 00000000..8b68a66b --- /dev/null +++ b/pkg/images/tv/display/t_dcontrol.x @@ -0,0 +1,193 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <fset.h> +include "display.h" +include "zdisplay.h" +include "iis.h" + +# DCONTROL -- Control functions for the image display device. This has been +# cleaned up to eliminate unecessary operations and make it more efficient, +# but is only a throwaway program which breaks a few rules. This file contains +# some explicitly IIS dependent code. + +procedure t_dcontrol() + +real rate +int zoom, type, status +pointer sp, device, devinfo, tty +bool erase, window, rgb_window, blink, match, roam +int red_frame, green_frame, blue_frame, prim_frame, alt_frame, nframes +int red_chan[2], green_chan[2], blue_chan[2], prim_chan[2], alt_chan[2] +char type_string[SZ_FNAME], map_string[SZ_FNAME] +int chan[2], alt1[2], alt2[2] alt3[2] alt4[2] + +real clgetr() +pointer ttygdes() +bool clgetb(), streq(), ttygetb() +int clgeti(), clscan(), nscan(), envgets(), ttygets(), ttygeti(), btoi() +string stdimage "stdimage" +include "iis.com" +define err_ 91 + +begin + call smark (sp) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (devinfo, SZ_LINE, TY_CHAR) + + # Get display parameters. + + call clgstr ("type", type_string, SZ_FNAME) + call clgstr ("map", map_string, SZ_FNAME) + + red_frame = clgeti ("red_frame") + green_frame = clgeti ("green_frame") + blue_frame = clgeti ("blue_frame") + prim_frame = clgeti ("frame") + alt_frame = clgeti ("alternate") + + zoom = clgeti ("zoom") + rate = clgetr ("rate") + erase = clgetb ("erase") + window = clgetb ("window") + rgb_window = clgetb ("rgb_window") + blink = clgetb ("blink") + match = clgetb ("match") + roam = clgetb ("roam") + + # Remember current frame. + call clputi ("frame", prim_frame) + call iis_setframe (prim_frame) + + # Get device information. + call clgstr ("device", Memc[device], SZ_FNAME) + if (streq (device, stdimage)) { + if (envgets (stdimage, Memc[device], SZ_FNAME) <= 0) + call syserrs (SYS_ENVNF, stdimage) + } + tty = ttygdes (Memc[device]) + if (ttygets (tty, "DD", Memc[devinfo], SZ_LINE) <= 0) + call error (1, "no `DD' entry in graphcap entry for device") + + # Pick up the frame size and configuration number. + iis_xdim = ttygeti (tty, "xr") + iis_ydim = ttygeti (tty, "yr") + iis_config = ttygeti (tty, "cn") + iis_server = btoi (ttygetb (tty, "LC")) + + # Verify operation is legal on device. + if (iis_server == YES) { + if (!streq (type_string, "frame")) + goto err_ + if (!streq (map_string, "mono")) + goto err_ + if (erase) + ; + if (roam) + goto err_ + if (window) + goto err_ + if (rgb_window) + goto err_ + if (blink) + goto err_ + if (match) { +err_ call eprintf ("operation not supported for display device %s\n") + call pargstr (Memc[device]) + call ttycdes (tty) + call sfree (sp) + return + } + } + + # Access display. + call strpak (Memc[devinfo], Memc[devinfo], SZ_LINE) + call iisopn (Memc[devinfo], READ_WRITE, chan) + if (chan[1] == ERR) + call error (2, "cannot open display") + + call fseti (STDOUT, F_FLUSHNL, YES) + + red_chan[1] = FRTOCHAN(red_frame) + green_chan[1] = FRTOCHAN(green_frame) + blue_chan[1] = FRTOCHAN(blue_frame) + prim_chan[1] = FRTOCHAN(prim_frame) + alt_chan[1] = FRTOCHAN(alt_frame) + + red_chan[2] = MONO + green_chan[2] = MONO + blue_chan[2] = MONO + prim_chan[2] = MONO + alt_chan[2] = MONO + + # Execute the selected control functions. + if (streq (type_string, "rgb")) { + type = RGB + call zrgbim (red_chan, green_chan, blue_chan) + } else if (streq (type_string, "frame")) { + type = FRAME + call zfrmim (prim_chan) + } else + call error (3, "unknown display type") + + # Set display mapping. + call zmapim (prim_chan, map_string) + + if (erase) { + switch (type) { + case RGB: + call zersim (red_chan) + call zersim (green_chan) + call zersim (blue_chan) + case FRAME: + call zersim (prim_chan) + } + + } else { + if (roam) { + call printf ("Roam display and exit by pushing any button\n") + call zrmim (prim_chan, zoom) + } + + if (window) { + call printf ("Window display and exit by pushing any button\n") + call zwndim (prim_chan) + } + + if (rgb_window) { + call printf ("Window display and exit by pushing any button\n") + call zwndim3 (red_chan, green_chan, blue_chan) + } + + if (match) + call zmtcim (alt_chan, prim_chan) + + if (blink) { + if (clscan ("alternate") != EOF) { + call gargi (alt1[1]) + call gargi (alt2[1]) + call gargi (alt3[1]) + call gargi (alt4[1]) + nframes = nscan() + + alt1[1] = FRTOCHAN(alt1[1]) + alt2[1] = FRTOCHAN(alt2[1]) + alt3[1] = FRTOCHAN(alt3[1]) + alt4[1] = FRTOCHAN(alt4[1]) + + alt1[2] = MONO + alt2[2] = MONO + alt3[2] = MONO + alt4[2] = MONO + + call printf ("Exit by pushing any button\n") + call zblkim (alt1, alt2, alt3, alt4, nframes, rate) + } + } + } + + # Close display. + call zclsim (chan[1], status) + call ttycdes (tty) + call sfree (sp) +end diff --git a/pkg/images/tv/display/t_display.x b/pkg/images/tv/display/t_display.x new file mode 100644 index 00000000..f4156f39 --- /dev/null +++ b/pkg/images/tv/display/t_display.x @@ -0,0 +1,885 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imset.h> +include <imhdr.h> +include <error.h> +include <pmset.h> +include "display.h" +include "gwindow.h" +include "iis.h" + +# DISPLAY - Display an image. The specified image section is mapped into +# the specified section of an image display frame. The mapping involves +# a linear transformation in X and Y and a linear or logarithmic transformation +# in Z (greyscale). Images of all pixel datatypes are supported, and there +# no upper limit on the size of an image. The display device is interfaced +# to FIO as a file and is accessed herein via IMIO as just another imagefile. +# The physical characteristics of the display (i.e., X, Y, and Z resolution) +# are taken from the image header. The display frame buffer is the pixel +# storage "file". + +procedure t_display() + +char image[SZ_FNAME] # Image to display +int frame # Display frame +int erase # Erase frame? + +int i +pointer sp, wdes, im, ds + +bool clgetb() +int clgeti(), btoi(), imd_wcsver(), imtlen(), imtgetim() +pointer immap(), imd_mapframe1(), imtopenp() +errchk immap, imd_mapframe1 +errchk ds_getparams, ds_setwcs, ds_load_display, ds_erase_border + +begin + call smark (sp) + call salloc (wdes, LEN_WDES, TY_STRUCT) + call aclri (Memi[wdes], LEN_WDES) + + # Open input imagefile. + im = imtopenp ("image") + if (imtlen (im) != 1) + call error (1, "Only one image may be displayed") + i = imtgetim (im, image, SZ_FNAME) + call imtclose (im) + #call clgstr ("image", image, SZ_FNAME) + im = immap (image, READ_ONLY, 0) + if (IM_NDIM(im) <= 0) + call error (1, "image has no pixels") + + # Query server to get the WCS version, this also tells us whether + # we can use the all 16 supported frames. + if (imd_wcsver() == 0) + call clputi ("display.frame.p_max", 4) + else + call clputi ("display.frame.p_max", 16) + + + # Open display device as an image. + frame = clgeti ("frame") + W_FRAME(wdes) = frame + + erase = btoi (clgetb ("erase")) + if (erase == YES) + ds = imd_mapframe1 (frame, WRITE_ONLY, + btoi (clgetb ("select_frame")), erase) + else + ds = imd_mapframe1 (frame, READ_WRITE, + btoi (clgetb ("select_frame")), erase) + + # Get display parameters and set up transformation. + call ds_getparams (im, ds, wdes) + + # Compute and output the screen to image pixel WCS. + call ds_setwcs (im, ds, wdes, image, frame) + + # Display the image and zero the border if necessary. + call ds_load_display (im, ds, wdes) + if (!clgetb ("erase") && clgetb ("border_erase")) + call ds_erase_border (im, ds, wdes) + + # Free storage. + call maskcolor_free (W_OCOLORS(wdes)) + call maskcolor_free (W_BPCOLORS(wdes)) + do i = 0, W_MAXWC + if (W_UPTR(W_WC(wdes,i)) != NULL) + call ds_ulutfree (W_UPTR(W_WC(wdes,i))) + call imunmap (ds) + call imunmap (im) + + call sfree (sp) +end + + +# DS_GETPARAMS -- Get the parameters controlling how the image is mapped +# into the display frame. Set up the transformations and save in the graphics +# descriptor file. If "repeat" mode is enabled, read the graphics descriptor +# file and reuse the transformations therein. + +procedure ds_getparams (im, ds, wdes) + +pointer im, ds, wdes #I Image, display, and graphics descriptors + +bool fill, zscale_flag, zrange_flag, zmap_flag +real xcenter, ycenter, xsize, ysize +real xmag, ymag, xscale, yscale, pxsize, pysize +real z1, z2, contrast +int nsample, ncols, nlines +pointer wnwin, wdwin, wwwin, wipix, wdpix, zpm, bpm +pointer sp, str, ztrans, lutfile + +int clgeti(), clgwrd(), nowhite() +real clgetr() +pointer maskcolor_map(), ds_pmmap(), zsc_pmsection() +pointer ds_ulutalloc() +bool streq(), clgetb() +errchk maskcolor_map, ds_pmmap, zsc_pmsection, mzscale + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (ztrans, SZ_FNAME, TY_CHAR) + + # Get overlay mask and colors. + call clgstr ("overlay", W_OVRLY(wdes), W_SZSTRING) + call clgstr ("ocolors", Memc[str], SZ_LINE) + W_OCOLORS(wdes) = maskcolor_map (Memc[str]) + + # Get bad pixel mask. + call clgstr ("bpmask", W_BPM(wdes), W_SZSTRING) + W_BPDISP(wdes) = clgwrd ("bpdisplay", Memc[str], SZ_LINE, BPDISPLAY) + call clgstr ("bpcolors", Memc[str], SZ_LINE) + W_BPCOLORS(wdes) = maskcolor_map (Memc[str]) + + # Determine the display window into which the image is to be mapped + # in normalized device coordinates. + + xcenter = max(0.0, min(1.0, clgetr ("xcenter"))) + ycenter = max(0.0, min(1.0, clgetr ("ycenter"))) + xsize = max(0.0, min(1.0, clgetr ("xsize"))) + ysize = max(0.0, min(1.0, clgetr ("ysize"))) + + # Set up a new graphics descriptor structure defining the coordinate + # transformation used to map the image into the display frame. + + wnwin = W_WC(wdes,W_NWIN) + wdwin = W_WC(wdes,W_DWIN) + wwwin = W_WC(wdes,W_WWIN) + wipix = W_WC(wdes,W_IPIX) + wdpix = W_WC(wdes,W_DPIX) + + # Determine X and Y scaling ratios required to map the image into the + # normalized display window. If spatial scaling is not desired filling + # must be disabled and XMAG and YMAG must be set to 1.0 in the + # parameter file. Fill mode will always produce an aspect ratio of 1; + # if nonequal scaling is required then the magnification ratios must + # be set explicitly by the user. + + fill = clgetb ("fill") + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + if (fill) { + # Compute scale in units of window coords per data pixel required + # to scale image to fit window. + + xmag = (IM_LEN(ds,1) * xsize) / ncols + ymag = (IM_LEN(ds,2) * ysize) / nlines + + if (xmag > ymag) + xmag = ymag + else + ymag = xmag + + } else { + # Compute scale required to provide image magnification ratios + # specified by the user. Magnification is specified in units of + # display pixels, i.e, a magnification ratio of 1.0 means that + # image pixels will map to display pixels without scaling. + + xmag = clgetr ("xmag") + ymag = clgetr ("ymag") + } + + xscale = 1.0 / (IM_LEN(ds,1) / xmag) + yscale = 1.0 / (IM_LEN(ds,2) / ymag) + + # Set device window limits in normalized device coordinates. + # World coord system 0 is used for the device window. + + W_XS(wnwin) = xcenter - xsize / 2.0 + W_XE(wnwin) = xcenter + xsize / 2.0 + W_YS(wnwin) = ycenter - ysize / 2.0 + W_YE(wnwin) = ycenter + ysize / 2.0 + + # Set pixel coordinates of window. + # If the image is too large to fit in the window given the scaling + # factors XSCALE and YSCALE, the following will set starting and ending + # pixel coordinates in the interior of the image. If the image is too + # small to fill the window then the pixel coords will reference beyond + # the bounds of the image. Note that the 0.5 is because NDC has + # the screen corner at 0 while screen pixels have the corner at 0.5. + + pxsize = xsize / xscale + pysize = ysize / yscale + + W_XS(wdwin) = (ncols / 2.0) - (pxsize / 2.0) + 0.5 + W_XE(wdwin) = W_XS(wdwin) + pxsize + W_YS(wdwin) = (nlines / 2.0) - (pysize / 2.0) + 0.5 + W_YE(wdwin) = W_YS(wdwin) + pysize + + # Compute X and Y magnification ratios required to map image into + # the device window in device pixel units. + + xmag = (W_XE(wnwin)-W_XS(wnwin))*IM_LEN(ds,1)/(W_XE(wdwin)-W_XS(wdwin)) + ymag = (W_YE(wnwin)-W_YS(wnwin))*IM_LEN(ds,2)/(W_YE(wdwin)-W_YS(wdwin)) + + # Compute the coordinates of the image section to be displayed. + # Round down if upper pixel is exactly at one-half. + + W_XS(wipix) = max (1, nint(W_XS(wdwin))) + W_XE(wipix) = min (ncols, nint(W_XE(wdwin)-1.01)) + W_YS(wipix) = max (1, nint(W_YS(wdwin))) + W_YE(wipix) = min (nlines, nint(W_YE(wdwin)-1.01)) + + # Now compute the image and display pixels to be used. + # The image may be truncated to fit in the display window. + # These are integer coordinates at the pixel centers. + + pxsize = W_XE(wipix) - W_XS(wipix) + 1 + pysize = W_YE(wipix) - W_YS(wipix) + 1 + xcenter = (W_XE(wnwin) + W_XS(wnwin)) / 2.0 * IM_LEN(ds,1) + 0.5 + ycenter = (W_YE(wnwin) + W_YS(wnwin)) / 2.0 * IM_LEN(ds,2) + 0.5 + + #W_XS(wdpix) = max (1, nint (xcenter - (pxsize/2.0*xmag) + 0.5)) + W_XS(wdpix) = max (1, int (xcenter - (pxsize/2.0*xmag) + 0.5)) + W_XE(wdpix) = min (IM_LEN(ds,1), nint (W_XS(wdpix)+pxsize*xmag - 1.01)) + #W_YS(wdpix) = max (1, nint (ycenter - (pysize/2.0*ymag) + 0.5)) + W_YS(wdpix) = max (1, int (ycenter - (pysize/2.0*ymag) + 0.5)) + W_YE(wdpix) = min (IM_LEN(ds,2), nint (W_YS(wdpix)+pysize*ymag - 1.01)) + + # Now adjust the display window to be consistent with the image and + # display pixels to be used. + + W_XS(wdwin) = W_XS(wnwin) * IM_LEN(ds,1) + 0.5 + W_XE(wdwin) = W_XE(wnwin) * IM_LEN(ds,1) + 0.5 + W_YS(wdwin) = W_YS(wnwin) * IM_LEN(ds,2) + 0.5 + W_YE(wdwin) = W_YE(wnwin) * IM_LEN(ds,2) + 0.5 + W_XS(wdwin) = (W_XS(wipix)-0.5) + (W_XS(wdwin)-(W_XS(wdpix)-0.5))/xmag + W_XE(wdwin) = (W_XS(wipix)-0.5) + (W_XE(wdwin)-(W_XS(wdpix)-0.5))/xmag + W_YS(wdwin) = (W_YS(wipix)-0.5) + (W_YS(wdwin)-(W_YS(wdpix)-0.5))/ymag + W_YE(wdwin) = (W_YS(wipix)-0.5) + (W_YE(wdwin)-(W_YS(wdpix)-0.5))/ymag + + # Order of interpolator used for spatial transformation. + W_XT(wdwin) = max(0, min(1, clgeti ("order"))) + W_YT(wdwin) = W_XT(wdwin) + + # Determine the greyscale transformation. + call clgstr ("ztrans", Memc[ztrans], SZ_FNAME) + if (streq (Memc[ztrans], "log")) + W_ZT(wdwin) = W_LOG + else if (streq (Memc[ztrans], "linear")) + W_ZT(wdwin) = W_LINEAR + else if (streq (Memc[ztrans], "none")) + W_ZT(wdwin) = W_UNITARY + else if (streq (Memc[ztrans], "user")) { + W_ZT(wdwin) = W_USER + call salloc (lutfile, SZ_FNAME, TY_CHAR) + call clgstr ("lutfile", Memc[lutfile], SZ_FNAME) + W_UPTR(wdwin) = ds_ulutalloc (Memc[lutfile], z1, z2) + } else { + call eprintf ("Bad greylevel transformation '%s'\n") + call pargstr (Memc[ztrans]) + W_ZT(wdwin) = W_LINEAR + } + + # The zscale, and zrange parameters determine the algorithms for + # determining Z1 and Z2, the range of input z values to be mapped + # into the fixed range of display greylevels. If sampling and no + # sample mask is given then create one as a subsampled image section. + # If greyscale mapping is disabled the zscale and zrange options are + # disabled. Greyscale mapping can also be disabled by turning off + # zscale and zrange and setting Z1 and Z2 to the device greyscale min + # and max values, producing a unitary transformation. + + if (W_ZT(wdwin) == W_UNITARY || W_ZT(wdwin) == W_USER) { + zscale_flag = false + zrange_flag = false + zmap_flag = false + } else { + zmap_flag = true + zscale_flag = clgetb ("zscale") + if (!zscale_flag) + zrange_flag = clgetb ("zrange") + } + + if (zscale_flag || (zrange_flag && IM_LIMTIME(im) < IM_MTIME(im))) { + call clgstr ("zmask", W_ZPM(wdes), W_SZSTRING) + nsample = max (100, clgeti ("nsample")) + if (nowhite (W_ZPM(wdes), W_ZPM(wdes), W_SZSTRING) > 0) { + if (W_ZPM(wdes) == '[') + zpm = zsc_pmsection (W_ZPM(wdes), im) + else + zpm = ds_pmmap (W_ZPM(wdes), im) + } else + zpm = NULL + iferr (bpm = ds_pmmap (W_BPM(wdes), im)) { + call erract (EA_WARN) + bpm = NULL + } + } + + if (zscale_flag) { + # Autoscaling is desired. Compute Z1 and Z2 which straddle the + # median computed by sampling a portion of the image. + + contrast = clgetr ("contrast") + call mzscale (im, zpm, bpm, contrast, nsample, z1, z2) + if (zpm != NULL) + call imunmap (zpm) + if (bpm != NULL) + call imunmap (bpm) + + } else if (zrange_flag) { + # Use the limits in the header if current otherwise get the + # minimum and maximum of the sample mask. + if (IM_LIMTIME(im) >= IM_MTIME(im)) { + z1 = IM_MIN(im) + z2 = IM_MAX(im) + } else { + call mzscale (im, zpm, bpm, 0., nsample, z1, z2) + if (zpm != NULL) + call imunmap (zpm) + if (bpm != NULL) + call imunmap (bpm) + } + + } else if (zmap_flag) { + z1 = clgetr ("z1") + z2 = clgetr ("z2") + } else { + z1 = IM_MIN(ds) + z2 = IM_MAX(ds) + } + + W_ZS(wdwin) = z1 + W_ZE(wdwin) = z2 + + call printf ("z1=%g z2=%g\n") + call pargr (z1) + call pargr (z2) + call flush (STDOUT) + + # The user world coordinate system should be set from the CTRAN + # structure in the image header, but for now we just make it equal + # to the pixel coordinate system. + + call amovi (Memi[wdwin], Memi[wwwin], LEN_WC) + W_UPTR(wwwin) = NULL # should not copy pointers!! + call sfree (sp) +end + + +# DS_SETWCS -- Compute the rotation matrix needed to convert screen coordinates +# (zero indexed, y-flipped) to image pixel coordinates, allowing both for the +# transformation from screen space to the image section being displayed, and +# from the image section to the physical input image. +# +# NOTE -- This code assumes that the display device is zero-indexed and +# y-flipped; this is usually the case, but should be parameterized in the +# graphcap. This code also assumes that the full device screen is being used, +# and that we are not assigning multiple WCS to different regions of the screen. + +procedure ds_setwcs (im, ds, wdes, image, frame) + +pointer im, ds, wdes # image, display, and coordinate descriptors +char image[SZ_FNAME] # image section name +int frame # frame + +real a, b, c, d, tx, ty +int ip, i, j, axis[2] +real sx, sy +int dx, dy, snx, sny, dnx, dny +pointer sp, imname, title, wnwin, wdwin +pointer src, dest, region, objref +long lv[IM_MAXDIM], pv1[IM_MAXDIM], pv2[IM_MAXDIM] + +bool streq() + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (region, SZ_FNAME, TY_CHAR) + call salloc (objref, SZ_FNAME, TY_CHAR) + + # Compute the rotation matrix needed to transform screen pixel coords + # to image section coords. + + wnwin = W_WC(wdes,W_NWIN) + wdwin = W_WC(wdes,W_DWIN) + + # X transformation. + a = (W_XE(wdwin)-W_XS(wdwin))/((W_XE(wnwin)-W_XS(wnwin))*IM_LEN(ds,1)) + c = 0.0 # not rotated, cross term is zero + tx = W_XS(wdwin) - a * (W_XS(wnwin) * IM_LEN(ds,1)) + + # Y transformation. + b = 0.0 # not rotated, cross term is zero + d = (W_YE(wdwin)-W_YS(wdwin))/((W_YE(wnwin)-W_YS(wnwin))*IM_LEN(ds,2)) + ty = W_YS(wdwin) - d * (W_YS(wnwin) * IM_LEN(ds,2)) + + # Now allow for the Y-flip (origin at upper left in display window). + d = -d + ty = W_YE(wdwin) - d * ((1.0 - W_YE(wnwin)) * IM_LEN(ds,2)) + + # Now translate the screen corner to the center of the screen pixel. + tx = tx + 0.5 * a + ty = ty + 0.5 * d + + # Determine the logical to physical mapping by evaluating two points. + # and determining the axis reduction if any. pv1 will be the + # offset and pv2-pv1 will be the scale. + + call aclrl (pv1, IM_MAXDIM) + call aclrl (lv, IM_MAXDIM) + call imaplv (im, lv, pv1, 2) + call amovkl (long(1), lv, IM_MAXDIM) + call aclrl (pv2, IM_MAXDIM) + call imaplv (im, lv, pv2, 2) + + i = 1 + axis[1] = 1; axis[2] = 2 + do j = 1, IM_MAXDIM + if (pv1[j] != pv2[j]) { + axis[i] = j + i = i + 1 + } + + pv2[axis[1]] = (pv2[axis[1]] - pv1[axis[1]]) + pv2[axis[2]] = (pv2[axis[2]] - pv1[axis[2]]) + + # These imply a new rotation matrix which we won't bother to work out + # separately here. Multiply the two rotation matrices and add the + # translation vectors to get the overall transformation from screen + # coordinates to image coordinates. + a = a * pv2[axis[1]] + d = d * pv2[axis[2]] + tx = tx * pv2[axis[1]] + pv1[axis[1]] + ty = ty * pv2[axis[2]] + pv1[axis[2]] + + # Get the image name (minus image section) and + # title string (minus any newline. + call ds_gimage (im, image, Memc[imname], SZ_FNAME) + call strcpy (IM_TITLE(im), Memc[title], SZ_LINE) + for (ip=title; Memc[ip] != '\n' && Memc[ip] != EOS; ip=ip+1) + ; + Memc[ip] = EOS + + + # Define the mapping from the image pixels to frame buffer pixels. + src = W_WC(wdes,W_IPIX) + sx = W_XS(src) + sy = W_YS(src) + snx = (W_XE(src) - W_XS(src) + 1) + sny = (W_YE(src) - W_YS(src) + 1) + + dest = W_WC(wdes,W_DPIX) + dx = W_XS(dest) + dy = W_YS(dest) + dnx = (W_XE(dest) - W_XS(dest) + 1) + dny = (W_YE(dest) - W_YS(dest) + 1) + + # For a single image display the 'region' is fixed. The object ref + # is the fully defined image node!prefix path, including any sections. + # We need a special kludge to keep backward compatability with the + # use of "dev$pix" as the standard test image name. + call strcpy ("image", Memc[region], SZ_FNAME) + if (streq (image, "dev$pix")) + call fpathname ("dev$pix.imh", Memc[objref], SZ_PATHNAME) + else + call fpathname (image, Memc[objref], SZ_PATHNAME) + + # Add the mapping info to be written with the WCS. + call imd_setmapping (Memc[region], sx, sy, snx, sny, + dx, dy, dnx, dny, Memc[objref]) + + # Write the WCS. + call imd_putwcs (ds, frame, Memc[imname], Memc[title], + a, b, c, d, tx, ty, W_ZS(wdwin), W_ZE(wdwin), W_ZT(wdwin)) + + call sfree (sp) +end + + +# DS_GIMAGE -- Convert input image section name to a 2D physical image section. + +procedure ds_gimage (im, input, output, maxchar) + +pointer im #I IMIO pointer +char input[ARB] #I Input image name +char output[maxchar] #O Output image name +int maxchar #I Maximum characters in output name. + +int i, fd +pointer sp, section, lv, pv1, pv2 + +int stropen(), strlen() +bool streq() + +begin + call smark (sp) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (lv, IM_MAXDIM, TY_LONG) + call salloc (pv1, IM_MAXDIM, TY_LONG) + call salloc (pv2, IM_MAXDIM, TY_LONG) + + # Get endpoint coordinates in original image. + call amovkl (long(1), Meml[lv], IM_MAXDIM) + call aclrl (Meml[pv1], IM_MAXDIM) + call imaplv (im, Meml[lv], Meml[pv1], 2) + call amovl (IM_LEN(im,1), Meml[lv], IM_NDIM(im)) + call aclrl (Meml[pv2], IM_MAXDIM) + call imaplv (im, Meml[lv], Meml[pv2], 2) + + # Set image section. + fd = stropen (Memc[section], SZ_FNAME, NEW_FILE) + call fprintf (fd, "[") + do i = 1, IM_MAXDIM { + if (Meml[pv1+i-1] != Meml[pv2+i-1]) + call fprintf (fd, "*") + else if (Meml[pv1+i-1] != 0) { + call fprintf (fd, "%d") + call pargi (Meml[pv1+i-1]) + } else + break + call fprintf (fd, ",") + } + call close (fd) + i = strlen (Memc[section]) + Memc[section+i-1] = ']' + + if (streq ("[*,*]", Memc[section])) + Memc[section] = EOS + + # Strip existing image section and add new section. +# call imgimage (input, output, maxchar) +# call strcat (Memc[section], output, maxchar) + + if (Memc[section] == EOS) + call imgimage (input, output, maxchar) + else + call strcpy (input, output, maxchar) + + call sfree (sp) +end + + +# DS_LOAD_DISPLAY -- Map an image into the display window. In general this +# involves independent linear transformations in the X, Y, and Z (greyscale) +# dimensions. If a spatial dimension is larger than the display window then +# the image is block averaged. If a spatial dimension or a block averaged +# dimension is smaller than the display window then linear interpolation is +# used to expand the image. Both the input image and the output device appear +# to us as images, accessed via IMIO. All spatial scaling is +# handled by the "scaled input" package, i.e., SIGM2[SR]. Our task is to +# get lines from the scaled input image, transform the greyscale if necessary, +# and write the lines to the output device. + +procedure ds_load_display (im, ds, wdes) + +pointer im # input image +pointer ds # output image +pointer wdes # graphics window descriptor + +real z1, z2, dz1, dz2, px1, px2, py1, py2 +int i, order, zt, wx1, wx2, wy1, wy2, wy, nx, ny, xblk, yblk, color +pointer wdwin, wipix, wdpix, ovrly, bpm, pm, uptr +pointer in, out, si, si_ovrly, si_bpovrly, ocolors, bpcolors, rtemp +bool unitary_greyscale_transformation +short lut1, lut2, dz1_s, dz2_s, z1_s, z2_s + +bool fp_equalr() +int imstati(), maskcolor() +pointer ds_pmmap(), imps2s(), imps2r() +pointer sigm2s(), sigm2i(), sigm2r(), sigm2_setup() +errchk ds_pmmap, imps2s, imps2r, sigm2s, sigm2i, sigm2r, sigm2_setup +errchk maskexprn + +begin + wdwin = W_WC(wdes,W_DWIN) + wipix = W_WC(wdes,W_IPIX) + wdpix = W_WC(wdes,W_DPIX) + + # Set image and display pixels. + px1 = nint (W_XS(wipix)) + px2 = nint (W_XE(wipix)) + py1 = nint (W_YS(wipix)) + py2 = nint (W_YE(wipix)) + wx1 = nint (W_XS(wdpix)) + wx2 = nint (W_XE(wdpix)) + wy1 = nint (W_YS(wdpix)) + wy2 = nint (W_YE(wdpix)) + + z1 = W_ZS(wdwin) + z2 = W_ZE(wdwin) + zt = W_ZT(wdwin) + uptr = W_UPTR(wdwin) + order = max (W_XT(wdwin), W_YT(wdwin)) + + # Setup scaled input and masks. + si = NULL + si_ovrly = NULL + si_bpovrly = NULL + nx = wx2 - wx1 + 1 + ny = wy2 - wy1 + 1 + xblk = INDEFI + yblk = INDEFI + + ocolors = W_OCOLORS(wdes) + iferr (ovrly = ds_pmmap (W_OVRLY(wdes), im)) { + call erract (EA_WARN) + ovrly = NULL + } + if (ovrly != NULL) { + xblk = INDEFI + yblk = INDEFI + si_ovrly = sigm2_setup (ovrly, NULL, px1,px2,nx,xblk, + py1,py2,ny,yblk, -1) + } + + bpcolors = W_BPCOLORS(wdes) + switch (W_BPDISP(wdes)) { + case BPDNONE: + si = sigm2_setup (im, NULL, px1,px2,nx,xblk, py1,py2,ny,yblk, order) + case BPDOVRLY: + si = sigm2_setup (im, NULL, px1,px2,nx,xblk, py1,py2,ny,yblk, order) + iferr (bpm = ds_pmmap (W_BPM(wdes), im)) + bpm = NULL + if (bpm != NULL) + si_bpovrly = sigm2_setup (bpm, NULL, px1,px2,nx,xblk, + py1,py2,ny,yblk, -1) + case BPDINTERP: + iferr (bpm = ds_pmmap (W_BPM(wdes), im)) + bpm = NULL + if (bpm != NULL) + pm = imstati (bpm, IM_PMDES) + else + pm = NULL + si = sigm2_setup (im, pm, px1,px2,nx,xblk, py1,py2,ny,yblk, order) + } + + # The device IM_MIN and IM_MAX parameters define the acceptable range + # of greyscale values for the output device (e.g., 0-255 for most 8-bit + # display devices). Values Z1 and Z2 are mapped linearly or + # logarithmically into IM_MIN and IM_MAX. + + dz1 = IM_MIN(ds) + dz2 = IM_MAX(ds) + if (fp_equalr (z1, z2)) { + z1 = z1 - 1 + z2 = z2 + 1 + } + + # If the user specifies the transfer function, verify that the + # intensity and greyscale are in range. + + if (zt == W_USER) { + call alims (Mems[uptr], U_MAXPTS, lut1, lut2) + dz1_s = short (dz1) + dz2_s = short (dz2) + if (lut2 < dz1_s || lut1 > dz2_s) + call eprintf ("User specified greyscales out of range\n") + if (z2 < IM_MIN(im) || z1 > IM_MAX(im)) + call eprintf ("User specified intensities out of range\n") + } + + # Type short pixels are treated as a special case to minimize vector + # operations for such images (which are common). If the image pixels + # are either short or real then only the ALTR (greyscale transformation) + # vector operation is required. The ALTR operator linearly maps + # greylevels in the range Z1:Z2 to DZ1:DZ2, and does a floor ceiling + # of DZ1:DZ2 on all pixels outside the range. 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. + + if (zt == W_UNITARY) { + unitary_greyscale_transformation = true + } else if (zt == W_LINEAR) { + unitary_greyscale_transformation = + (fp_equalr(z1,dz1) && fp_equalr(z2,dz2)) + } else + unitary_greyscale_transformation = false + + if (IM_PIXTYPE(im) == TY_SHORT && zt != W_LOG) { + z1_s = z1; z2_s = z2 + if (z1_s == z2_s) { + z1_s = z1_s - 1 + z2_s = z2_s + 1 + } + + for (wy=wy1; wy <= wy2; wy=wy+1) { + in = sigm2s (si, wy - wy1 + 1) + out = imps2s (ds, wx1, wx2, wy, wy) + + if (unitary_greyscale_transformation) { + call amovs (Mems[in], Mems[out], nx) + } else if (zt == W_USER) { + dz1_s = U_Z1; dz2_s = U_Z2 + call amaps (Mems[in],Mems[out],nx, z1_s,z2_s, dz1_s,dz2_s) + call aluts (Mems[out], Mems[out], nx, Mems[uptr]) + } else { + dz1_s = dz1; dz2_s = dz2 + call amaps (Mems[in],Mems[out],nx, z1_s,z2_s, dz1_s,dz2_s) + } + + if (si_ovrly != NULL) { + in = sigm2i (si_ovrly, wy - wy1 + 1) + call maskexprn (ocolors, in, nx) + do i = 0, nx-1 { + if (Memi[in+i] != 0) { + color = maskcolor (ocolors, Memi[in+i]) + if (color >= 0) + Mems[out+i] = color + } + } + } + if (si_bpovrly != NULL) { + in = sigm2i (si_bpovrly, wy - wy1 + 1) + call maskexprn (bpcolors, in, nx) + do i = 0, nx-1 { + if (Memi[in+i] != 0) { + color = maskcolor (bpcolors, Memi[in+i]) + if (color >= 0) + Mems[out+i] = color + } + } + } + } + + } else if (zt == W_USER) { + call salloc (rtemp, nx, TY_REAL) + + for (wy=wy1; wy <= wy2; wy=wy+1) { + in = sigm2r (si, wy - wy1 + 1) + out = imps2s (ds, wx1, wx2, wy, wy) + + call amapr (Memr[in], Memr[rtemp], nx, z1, z2, + real(U_Z1), real(U_Z2)) + call achtrs (Memr[rtemp], Mems[out], nx) + call aluts (Mems[out], Mems[out], nx, Mems[uptr]) + + if (si_ovrly != NULL) { + in = sigm2i (si_ovrly, wy - wy1 + 1) + call maskexprn (ocolors, in, nx) + do i = 0, nx-1 { + if (Memi[in+i] != 0) { + color = maskcolor (ocolors, Memi[in+i]) + if (color >= 0) + Mems[out+i] = color + } + } + } + if (si_bpovrly != NULL) { + in = sigm2i (si_bpovrly, wy - wy1 + 1) + call maskexprn (bpcolors, in, nx) + do i = 0, nx-1 { + if (Memi[in+i] != 0) { + color = maskcolor (bpcolors, Memi[in+i]) + if (color >= 0) + Mems[out+i] = color + } + } + } + } + + } else { + for (wy=wy1; wy <= wy2; wy=wy+1) { + in = sigm2r (si, wy - wy1 + 1) + out = imps2r (ds, wx1, wx2, wy, wy) + + if (unitary_greyscale_transformation) { + call amovr (Memr[in], Memr[out], nx) + } else if (zt == W_LOG) { + call amapr (Memr[in], Memr[out], nx, + z1, z2, 1.0, 10.0 ** MAXLOG) + do i = 0, nx-1 + Memr[out+i] = log10 (Memr[out+i]) + call amapr (Memr[out], Memr[out], nx, + 0.0, real(MAXLOG), dz1, dz2) + } else + call amapr (Memr[in], Memr[out], nx, z1, z2, dz1, dz2) + + if (si_ovrly != NULL) { + in = sigm2i (si_ovrly, wy - wy1 + 1) + call maskexprn (ocolors, in, nx) + do i = 0, nx-1 { + if (Memi[in+i] != 0) { + color = maskcolor (ocolors, Memi[in+i]) + if (color >= 0) + Memr[out+i] = color + } + } + } + if (si_bpovrly != NULL) { + in = sigm2i (si_bpovrly, wy - wy1 + 1) + call maskexprn (bpcolors, in, nx) + do i = 0, nx-1 { + if (Memi[in+i] != 0) { + color = maskcolor (bpcolors, Memi[in+i]) + if (color >= 0) + Memr[out+i] = color + } + } + } + } + } + + call sigm2_free (si) + if (si_ovrly != NULL) + call sigm2_free (si_ovrly) + if (si_bpovrly != NULL) + call sigm2_free (si_bpovrly) + if (ovrly != NULL) + call imunmap (ovrly) + if (bpm != NULL) + call imunmap (bpm) +end + + +# DS_ERASE_BORDER -- Zero the border of the window if the frame has not been +# erased, and if the displayed section does not occupy the full window. +# It would be more efficient to do this while writing the greyscale data to +# the output image, but that would complicate the display procedures and frames +# are commonly erased before displaying an image. + +procedure ds_erase_border (im, ds, wdes) + +pointer im # input image +pointer ds # output image (display) +pointer wdes # window descriptor + +int wx1,wx2,wy1,wy2 # section of display window filled by image data +int dx1,dx2,dy1,dy2 # coords of full display window in device pixels +int i, nx +pointer wdwin, wdpix +pointer imps2s() +errchk imps2s + +begin + wdwin = W_WC(wdes,W_DWIN) + wdpix = W_WC(wdes,W_DPIX) + + # Set display pixels and display window pixels. + wx1 = nint (W_XS(wdpix)) + wx2 = nint (W_XE(wdpix)) + wy1 = nint (W_YS(wdpix)) + wy2 = nint (W_YE(wdpix)) + dx1 = max (1, nint (W_XS(wdwin))) + dx2 = min (IM_LEN(ds,1), nint (W_XE(wdwin) - 0.01)) + dy1 = max (1, nint (W_YS(wdwin))) + dy2 = min (IM_LEN(ds,2), nint (W_YE(wdwin) - 0.01)) + nx = dx2 - dx1 + 1 + + # Erase lower margin. + for (i=dy1; i < wy1; i=i+1) + call aclrs (Mems[imps2s (ds, dx1, dx2, i, i)], nx) + + # Erase left and right margins. By doing the right margin of a line + # immediately after the left margin we have a high liklihood that the + # display line will still be in the FIO buffer. + + for (i=wy1; i <= wy2; i=i+1) { + if (dx1 < wx1) + call aclrs (Mems[imps2s (ds, dx1, wx1-1, i, i)], wx1 - dx1) + if (wx2 < dx2) + call aclrs (Mems[imps2s (ds, wx2+1, dx2, i, i)], dx2 - wx2) + } + + # Erase upper margin. + for (i=wy2+1; i <= dy2; i=i+1) + call aclrs (Mems[imps2s (ds, dx1, dx2, i, i)], nx) +end diff --git a/pkg/images/tv/display/zardim.x b/pkg/images/tv/display/zardim.x new file mode 100644 index 00000000..e09c4b10 --- /dev/null +++ b/pkg/images/tv/display/zardim.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZARDIM -- Read data from a binary file display device. + +procedure zardim (chan, buf, nbytes, offset) + +int chan[ARB] +short buf[ARB] +int nbytes +long offset +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisrd (chan, buf, nbytes, offset) + } +end diff --git a/pkg/images/tv/display/zawrim.x b/pkg/images/tv/display/zawrim.x new file mode 100644 index 00000000..a7219b07 --- /dev/null +++ b/pkg/images/tv/display/zawrim.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZAWRIM -- Write data to a binary file display device. + +procedure zawrim (chan, buf, nbytes, offset) + +int chan[ARB] +short buf[ARB] +int nbytes +long offset +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iiswr (chan, buf, nbytes, offset) + } +end diff --git a/pkg/images/tv/display/zawtim.x b/pkg/images/tv/display/zawtim.x new file mode 100644 index 00000000..13756adc --- /dev/null +++ b/pkg/images/tv/display/zawtim.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZAWTIM -- Wait for an image display frame which is addressable as +# a binary file. + +procedure zawtim (chan, nbytes) + +int chan[ARB], nbytes +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iiswt (chan, nbytes) + } +end diff --git a/pkg/images/tv/display/zblkim.x b/pkg/images/tv/display/zblkim.x new file mode 100644 index 00000000..55041809 --- /dev/null +++ b/pkg/images/tv/display/zblkim.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZBLKIM -- Blink binary file display device (millisecond time resolution). + +procedure zblkim (chan1, chan2, chan3, chan4, nframes, rate) + +int chan1[ARB] +int chan2[ARB] +int chan3[ARB] +int chan4[ARB] +int nframes +real rate +int device + +begin + device = chan1[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisblk (chan1, chan2, chan3, chan4, nframes, rate) + } +end diff --git a/pkg/images/tv/display/zclrim.x b/pkg/images/tv/display/zclrim.x new file mode 100644 index 00000000..268123cc --- /dev/null +++ b/pkg/images/tv/display/zclrim.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZCLRIM -- Color window binary file display device. + +procedure zclrim (chan) + +int chan[ARB] +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisclr (chan) + } +end diff --git a/pkg/images/tv/display/zclsim.x b/pkg/images/tv/display/zclsim.x new file mode 100644 index 00000000..8f3f34b0 --- /dev/null +++ b/pkg/images/tv/display/zclsim.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZCLSIM -- Close an image display frame which is addressable as +# a binary file. + +procedure zclsim (chan, status) + +int chan[ARB] +int status +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iiscls (chan, status) + default: + status = ERR + } +end diff --git a/pkg/images/tv/display/zdisplay.h b/pkg/images/tv/display/zdisplay.h new file mode 100644 index 00000000..b55b94dc --- /dev/null +++ b/pkg/images/tv/display/zdisplay.h @@ -0,0 +1,6 @@ +# Display devices defined by OS + +define IIS "/dev/iis" # IIS display device +define IIS_CHAN 1 # Device channel identifier +define DEVCODE 100 # Channel = DEVCODE * DEVCHAN +define FRTOCHAN (IIS_CHAN*DEVCODE+($1)) diff --git a/pkg/images/tv/display/zersim.x b/pkg/images/tv/display/zersim.x new file mode 100644 index 00000000..c1b280e4 --- /dev/null +++ b/pkg/images/tv/display/zersim.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZERSIM -- Erase binary file display device. + +procedure zersim (chan) + +int chan[ARB] +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisers (chan) + } +end diff --git a/pkg/images/tv/display/zfrmim.x b/pkg/images/tv/display/zfrmim.x new file mode 100644 index 00000000..de2bfee2 --- /dev/null +++ b/pkg/images/tv/display/zfrmim.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZFRMIM -- Set FRAME display. + +procedure zfrmim (chan) + +int chan[ARB] + +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisrgb (chan, chan, chan) + } +end diff --git a/pkg/images/tv/display/zmapim.x b/pkg/images/tv/display/zmapim.x new file mode 100644 index 00000000..5c3e663a --- /dev/null +++ b/pkg/images/tv/display/zmapim.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZMAPIM -- Set display map. + +procedure zmapim (chan, maptype) + +int chan[ARB] +char maptype[ARB] +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisofm (maptype) + } +end diff --git a/pkg/images/tv/display/zmtcim.x b/pkg/images/tv/display/zmtcim.x new file mode 100644 index 00000000..11dddb65 --- /dev/null +++ b/pkg/images/tv/display/zmtcim.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZMTCIM -- Match lut to frame. + +procedure zmtcim (chan1, chan2) + +int chan1[ARB], chan2[ARB] +int device + +begin + device = chan1[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iismtc (chan1, chan2) + } +end diff --git a/pkg/images/tv/display/zopnim.x b/pkg/images/tv/display/zopnim.x new file mode 100644 index 00000000..ddd18d3a --- /dev/null +++ b/pkg/images/tv/display/zopnim.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZOPNIM -- Open an image display frame which is addressable as +# a binary file. + +procedure zopnim (devinfo, mode, chan) + +char devinfo[ARB] # packed devinfo string +int mode # access mode +int chan + +int iischan[2] # Kludge + +begin + call iisopn (devinfo, mode, iischan) + chan = iischan[1] +end diff --git a/pkg/images/tv/display/zrcrim.x b/pkg/images/tv/display/zrcrim.x new file mode 100644 index 00000000..3f4f939b --- /dev/null +++ b/pkg/images/tv/display/zrcrim.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZRCRIM -- Read Cursor from binary file display device. + +procedure zrcrim (chan, xcur, ycur) + +int chan[ARB] +int status, xcur, ycur +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisrcr (status, xcur, ycur) + } +end diff --git a/pkg/images/tv/display/zrgbim.x b/pkg/images/tv/display/zrgbim.x new file mode 100644 index 00000000..04c0e147 --- /dev/null +++ b/pkg/images/tv/display/zrgbim.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZRGBIM -- Set RGB display. + +procedure zrgbim (red_chan, green_chan, blue_chan) + +int red_chan[ARB], green_chan[ARB], blue_chan[ARB] + +int device + +begin + device = red_chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisrgb (red_chan, green_chan, blue_chan) + } +end diff --git a/pkg/images/tv/display/zrmim.x b/pkg/images/tv/display/zrmim.x new file mode 100644 index 00000000..f26ee6ef --- /dev/null +++ b/pkg/images/tv/display/zrmim.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZRMIM -- Zoom and roam display. + +procedure zrmim (chan, zfactor) + +int chan[ARB] +int zfactor +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iisrm (zfactor) + } +end diff --git a/pkg/images/tv/display/zscale.x b/pkg/images/tv/display/zscale.x new file mode 100644 index 00000000..abbf2ecb --- /dev/null +++ b/pkg/images/tv/display/zscale.x @@ -0,0 +1,623 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <imio.h> + +# User callable routines. +# ZSCALE -- Sample an image and compute greyscale limits. +# MZSCALE -- Sample an image with pixel masks and compute greyscale limits. +# ZSC_PMSECTION -- Create a pixel mask from an image section. +# ZSC_ZLIMITS -- Compute Z transform limits from a sample of pixels. + + +# ZSCALE -- Sample an image and compute greyscale limits. +# A sample mask is created based on the input parameters and then +# MZSCALE is called. + +procedure zscale (im, z1, z2, contrast, optimal_sample_size, len_stdline) + +pointer im # image to be sampled +real z1, z2 # output min and max greyscale values +real contrast # adj. to slope of transfer function +int optimal_sample_size # desired number of pixels in sample +int len_stdline # optimal number of pixels per line + +int nc, nl +pointer sp, section, zpm, zsc_pmsection() +errchk zsc_pmsection, mzscale + +begin + call smark (sp) + call salloc (section, SZ_FNAME, TY_CHAR) + + # Make the sample image section. + switch (IM_NDIM(im)) { + case 1: + call sprintf (Memc[section], SZ_FNAME, "[*]") + default: + nc = max (1, min (IM_LEN(im,1), len_stdline)) + nl = max (1, min (IM_LEN(im,2), optimal_sample_size / nc)) + call sprintf (Memc[section], SZ_FNAME, "[*:%d,*:%d]") + call pargi (IM_LEN(im,1) / nc) + call pargi (IM_LEN(im,2) / nl) + } + + # Make a mask and compute the greyscale limits. + zpm = zsc_pmsection (Memc[section], im) + call mzscale (im, zpm, NULL, contrast, optimal_sample_size, z1, z2) + call imunmap (zpm) + call sfree (sp) +end + + +# MZSCALE -- Sample an image with pixel masks and compute greyscale limits. +# The image is sampled through a pixel mask. If no pixel mask is given +# a uniform sample mask is generated. If a bad pixel mask is given +# bad pixels in the sample are eliminated. Once the sample is obtained +# the greyscale limits are obtained using the ZSC_ZLIMITS algorithm. + +procedure mzscale (im, zpm, bpm, contrast, maxpix, z1, z2) + +pointer im #I image to be sampled +pointer zpm #I pixel mask for sampling +pointer bpm #I bad pixel mask +real contrast #I contrast parameter +int maxpix #I maximum number of pixels in sample +real z1, z2 #O output min and max greyscale values + +int i, ndim, nc, nl, npix, nbp, imstati() +pointer sp, section, v, sample, zmask, bp, zim, pmz, pmb, buf +pointer zsc_pmsection(), imgnlr() +bool pm_linenotempty() +errchk zsc_pmsection, zsc_zlimits + +begin + call smark (sp) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (v, IM_MAXDIM, TY_LONG) + call salloc (sample, maxpix, TY_REAL) + zmask = NULL + bp = NULL + + ndim = min (2, IM_NDIM(im)) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + # Generate a uniform sample mask if none is given. + if (zpm == NULL) { + switch (IM_NDIM(im)) { + case 1: + call sprintf (Memc[section], SZ_FNAME, "[*]") + default: + i = max (1., sqrt ((nc-1)*(nl-1) / real (maxpix))) + call sprintf (Memc[section], SZ_FNAME, "[*:%d,*:%d]") + call pargi (i) + call pargi (i) + } + zim = zsc_pmsection (Memc[section], im) + pmz = imstati (zim, IM_PMDES) + } else + pmz = imstati (zpm, IM_PMDES) + + # Set bad pixel mask. + if (bpm != NULL) + pmb = imstati (bpm, IM_PMDES) + else + pmb = NULL + + # Get the sample up to maxpix pixels. + npix = 0 + nbp = 0 + call amovkl (long(1), Memi[v], IM_MAXDIM) + repeat { + if (pm_linenotempty (pmz, Meml[v])) { + if (zmask == NULL) + call salloc (zmask, nc, TY_INT) + call pmglpi (pmz, Meml[v], Memi[zmask], 0, nc, 0) + if (pmb != NULL) { + if (pm_linenotempty (pmb, Meml[v])) { + if (bp == NULL) + call salloc (bp, nc, TY_INT) + call pmglpi (pmb, Meml[v], Memi[bp], 0, nc, 0) + nbp = nc + } else + nbp = 0 + + } + if (imgnlr (im, buf, Meml[v]) == EOF) + break + do i = 0, nc-1 { + if (Memi[zmask+i] == 0) + next + if (nbp > 0) + if (Memi[bp+i] != 0) + next + Memr[sample+npix] = Memr[buf+i] + npix = npix + 1 + if (npix == maxpix) + break + } + if (npix == maxpix) + break + } else { + do i = 2, ndim { + Meml[v+i-1] = Meml[v+i-1] + 1 + if (Meml[v+i-1] <= IM_LEN(im,i)) + break + else if (i < ndim) + Meml[v+i-1] = 1 + } + } + } until (Meml[v+ndim-1] > IM_LEN(im,ndim)) + + if (zpm == NULL) + call imunmap (zim) + + # Compute greyscale limits. + call zsc_zlimits (Memr[sample], npix, contrast, z1, z2) + + call sfree (sp) +end + + +# ZSC_PMSECTION -- Create a pixel mask from an image section. +# This only applies the mask to the first plane of the image. + +pointer procedure zsc_pmsection (section, refim) + +char section[ARB] #I Image section +pointer refim #I Reference image pointer + +int i, j, ip, ndim, temp, a[2], b[2], c[2], rop, ctoi() +pointer pm, im, mw, dummy, pm_newmask(), im_pmmapo(), imgl1i(), mw_openim() +define error_ 99 + +begin + # Decode the section string. + call amovki (1, a, 2) + call amovki (1, b, 2) + call amovki (1, c, 2) + ndim = min (2, IM_NDIM(refim)) + do i = 1, ndim + b[i] = IM_LEN(refim,i) + + ip = 1 + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == '[') { + ip = ip + 1 + + do i = 1, ndim { + while (IS_WHITE(section[ip])) + ip = ip + 1 + + # 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[i] = temp + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, b[i]) == 0) # a:b + goto error_ + } else + b[i] = a[i] + } else if (section[ip] == '-') { # -* + temp = a[i] + a[i] = b[i] + b[i] = temp + ip = ip + 1 + if (section[ip] == '*') + ip = ip + 1 + } else if (section[ip] == '*') # * + ip = ip + 1 + if (section[ip] == ':') { # ..:step + ip = ip + 1 + if (ctoi (section, ip, c[i]) == 0) + goto error_ + else if (c[i] == 0) + goto error_ + } + if (a[i] > b[i] && c[i] > 0) + c[i] = -c[i] + + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (i < ndim) { + if (section[ip] != ',') + goto error_ + } else { + if (section[ip] != ']') + goto error_ + } + ip = ip + 1 + } + } + + # In this case make the values be increasing only. + do i = 1, ndim + if (c[i] < 0) { + temp = a[i] + a[i] = b[i] + b[i] = temp + c[i] = -c[i] + } + + # Make the mask. + pm = pm_newmask (refim, 16) + + rop = PIX_SET+PIX_VALUE(1) + if (c[1] == 1 && c[2] == 1) + call pm_box (pm, a[1], a[2], b[1], b[2], rop) + + else if (c[1] == 1) + for (i=a[2]; i<=b[2]; i=i+c[2]) + call pm_box (pm, a[1], i, b[1], i, rop) + + else + for (i=a[2]; i<=b[2]; i=i+c[2]) + for (j=a[1]; j<=b[1]; j=j+c[1]) + call pm_point (pm, j, i, rop) + + i = IM_NPHYSDIM(refim) + IM_NPHYSDIM(refim) = ndim + im = im_pmmapo (pm, refim) + IM_NPHYSDIM(refim) = i + dummy = imgl1i (im) # Force I/O to set header + ifnoerr (mw = mw_openim (refim)) { # Set WCS + call mw_saveim (mw, im) + call mw_close (mw) + } + + return (im) + +error_ + call error (1, "Error in image section specification") +end + + +.help zsc_zlimits +.nf ___________________________________________________________________________ +ZSC_ZLIMITS -- Compute limits for a linear transform that best samples the +the histogram about the median value. This is often called to compute +greyscale limits from a sample of pixel values. + +If the number of pixels is too small an error condition is returned. If +the contrast parameter value is zero the limits of the sample are +returned. Otherwise the sample is sorted and the median is found from the +central value(s). A straight line is fitted to the sorted sample with +interative rejection. If more than half the pixels are rejected the full +range is returned. The contrast parameter is used to adjust the transfer +slope about the median. The final limits are the extension of the fitted +line to the first and last array index. +.endhelp ______________________________________________________________________ + +define MIN_NPIXELS 5 # smallest permissible sample +define MAX_REJECT 0.5 # max frac. of pixels to be rejected +define GOOD_PIXEL 0 # use pixel in fit +define BAD_PIXEL 1 # ignore pixel in all computations +define REJECT_PIXEL 2 # reject pixel after a bit +define KREJ 2.5 # k-sigma pixel rejection factor +define MAX_ITERATIONS 5 # maximum number of fitline iterations + + +# ZSC_ZLIMITS -- Compute Z transform limits from a sample of pixels. + +procedure zsc_zlimits (sample, npix, contrast, z1, z2) + +real sample[ARB] #I Sample of pixel values (possibly resorted) +int npix #I Number of pixels +real contrast #I Contrast algorithm parameter +real z1, z2 #O Z transform limits + +int center_pixel, minpix, ngoodpix, ngrow, zsc_fit_line() +real zmin, zmax, median +real zstart, zslope + +begin + # Check for a sufficient sample. + if (npix < MIN_NPIXELS) + call error (1, "Insufficient sample pixels found") + + # If contrast is zero return the range. + if (contrast == 0.) { + call alimr (sample, npix, z1, z2) + return + } + + # Sort the sample, compute the range, and median pixel values. + # The median value is the average of the two central values if there + # are an even number of pixels in the sample. + + call asrtr (sample, sample, npix) + zmin = sample[1] + zmax = sample[npix] + + center_pixel = (npix + 1) / 2 + if (mod (npix, 2) == 1) + median = sample[center_pixel] + else + median = (sample[center_pixel] + sample[center_pixel+1]) / 2 + + # Fit a line to the sorted sample vector. If more than half of the + # pixels in the sample are rejected give up and return the full range. + # If the user-supplied contrast factor is not 1.0 adjust the scale + # accordingly and compute Z1 and Z2, the y intercepts at indices 1 and + # npix. + + minpix = max (MIN_NPIXELS, int (npix * MAX_REJECT)) + ngrow = max (1, nint (npix * .01)) + ngoodpix = zsc_fit_line (sample, npix, zstart, zslope, + KREJ, ngrow, MAX_ITERATIONS) + + if (ngoodpix < minpix) { + z1 = zmin + z2 = zmax + } else { + if (contrast > 0) + zslope = zslope / contrast + z1 = max (zmin, median - (center_pixel - 1) * zslope) + z2 = min (zmax, median + (npix - center_pixel) * zslope) + } +end + + +# ZSC_FIT_LINE -- Fit a straight line to a data array of type real. This is +# an iterative fitting algorithm, wherein points further than ksigma from the +# current fit are excluded from the next fit. Convergence occurs when the +# next iteration does not decrease the number of pixels in the fit, or when +# there are no pixels left. The number of pixels left after pixel rejection +# is returned as the function value. + +int procedure zsc_fit_line (data, npix, zstart, zslope, krej, ngrow, maxiter) + +real data[npix] # data to be fitted +int npix # number of pixels before rejection +real zstart # Z-value of pixel data[1] (output) +real zslope # dz/pixel (output) +real krej # k-sigma pixel rejection factor +int ngrow # number of pixels of growing +int maxiter # max iterations + +int i, ngoodpix, last_ngoodpix, minpix, niter +real xscale, z0, dz, x, z, mean, sigma, threshold +double sumxsqr, sumxz, sumz, sumx, rowrat +pointer sp, flat, badpix, normx +int zsc_reject_pixels(), zsc_compute_sigma() + +begin + call smark (sp) + + if (npix <= 0) + return (0) + else if (npix == 1) { + zstart = data[1] + zslope = 0.0 + return (1) + } else + xscale = 2.0 / (npix - 1) + + # Allocate a buffer for data minus fitted curve, another for the + # normalized X values, and another to flag rejected pixels. + + call salloc (flat, npix, TY_REAL) + call salloc (normx, npix, TY_REAL) + call salloc (badpix, npix, TY_SHORT) + call aclrs (Mems[badpix], npix) + + # Compute normalized X vector. The data X values [1:npix] are + # normalized to the range [-1:1]. This diagonalizes the lsq matrix + # and reduces its condition number. + + do i = 0, npix - 1 + Memr[normx+i] = i * xscale - 1.0 + + # Fit a line with no pixel rejection. Accumulate the elements of the + # matrix and data vector. The matrix M is diagonal with + # M[1,1] = sum x**2 and M[2,2] = ngoodpix. The data vector is + # DV[1] = sum (data[i] * x[i]) and DV[2] = sum (data[i]). + + sumxsqr = 0 + sumxz = 0 + sumx = 0 + sumz = 0 + + do i = 1, npix { + x = Memr[normx+i-1] + z = data[i] + sumxsqr = sumxsqr + (x ** 2) + sumxz = sumxz + z * x + sumz = sumz + z + } + + # Solve for the coefficients of the fitted line. + z0 = sumz / npix + dz = sumxz / sumxsqr + + # Iterate, fitting a new line in each iteration. Compute the flattened + # data vector and the sigma of the flat vector. Compute the lower and + # upper k-sigma pixel rejection thresholds. Run down the flat array + # and detect pixels to be rejected from the fit. Reject pixels from + # the fit by subtracting their contributions from the matrix sums and + # marking the pixel as rejected. + + ngoodpix = npix + minpix = max (MIN_NPIXELS, int (npix * MAX_REJECT)) + + for (niter=1; niter <= maxiter; niter=niter+1) { + last_ngoodpix = ngoodpix + + # Subtract the fitted line from the data array. + call zsc_flatten_data (data, Memr[flat], Memr[normx], npix, z0, dz) + + # Compute the k-sigma rejection threshold. In principle this + # could be more efficiently computed using the matrix sums + # accumulated when the line was fitted, but there are problems with + # numerical stability with that approach. + + ngoodpix = zsc_compute_sigma (Memr[flat], Mems[badpix], npix, + mean, sigma) + threshold = sigma * krej + + # Detect and reject pixels further than ksigma from the fitted + # line. + ngoodpix = zsc_reject_pixels (data, Memr[flat], Memr[normx], + Mems[badpix], npix, sumxsqr, sumxz, sumx, sumz, threshold, + ngrow) + + # Solve for the coefficients of the fitted line. Note that after + # pixel rejection the sum of the X values need no longer be zero. + + if (ngoodpix > 0) { + rowrat = sumx / sumxsqr + z0 = (sumz - rowrat * sumxz) / (ngoodpix - rowrat * sumx) + dz = (sumxz - z0 * sumx) / sumxsqr + } + + if (ngoodpix >= last_ngoodpix || ngoodpix < minpix) + break + } + + # Transform the line coefficients back to the X range [1:npix]. + zstart = z0 - dz + zslope = dz * xscale + + call sfree (sp) + return (ngoodpix) +end + + +# ZSC_FLATTEN_DATA -- Compute and subtract the fitted line from the data array, +# returned the flattened data in FLAT. + +procedure zsc_flatten_data (data, flat, x, npix, z0, dz) + +real data[npix] # raw data array +real flat[npix] # flattened data (output) +real x[npix] # x value of each pixel +int npix # number of pixels +real z0, dz # z-intercept, dz/dx of fitted line +int i + +begin + do i = 1, npix + flat[i] = data[i] - (x[i] * dz + z0) +end + + +# ZSC_COMPUTE_SIGMA -- Compute the root mean square deviation from the +# mean of a flattened array. Ignore rejected pixels. + +int procedure zsc_compute_sigma (a, badpix, npix, mean, sigma) + +real a[npix] # flattened data array +short badpix[npix] # bad pixel flags (!= 0 if bad pixel) +int npix +real mean, sigma # (output) + +real pixval +int i, ngoodpix +double sum, sumsq, temp + +begin + sum = 0 + sumsq = 0 + ngoodpix = 0 + + # Accumulate sum and sum of squares. + do i = 1, npix + if (badpix[i] == GOOD_PIXEL) { + pixval = a[i] + ngoodpix = ngoodpix + 1 + sum = sum + pixval + sumsq = sumsq + pixval ** 2 + } + + # Compute mean and sigma. + switch (ngoodpix) { + case 0: + mean = INDEF + sigma = INDEF + case 1: + mean = sum + sigma = INDEF + default: + mean = sum / ngoodpix + temp = sumsq / (ngoodpix - 1) - sum**2 / (ngoodpix * (ngoodpix - 1)) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngoodpix) +end + + +# ZSC_REJECT_PIXELS -- Detect and reject pixels more than "threshold" greyscale +# units from the fitted line. The residuals about the fitted line are given +# by the "flat" array, while the raw data is in "data". Each time a pixel +# is rejected subtract its contributions from the matrix sums and flag the +# pixel as rejected. When a pixel is rejected reject its neighbors out to +# a specified radius as well. This speeds up convergence considerably and +# produces a more stringent rejection criteria which takes advantage of the +# fact that bad pixels tend to be clumped. The number of pixels left in the +# fit is returned as the function value. + +int procedure zsc_reject_pixels (data, flat, normx, badpix, npix, + sumxsqr, sumxz, sumx, sumz, threshold, ngrow) + +real data[npix] # raw data array +real flat[npix] # flattened data array +real normx[npix] # normalized x values of pixels +short badpix[npix] # bad pixel flags (!= 0 if bad pixel) +int npix +double sumxsqr,sumxz,sumx,sumz # matrix sums +real threshold # threshold for pixel rejection +int ngrow # number of pixels of growing + +int ngoodpix, i, j +real residual, lcut, hcut +double x, z + +begin + ngoodpix = npix + lcut = -threshold + hcut = threshold + + do i = 1, npix + if (badpix[i] == BAD_PIXEL) + ngoodpix = ngoodpix - 1 + else { + residual = flat[i] + if (residual < lcut || residual > hcut) { + # Reject the pixel and its neighbors out to the growing + # radius. We must be careful how we do this to avoid + # directional effects. Do not turn off thresholding on + # pixels in the forward direction; mark them for rejection + # but do not reject until they have been thresholded. + # If this is not done growing will not be symmetric. + + do j = max(1,i-ngrow), min(npix,i+ngrow) { + if (badpix[j] != BAD_PIXEL) { + if (j <= i) { + x = normx[j] + z = data[j] + sumxsqr = sumxsqr - (x ** 2) + sumxz = sumxz - z * x + sumx = sumx - x + sumz = sumz - z + badpix[j] = BAD_PIXEL + ngoodpix = ngoodpix - 1 + } else + badpix[j] = REJECT_PIXEL + } + } + } + } + + return (ngoodpix) +end diff --git a/pkg/images/tv/display/zsttim.x b/pkg/images/tv/display/zsttim.x new file mode 100644 index 00000000..dc6c91f6 --- /dev/null +++ b/pkg/images/tv/display/zsttim.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <knet.h> +include <fio.h> +include "iis.h" + +# ZSTTIM -- Return status on binary file display device. + +procedure zsttim (chan, what, lvalue) + +int chan[ARB], what +long lvalue + +include "iis.com" + +begin + call zsttgd (iischan, what, lvalue) + + if (what == FSTT_MAXBUFSIZE) { + # Return the maximum transfer size in bytes. + if (lvalue == 0) + lvalue = FSTT_MAXBUFSIZE + if (!packit) + lvalue = min (IIS_MAXBUFSIZE, lvalue) * 2 + } +end diff --git a/pkg/images/tv/display/zwndim.x b/pkg/images/tv/display/zwndim.x new file mode 100644 index 00000000..d27027cf --- /dev/null +++ b/pkg/images/tv/display/zwndim.x @@ -0,0 +1,31 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "zdisplay.h" + +# ZWNDIM -- Window binary file display device. + +procedure zwndim (chan) + +int chan[ARB] +int device + +begin + device = chan[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iiswnd3 (chan, chan, chan) + } +end + +procedure zwndim3 (chan1, chan2, chan3) + +int chan1[ARB], chan2[ARB], chan3[ARB] +int device + +begin + device = chan1[1] / DEVCODE + switch (device) { + case IIS_CHAN: + call iiswnd3 (chan1, chan2, chan3) + } +end diff --git a/pkg/images/tv/display/zzdebug.x b/pkg/images/tv/display/zzdebug.x new file mode 100644 index 00000000..eb642d42 --- /dev/null +++ b/pkg/images/tv/display/zzdebug.x @@ -0,0 +1,165 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +task mktest = t_mktest, + sigl2 = t_sigl2, + wrimage = t_wrimage, + zscale = t_zscale, + rcur = t_rcur + +define TWOPI 6.23 + + +# MKTEST -- Make a test image containing a circularly symetric sinusoid. + +procedure t_mktest() + +char imname[SZ_FNAME] +int nx, ny +int i, j +real period, xcen, ycen, radius +pointer im, line + +int clgeti() +real clgetr() +pointer immap(), impl2r() + +begin + call clgstr ("imname", imname, SZ_FNAME) + im = immap (imname, NEW_IMAGE, 0) + + nx = clgeti ("nx") + ny = clgeti ("ny") + period = clgetr ("period") + + IM_LEN(im,1) = nx + IM_LEN(im,2) = ny + + xcen = (nx + 1) / 2.0 + ycen = (ny + 1) / 2.0 + + do j = 1, ny { + line = impl2r (im, j) + do i = 1, nx { + radius = sqrt ((i - xcen) ** 2 + (j - ycen) ** 2) + Memr[line+i-1] = sin ((radius / period) * TWOPI) * 255.0 + } + } + + call imunmap (im) +end + + +# READ -- Benchmark scaled input procedure. + +procedure t_sigl2 () + +char imname[SZ_FNAME] +pointer im, si, buf +int i, nx, ny, xblk, yblk +pointer sigl2_setup(), sigl2s(), immap() + +begin + call clgstr ("imname", imname, SZ_FNAME) + im = immap (imname, READ_ONLY, 0) + + nx = IM_LEN(im,1) + ny = IM_LEN(im,2) + + xblk = INDEFI + yblk = INDEFI + si = sigl2_setup (im, 1.0,real(nx),nx,xblk, 1.0,real(ny),ny,yblk,0) + + do i = 1, ny + buf = sigl2s (si, i) + + call sigl2_free (si) + call imunmap (im) +end + + +# WRIMAGE -- Benchmark image output as used in the display program. + +procedure t_wrimage () + +char imname[SZ_FNAME] +int i, ncols, nlines +pointer im, buf +int clgeti() +pointer immap(), imps2s() + +begin + call clgstr ("imname", imname, SZ_FNAME) + im = immap (imname, NEW_IMAGE, 0) + + ncols = clgeti ("ncols") + nlines = clgeti ("nlines") + + IM_LEN(im,1) = ncols + IM_LEN(im,2) = nlines + IM_PIXTYPE(im) = TY_SHORT + + do i = 1, nlines + buf = imps2s (im, 1, ncols, i, i) + + call imunmap (im) +end + + +# ZSCALE -- Test the zscale procedure, used to determine the smallest range of +# greyscale values which preserves the most information in an image. + +procedure t_zscale() + +char imname[SZ_FNAME] +int sample_size, len_stdline +real z1, z2, contrast +int clgeti() +real clgetr() +pointer im, immap() + +begin + call clgstr ("imname", imname, SZ_FNAME) + im = immap (imname, READ_ONLY, 0) + + sample_size = clgeti ("npix") + len_stdline = clgeti ("stdline") + contrast = clgetr ("contrast") + + call zscale (im, z1, z2, contrast, sample_size, len_stdline) + call printf ("z1=%g, z2=%g\n") + call pargr (z1) + call pargr (z2) +end + + +# RCUR -- Try reading the image cursor. + +procedure t_rcur() + +real x, y +int wcs, key +int wci, pause +char device[SZ_FNAME] +char strval[SZ_LINE] + +bool clgetb() +int btoi(), clgeti(), imdrcur() + +begin + call clgstr ("device", device, SZ_FNAME) + wci = clgeti ("wcs") + pause = btoi (clgetb ("pause")) + + while (imdrcur (device, x,y,wcs,key,strval,SZ_LINE, wci,pause) != EOF) { + call printf ("%8.2f %8.2f %d %o %s\n") + call pargr (x) + call pargr (y) + call pargi (wcs) + call pargi (key) + call pargstr (strval) + if (key == 'q') + break + } +end diff --git a/pkg/images/tv/doc/Tv.hlp b/pkg/images/tv/doc/Tv.hlp new file mode 100644 index 00000000..c48bbe2e --- /dev/null +++ b/pkg/images/tv/doc/Tv.hlp @@ -0,0 +1,357 @@ +.helpsys dcontrol Feb84 "Image Display Control" +.ce +\fBImage Display Control Software\fR +.ce +Technical Specifications +.ce +February 17, 1984 + + +.nh +Virtual Display Characteristics + + The display device is assumed to have N image memories or frames, +where N is at least one. All frames are assumed to be the same size and depth. +The frame size and depth (number of bits per pixel) are constant for a device. +There should be at least one graphics frame. The virtual interface associates +one graphics frame with each image frame, but at the device level the graphics +may be or-ed together and displayed on a single plane, if necessary. +A lookup table is associated with each image frame buffer and with each +color gun. The input of a color gun is the sum of the outputs of zero +or more frame buffers. There must be at least one cursor. + +.nh 2 +Basic Functions + + The virtual display device is assumed to provide the following +minimal set of basic functions. +.ls 4 +.ls [1] +Read or write an image frame buffer. Random addressability of pixels +is not assumed; writes may be aligned on image lines if necessary. +The ability to write more than one image line in a single transfer is assumed. +.le +.ls [2] +Erase an entire image frame buffer. +.le +.ls [3] +Read or write an image frame lookup table. +.le +.ls [4] +Read or write the pseudocolor lookup table. +.le +.ls [5] +Connect the output of one or more image frame lookup tables to a +color gun (used to select the frame to be displayed, etc.). +.le +.ls [6] +Read or write the position of a cursor. +.le +.ls [7] +Read, write, or "or into" a graphics overlay bit plane. A one bit +graphics plane is associated with each image frame. Graphics planes +may be erased and turned on and off independently of each other and +the image planes. A read or write operation may reference any combination +of graphics planes simultaneously, permitting multicolor vector graphics. +A single lookup table is used to assign a color to each graphics plane. +.le +.le + + +The following functions are supported but are not required. +.ls +.ls [8] +Zoom and pan. +.le +.ls [9] +Split screen: simultaneous display of any two frames, horizontal or vertical +split through the center of the display. +.le +.le + + +Blinking of two or more image frames is provided in software. Character and +vector generation in the graphics overlays is only provided in software in the +current interface. + +.nh 2 +Lookup Tables + + A monochrome lookup table is associated with each image frame and with +each of the three color guns (red, green, and blue). A lookup table may be +read and written independently of any other lookup table or image frame. +The image frame lookup tables are used principally for window stretch +enhancement (contrast and dc offset), and the color lookup tables are used +for pseudocolor. + +Our model assumes that the input of each color gun may be connected to the +sum of the lookup table outputs of zero or more image frames. Furthermore, +each color gun assignment may be specified independently of that for any +other color gun. The more common display modes are shown below. The table +illustrates the assignment of image frames to color guns. If only one image +frame combination appears in the list, that one combination is taken to be +assigned to each gun. Thus, "RGB = 123" indicates that the \fIsum\fR of the +outputs of frames 1, 2, and 3 is assigned to \fIeach\fR of the three color guns. + +.nf + RGB = 1 single frame monochrome, pseudocolor, etc. + RGB = 1,2,3 true color (R=1, G=2, B=3) + RGB = 123 multi frame monochrome, pseudocolor, etc. +.fi + +On many displays, there will be restrictions on the ways in which frames +may be assigned to guns. For example, many displays will not permit a gun +to be assigned to more than one frame. + +Our model also associates a single monochrome lookup table with each of +the three color guns. By feeding the same input into each of the guns, +but loading a different lookup table into each gun, many types of +pseudocolor enhancement are possible. If monochrome enhancement or +true color is desired, the color lookup tables are normally all set to +provide a one to one mapping, effectively taking them out of the circuit. + +.nh 2 +Cursors + + Each image display device is assumed to have at least one cursor, +with the following associated control functions: +.ls 4 +.ls [1] +Read cursor position. The one-indexed coordinates of the center of the +visible cursor are returned. The origin is assumed to be consistent +with that used for reading and writing image data, but is otherwise +undefined. A read should return immediately (sample mode), rather than +wait for some external event to occur (event mode). +.le +.ls [2] +Write cursor position. A read followed by a write does not move the +cursor. Cursor motions do not affect image data in any way. +.le +.ls [3] +Disable cursor (invisible cursor). +.le +.ls [4] +Enable cursor. +.le +.ls [5] +Blink cursor. +.le +.le + +.nh +Display Control Software + + A single executable process contains all display control functions. +A separate process (executable image) is provided for each display device. +All display control processes behave identically at the CL level. The STDIMAGE +environment variable is used to select the particular display control process +to be run. + + +.ks +.nf + user interface + display control process + virtual device interface + physical device +.fi + +.ce +Structure of the Display Control Software +.ke + + +The display control process consists of a device independent part and a +device dependent part. The device dependent part provides the virtual +device control and data functions identified in section 1. +The specifications of the virtual device interface have not yet been written, +though a prototype interface has been implemented for the IIS model 70. +In the long run, the virtual device interface may be provided by an +extension to GKS (the Graphical Kernel System). + +.nh 2 +User Interfaces + + At least two user interfaces are planned for display control. The first, +and most transportable, interface will be a conventional CL level command +interface. Separate commands will be provided for frame selection, +enhancement selection, frame erase, windowing, blinking, etc. The second +interface will be a menu driven interface run on a dedicated terminal +with touch screen overlay for input. This latter interface will run +asynchronously with the user terminal, and will therefore provide access +to the display at all times, as well as increased functionality and +interactiveness. Both user interfaces will use the same virtual device +interface. + +.nh 3 +The Display Control Package + + The command oriented image display control interface will be implemented +as a set of CL callable tasks in the package \fBimages.dcontrol\fR. +The new \fBdcontrol\fR package will include the \fBdisplay\fR program, +used to load images into the image display device, and any other programs +specifically concerned with the image display device. +The specifications for the package are given below (excluding the \fBdisplay\fR +program, which is documented elsewhere). All control functions operate +independently of each other, i.e., without side effects, unless otherwise noted. + + +.ks +.nf + blink dsave initdisplay rgb + contour frame lumatch splitscreen + display grclear monochrome window + drestore imclear pseudocolor zoom +.fi + +.ce +The \fBDcontrol\fR Package +.ke + + +The basic \fBdcontrol\fR package is shown above, and further documentation +is given below. Additional routines will be added in the future. +These will include: +.ls +.ls [1] +An display routine wherein the image histogram is computed and plotted, +then the user interactively marks the intensity region to be mapped into +the display, using the graphics cursor. +.le +.ls [2] +A routine for reading out a monochrome display into an imagefile, +which is then plotted on a hardcopy device (i.e., the Dicomed). +.le +.ls [3] +A routine for drawing vectors, marks, and text strings into a graphics +overlay. +.le +.le + +The display status should not be modified upon entry to the package, i.e., +the display should not change except under control of the user. +For example, if a new user logs on and a previous user's image is still +loaded and being displayed in pseudocolor, the control software should not +suddenly change the display mode to RGB, merely because the new user left +the display in RGB mode when they last logged off. The physical display +device is the important reference frame. +[N.B.: See also \fBdsave\fR and \fBdrestore\fR]. + +.ls +.ls \fBblink\fR (frame1, frame2 [, ... frameN] [, rate=1]) +The indicated frames are blinked at a rate given by the hidden parameter +\fIrate\fR. The positional arguments are the frame numbers; +a variable number of arguments are permitted. The order of the arguments +determines the order in which the frames are displayed. The same frame +may appear any number of times in the list, permitting different frames +to be displayed for various lengths of time. +.le +.ls \fBcontour\fR ([frame]) +The operation of this routine is very similar to that of \fBwindow\fR. +A cursor device is interactively used to control the spacing and width +of black contour lines, written with equal spacing into the image +lookup table. The window transfer function is not changed, other than +to black out the regions where the contour bands fall. Since only the +image frame lookup table is affected, this routine may be used with any +form of enhancement (i.e., pseudocolor). +.le +.ls \fBdsave\fR (save_file [, image=1234, graphics=1234]) +The full control status of the display, and optionally the image and +graphics memories, are saved in the named savefile for later restoration by +\fBdrestore\fR. By default all image and graphics memories are saved; +the hidden parameters \fBimage\fR and \fBgraphics\fR may be used to +indicate the specific image frames or graphics planes to be saved, +if desired. +.le +.ls \fBdrestore\fR (savefile) +The display device is restored to a previously saved state from the named +savefile. +.le +.ls \fBframe\fR (frame_number) +Select single frame mode and display the indicated frame. Frame enhancement +is not affected. This command will clear any multiple frame modes +(rgb, blink, split screen, etc.) previously in effect. +.le +.ls \fBgrclear\fR (frame) +The specified graphics frame is cleared. If the frame number is zero, +all graphics frames are cleared. +.le +.ls \fBimclear\fR (frame) +The specified image frame is cleared. If the frame number is zero, +all image frames are cleared. +.le +.ls \fBinitdisplay\fR +Initializes the image display to a default (device dependent) state. +All image and graphics memories are cleared, all lookup tables are +set to a default mapping (usually one-to-one), the cursor is centered +and enabled, single frame monochrome enhancement is selected, zoom, +blink, etc. are disabled, and frame one is selected for display. +.le +.ls \fBmonochrome\fR +Select monochrome enhancement (black and white). +.le +.ls \fBlumatch\fR (frame, reference_frame) +The image frame lookup table of the first frame is matched to that of +the reference frame. +.le +.ls \fBpseudocolor\fR (type_of_pseudocolor [, ncolors=64]) +Select one of the many possible pseudocolor enhancement modes. A single +string type argument selects the type of enhancement to be displayed. +The hidden parameter \fBncolors\fR controls the maximum number of +colors to be displayed; permissible values are limited to powers of +two. Pseudocolor is a contrast enhancement technique, and is most useful for +smooth images. The types of pseudocolor enhancement currently implemented +are the following: +.ls +.ls linear +The full range of greylevels are uniformly mapped into a spectrum of colors +ranging from blue through red. +.le +.ls random +A randomly selected color is assigned to each output greylevel. +This mode provides maximum discrimination between successive greylevels. +.le +.le +.sp +Selecting a pseudocolor or monochrome enhancement mode does not change the +windowing. After selecting an enhancement mode, \fBwindow\fR may be used +to control the number and range of color or grey levels in the image. +The number of greylevels or colors actually displayed will depend on the +smoothness of the input frames, and on how the input frames are windowed. +.le +.ls \fBrgb\fR [red=1, green=2, blue=3] +True color mode is selected, i.e., the specified red frames are mapped +to the red gun, the green frames are mapped to the green gun, and so on. +The hidden parameters \fIred\fR, \fIgreen\fR, and \fIblue\fR define +the mapping of image frames to guns. On some displays, it may be possible +to additively assign more than one frame to a single gun, i.e., "red=123" +would assign the sum of frames 1 through 3 to the red gun. +If pseudocolor enhancement was previously in effect it may or may not +be cleared, depending on the display characteristics. +.le +.ls \fBsplitscreen\fR (frame, frame [, vertical=yes]) +Two images are displayed simultaneously, one on either half of the image. +The two images may be split either horizontally or vertically. +.le +.ls \fBwindow\fR [frame] [, ...frame] +This command causes a linear mapping function to be repetitively loaded +into the lookup table for one or more image frames. If no frame +arguments are given, the frame or frames currently displayed are windowed. +In RGB mode, for example, all frames are simultaneously windowed by +default. The \fBhjklHJKL\fR keys on the terminal, the trackball, +or some other analog input device associated with the display, may be used +to interactively adjust the mapping. As the mapping is changed, the cursor +will be seen to move on the display. Vertical motions control the contrast +and whether or not a positive or negative image is displayed; the highest +contrast lies furthest from the center. Horizontal motions adjust the dc +offset. [N.B.: Initialize the cursor position to reflect the current mapping +before entering the loop, to avoid any abrupt changes in the windowing.] +.le +.ls \fBzoom\fR (scale_factor) +The current display is magnified by the indicated scale factor, which +is normally limited to small powers of two (i.e., 1, 2, 4, and 8). +While in zoom mode, the cursor controls the position of the viewport window +on the full image. +.le +.le +.endhelp diff --git a/pkg/images/tv/doc/bpmedit.hlp b/pkg/images/tv/doc/bpmedit.hlp new file mode 100644 index 00000000..2350b846 --- /dev/null +++ b/pkg/images/tv/doc/bpmedit.hlp @@ -0,0 +1,155 @@ +.help bpmedit Aug07 images.tv +.ih +NAME +bpmedit -- examine and edit bad pixel masks associated with images +.ih +USAGE +bpmedit images +.ih +PARAMETERS +.ls images +List of images whose bad pixel masks are to be edit. The images must +contain the keyword BPM whose value is an existing bad pixel mask to +be edit. If the keyword is missing or the mask does not exit a warning +is issued and the task proceeds to the next image. +.le +.ls bpmkey = "BPM" +The mask to be edited is defined by the value of this keyword. +.le +.ls frame = 1 +The display frame where the image with the mask overlay is shown. +.le +.ls refframe = 2 +The display frame with the image without the mask is shown. +.le +.ls command = "display ..." +Command for displaying and updating the mask overlay. This is the +command used with \fBimedit\fR. This should be changed with care. +In the string the following changes are made: + +.nf + $image -- substitute the image + $mask -- substitute the mask being edited + $frame -- substitute the value of the frame parameter + $erase -- substituted by imedit +.fi +.le + +.ls display = yes +Use the task interactively with the display? This sets the behavior +of \fBimedit\fR as described for the parameter of the same name. +.le +.ls cursor = "" +Image cursor input. This is normally either a null string for interactive +display editing or the value of a file with cursor commands to edit +non-interactively. See the help for \fBimedit\fR for more information. +.le + +.ih +ADDITIONAL PARAMETERS + +This task calls \fBdisplay\fR to load the image display and \fBimedit\fR +to do the editing. The current default parameters are used from those +tasks except the image names, frames, and the display command are set by +this task. Also the search radius is set to zero (i.e. no centering). +Also the \fIdisplay\fR and \fIcursor\fR parameters override the +values of the parameters of the same name in \fBimedit\fR. Of particular +note is the default value for imedit.value which defines the mask value to +be set initially. This value may be changed interactively in \fBimedit\fR. +.ih +DESCRIPTION +\fBBpmedit\fR is a variant of \fBimedit\fR. It displays the input images +with the masks overlaid. The mask is defined +by the value of the keyword keywords specified by the \fIbpmkey\fR +parameter. The editing commands apply to the mask overlay and not the +image pixels. In this application the edited values should be integer mask +values. In the usual case where zero indicates good pixels and non-zero +indicates bad pixels one can set and unset values by changing current +replacement value with ":value". Two useful parameters, ":minvalue" +and ":maxvalue", are useful in this context to allow editing only +specific ranges of mask values. Note that many of the imedit options are +not useful for mask editing. The '?' keystroke prints a list of the +useful cursor and colon commands. This list is also shown below. + +Because it is common to want to see the image pixels to which the +mask values apply this task loads two image display frames. In one the +mask is overlaid and changes to the mask are updated with the +redisplay options of imedit (note the options to turn on and off +automatic redisplay). In the second the image without the mask is +displayed. The editing commands may be given in either frame but the +mask updates will appear only in the mask overlay frame. + +This task also provides the parameters \fIdisplay\fR and \fIcursor\fR +to use \fBimedit\fR in a non-interactive manner as described for that +task. Because only the setting and clearing of rectangles, circles, +or vectors makes sense with this task this may not be of great use. +Also there are many other tasks that can be used to edit masks +non-interactively. + +Please read the help for \fBimedit\fR for details of the editing +process. + +.nf + BPMEDIT CURSOR KEYSTROKE COMMANDS + + The following are the useful commands for BPMEDIT. Note all + the commands for IMEDIT are available but only those shown + here should be used for editing pixel masks. + + ? Print help + : Colon commands (see below) + i Initialize (start over without saving changes) + q Quit and save changes + r Redraw image display + + Increase radius by one + - Decrease radius by one + I Interrupt task immediately + Q Quit without saving changes + + The following editing options are available. Rectangular + and vector regions are specified with two positions and + aperture regions are specified by one position. The current + aperture type (circular or square) is used in the latter + case. All the following substitute the new value set for + the "value" parameter (see :value). Some replace all pixels + within the mask that have the same pixel value as the value + at the cursor position. + + d Set rectangle to "value" + e Set aperture to "value" + u Undo last change (see also 'i', 'j', and 'k') + v Set vector to "value" + = Replace pixels = to "cursor value" to "value" + < Replace pixels < or = to "cursor value" to "value" + > Replace pixels > than or = to "cursor value" to "value" + + + BPMEDIT COLON COMMANDS + + The colon either print the current value of a parameter when + there is no value or set the parameter to the specified + value. + + aperture [type] Aperture type (circular|square) + autodisplay [yes|no] Automatic image display? + command [string] Display command + display [yes|no] Display image? + eparam Edit parameters + radius [value] Aperture radius + value [value] Constant substitution value + minvalue [value] Minimum value for modification (INDEF=minimum) + maxvalue [value] Maximum value for modification (INDEF=maximum) + write [name] Write changes to name +.fi +.ih +EXAMPLES +1. Interactively edit a mask. + +.nf + cl> bpmedit wpix +.fi + +.ih +SEE ALSO +imedit, display, badpiximage, text2mask, mskexpr, mskregions, imexpr +.endhelp diff --git a/pkg/images/tv/doc/display.hlp b/pkg/images/tv/doc/display.hlp new file mode 100644 index 00000000..9e8670c4 --- /dev/null +++ b/pkg/images/tv/doc/display.hlp @@ -0,0 +1,555 @@ +.help display Mar97 images.tv +.ih +NAME +display -- Load and display images in an image display +.ih +USAGE +display image frame +.ih +PARAMETERS +.ls image +Image to be loaded. +.le +.ls frame +Display frame to be loaded. +.le + +.ls bpmask = "BPM" +Bad pixel mask. The bad pixel mask is used to exclude bad pixels from the +automatic intensity mapping algorithm. It may also be displayed as an +overlay or to interpolate the input image as selected by the \fIbpdisplay\fR +parameter. The bad pixel mask is specified by a pixel list image +(.pl extension) or an regular image. Values greater than zero define the +bad pixels. The special value "BPM" may be specified to select a pixel list +image defined in the image header under the keyword "BPM". If the +bad pixel mask cannot be found a warning is given and the bad pixel mask +is not used in the display. +.le +.ls bpdisplay = "none" (none|overlay|interpolate) +Type of display for the bad pixel mask. The options are "none" to not +display the mask, "overlay" to display as an overlay with the colors given +by the \fIbpcolors\fR parameter, or "interpolate" to linearly interpolate +across the bad pixels in the displayed image. Note that the bad is still +used in the automatic intensity scaling regardless of the type of display +for the bad pixel mask. +.le +.ls bpcolors = "red" +The mapping between bad pixel values and display colors or intensity values +when the bad pixels are displayed as an overlay. There are two forms, +explicit color assignments for values or ranges of values, and expressions. +These is described in the OVERLAY COLOR section. +.le + +.ls overlay = "" +Overlay mask to be displayed. The overlay mask may be a pixel list image +(.pl extension) or a regular image. Overlay pixels are identified by +values greater than zero. The overlay values are displayed with a mapping +given by the \fIocolors\fR parameter. If the overlay cannot be found a +warning is given and the overlay is not displayed. +.le +.ls ocolors = "green" +The mapping between bad pixel values and display colors or intensity values +when the bad pixels are displayed as an overlay. There are two forms, +explicit color assignments for values or ranges of values, and expressions. +These is described in the OVERLAY COLOR section. +.le + +.ls erase = yes +Erase frame before loading image? +.le +.ls border_erase = no +Erase unfilled area of window in display frame if the whole frame is not +erased? +.le +.ls select_frame = yes +Select the display frame to be the same as the frame being loaded? +.le +.ls repeat = no +Repeat the previous spatial and intensity transformations? +.le +.ls fill = no +Interpolate the image to fit the display window? +.le +.ls zscale = yes +Apply an automatic intensity mapping algorithm when loading the image? +.le +.ls contrast = 0.25 +Contrast factor for the automatic intensity mapping algorithm. +If a value of zero is given then the minimum and maximum of the +intensity sample is used. +.le +.ls zrange = yes +If not using the automatic mapping algorithm (\fIzscale = no\fR) map the +full range of the image intensity to the full range of the display? If the +displayed image has current min/max values defined these will be used to +determine the mapping, otherwise the min/max of the intensity sample will +be used. The \fIMINMAX\fR task can be used to update the min/max values in +the image header. +.le +.ls zmask = "" +Pixel mask selecting the sample pixels for the automatic or range intensity +mapping algorithm. The pixel mask may be a pixel list image (.pl +extension), a regular image, or an image section. The sample pixels are +identified by values greater than zero in the masks and by the region specified +in an image section. If no mask specification is given then a uniform sample +of approximately \fInsample\fR good pixels will be used. The \fInsample\fR +parameter also limits the number of sample pixels used from a mask. Note that +pixels identified by the bad pixel mask will be excluded from the sample. +.le +.ls nsample = 1000 (minimum of 100) +The number of pixels from the image sampled for computing the automatic +intensity scaling. This number will be uniformly sampled from the image +if the default \fIzmask\fR is used otherwise the first \fInsample\fR +pixels from the specified mask will be used. +.le +.ls xcenter = 0.5, ycenter = 0.5 +Horizontal and vertical centers of the display window in normalized +coordinates measured from the left and bottom respectively. +.le +.ls xsize = 1, ysize = 1 +Horizontal and vertical sizes of the display window in normalized coordinates. +.le +.ls xmag = 1., ymag = 1. +Horizontal and vertical image magnifications when not filling the display +window. Magnifications greater than 1 map image pixels into more than 1 +display pixel and magnifications less than 1 map more than 1 image pixel +into a display pixel. +.le +.ls order = 0 +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 z1, z2 +Minimum and maximum image intensity to be mapped to the minimum and maximum +display levels. These values apply when not using the automatic or range +intensity mapping methods. +.le +.ls ztrans = "linear" +Transformation of the image intensity levels to the display levels. The +choices are: +.ls "linear" +Map the minimum and maximum image intensities linearly to the minimum and +maximum display levels. +.le +.ls "log" +Map the minimum and maximum image intensities linearly to the range 1 to 1000, +take the logarithm (base 10), and then map the logarithms to the display +range. +.le +.ls "none" +Apply no mapping of the image intensities (regardless of the values of +\fIzcale, zrange, z1, and z2\fR). For most image displays, values exceeding +the maximum display value are truncated by masking the highest bits. +This corresponds to applying a modulus operation to the intensity values +and produces "wrap-around" in the display levels. +.le +.ls "user" +User supplies a look up table of intensities and their corresponding +greyscale values. +.le +.le +.ls lutfile = "" +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 +.ih +DESCRIPTION +The specified image and overlay mask are loaded into the specified frame of +the standard image display device ("stdimage"). For devices with more than +one frame it is possible to load an image in a frame different than that +displayed on the monitor. An option allows the loaded frame to become the +displayed frame. The previous contents of the frame may be erased (which +can be done very quickly on most display devices) before the image is +loaded. Without erasing, the image replaces only those pixels in the frame +defined by the display window and spatial mapping described below. This +allows displaying more than one image in a frame. An alternate erase +option erases only those pixels in the defined display window which are not +occupied by the image being loaded. This is generally slower than erasing +the entire frame and should be used only if a display window is smaller +than the entire frame. + +The image is mapped both in intensity and in space. The intensity is +mapped from the image pixel values to the range of display values in the +device. Spatial interpolation maps the image pixel coordinates into a part +of the display frame called the display window. Many of the parameters of +this task are related to these two transformations. + +A bad pixel mask may be specified to be displayed as an overlay or to +interpolate the displayed image. It is also used to exclude bad pixels +from the automatic intensity scaling. The bad pixel mask is specified by +the parameter \fIbpmask\fR and the display mode by the \fIbpdisplay\fR +parameter. The overlay display option uses the \fIbpcolors\fR parameters +to specify a color mapping as described in the OVERLAY COLOR section. +Interpolation consists of linear interpolation across columns if the mask +value is one, across lines if the mask value is two, or across the shortest +direction for other values. This interpolation is done on the input data +before any spatial interpolation and filling is done. It does not modify +the input data. The task \fBfixpix\fR provides the same algorithm to fix +the data in the image. + +An overlay mask may be specified by the \fIoverlay\fR parameter. Any +value greater than zero in the overlay mask will be displayed in the color or +intensity specified by the \fIocolor\fR parameter (see the OVERLAY COLOR +section). + +Note that bad pixel masks in "pixel list" format are constrained to +non-negative values. When an image is used instead of a pixel list the +image is internally converted to a pixel list. Negative values are +set to zero or good pixels and positive real values are truncated to +the nearest integer. + +A display window is defined in terms of the full frame. The lower left +corner of the frame is (0, 0) and the upper right corner is (1, 1) as +viewed on the monitor. The display window is specified by a center +(defaulted to the center of the frame (0.5, 0.5)) and a size (defaulted to +the full size of the frame, 1 by 1). The image is loaded only within the +display window and does not affect data outside the window; though, of +course, an initial frame erase erases the entire frame. By using different +windows one may load several images in various parts of the display frame. + +If the option \fIfill\fR is selected the image and overlay mask are +spatially interpolated to fill the display window in its largest dimension +(with an aspect ratio of 1:1). When the display window is not +automatically filled the image is scaled by the magnification factors +(which need not be the same) and centered in the display window. If the +number of image pixels exceeds the number of display pixels in the window +only the central portion of the image which fills the window is loaded. By +default the display window is the full frame, the image is not interpolated +(no filling and magnification factors of 1), and is centered in the frame. +The spatial interpolation algorithm is described in the section MAGNIFY AND +FILL ALGORITHM. + +There are several options for mapping the pixel values to the display values. +There are two steps; mapping a range of image intensities to +the full display range and selecting the mapping function or +transformation. The mapping transformation is set by the parameter +\fIztrans\fR. The most direct mapping is "none" which loads the +image pixel values directly without any transformation or range +mapping. Most displays only use the lowest bits resulting in a +wrap-around effect for images with a range exceeding the display range. +This is sometimes desirable because it produces a contoured image which +is not saturated at the brightest or weakest points. +This is the fastest method of loading the display. Another +transformation, "linear", maps the selected image range linearly to the full +display range. The logarithmic transformation, "log", maps the image range +linearly between 1 and 1000 and then maps the logarithm (base 10) linearly +to the full display range. In the latter transformations pixel values +greater than selected maximum display intensity are set to the maximum +display value and pixel values less than the minimum intensity +are set to the minimum display value. + +Methods for setting of the range of image pixel values, \fIz1\fR and +\fIz2\fR, to be mapped to the full display range are arranged in a +hierarchy from an automatic mapping which gives generally good result for +typical astronomical images to those requiring the user to specify the +mapping in detail. The automatic mapping is selected with the parameter +\fIzscale\fR. The automatic mapping algorithm is described in the section +ZSCALE ALGORITHM and has three parameters, \fIzmask\fR, \fInsample\fR and +\fIcontrast\fR. + +When \fIztrans\fR = user, a look up table of intensity values and their +corresponding greyscale levels is read from the file specified by the +\fIlutfile\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. When \fIztrans\fR = user, parameters \fIzscale\fR, +\fIzrange\fR and \fIzmap\fR are ignored. + +If the zscale algorithm is not selected the \fIzrange\fR parameter is +examined. If \fIzrange\fR is yes then the minimum and maximum pixel values +in the image are taken from the image header or estimated from the +intensity sample and \fIz1\fR and \fIz1\fR are set to those values, +respectively. This insures that the full range of the image is displayed +but is generally slower than the zscale algorithm (because all the image +pixels must be examined) and, for images with a large dynamic range, will +generally show only the brightest parts of the image. + +Finally, if the zrange algorithm is not selected the user specifies the +values of \fIz1\fR and \fIz2\fR directly. + +Often several images are to be loaded with the same intensity and spatial +transformations. The option \fIrepeat\fR repeats the transformations from +the previous image loaded. +.ih +ZSCALE ALGORITHM +The zscale algorithm is designed to display the image values near the median +image value without the time consuming process of computing a full image +histogram. This is particularly useful for astronomical images which +generally have a very peaked histogram corresponding to the background +sky in direct imaging or the continuum in a two dimensional spectrum. + +The sample of pixels, specified by values greater than zero in the sample mask +\fIzmask\fR or by an image section, is selected up to a maximum of +\fInsample\fR pixels. If a bad pixel mask is specified by the \fIbpmask\fR +parameter then any pixels with mask values which are greater than zero are not +counted in the sample. Only the first pixels up to the limit are selected +where the order is by line beginning from the first line. If no mask is +specified then a grid of pixels with even spacing along lines and columns +that make up a number less than or equal to the maximum sample size is +used. + +If a \fIcontrast\fR of zero is specified (or the \fIzrange\fR flag is +used and the image does not have a valid minimum/maximum value) then +the minimum and maximum of the sample is used for the intensity mapping +range. + +If the contrast is not zero the sample pixels are ranked in brightness to +form the function I(i) where i is the rank of the pixel and I is its +value. Generally the midpoint of this function (the median) is very near +the peak of the image histogram and there is a well defined slope about the +midpoint which is related to the width of the histogram. At the ends of +the I(i) function there are a few very bright and dark pixels due to +objects and defects in the field. To determine the slope a linear function +is fit with iterative rejection; + + I(i) = intercept + slope * (i - midpoint) + +If more than half of the points are rejected then there is no well defined +slope and the full range of the sample defines \fIz1\fR and \fIz2\fR. +Otherwise the endpoints of the linear function are used (provided they are +within the original range of the sample): + +.nf + z1 = I(midpoint) + (slope / contrast) * (1 - midpoint) + z2 = I(midpoint) + (slope / contrast) * (npoints - midpoint) +.fi + +As can be seen, the parameter \fIcontrast\fR may be used to adjust the contrast +produced by this algorithm. +.ih +MAGNIFY AND FILL ALGORITHM +The spatial interpolation algorithm magnifies (or demagnifies) the image +(and the bad pixel and overlay masks) along each axis by the desired +amount. The fill option is a special case of magnification in that the +magnification factors are set by the requirement that the image just fit +the display window in its maximum dimension with an aspect ratio (ratio of +magnifications) of 1. There are two requirements on the interpolation +algorithm; all the image pixels must contribute to the interpolated image +and the interpolation must be time efficient. The second requirement means +that simple linear interpolation is used. If more complex interpolation is +desired then tasks in the IMAGES package must be used to first interpolate +the image to the desired size before loading the display frame. + +If the magnification factors are greater than 0.5 (sampling step size +less than 2) then the image is simply interpolated. However, if the +magnification factors are less than 0.5 (sampling step size greater +than 2) the image is first block averaged by the smallest amount such +that magnification in the reduced image is again greater than 0.5. +Then the reduced image is interpolated to achieve the desired +magnifications. The reason for block averaging rather than simply +interpolating with a step size greater than 2 is the requirement that +all of the image pixels contribute to the displayed image. If this is +not desired then the user can explicitly subsample using image +sections. The effective difference is that with subsampling the +pixel-to-pixel noise is unchanged and small features may be lost due to +the subsampling. With block averaging pixel-to-pixel noise is reduced +and small scale features still contribute to the displayed image. +.ih +OVERLAY COLORS +The masks specified by the \fIbpmask\fR and \fIoverlay\fR parameters may be +displayed as color overlays on the image data. The non-zero pixels in the +mask are assigned integer display values. The values may fall in the same +range, 1 to 200, as the mapped image pixel data values and will behave the +same way as the pixel values when the display map is interactively adjusted. +Values of 0 and 201 to 255 may be used and depend on the display server and +display resource definitions. The expected or standard server behavior is +that 0 is the background color and 201 to 255 are various colors with the +lower numbers being the more standard primary colors. The expected colors +are: + +.nf + Value Color Value Color + 201 white (cursor) 210 coral + 202 black (background) 211 maroon + 203 white 212 orange + 204 red 213 khaki + 205 green 214 orchid + 206 blue 215 turquoise + 207 yellow 216 violet + 208 cyan 217 wheat + 209 magenta +.fi + +The values 201 and 202 are tied to the cursor and background resource +colors. These are generally white and black respectively. Values above 217 +are not defined and depend on the current state of the color table for the +window system. + +The mapping between mask values and overlay colors are specified +by the \fIbpcolors\fR and \fIocolors\fR parameters. There are two mapping +syntax, a list and an expression. + +The list syntax consists of +a comma delimited set of values and assignments with one of the following +forms. + +.nf + color + maskvalue=color + maskvalue-maskvalue=color +.fi + +where color may be a color name, a color value, or value to be added or +subtracted to the mask value to yield a color value. Color names may be +black, white, red, green, blue, yellow, cyan, magenta, or transparent with +case ignored and abbreviations allowed. Transparent does the obvious of +being invisible. These values are based on the default resource colors for +the display servers (as shown above) and any custom definitions may result +in incorrect colors. + +The color values are unsigned integers (no '+' or '-') or values to be added +or subtracted are given as signed integers. The first form provides the +default intensity or color for all mask values. Note that if no default +color is specified the default will be white. The other forms map a mask +value or range of mask values to a color. In a list the last color defined +for the default or mask value will be used. + +The addition or subtraction from mask values provides a mechanism to have +the bad pixel or overlay masks encode a variety of overlay colors. Note +that to display the mask values directly as colors one would use the color +value "+0". Subtraction may produce values less than zero which then +are not visible; i.e. equivalent to "transparent". + +The following examples illustrate the features of the syntax. + +.nf + ocolors="" Display in default white + ocolors="red" Display in red + ocolors="+0" Display mask values as color values + ocolors="+200" Display mask values offset by 200 + + ocolors="205,1=red,2=yellow,10-20=cyan,30-40=+100,50-100=transparent" +.fi + +The last example has a default color of 205, mask values of 1 are +red, mask values of 2 are yellow, mask values of 10 to 20 are cyan, +and mask values of 30 to 40 are displayed as intensities 130 to 140. + +Expressions are identified by being enclosed in parentheses. +This uses the general IRAF expression syntax (see \fBexpressions\fR). +The mask values are referenced by the character $. The same named +colors (black, white, red, green, blue, yellow, cyan, magenta, +and transparent) may be used in place of color values. Expressions +must evaluate to integer values. To avoid needing special handling of +input mask values of zero, all pixels with input mask values of zero +are not shown regardless of the expression value. + +There are currently two function extensions, "colors" and "acenum". +In both functions the first and only required argument, arg1, is an integer +value. Typically this will '$' or a function based on '$'. + +The "colors" function maps input values with a modulus type behavior. The +optional second argument, arg2, is a color value for mapping zero. As noted +above, if the input mask value is zero it will not be displayed. However, +functions applied to non-zero input mask values may return a value of zero +which may then be displayed with the specified color. The default is +transparent. The next two optional arguments (arg3 and arg4) define a color +range with defaults of 204 to 217. If only arg3 is specified then +arg4 takes the value of arg3, thus having the effect of a constant +output color. Positive values of the first argument are mapped to a color +value by + +.nf + if arg1 is 0: result = arg2 + if arg1 greater 0: result = arg3 + mod ($-1, arg4-arg3+1) + otherwise: result = arg1 +.fi + +This function is primarily used to make colorful displays of regions +defined with different mask values. + +The "acenum" function handles \fBace\fR package object detection masks +which include bit flags. Each object in the mask has an object number +with value greater than 10. Values less than 10 are passed along during +detection and generally identify detector or saturated bad pixels. +Along with the object number there may be zero or more bit flags +set. This function removes the bit flags and returns the mask number. +The optional second argument, arg2, is a string of letters which selects +pixels with certain sets of bit flags. The bit flags are: + +.nf + B -- a bad pixel treated as a good for detection + D -- original detection (i.e. without G or S flag) + E -- edge pixel used for displaying detection isophotes + F -- object contains a bad pixel + G -- grown pixel + S -- pixel not assigned to an object during splitting +.fi + +The default of arg2 is "BDEG" which essentially returns all pixels +in an object. + +The acenum function also returns 0 for the pixels with values between +one and ten and -1 for the pixels not selected by the flags. The value +of zero may be made visible using the colors function. The two functions +are often used in concert: + +.nf + (colors(acenum($))) + (colors(acenum($),black)) + (colors(acenum($,'E'),red,green) +.fi + +Note that when filling and anti-aliasing the behavior of the overlay +colors may be different than intended. +.ih +EXAMPLES +For the purpose of these examples we assume a display with four frames, +512 x 512 in size, and a display range of 0 to 255. Also consider two +images, image1 is 100 x 200 with a range 200 to 2000 and image2 is +2000 x 1000 with a range -1000 to 1000. To load the images with the +default parameters: + +.nf + cl> display image1 1 + cl> display image2 2 +.fi + +The image frames are first erased and image1 is loaded in the center of +display frame 1 without spatial interpolation and with the automatic intensity +mapping. Only the central 512x512 area of image2 is loaded in display frame 2 + +To load the display without any intensity transformation: + + cl> cvl image1 1 ztrans=none + +The next example interpolates image2 to fill the full 512 horizontal range +of the frame and maps the full image range into the display range. Note +that the spatial interpolation first block averages by a factor of 2 and then +magnifies by 0.512. + + cl> display image2 3 fill+ zscale- + +The next example makes image1 square and sets the intensity range explicitly. + + cl> display image1 4 zscale- zrange- z1=800 z2=1200 xmag=2 + +The next example loads the two images in the same frame side-by-side. + +.nf + cl> display.xsize=0.5 + cl> display image1 fill+ xcen=0.25 + cl> display image2 erase- fill+ xcen=0.75 +.fi +.ih +REVISIONS +.ls DISPLAY V2.11 +The bad pixel mask, overlay mask, sample mask, and overlay colors +parameters and functionality have been added. The "nsample_lines" +parameter is now an "nsample" parameter. + +Bugs in the coordinate system sent to the image display for cursor +readback were fixed. +.le +.ih +BUGS +The "repeat" option is not implemented. +.ih +SEE ALSO +cvl, magnify, implot, minmax, fixpix +.endhelp diff --git a/pkg/images/tv/doc/imedit.hlp b/pkg/images/tv/doc/imedit.hlp new file mode 100644 index 00000000..66b113af --- /dev/null +++ b/pkg/images/tv/doc/imedit.hlp @@ -0,0 +1,493 @@ +.help imedit Aug07 images.tv +.ih +NAME +imedit -- examine and edit pixels in images +.ih +USAGE +imedit input output +.ih +PARAMETERS +.ls input +List of images to be edited. Images must be two dimensional. +.le +.ls output +List of output images. The list must match the input list or be empty. +In the latter case the output image is the same as the input image; i.e. +the edited image replaces the input image. +.le +.ls cursor = "" +The editing commands are entered via a cursor list. When the task is +run interactively this will normally be the standard image cursor +(stdimcur) specified by a null string. Commands may be read from +a file. The file format may be cursor values including the command +keys, a simple list of positions with the default command given +by the \fIdefault\fR parameter, and a regions file, as used in +the task \fBfixpix\fR and the \fBccdred\fR package, selected by +the \fIfixpix\fR parameter. +.le +.ls logfile = "" +File in which to record the editing commands which modify the images. +The display and statistics commands which don't modify the images are +not recorded. This file may be used for keeping a record of the +modifications. It may also be used as cursor input for other images +to replicate the same editing operations. +.le +.ls display = yes +Display the image during editing? If yes then the display command, +given by the parameter \fIcommand\fR, is used to display the image. +Normally the display is used when editing interactively and turned +off when using file input. +.le +.ls autodisplay = yes +Automatically redisplay the image after each change? If the display +of the image is rapid enough then each change can be displayed as +it is made by setting this parameter to yes. However, it is faster +to accumulate changes and then explicitly redisplay the image. +When the parameter is no then the image is only redisplayed by +explicit command. +.le +.ls autosurface = no +Automatically display surface plots after each change? In addition +to the image display command, the task can display a before and after +surface plot of the modified region. This can be done by explicit +command or automatically after each change. +.le +.ls aperture = "circular" +Aperture for aperture editing. Some commands specify the region to +be edited by a center and radius. The shape of the aperture is selected +by this parameter. The choices are "circular" and "square". Note that +this does not apply to commands in which a rectangle is specified by +selecting the corners. +.le +.ls radius = 2. +Radius of the aperture for commands selecting an aperture. For circular +apertures this is the radius while for square apertures it is half of the +side of the square. Note that partial pixels are not used so that a +circular aperture is not perfectly circular; i.e. if the center of a +pixel is within this distance of the center pixel it is modified and +otherwise it is not. A radius of zero may be used to select a single +pixel (with either aperture type). +.le +.ls search = 2. +Search radius for adjusting the position of the region to be edited. +This applies to both aperture regions and rectangular regions. The +center pixel of the region is searched within this radius for the +maximum or minimum pixel value. If the value is zero then no searching +is done and the specified region is used directly. If the value is +positive then the specified region is adjusted to be centered on a +relative maximum. A relative minimum may be found if the value is +negative with the absolute value used as the search radius. +.le +.ls buffer = 1. +Background buffer width. A buffer annulus separates the region to be +edited from a background annulus used for determining the background. +It has the same shape as the region to be edited; i.e. circular, square, +rectangular, or line. +.le +.ls width = 2. +Width of background annulus. The pixels used for background determinations +is taken from an annulus of the same shape as the region to be edited and +with the specified width in pixels. +.le +.ls xorder = 2, yorder = 2 +Orders (number of terms) of surface polynomial fit to background pixels +for statistics and background subtraction. The orders should generally +be low with orders of 2 for a plane background. If either order is +zero then a median background is used. +.le +.ls value = 0. +Value for constant substitution. One editing command is replacement of +a region by this value. +.le +.ls minvalue = INDEF, maxvalue = INDEF +Range of values which may be modified. Value of INDEF map to the minimum +and maximum possible values. +.le +.ls sigma = INDEF +Sigma of noise to be added to substitution values. If less than or +equal to zero then no noise is added. If INDEF then pixel values from +the background region are randomly selected after subtracting the +fitted background surface or median. Finally if a positive value is given than +a gaussian noise distribution is added. +.le +.ls angh = -33., angv = 25. +Horizontal and vertical viewing angles (in degrees) for surface plots. +.le +.ls command = "display $image 1 erase=$erase fill=yes order=0 >& dev$null" +Command for displaying images. This task displays images by executing a +standard IRAF command. Two arguments may be substituted by the appropriate +values; the image name specified by "$image" and the boolean erase +flag specified by "$erase". Except for unusual cases the \fBtv.display\fR +command is used with the fill option. The fill option is required to +provide a zoom feature. See the examples for another possible command. +.le +.ls graphics = "stdgraph" +Graphics device used for surface plots. Normally this is the standard +graphics device "stdgraph" though other possibilities are "stdplot" +and "stdvdm". Note the standard graphics output may also be +redirected to a file with ">G file" where "file" is any file name. +.le +.ls default = "b" +Default command option for simple position list input. If the input +is a list of column and line positions (x,y) then the command executed +at each position is given by this parameter. This should be one of +the aperture type editing commands, the statistics command, or the +surface plotting command. Two keystroke commands would obviously +be incorrect. \fIThis parameter is ignored in "fixpix" mode\fR. +.le +.ls fixpix = no +Fixpix style input? This type of input consists of rectangular regions +specified by lines giving the starting and ending column and starting +and ending line. This is the same input used by \fBfixpix\fR and in +the \fBccdred\fR package. The feature to refer to "untrimmed" images +in the latter package is not available in this task. When selected +the editing consists of interpolation across the narrowest dimension +of the region and the default key is ignored. +.le +.ih +DESCRIPTION +Regions of images are examined and edited. This may be done interactively +using an image display and cursor or non-interactively using a list of +positions and commands. There are a variety of display and editing +options. A list of input images and a matching list of output images +are specified. The output images are only created if the input image +is modified (except by an explicit "write" command). If no output +list is specified (an empty list given by "") then the modified images +are written back to the input images. The images are edited in +a temporary buffer image beginning with "imedit". + +Commands are given via a cursor list. When the task is run +interactively this will normally be the standard image cursor +(stdimcur). Commands may be read from a file. The file format may be +cursor values including the command keys, a simple list of positions +with the default command given by the \fIdefault\fR parameter, and a +regions file, as used in the task \fBfixpix\fR and the \fBccdred\fR +package, selected by the \fIfixpix\fR parameter. + +The commands which modify the image may be written to a log file specified +by parameter \fIlogfile\fR. This file can be used as a record of the +pixels modified. The format of this file is also suitable for input +as a cursor list. This allows the same commands to be applied to other +images. \fIBe careful not to have the cursor input and logfile have the +same name!\fR + +When the \fIdisplay\fR parameter is set the command given by the parameter +\fIcommand\fR is executed. Normally this command loads the image display +though it could also create a contour map or other graph whose x and y +coordinates are the same as the image coordinates. The image is displayed +when editing interactively and the standard image cursor (which can +be redefined to be the standard graphics cursor) is used to select +regions to be edited. When not editing interactively the display +flag should be turned off. + +It is nice to see changes to the image displayed immediately. This is +possible using the \fIautodisplay\fR option. Note that this requires +the display parameter to also be set. If the autodisplay flag is set +the display command is repeated after each change to the image. The +drawback to this is that the full image (or image section) is reloaded +and so can be slow. If not set it is still possible to explicitly give +a redisplay command, 'r', after a number of changes have been made. + +Another display option is to make surface graphs to the specified +graphics device (normally the standard graphics terminal). This may +be done by the commands 'g' and 's' and automatically after each +change if the \fIautosurface\fR parameter is set. The two types of +surface plots are a single surface of the image at the marked position +and before and after plots for a change. + +Regions of the image to be examined or edited are selected by one +or two cursor commands. The single cursor commands define the center +of an aperture. The shape of the aperture, circular or square, is +specified by the \fIaperture\fR parameter and the radius (or half +the edge of a square) is specified by the \fIradius\fR parameter. +The radius may be zero to select a single pixel. The keys '+' and +'-' may be used to quickly increment or decrement the current radius. +The two keystroke commands either define the corners of a rectangular +region or the endpoints of a line. + +Because it is sometimes difficult to mark cursor position precisely +the defined region may be shifted so that the center is either +a local maximum or minimum. This is usually desired for editing +cosmicrays, bad pixels, and stars. The center pixel of the aperture +is moved within a specified search radius given by parameter +\fIsearch\fR. If the search radius is zero then the region defined +by the cursor is not adjusted. The sign of the search radius +selects whether a maximum (positive value) or a minimum (negative value) +is sought. The special key 't' toggles between the two modes +in order to quickly edit both low sensitivity bad pixels and +cosmicrays and stars. + +Once a region has been defined a background region may be required +to estimate the background for replacement. The background +region is an annulus of the same shape separated by a buffer width, +given by the parameter \fIbuffer\fR, and having a width given by +the parameter \fIwidth\fR. + +The replacement options are described below as is a summary of all the +commands. Two commands requiring a little more description are the +space and 'p' commands. These print the statistics at the cursor +position for the current aperture and background parameters. The +printout gives the x and y position of the aperture center (after the +search if any), the pixel value (z) at that pixel, the mean background +subtracted flux in the aperture, the number of pixels in the aperture, +the mean background "sky", the sigma of the background residuals from +the background fit, and the number of pixels in the background region. +The 'p' key additionally prints the pixel values in the aperture. +Beware of apertures with radii greater than 5 since they will wrap +around in an 80 column terminal. + +When done editing or examining an image exit with 'q' or 'Q'. The +former saves the modified image in the output image (which might be +the same as the input image) while the latter does not save the +modified image. Note that if the image has not been modified then +no output occurs. After exiting the next image in the input +list is edited. One may also change input images using the +":input" command. Note that this command sets the output to be the +same as the input and a subsequent ":output" command should be +used to define a different output image name. A final useful +colon command is ":write" which forces the current editor buffer +to be written. This can be used to save partial changes. +.ih +REPLACEMENT ALGORITHMS +The parameters "minvalue" and "maxvalue" are may be used to limit the +range of values modified. The default is to modify all pixels which +are selected as described below. + +.ls a, b +Replace rectangular or aperture regions by background values. A background +surface is fit the pixels in the background annulus if the x and y orders +are greater than zero otherwise a median is computed. The x and y orders +of the surface function are given by the \fIxorder\fR and \fIyorder\fR +parameters. The median is used or the surface is evaluated for the pixels +in the replacement region. If a positive sigma is specified then gaussian +noise is added. If a sigma of INDEF is specified then the residuals of the +background pixels are sorted, the upper and lower 10% are excluded, and the +remainder are randomly selected as additive noise. +.le +.ls c, f, l +Replace rectangular or line regions by interpolation from the nearest +background column or line. The 'f' line option interpolates across the +narrowest dimension; i.e. for lines nearer to the line axis interpolation +is by lines while for those nearer to the column axis interpolation is +by columns. The buffer region applies but only the nearest background +pixel at each line or column on either side of the replacement region +is used for interpolation. Gaussian noise may be added but background +sampling is not available. This method is similar to the method used +in \fBfixpix\fR or \fBccdred\fR with no buffer. For "fixpix" type +input the type of interpolation is automatically selected for the +narrower dimension with column interpolation for square regions. +.le +.ls d, e, v +Replace rectangular, aperture, or vector regions by the specified +constant value. This may be used to flag pixels or make masks. +The vector option makes a line between two points with a width +set by the radius value. +.le +.ls j, k +Replace rectangular or aperture regions in the editor buffer by the data +from the input image. This may be used to undo any change. Note that +the 'i' command can be used to completely reinitialize the editor +buffer from the input image. +.le +.ls m, n +Replace an aperture region by another aperture region. There is no +centering applied in this option. The aperture region to copy is +background subtracted using the background annulus for median or surface +fitting. This data may then be added to the destination aperture or +replace the data in the destination aperture. In the latter case the +destination background surface is also computed and added. +.le +.ls u +Undo the last change. When a change is made the before and after data +are saved. An undo exchanges the two sets of data. Note that it is +possible to undo an undo to restore a change. If any other command is +used which causes data to be read (including the statistics and surface +plotting) then the undo is lost. +.le +.ls =, <, > +The all pixels with a value equal to that of the pixel at the cursor +position are replaced by the specified constant value. This is intended +for editing detection masks where detected objects have specific mask +values. +.le +.ih +COMMANDS +.ce + IMEDIT CURSOR KEYSTROKE COMMANDS + +.nf + ? Print help + : Colon commands (see below) + <space> Statistics + g Surface graph + i Initialize (start over without saving changes) + q Quit and save changes + p Print box of pixel values and statistics + r Redraw image display + s Surface plot at cursor + t Toggle between minimum and maximum search + + Increase radius by one + - Decrease radius by one + I Interrupt task immediately + Q Quit without saving changes +.fi + +The following editing options are available. Rectangular, line, and +vector regions are specified with two positions and aperture regions +are specified by one position. The current aperture type (circular or +square) is used in the latter case. The move option takes two positions, +the position to move from and the position to move to. + +.nf + a Background replacement (rectangle) + b Background replacement (aperture) + c Column interpolation (rectangle) + d Constant value substitution (rectangle) + e Constant value substitution (aperture) + f Interpolation across line (line) + j Replace with input data (rectangle) + k Replace with input data (aperture) + l Line interpolation (rectangle) + m Copy by replacement (aperture) + n Copy by addition (aperture) + u Undo last change (see also 'i', 'j', and 'k') + v Constant value substitution (vector) + = Constant value substitution of pixels equal + to pixel at the cursor position + < Constant value substitution of pixels less than or equal + to pixel at the cursor position + > Constant value substitution of pixels greater than or equal + to pixel at the cursor position +.fi + +When the image display provides a fill option then the effect of zoom +and roam is provided by loading image sections. This is a temporary +mechanism which will eventually be replaced by a more sophisticated +image display interface. + +.nf + E Expand image display + P Pan image display + R Redraw image display + Z Zoom image display + 0 Redraw image display with no zoom + 1-9 Shift display +.fi + + +.ce +IMEDIT COLON COMMANDS + +The colon either print the current value of a parameter when there is +no value or set the parameter to the specified value. + +.nf +angh [value] Horizontal viewing angle (degrees) +angv [value] Vertical viewing angle (degrees) +aperture [type] Aperture type (circular|square) +autodisplay [yes|no] Automatic image display? +autosurface [yes|no] Automatic surface plots? +buffer [value] Background buffer width +command [string] Display command +display [yes|no] Display image? +eparam Edit parameters +graphics [device] Graphics device +input [image] New input image to edit (output name = input) +output [image] New output image name +radius [value] Aperture radius +search [value] Search radius +sigma [value] Noise sigma (INDEF for histogram replacement) +value [value] Constant substitution value +minvalue [value] Minimum value for modification (INDEF=minimum) +maxvalue [value] Maximum value for modification (INDEF=maximum) +width [value] Background annulus width +write [name] Write changes to name (default current output) +xorder [value] X order for background fitting +yorder [value] Y order for background fitting +.fi +.ih +KEYWORDS +None +.ih +EXAMPLES +1. Interactively edit an image. + + cl> imedit raw002 ed002 + +2. Edit pixels non-interactively from an x-y list. Replace the original images + by the edited images. + +.nf + cl> head bad + 20 32 + 40 91 + <etc> + cl> imedit raw* "" cursor=bad display- +.fi + +3. It is possible to use a contour plot for image display. This is really + not very satisfactory but can be used in desperation. + +.nf + cl> reset stdimcur=stdgraph + cl> display.command="contour $image >& dev$null" + cl> imedit raw002 ed002 +.fi + +4. Use a "fixpix" file (without trim option). + +.nf + cl> head fixpix + 20 22 30 80 + 99 99 1 500 + <etc> + cl> imedit raw* %raw%ed%* cursor=fixpix fixpix+ display- +.fi +.ih +REVISIONS +.ls IMEDIT V2.13 +The 'v' option was added to allow vector replacement. +The '=', '<', '>' options were added to replace values matching the pixel +at the cursor. +.le +.ls IMEDIT V2.11.2 +The temporary editor image was changed to use a unique temporary image +name beginning with "imedit" rather than the fixed name of "epixbuf". +.le +.ls IMEDIT V2.11 +If xorder or yorder are zero then a median background is computed +for the 'a' and 'b' keys. +.le +.ls IMEDIT V2.10.4 +The 'u', 'j', 'k', and 'n' keys were added to those recorded in the +log file. +.le +.ls IMEDIT V2.8 +This task is a first version of what will be an evolving task. +Additional features and options will be added as they are suggested. +It is also a prototype using a very limited display interface; execution +of a separate display command. Much better interaction with a variety +of image displays will be provided after a planned "image display +interface" is implemented. Therefore any deficiencies in this area +should be excused. + +The zoom and roam features provided here are quite useful. However, +they depend on a feature of the tv.display program which fills the +current image display window by pixel replication or interpolation. +If this is left out of the display command these features will not +work. The trick is that this task displays sections of the editor +buffer whose size and position is based on an internal zoom and +center and the display program expands the section to fill the +display. + +The surface plotting is done using an imported package. The limitations +of this package (actually limitations in the complexity of interfacing +the application to this sophisticated package) mean that the +surface plots are always scaled to the range of the data and that +it is not possible to label the graph or use the graphics cursor to +point at features for the task. +.le +.ih +SEE ALSO +ccdred.instruments proto.fixpix +.endhelp diff --git a/pkg/images/tv/doc/imexamine.hlp b/pkg/images/tv/doc/imexamine.hlp new file mode 100644 index 00000000..14dbb59d --- /dev/null +++ b/pkg/images/tv/doc/imexamine.hlp @@ -0,0 +1,1043 @@ +.help imexamine Mar96 images.tv +.ih +NAME +imexamine -- examine images using image display, plots, and text +.ih +USAGE +imexamine [input [frame]] +.ih +PARAMETERS +.ls input +Optional list of images to be examined. If specified, images are examined +in turn, displaying them automatically. If no images are specified the +images currently loaded into the image display are examined. +.le +.ls output = "" +Rootname for output images created with the 't' key. If no name is specified +then the name of the input image is used. A three digit number is appended +to the rootname, such as ".001", starting with 1 until no image is found with +that name. Thus, successive output images with the same rootname will be +numbered sequentially. +.le +.ls ncoutput = 101, nloutput = 101 +Size of the output image created with the 't' key which is centered on the +position of the cursor. +.le +.ls frame = 1 +During program execution, a query parameter specifying the frame to be loaded. +May also be specified on the command line when \fIimexamine\fR is used as a +task to display a new image, to specify the frame to be loaded. +.le +.ls image +Query parameter for selecting images to be loaded. +.le +.ls logfile = "" +Logfile filename in which to record output of the commands producing text. +If no filename is given then no logfile will be kept. +.le +.ls keeplog = no +Log output results initially? Logging can be toggled interactively during +program execution. +.le +.ls defkey = "a" +Default key for cursor x-y input list. This key is applied to input +cursor lists which do not have a cursor key specified. It is used +to repetitively apply a cursor command to a list of positions typically +obtained from another task. +.le +.ls autoredraw = yes +Automatically redraw graphs after a parameter change? If no then graphs +are only drawn when a graph or redraw command is given. +If yes then colon commands which modify a parameter of the last graph +will automatically redraw the graph. A common example of this would +be changing the graph limits. +.le +.ls allframes = yes +Use all frames for displaying images? If set, images from the input list +are loaded cycling through the available frames. If not set the last frame +loaded is reused. +.le +.ls nframes = 0 +Number of display frames. When automatically loading images from the input +list only this number of frames will be used. This should, of course, +not exceed the number of frames provided by the display device. +If the number of frames is set to 0 then the task will query the display +device to determine how many frames are currently allocated. New frames may +be allocated during program execution by displaying images with the 'd' key. +.le +.ls ncstat = 5, nlstat = 5 +The statistics command computes values from a box centered on the +specified cursor position with the number of columns and lines +given by these parameters. +.le +.ls graphcur = "" +Graphics cursor input. If null the standard graphics cursor is used whenever +graphics cursor input is requested. A cursor file in the appropriate +format may be substituted by specifying the name of the file. +.le +.ls imagecur = "" +Image display cursor input. If null the standard image display cursor is +used whenever image cursor input is requested. A cursor file in the +appropriate format may be substituted by specifying the name of the file. +Also the image cursor may be changed to query the graphics device or +the terminal by setting the environment parameter "stdimcur" +to "stdgraph" or "text" respectively. +.le +.ls wcs = "logical" +The world coordinate system (\fIwcs\fR) to be used for axis labeling when +input is from images. +The following standard world systems are predefined. +.ls logical +Logical coordinates are image pixel coordinates relative to the image currently +being displayed. +.le +.ls physical +The physical coordinate system is invariant with respect to linear +transformations of the physical image matrix. For example, if the reference +image was created by extracting a section of another image, the physical +coordinates of an object in the reference image will be the pixel coordinates +of the same object in the original image. The physical coordinate system +thus provides a consistent coordinate system (a given object always has the +same coordinates) for all images, regardless of whether any user world +coordinate systems have been defined. +.le +.ls world +The "world" coordinate system is the \fIcurrent default WCS\fR. +The default world system is the system named by the environment variable +\fIdefwcs\fR if defined in the user environment and present in the reference +image WCS description, else it is the first user WCS defined for the image +(if any), else physical coordinates are returned. +.le +.ls xformat = "", yformat = "" +The numerical format for the world coordinate labels in the line and column +plots and the format for printing world coordinates. The values may be "" +(an empty string), %f for decimal format, %h and %H for xx:xx:xx format, and +%m and %M for xx:xx.x format. The upper case %H and %M convert degrees +to hours. Images sometimes include recommended coordinate formats as +WCS attributes. These are used if the format specified by these parameters +is "". Any other value will override the image attribute. +.le + +In addition to these three reserved WCS names, the name of any user WCS +defined for the reference image may be given. A user world coordinate system +may be any linear or nonlinear world system. +.le +.ls graphics = "stdgraph" +Graphics output device. Normally this is the standard graphics device +specified by the environment variable "stdgraph". +.le +.ls display = "display(image='$1',frame=$2)" +Command template used to display an image. The image to be displayed is +substituted for argument $1 and the frame for argument $2. Any display task +may be used for image display by modifying this template. +.le +.ls use_display = yes +Use the image display? Set to no to disable all interaction with the +display device, e.g., when working at a terminal that does not provide image +display capabilities. +.le +.ih +ADDITIONAL PARAMETERS +The various graphs and the aperture sum command have parameters defined in +additional parameter sets. The parameter sets are hidden tasks with +the first character being the cursor command graph key that uses the +parameters followed by "imexam". The parameter sets are: + +.nf + cimexam Parameters for column plots + eimexam Parameters for contour plots + himexam Parameters for histogram plots + jimexam Parameters for line 1D gaussian fit plots + kimexam Parameters for column 1D gaussian fit plots + limexam Parameters for line plots + rimexam Parameters for radial profile plots and aperture sums + simexam Parameters for surface plots + vimexam Parameters for vector plots (centered and endpoint) +.fi + +The same parameters dealing with graph formats occur in many of the parameter +sets while some are specific only to one parameter set. In the +summary below those common to more than one parameter set are shown +only once. The characters in parenthesis are the graph key prefixes +for the parameter sets in which the parameter occurs. + +.ls angh = -33., angv = 25. (s) +Horizontal and vertical viewing angles (degrees) for surface plots. +.le +.ls autoscale = yes (h) +In the case of integer data, automatically adjust \fInbins\fR and +\fIz2\fR to avoid aliasing effects. +.le +.ls axes = yes (s) +Draw axes along edge of surface plots? +.le +.ls background = yes (jkr.) +Fit and subtract a background for aperture sums, 1D gaussian fits, and +radial profile plots? +.le +.ls banner = yes (cehjklrsv.) +Add a standard banner to a graph? The standard banner includes the +IRAF user and host identification and time, the image name and title, +and graph specific parameters. +.le +.ls beta = INDEF (ar.) +Beta value to use for Moffat profile fits. If the value is INDEF +the value will be determine as part of the fit otherwise the parameter +will be fixed at the specified value. +.le +.ls boundary = "constant" (v) +Boundary extension for vector plots in which the averaging width might +go outside of the image. +.le +.ls box = yes (cehjklrv.) +Draw graph box and axes? +.le +.ls buffer = 5. (r.) +Buffer distance from object aperture of background annulus for aperture sums +and radial profile plots. +.le +.ls ceiling = INDEF (es) +Ceiling data value for contour and surface plots. A value of INDEF does +not apply a ceiling. (In contour plots a value of 0. also does not +apply a ceiling.) +.le +.ls center = yes (jkr.) +Apply a centering algorithm for doing aperture sums, 1D gaussian fits, +and radial profile plots? +.le +.ls constant = 0. (v) +Boundary extension constant for vector plots in which the averaging width +might go outside of the image. +.le +.ls dashpat = 528 (e) +Dash pattern for negative contours. +.le +.ls fill = no (e) +Fill the output viewport regardless of the device aspect ratio? +.le +.ls fitplot = yes (r.) +Overplot the profile fit on the radial profile data? +.le +.ls fittype = "moffat" (ar.) +Profile type to fit the radial profile data? The choices are "gaussian" +and "moffat". +.le +.ls floor = INDEF (es) +Floor data value for contour and surface plots. A value of INDEF does +not apply a floor. (In contour plots a value of 0. also does not +apply a floor.) +.le +.ls interval = 0 (e) +Contour interval. If 0, a contour interval is chosen which places 20 to 30 +contours spanning the intensity range of the image. +.le +.ls iterations = 3 (ar) +Number of iterations to adjust the fitting radius. +.le +.ls label= no (e) +Label the major contours in the contour plot? +.le +.ls logx = no, logy = no (chjklrv.) +Plot the x or y axis logarithmically? The default for histogram plots is +to plot the y axis logarithmically. +.le +.ls magzero = 25. (r.) +Magnitude zero point for aperture sums. +.le +.ls majrx=5, minrx=5, majry=5, minry=5 (cehjklrv.) +Maximum number of major tick marks on each axis and number of minor tick marks +between major tick marks. +.le +.ls marker = "box" (chjklrv.) +Marker to be drawn if \fBpointmode\fR = yes. Markers are "point", "box", +"cross", "plus", "circle", "hebar", "vebar", "hline", "vline" or "diamond". +.le +.ls naverage = 1 (cjklv) +Number of lines, columns, or width perpendicular to a vector to be averaged. +.le +.ls nbins = 512 (h) +The number of bins in, or resolution of, histogram plots. +.le +.ls ncolumns = 21, nlines = 21 (ehs) +Number of columns and lines used in contour, histogram, and surface plots. +.le +.ls ncontours = 5 (e) +Number of contours to be drawn. If 0, the contour interval may be specified, +otherwise 20-30 nicely spaced contours are drawn. A maximum of 40 contours +can be drawn. +.le +.ls nhi = -1 (e) +If -1, highs and lows are not marked. If 0, highs and lows are marked +on the plot. If 1, the intensity of each pixel is marked on the plot. +.le +.ls pointmode = no (chlv) +Plot points or marks instead of lines? +.le +.ls pointmode = yes (jkr.) +Plot points or marks instead of lines? For radial profile plots point +mode should always be yes. +.le +.ls radius = 5. (r.) +Radius of aperture for aperture sums and centering. +.le +.ls round = no (cehjklrv.) +Extend the axes up to "nice" values? +.le +.ls rplot = 8. (jkr.) +Radius to which the radial profile or 1D profile fits are plotted. +.le +.ls sigma = 2. (jk) +Initial guess for 1D gaussian fits. The value is in pixels even if the fitting +is done in world coordinates. This must be close to the true value +for convergence. Also the four times the initial sigma is used to define +the distance to the background region for the initial background estimate. +.le +.ls szmarker = 1 (chjklrv.) +Size of mark (except for points). A positive size less than 1 specifies +a fraction of the device size. Values of 1, 2, 3, and 4 signify +default sizes of increasing size. +.le +.ls ticklabels = yes (cehjklrv.) +Label the tick marks? +.le +.ls title = "" (cehjklrsv.) +User title. This is independent of the standard banner title. +.le +.ls top_closed = no (h) +Include z2 in the top histogram bin? Each bin of the histogram is a +subinterval that is half open at the top. \fITop_closed\fR decides whether +those pixels with values equal to z2 are to be counted in the histogram. If +\fBtop_closed\fR is yes, the top bin will be larger than the other bins. +.le +.ls width = 5. (jkr.) +Width of background region for background subtraction in aperture sums, +1D profile fits, and radial profile plots. +.le +.ls wcs = "physical" +World coordinate system for axis labeling and coordinate readback. +.le +.ls x1 = INDEF, x2 = INDEF, y1 = INDEF, y2 = INDEF (chjklrv.) +Range of graph along each axis. If INDEF the range is determined from +the data range plus a buffer. The default y1 for histogram plots is 0. +.le +.ls xformat, yformat +Set world image coordinate formats. Any format changes take effect on the next +usage; i.e. there is no automatic redrawing. +.le +.ls xlabel, ylabel (cehjklrv.) +Axis labels. Each graph type has an appropriate default. If the label +value is "wcslabel" then the coordinate label from the image WCS +will be used if defined. +.le +.ls xorder = 0 (jk) +Order for 1D gaussian background. If 0 then a median is computed. If +1 then a constant background is fit simultaneously with the other gaussian +parameters. If 2 then a linear background is fit simultaneously with the +other gaussian parameters. +.le +.ls xorder = 0, yorder = 0 (r.) +If either parameter is zero then the median value of the +background annulus is used for background subtraction in aperture sums and +radial profile plots. Values greater than zero define polynomial +surface orders for background subtraction. The orders are actually the +number of polynomial terms. An order of 1 is a constant an order of 2 +is a plane. +.le +.ls zero = 0. (e) +Greyscale value of the zero contour, i.e., the value of a zero point shift +to be applied to the image data before plotting. Does not affect the values +of the floor and ceiling parameters. +.le +.ls z1 = INDEF, z2 = INDEF (h) +Range of pixel values to be used in histogram. INDEF values default to +the range in the region being histogramed. +.le +.ih +DESCRIPTION +Images are examined using an image display, various types of plots, and +text output. Commands are given using the image display cursor and/or +graphics cursor. This task brings together many of the features of the +IRAF image display and graphics facilities with some simple image +analysis capabilities. + +IMAGE DISPLAY + +If \fIuse_display\fR is yes the image display is used to examine images. +When no input list is specified images may be loaded with the 'd' key, +frames selected with 'n', 'p', and ":select", and the scaled contents +of the display frame buffer examined if the image itself is not available. + +When an input list is specified the 'n', 'p', and ":select" allow +moving about the list and new images may be added to the end of the +list with 'd'. Images are automatically loaded as they are selected if +not currently loaded. Two parameters control how the frames are +loaded. The \fInframes\fR parameter determines which frames are +available. Within the available frames images may be loaded by cycling +through them if \fIallframes\fR is yes or in the last loaded frame +(initially frame 1) if it is no. + +When reading the image cursor the frame and the name of the image in +the frame are determined. Therefore images may also be selected +by changing the frame externally or if the image cursor input is +changed from the standard image display to text or file input. + +The 'd' command displays an image using the template CL command given +by parameter \fIdisplay\fR. Usually this is the standard +IRAF \fBtv.display\fR command though in some circumstances other commands +like \fBplot.contour\fR may be used. This command may be used to +display an image even if \fIuse_display\fR is no. + +This task is generally intended for interactive use with an image +display. However it is possible to disable use of the image display +and change the image cursor input to a graphics cursor, a file, +or typed in by the user. In this case an input image list is most +appropriate but if one is missing, a query will be issued each time +a command requiring an image is given. + +CURSOR INPUT + +Commands are given using cursor input. Generally the image cursor is +used to select points in the images to be examined and the key typed +selects a particular operation. In addition to the image cursor the +graphics cursor is sometimes useful. First, it gives access to the +graphics cursor mode commands (see \fBcursors\fR) such as annotating, +saving or printing a graph, expanding and roaming, and printing cursor +positions. Second, it can give a better perspective on the data for +cursor positions than the image cursor. And lastly, it may be needed +when an image display is not available. The commands 'g' and 'i' +select between the graphics and image cursors. Initially the image +cursor is read. + +Interpretation of the graph coordinate in terms of an image coordinate +depends on the type of graph as described below. + +.ls contour plot +This gives image coordinates directly and both the x and y cursor values +are used. +.le +.ls column plot +The x cursor position gives the line coordinate and the column coordinate +used for the plot (that specified before averaging) gives the column +coordinate. +.le +.ls line plot +The x cursor position gives the column coordinate and the line coordinate +used for the plot (that specified before averaging) gives the line +coordinate. +.le +.ls vector plot +The x cursor position defines a column and line coordinate along the vector +plotted. +.le +.ls surface plot +No cursor information is available in this plot and the cursor position +used to make the surface plot (the center of the surface) is used again. +.le +.ls histogram plot +No cursor information is available in this plot and the cursor position +used to make the histogram (the center of the box) is used again. +.le +.ls radial profile plot +No cursor information is available in this plot and the cursor position +used to define the center is used again. +.le + +There are some special features associated with cursor input in IRAF +which might be useful in some circumstances. The image display cursor +can be reset to be a text cursor, graphics cursor, or image cursor by +setting the environment variable "stdimcur" to "text", "stdgraph", +or "stdimage" respectively. Text cursor input consists of the x and +y coordinates, a frame number, and the key or colon command. Another +form of text input is to set the value of the cursor input parameter +to a file containing cursor commands. There are two special features +dealing with text cursor input. If only x and y are entered the default +key parameter \fIdefkey\fR determines the command. This is particularly +useful if one has a list of pixel positions prepared by some other +program. The second feature is that for commands not requiring coordinates +they may be left out and the command key or colon command entered. + +TEXT OUTPUT + +The following commands produce text output which may also be appended to +a logfile. + +.ls a, ',' +Circular aperture photometry is performed at the position of the cursor. +If the centering option is selected the cursor position is used as the +initial point for computing the central moments of the marginal +distributions in x and y. The marginal distributions are obtained from a +square aperture with edge dimensions of twice the aperture radius +parameter. Only the pixels above the mean are used in computing the +central moments. If the central moments are in a different pixel than that +used for extracting the marginal distributions the computation is repeated +using the new center. + +The radius of the photometry and fitting aperture is specified by the +\fIradius\fR parameter and the \fIiteration\fR parameter. Iteration of the +fitting radius and printing of the final radius is only done for the 'a' +key. If the number of iterations is one then the radius is not adjusted. +If it is greater than one then the direct FWHM (described) below is used to +adjust the radius. At each iteration the new radius is set to three times +the direct FWHM (which is six times the radius at half-maximum). The +radius is printed as part of the output. + +If the background subtraction option is selected a concentric circular +annulus is defined. The inner edge is separated from the object +aperture by a specified buffer distance and the outer edge is defined +by a width for the annulus. The type of background used is determined +by the parameters \fIxorder\fR and \fIyorder\fR. If either parameter +is zero then a median of the background annulus is determined. +If 1 or greater a polynomial surface of the specified number of terms +is fit. Typically the orders are 1 for a constant or 2 for a plane. +The median or fitted surface values within the object aperture are then +subtracted. + +The flux within the circular aperture is computed by simply summing the +pixel values with centers within the specified radius of the center +position. No partial pixel adjustments are made. If the flux is +positive a magnitude is computed as + + magnitude = magzero - 2.5 * log10 (flux) + +where the magnitude zero point is a user defined parameter. + +In addition to the flux, the second intensity moments are used to compute +an ellipticity and position angle. The equations defining the moments and +related parameters are: + +.nf + Mxx = sum (x * x * I) / sum (I) + Myy = sum (y * y * I) / sum (I) + Mxy = sum (x * y * I) / sum (I) + e = sqrt ((Mxx - Myy) ** 2 + (2 * Mxy) ** 2) / (Mxx + Myy) + pa = 0.5 * atan (2 * Mxy / (Mxx - Myy)) +.fi + +A nonlinear least squares profile of fixed center and zero background is +fit to the radius and flux values of the background subtracted pixels to +determine a peak intensity and FWHM. The profile type is set by the +\fIfittype\fR parameter. The choices are "gaussian" and "moffat". If the +profile type is "moffat" there is an additional parameter "beta". This +value may be specified to fix it or given as INDEF to also be determined. +The profile equations are: + +.nf + I = Ic exp (-0.5 * (r / sigma)**2) (fittype = "gaussian") + I = Ic (1 + (r / alpha)**2)**(-beta) (fittype = "moffat") +.fi + +where Ic is the peak value, r is the radius, and the parameters are +sigma, alpha, and beta. The sigma and alpha values are converted to +FWHM in the reported results. + +Weights which are the inverse square of the pixel radius are used. This +has the effect of giving equal weight to all parts of the profile instead +of being overwhelmed by the larger number of pixels are larger radii. An +additional weighting factor is used for pixels outside the half-maximum +radius (as determined using the algorithm described below). The weights +are + +.nf + wt = exp (-(r/rhalf - 1)**2) for r/rhalf > 1 +.fi + +where rhalf is the radius at half-maximum. This has the effect +of reducing the contribution of the profile wings. + +The above fit is done to the individual pixel values with a radius measured +to the center of the pixel. For the 'a' key two additional measurements +are made on a azimuthally averaged radial profile with a finer sampling of +the radial bins. This uses the same algorithms for centering, background +estimation, and FWHM measurement as in the task \fBpsfmeasure\fR. The +centering is essentially the same as described above but the background +estimation is a mode of the sky annulus pixels. Note that the centering +and background subtraction are done for these measurements regardless of +the the \fIcenter\fR and \fIbackground\fR parameters which apply only to +the photometry and profile fitting to the individual pixel values. + +To form the radially smoothed profile an image interpolator function is fit +to the region containing the object. The enclosed flux profile (total flux +within a particular radius) is computed. The sampling is done at a much +finer resolution than individual pixels. The subsampling scheme is that +described in \fBpsfmeasure\fR and is such that the center of the profile is +more finely sampled than the edges of the profile. + +Because the image interpolator function may not be very good for narrow +profiles a second iteration is done if the radius enclosing half the flux +is less than two pixels. In this second iteration an analytic, radially +symmetric Gaussian profile is subtracted from the image raster and the +interpolation function is fit to the residuals. Subpixel values are then +computed by evaluating the analytic function plus the interpolated residual +value. + +There are two FWHM measurements computed using the enclosed flux +radial profile. One is to fit a Gaussian or Moffat profile to the +enclosed flux profile. The type is selected by the same \fIfittype\fR +parameter used to select the profile to fit to the individual pixel +values. As with the direct fit the Moffat beta value may be fixed or +included in the fit. The FWHM of the fit is then printed on the +status line, terminal output, and log file. + +The other FWHM measurement directly measure the FWHM independent of a +profile model. The derivative of the enclosed flux profile is computed. +This derivative is the azimuthally averaged radial profile with the radial +bin sampling mentioned above. The peak of this profile is found and the +FWHM is twice the radius of the profile at half the peak value. This +"direct FWHM" is part of the output and is also used for the iterative +adjustment of the fitting radius as noted above. + +.ls a +The output consists of the image line and column, the coordinates, the +final radius used for the photometry and fitting, magnitude, flux, mean +background, peak value of the profile fit, e, pa (in degrees between -90 +and +90 with 0 along the x axis), the Moffat beta value if a Moffat profile +is fit, and three measures of the FWHM. The coordinates are those +specified by the \fIwcs\fR and formatted by the format parameters. For the +logical wcs the coordinates will be the same as the column and line +values. If a value is numerically undefined then INDEF is printed. The +FWHM values are, in order, the profile fit to the enclosed flux, the +profile fit to the individual pixels, and the direct measurement from the +derivative of the enclosed flux profile. Note that except for the direct +method, the other estimates are not really measurements of the FWHM but are +quantities which give the correct FWHM for the specified profile type. +.le +.ls ',' +The output consists of the image line and column, magnitude, flux, number +of pixels within the aperture, mean background, r (moment FWHM), e, pa (in +degrees between -90 and +90 with 0 along the x axis), and the peak value +and FWHM of the profile fit. The label GFWHM indicates a Gaussian fit +while the label MFWHM indicates a Moffat profile fit. If a quantity is +numerically undefined then INDEF is printed. +.le + +This aperture photometry and FWHM tool is intended only for general image +analysis and quick look measurements. The background fitting, photometry, +and FWHM techniques used are not intended for serious astronomical +photometry; other packages, e.g., \fInoao.digiphot.apphot\fR, should be +used if precise results are desired. +.le +.ls b +The integer pixel coordinates defining a region of the image are printed. +Two cursor positions are used to select the range of columns and lines. +The output format consists of the starting and ending column +coordinates and the starting and ending line coordinates. This format is +used as input by some tasks and can be used to generate image sections if +desired. +.le +.ls j, k +The fitted gaussian center, peak, sigma, full width at half maximum, and +background at the center is computed and printed. +.le +.ls m +Statistics of a rectangular region centered on the cursor position are +computed and printed. The size of the statistics box is set by the +parameters \fIncstat\fR and \fInlstat\fR. The output format consists +of the image section, the number of pixels, the mean, the median, the +standard deviation, the minimum, and the maximum. +.le +.ls x, y +The cursor x and y coordinates and the pixel value nearest this position +are printed. The 'y' key may be used define a relative origin. If +an origin is defined (is not 0,0) then additional quantities are printed. +These quantities are origin coordinates, the delta x and delta y distances, +the radial distance, and the position angle (in degrees counterclockwise from +the x axis). +.le +.ls z +A 10x10 grid of pixel values is printed. The integer coordinates are +also printed around the grid. +.le + +GRAPHICS OUTPUT + +The following commands produce graphics output to the specified graphics +device (normally the graphics terminal). + +.ls c +A plot of a column or average of columns is made with the line number as +the ordinate and the pixel value as the abscissa. The averaging number +and various graph options are specified by the parameters from the +\fBcimexam\fR parameter set. +.le +.ls e +A contour plot of a region centered on the cursor is made. The +size of the region and various contouring and labeling options are +specified by the parameters from the \fBeimexam\fR parameter set. +.le +.ls h +A histogram of a region centered on the cursor is made. The size +of the region and various binning parameters are specified by +the parameters from the \fBhimexam\fR parameter set. +.le +.ls l +A plot of a line or average of lines is made with the column number as +the ordinate and the pixel value as the abscissa. The averaging number +and various graph options are specified by the parameters from the +\fBlimexam\fR parameter set. +.le +.ls r, '.' +A radial profile plot is made. As with 'a'/',' there are options for centering +and background subtraction. There are also graphics option to set the +radius to be plotted (\fIrplot\fR) and to overplot the profile fit +(\fIfitplot\fR). The measurement algorithms are those described for the +'a'/',' key and the output is the same except that there is no header line and +the object center is given in the graph title rather than on the graphics +status line. The aperture sum and graph options are specified by the +parameters from the \fBrimexam\fR parameter set. +.le +.ls s +A surface plot of a region centered on the cursor is made. The size +of the region and various surface and labeling options are +specified by the parameters from the \fBsimexam\fR parameter set. +.le +.ls u, v +A plot of a vector defined by two cursor positions is made. The 'u' +plot uses the first cursor position to define the center of the vector +and the second position to define the endpoint. The vector is extended +an equal distance in the opposite direction and the graph x coordinates +are the radial distance from the center position. The 'v' plot +uses the two cursor positions as endpoints and the coordinates are +the radial distance from the first cursor position. The vector may +be averaged over a specified number of parallel vectors. The +averaging number and various graph options are specified by the parameters +from the \fBvimexam\fR parameter set. +.le + + +MISCELLANEOUS COMMANDS + +The following commands control useful features of the task. + +.ls d +The display command given by the parameter \fIdisplay\fR is given +with appropriate image name. By default this loads the image +display using the \fBtv.display\fR task. When using an input image +list this operation also appends new images to the list for subsequent +'n' and 'p' commands. +.le +.ls f +Redraw the last graph. If the \fIautoredraw\fR parameter is no then +this is used to redraw a graph after making parameter changes with +colon commands. If the parameter is yes then any colon command which +affects the current plot will execute a redraw automatically. +.le +.ls g, i +Cursor input may be selected to be from the graphics cursor (g) or +image display cursor (i). +.le +.ls n, p +Go to the next or previous image in the image list or display frames. +.le +.ls o +Overplot the next graph. This generally only makes sense with the +line, column, and histogram plots. +.le +.ls q +Quit the task. +.le +.ls t +Output an image centered on the cursor position with name and size set +by the \fIoutput\fR, \fIncoutput\fR and \fInloutput\fR parameters. +Note that the cursor input might be from a contour, surface, or other +plot as well as from the image display. +.le +.ls w +Toggle output to the logfile. If no logfile is specified this has no +effect except to print a message. If the logfile is specified a message +is printed indicating that the logfile has been opened or closed. +Every time the logfile is opened the current image name and title is +entered as well as when the image is changed. The logfile name may +be set or changed by a colon command. +.le +.ls :select +Select an image. If an input image list is used the specified index +number selects an image from the list. If an input image list is not +used and the image display is used then the specified display frame +is selected. If the new image is different from the previous image +an identification line is inserted in the logfile if it is open. +.le +.ls :eparam, :unlearn +These colon commands manipulate the various parameter sets as +described below. +.le +.ls :c<#>, :l<#> +Special colon commands to plot specific columns or lines, symbolically +shown as <#>, rather than use a cursor position. +.le +.ls :<column> <line> <key> +Special colon command syntax to explicitly give image coordinates for +a cursor command key. +.le + +COLON COMMANDS + +Sometimes one wants to explicitly enter the coordinates for a command. +This may be done with a colon command having the following syntax: + + :<column> <line> <key> + +where column and line are the coordinates and key is the command. +If the line is not given then <column> = <line>. For the frequently +used line and column plots there is also the simple syntax: + +.nf + :c<column> or :l<line> +.fi + +with no space, e.g., ":l64". + +Every parameter except the input image list and the display command +may be queried or set by a +colon command. In addition the parameter sets for the various graphs +and aperture sum algorithm may be edited using the \fBeparam\fR editor +and reinitialized to default values using the \fBunlearn\fR command. +There are a large number of parameters as well as many graph types / +parameter sets. To achieve some consistency and order as well as +simplify the colon commands several things have been done. + +Many parameters occur in more than one graph type. This includes things +like graph labeling, tickmarks, and so forth. When issuing a colon +command for one of these parameters the current graph type is assumed +to be the one affected. If the graph type is wrong or no graph has +been made then a warning is given. + +If the parameter only occurs in one parameter set then the colon command +may be used with any current graph. However, if the parameter affects the +current graph and the automatic redraw option is set then the graph will +be redrawn. + +The eparam and unlearn commands also apply by default to the parameters +for the current graph. However, they may take the keystroke character +for the graph as an argument to override this. If the current graph +parameters are changed and the automatic redraw option is set then +the graph will be redrawn. + +The important colon commands 'x' and 'y' affect the x1, y1, x2, y2 +parameters in most of the graphs. They are frequently used to override +the automatic graph scaling. If no arguments are given the window +limits are set to INDEF resulting in plotting the full range of the +data plus a buffer. If two values are given then only that range of +the data will be plotted. + +.ih +COMMANDS + +.ce +Cursor Keys + +.nf +? Print help +a Aperture sum, moment parameters, and profile fit +b Box coordinates for two cursor positions - c1 c2 l1 l2 +c Column plot +d Load the image display +e Contour plot +f Redraw the last graph +g Graphics cursor +h Histogram plot +i Image cursor +j Fit 1D gaussian to image lines +k Fit 1D gaussian to image columns +l Line plot +m Statistics + image[section] npixels mean median stddev min max +n Next frame or image +o Overplot +p Previous frame or image +q Quit +r Radial profile plot with fit and aperture sum values +s Surface plot +t Output image centered on cursor (parameters output, ncoutput, nloutput) +u Centered vector plot from two cursor positions +v Vector plot between two cursor positions +w Toggle write to logfile +x Print coordinates + col line pixval [xorign yorigin dx dy r theta] +y Set origin for relative positions +z Print grid of pixel values - 10 x 10 grid +, Quick Gaussian/Moffat photometry +. Quick Gaussian/Moffat radial profile plot and fit +.fi + +.ce +Colon Commands + +Explicit image coordinates may be entered using the colon command syntax: + + :<column> <line> <key> + +where column and line are the image coordinates and the key is one +of the cursor keys. A special syntax for line or column plots is also +available as :c# or :l# where # is a column or line and no space is +allowed. + +Other colon commands set or show parameters governing the plots and other +features of the task. Each graph type has it's own set of parameters. +When a parameter applies to more than one graph the current graph is assumed. +If the current graph is not applicable then a warning is given. The +"eparam" and "unlearn" commands may be used to change many parameters and +without an argument the current graph parameters are modified while with +the graph key as an argument the appropriate parameter set is modified. +In the list below the graph key(s) to which a parameter applies are shown. + +.nf +allframes Cycle through all display frames to display images +angh s Horizontal angle for surface plot +angv s Vertical angle for surface plot +autoredraw cehlrsuv Automatically redraw graph after colon command? +autoscale h Adjust number of histogram bins to avoid aliasing +axes s Draw axes in surface plot? +background jkr Subtract background for radial plot and photometry? +banner cehjklrsuv Include standard banner on plots? +beta ar Moffat beta parameter (INDEF to fit or value to fix) +boundary uv Boundary extension type for vector plots +box cehjklruv Draw box around graph? +buffer r Buffer distance for background subtraction +ceiling es Data ceiling for contour and surface plots +center jkr Find center for radial plot and photometry? +constant uv Constant value for boundary extension in vector plots +dashpat e Dash pattern for contour plot +eparam cehjklrsuv Edit parameters +fill e Fill viewport vs enforce unity aspect ratio? +fitplot r Overplot profile fit on data? +fittype ar Profile fitting type (gaussian|moffat) +floor es Data floor for contour and surface plots +interval e Contour interval (0 for default) +iterations ar Iterations on fitting radius +label e Draw axis labels for contour plot? +logfile Log file name +logx chjklruv Plot x axis logarithmically? +logy chjklruv Plot y axis logarithmically? +magzero r Magnitude zero for photometry +majrx cehjklruv Number of major tick marks on x axis +majry cehjklruv Number of major tick marks on y axis +marker chjklruv Marker type for graph +minrx cehjklruv Number of minor tick marks on x axis +minry cehjklruv Number of minor tick marks on y axis +naverage cjkluv Number of columns, lines, vectors to average +nbins h Number of histogram bins +ncolumns ehs Number of columns in contour, histogram, or surface plot +ncontours e Number of contours (0 for default) +ncoutput Number of columns in output image +ncstat Number of columns in statistics box +nhi e hi/low marking option for contours +nlines ehs Number of lines in contour, histogram, or surface plot +nloutput Number of lines in output image +nlstat Number of lines in statistics box +output Output image root name +pointmode chjkluv Plot points instead of lines? +radius r Radius of object aperture for radial plot and photometry +round cehjklruv Round axes to nice values? +rplot jkr Radius to plot in 1D and radial profile plots +select Select image or display frame +sigma jk Initial sigma for 1D gaussian fits +szmarker chjklruv Size of marks for point mode +ticklabels cehjklruv Label ticks? +title cehjklrsuv Optional title for graph +top_closed h Close last bin of histogram +unlearn cehjklrsuv Unlearn parameters to default values +wcs World coordinate system for axis labels and readback +width jkr Width of background region +x [min max] chjklruv Range of x to be plotted (no values for autoscaling) +xformat Coordinate format for column world coordinates +xlabel cehjklrsuv Optional label for x axis +xorder jkr X order of surface for background subtraction +y [min max] chjklruv Range of y to be plotted (no values for autoscaling) +yformat Coordinate format for line world coordinates +ylabel cehjklrsuv Optional label for y axis +yorder r Y order of surface for background subtraction +z1 h Lower intensity value limit of histogram +z2 h Upper intensity value limit of histogram +zero e Zero level for contour plot +.fi +.ih +EXAMPLES +The following example illustrates many of the features in a descriptive +way using the standard image dev$pix. + +.nf + cl> imexam dev$pix nframes=2 + [The image is loaded in the display if not already loaded] + <Image cursor> l # Make a line plot + <Image cursor> e # Make a contour plot + <image cursor> d # Load a new image + image name: saga + display frame (1:) (1): 2 + <Image cursor> e # Make a contour plot + <Image cursor> g # Switch to graphics cursor + <Graph cursor> u # Mark the center of a vector + <Graph cursor> u # Mark endpoint make a vector plot + <Graph cursor> i # Go back to display + <Image cursor> r # Select star and make radial plot + <Image cursor> :rplot 10 # Set radius of plot + <Image cursor> :epar # Set radius plot parameters + <Image cursor> c # Make column plot + <Image cursor> :100 l # Line 100 of image 1 + <Image cursor> :20 30 e # Contour plot at (20,30) + <Image cursor> p # Go to previous image + <Image cursor> n # Go to next image + <Image cursor> :sel 1 # Select image 1 + <Image cursor> :log log # Set log file + <Image cursor> w # Begin logging + Log file log is open + <Image cursor> a # Do aperture sum on star 1 + <Image cursor> a # Do aperture sum on star 2 + <Image cursor> a # Do aperture sum on star 3 + <Image cursor> a # Do aperture sum on star 4 + <Image cursor> w # Close log file + Log file log is closed + <Image cursor> y # Mark position of galaxy center + <Image cursor> x # Print position relative to center + <Image cursor> x # Print position relative to center + <Image cursor> s # Make surface plot + <Image cursor> q # Quit +.fi +.ih +BUGS +If an operation is interrupted, e.g., an image display or surface plot, +\fIimexamine\fR is terminated rather than the operation in progress. + +When used on a workstation \fIimexamine\fR attempts to always position the +cursor to the window (text, image, or graphics) from which input is being +taken. Moving the mouse manually while the program is also trying to move +it can cause the mouse to be positioned to the wrong window, requiring that +it be manually moved to the window from which input is currently being taken. + +When entering a colon command in image cursor mode, if one types too fast +the characters typed before the mouse is moved to the input window +will be lost. To avoid this, pause a moment after typing the colon, before +entering the command, and verify that the mouse has been moved to the correct +window. In the future colon command input will be entered without moving +the mouse out of the image window, which will avoid the problem. +.ih +REVISIONS +.ls IMEXAMINE V2.11.4 +('t'): A new cursor key to create an output image. +.le +.ls IMEXAMINE V2.11 +('a' and 'r'): The fit to the radial profile points now includes both a +Gaussian and a Moffat profile. The Moffat profile exponent parameter, +beta, may be fixed or left free to be fit. + +('a' and 'r'): New estimates of the FWHM were added to the 'a' and 'r' +keys. These include the Moffat profile fit noted above, a direct +measurement of the FWHM from the radially binned profile, and a Gaussian or +Moffat fit to the radial enclosed flux profile. The output from these keys +was modified to include the new information. + +('a' and 'r'): The direct FWHM may be used to iteratively adjust the +fitting radius to lessen the dependence on the initial fitting +radius value. + +(',' and '.'): New keys to do the Gaussian or Moffat fitting without +iteration or the enclosed flux and direct measurements. The output +format is the same as the previous version. + +('k'): Added a kimexam parameter set. +.le +.ih +SEE ALSO +cursors, eparam, unlearn, plot.*, tvmark, digiphot.*, apphot.*, +implot, splot, imedit, radplt, imcntr, imhistogram, imstatistics, display +psfmeasure. +.endhelp diff --git a/pkg/images/tv/doc/tvmark.hlp b/pkg/images/tv/doc/tvmark.hlp new file mode 100644 index 00000000..b6611b22 --- /dev/null +++ b/pkg/images/tv/doc/tvmark.hlp @@ -0,0 +1,405 @@ +.help tvmark Dec89 images.tv +.ih +NAME +tvmark -- mark objects on the image display +.ih +USAGE +tvmark frame coords +.ih +PARAMETERS +.ls frame +The frame or image plane number of the display to be marked. +.le +.ls coords +The text file containing the coordinates of objects to be +marked, one object per line with x and y in columns 1 and 2 respectively. +An optional label may be read out of the third column. +If \fIcoords\fR = "", the coordinate file is undefined. +.le +.ls logfile = "" +The text file in which image cursor commands typed in interactive mode +are logged. If \fIlogfile\fR = "" no commands are logged. +If automatic logging is enabled, all cursor commands +are logged, otherwise the user must use the interactive keep keystroke +command to select specific cursor commands for logging. +Commands are not logged in non-interactive mode. +.le +.ls autolog = no +Automatically log all cursor commands in interactive mode. +.le +.ls outimage = "" +The name of the output snapshot image. +If tvmark is run in non-interactive mode and no command file is specified, +a copy of the frame buffer +is automatically written to the IRAF image \fIoutimage\fR after tvmark +terminates execution. +If \fIoutimage\fR = "" no output image is written. +In interactive mode or in non-interactive mode if a command file +is specified, the user can make snapshots of the frame buffer +with the interactive colon write command. In this case the name of the output +snapped image will be in order of priority, the name specified +by the user in the colon write ommand, "outimage.snap.version", or, +"imagename.snap.version". +.le +.ls deletions = "" +The extension of the output file containing objects which were deleted +from the coordinate file in interactive or command file mode. +By default no output deletions file is written. +If \fIdeletions\fR is not equal to the null string (""), then deleted +objects are written to a file called \fIcoords.deletions\fR. For +example if \fIcoords\fR = "nite1" and \fIdeletions\fR = "del", then the +deletions file will be called "nite1.del". +.le +.ls commands = "" +The text file containing the marking commands. +In interactive mode if \fIcommands\fR = "", +\fIcommands\fR is the image cursor. In non-interactive mode +cursor commands may be read from a text file, by setting \fIcommands\fR = +"textfile". This file may be a user +created command file, or the \fIlogfile\fR from a previous run of tvmark. +If \fIcommands\fR = "" in non-interactive mode, the default mark is drawn +on the display at the positions of all the objects in \fIcoords\fR. +.le +.ls mark = "point" +The default mark type. The options are: +.ls point +A point. To ensure legibility \fIpoint\fR is actually a square dot whose +size is specified by \fIpointsize\fR. +.le +.ls plus +A plus sign. The shape of the plus sign is determined by the raster font +and its size is specified by \fItxsize\fR. +.le +.ls cross +An x. The shape of the x is determined by the raster font and its size is +is specified by \fItxsize\fR. +.le +.ls circle +A set of concentric circles whose radii are specified by the \fIradii\fR +parameter. The radii are in image pixel units. If the magnifications +used by display are not equal in x and y circles will become ellipses +when drawn. +.le +.ls rectangle +A set of concentric rectangles whose lengths and width/length ratio are +specified by the \fIlengths\fR parameter. The lengths are specified in +image pixel units. If the magnifications used by the display are not +equal in x and y then squares will become rectangles when drawn. +.le +.le +.ls radii = "0" +If the default mark type is "circle" than concentric circles of radii +"r1,r2,...rN" are drawn around each selected point. +.le +.ls lengths = "0" +if the default mark type is "rectangle" then concentric rectangles of +length and width / length ratio "l1,l2,...lN ratio" are drawn around +each selected point. If ratio is not supplied, it defaults to 1.0 +and squares are drawn. +.le +.ls font = "raster" +The name of the font. At present only a simple raster font is supported. +.le +.ls color = 255 +The numerical value or color of the marks drawn. +Any number between 0 and 255 may be specified. +The meaning of the color is device dependent. +In the current version of the Sun/IRAF IMTOOL numbers between 202 +and 217 may be used to display graphics colors. The current color +assignments for IMTOOL are summarized later in this help page. +.le +.ls label = no +Label the marked coordinates with the string in the third column of +the text file \fIcoords\fR. \fIlabel\fR overrides \fInumber\fR. +.le +.ls number = no +Label the marked objects with their sequence number in the coordinate +list \fIcoords\fR. +.le +.ls nxoffset = 0, nyoffset = 0 +The x and y offset in display pixels of the numbers to be drawn. +Numbers are drawn by default with the lower left corner of the first +digit at the coordinate list position. +.le +.ls pointsize = 3 +The size of the default mark type "point". Point size will be rounded up +to the nearest odd number. +.le +.ls txsize = 1 +The size of text, numbers and the plus and cross marks to be written. +The size is in font units which are 6 display pixels wide and 7 display +pixels high. +.le +.ls tolerance = 1.5 +Objects marked by the cursor for deletion from the coordinate list +\fIcoords\fR must be less than or equal to \fItolerance\fR pixels +from the cursor position to be deleted. If 1 or more objects +is closer than \fItolerance\fR, the closest object is deleted. +.le +.ls interactive = no +Interactive mode. +.le +.ih +DESCRIPTION +TVMARK marks objects on the display by writing directly into +the frame buffer specified by \fIframe\fR. TVMARK can draw on +any devices supported by the IRAF \fIdisplay\fR program. +After marking, the +contents of the frame buffer may be written out to the IRAF image +\fIoutimage\fR. The output image is equal in size and intensity +to the contents of the frame buffer displayed at the time of writing. + +In interactive mode objects to be marked may be selected interactively +using the image cursor or read from the text file \fIcoords\fR. +Objects in the coordinate list +may be selected individually by number, +in groups by specifying a range of numbers, or the entire list may +be read. New objects may be added to the list interactively +using the append keystroke command. In batch mode cursor commands +may be read from a text file by setting \fIcommands\fR to the name +of the text file. This may be a user created file of cursor +commands or a log file from a previous interactive run of TVMARK. +If no command file is specified then all the objects in the coordinate +list are marked with the default mark type /fImark/fR. + +The mark commands entered in interactive mode can be saved in the text +file \fIlogfile\fR. If \fIautolog\fR +is enabled and \fIlogfile\fR is defined all cursor commands +are automatically logged. If \fIautolog\fR is turned off then the user +can select which commands are to be logged interactively using the +interactive keep keystroke. + +The default mark type are currently "none", "point", "plus", "cross", +"circle", a +list of concentric circles, and "rectangles", a list of concentric rectangles. +The size of the "point" mark is set using the parameter \fIpointsize\fR +while the sizes of the "plus" and "cross" mark types are set by the +\fItxsize\fR parameter. Txsize is in font units which for the simple raster +font currently implemented is six display pixels in x and seven display +pixels in y. +The \fIradii\fR and \fIlengths\fR parameters +describe the concentric circles and concentric rectangles to be drawn +respectively. +If \fInumber=yes\fR then objects in the coordinate list will be automatically +numbered as well as marked. The position of the number can be altered +with the \fInxoffset\fR and \fInyoffset\fR parameters. + +In interactive mode tvmark maintains a scratch buffer. The user opens +the scratch buffer by issuing a save command which saves the current +contents of the frame buffer in a temporary IRAF image. +The user can continue marking and if unsatisfied with the results +restore the last saved copy of the frame buffer with the restore +command. Subsections of the saved frame buffer can be restored to the +current frame buffer with the erase keystroke command. +Finally a snapshot of the frame buffer can be saved permanently by +using the write command. These snapped images can be redisplayed +by setting the display task parameter \fIztrans\fR = "none". +.ih +CURSOR COMMANDS + +.nf + Interactive TVMARK Keystroke/Colon Commands + +The following keystroke commands are available. + + ? Print help + + Mark the cursor position with + + x Mark the cursor position with x + . Mark the cursor position with a dot + c Draw defined concentric circles around the cursor position + r Draw defined concentric rectangles around the cursor position + s Draw line segments, 2 keystrokes + v Draw a circle, 2 keystrokes + b Draw a rectangle, 2 keystrokes + f Draw filled rectangle, 2 keystrokes + e Mark region to be erased and restored, 2 keystrokes + + - Move to previous object in the coordinate list + m Move to next object in the coordinate list + p Mark the previous object in the coordinate list + n Mark next object in the coordinate list + l Mark all the objects in the coordinate list + o Rewind the coordinate list + a Append object at cursor position to coordinate list and mark + d Delete object nearest the cursor position in the coordinate list + and mark + + k Keep last cursor command + q Exit tvmark + +The following colon commands are available. + + :show List the tvmark parameters + :move N Move to Nth object in coordinate list + :next N M Mark objects N to M in coordinate list + :text [string] Write text at the cursor position + :save Save the current contents of frame buffer + :restore Restore last saved frame buffer + :write [imagename] Write the contents of frame buffer to an image + +The following parameters can be shown or set with colon commands. + + :frame [number] + :outimage [imagename] + :coords [filename] + :logfile [filename] + :autolog [yes/no] + :mark [point|line|circle|rectangle|cross|plus] + :radii [r1,...,rN] + :lengths [l1,...,lN] [width] + :font [raster] + :color [number] + :number [yes/no] + :label [yes/no] + :txsize [1,2,..] + :pointsize [1,3,5...] +.fi + +.ih +CURRENT IMTOOL COLORS + +.nf + 0 = sunview background color (normally white) + 1-200 = frame buffer data values, windowed + 201 = cursor color (white) + + 202 = black + 203 = white + 204 = red + 205 = green + 206 = blue + 207 = yellow + 208 = cyan + 209 = magenta + 210 = coral + 211 = maroon + 212 = orange + 213 = khaki + 214 = orchid + 215 = turquoise + 216 = violet + 217 = wheat + + 218-254 = reserved for use by other windows + 255 = black (sunview foreground color) +.fi + +.ih +EXAMPLES +1. Display an image, mark all the objects in the coordinate file +m92.coo.1 with red dots, and save the contents of the frame buffer +in the iraf image m92r.snap. Redisplay the marked image. + +.nf + cl> display m92r 1 + cl> tvmark 1 m92.coo.1 outimage=m92r.snap col=204 + cl> display m92r.snap 2 ztrans="none" +.fi + +2. Execute the same command only number the objects in the coordinate +list instead of marking them. + +.nf + cl> display m92r 1 + cl> tvmark 1 m92.coo.1 outimage=m92r.snap mark=none\ + >>> number+ col=204 + cl> display m92r.snap 2 ztrans="none" +.fi + +3. Display an image and draw concentric circles with radii of 5, 10 and +20 pixels corresponding to an aperture radius and inner and outer +sky annulus around the objects in the coordinate list. + +.nf + cl> display m92r 1 + cl> tvmark 1 m92.coo.1 mark=circle radii="5,10,20" col=204 +.fi + +4. Display an image, mark objects in a coordinate list with dots +and append new objects to the coordinate file. + +.nf + cl> display m92r 1 + + cl> tvmark 1 m92.coo.1 interactive+ + ... type q to quit the help menu ... + ... type :number yes to turn on numbering ... + ... type l to mark all objects in the coordinate file + ... move cursor to desired unmarked objects and type a + ... type :write to take a snap shot of the frame buffer + ... type q to quit +.fi + +5. Make a finder chart of a region containing 10 stars by drawing +a box around the field, marking each of the 10 stars with a dot, +labeling each with an id and finally labeling the whole field. +Save all the keystroke commands in a log file. + +.nf + cl> display m92r 1 log=m92r.log auto+ + + cl> tvmark 1 "" interactive+ + + ... type q to quit the help menu ... + + ... to draw a box around the finder field move the cursor to the + lower left corner of the finder field and type b, move the + cursor the upper right corner of the field and type b again + + ... to mark and label each object move to the position of the + object and type ., next move slightly away from the object + and type :text id + + ... to label the chart with a title first type :txsize 2 for + bigger text then move the cursor to the position where + the title should begin and type :text title + + ... save the marked image with :write + + ... type q to quit the program +.fi + +6. Edit the log file created above to remove any undesired commands +and rerun tvmark redirecting cursor input to the log file. + +.nf + cl> display m92r 1 + cl> tvmark 1 "" commands=logfile inter- +.fi + +7. Draw a box on the display with a lower left corner of 101,101 and an +upper right corner of 200,200 using a simple cursor command file. +Note than in interactive mode the b key is the one that draws a box. + +.nf +The command file contains the following 3 lines + + 101.0 101.0 101 b + 200.0 200.0 101 b + 200.0 200.0 101 q + + cl> display m92r 1 + cl> tvmark 1 "" commands=commandfile inter- +.fi +.ih +BUGS +Tvmark is a prototype task which can be expected to undergo considerable +modification and enhancement in the future. The current version of this +task does not produce publication quality graphics. +In particular aliasing is easily visible in the code which draws circles +and lines. + +Input from the coordinate list is sequential. No attempt has been made +to arrange the objects to be marked in order for efficiency of input and +output. + +Note that the move command does not currently physically move the image +cursor. However the next mark drawn will be at the current coordinate +list position. + +Users may wish to disable the markcur option in the imtool setup window +before running tvmark. +.ih +SEE ALSO +display, imedit, imexamine +.endhelp diff --git a/pkg/images/tv/doc/wcslab.hlp b/pkg/images/tv/doc/wcslab.hlp new file mode 100644 index 00000000..0095c68c --- /dev/null +++ b/pkg/images/tv/doc/wcslab.hlp @@ -0,0 +1,698 @@ +.help wcslab Dec91 images.tv + +.ih +NAME +wcslab -- overlay a labeled world coordinate grid on an image + +.ih +USAGE +wcslab image + +.ih +PARAMETERS + +.ls image +The name of the image to be labeled. If image is "", the parameters +in wcspars will be used to draw a labeled coordinate grid. +.le +.ls frame +The display frame buffer displaying the image to be labeled. +.le +.ls usewcs = no +Use the world coordinate system specified by the parameters in the wcspars +parameter set in place of the image world coordinate system or if +image is "" ? +.le +.ls wcspars = "" +The name of the parameter set defining the world coordinate system +to be used if image is "" or if usewcs = "yes". The wcspars parameters +are described in more detail below. +.le +.ls wlpars = "" +The name of the parameter set which controls the +detailed appearance of the plot. The wlpars parameters are described +in more detail below. +.le +.ls fill = yes +If fill is no, wcslab tries to +create a square viewport with a maximum size dictated by the viewport +parameters. If fill is yes, then wcslab +uses the viewport exactly as specified. +.le +.ls vl = INDEF, vr = INDEF, vb = INDEF, vt = INDEF +The left, right, bottom, and top edges of the viewport in NDC (0-1) +coordinates. If any of vl, vr, vb, or vt are INDEF, +wcslab computes a default value. To overlay the plot +with a displayed image, vl, vr, vb, and vt must use the same viewport used +by the display task to load the image into the frame buffer. +.le +.ls overplot = no +Overplot to an existing plot? If yes, wcslab will not erase the +current plot. This differs from append in that a new viewport +may be defined. Append has priority if both +append and overwrite are yes. +.le +.ls append = no +Append to an existing plot? If no, wcslab resets the +graphics to a new viewport/wcs for each new plot. Otherwise, it uses +the scaling from a previous plot. If append=yes but no plot was drawn, it +will behave as if append=no. This differs from overplot in that +the same viewport is used. Append has priority if both +append and overwrite are yes. +.le +.ls device = "imd" +The graphics device. To create an overlay plot, device must be set +to one of the imdkern devices listed in dev$graphcap. To create a +plot of the coordinate grid in the +graphics window, device should be set to "stdgraph". +.le + +.ih +WCSPARS PARAMETERS + +.ls ctype1 = "linear", ctype2 = "linear" +The coordinate system type of the first and second axes. +Valid coordinate system types are: +"linear", and "xxx--tan", "xxx-sin", and "xxx-arc", where "xxx" can be either +"ra-" or "dec". +.le +.ls crpix1 = 0.0, crpix2 = 0.0 +The X and Y coordinates of the reference point in pixel space that +correspond to the reference point in world space. +.le +.ls crval1 = 0.0, crval2 = 0.0 +The X and Y coordinate of the reference point in world space that +corresponds to the reference point in pixel space. +.le +.ls cd1_1 = 1.0, cd1_2 = 0.0 +The FITS CD matrix elements [1,1] and [1,2] which describe the x-axis +coordinate transformation. These elements usually have the values +<xscale * cos (angle)> and, <-yscale * sin (angle)>, or, for ra/dec systems +<-xscale * cos (angle)> and <yscale * sin (angle)>. +.le +.ls cd2_1 = 0.0, cd2_2 = 1.0 +The FITS CD matrix elements [2,1] and [2,2] which describe the y-axis +coordinate transformation. These elements usually have the values +<xscale * sin (angle)> and <yscale * cos (angle)>. +.le +.ls log_x1 = 0.0, log_x2 = 1.0, log_y1 = 0.0, log_y2 = 1.0 +The extent in pixel space over which the transformation is valid. +.le + + +.ih +WLPARS PARAMETERS + +.ls major_grid = yes +Draw a grid instead of tick marks at the position of the major +axes intervals? If yes, lines of constant axis 1 and axis 2 values +are drawn. If no, tick marks are drawn instead. Major grid +lines / tick marks are labeled with the appropriate axis values. +.le +.ls minor_grid = no +Draw a grid instead of tick marks at the position of the +minor axes intervals? If yes, lines of constant axis 1 and axis 2 values +are drawn between the major grid lines / tick +marks. If no, tick marks are drawn instead. Minor grid lines / tick +marks are not labeled. +.le +.ls dolabel = yes +Label the major grid lines or tick marks? +.le +.ls remember = no +Modify the wlpars parameter file when done? If yes, parameters that have +been calculated by the task are written back to the parameter file. +If no, the default, the parameter file is left untouched by the task. +This option is useful for fine-tuning the appearance of the graph. +.le +.ls axis1_beg = "" +The lowest value of axis 1 in world coordinates units +at which a major grid line / tick mark will be drawn. +If axis1_beg = "", wcslab will compute this quantity. +Axis1_beg will be ignored if axis1_end and axis1_int are undefined. +.le +.ls axis1_end = "" +The highest value of axis 1 in world coordinate +units at which a major grid line / tick mark will be drawn. +If axis1_end = "", wcslab will compute this quantity. +Axis1_end will be ignored if axis1_beg and axis1_int are undefined. +.le +.ls axis1_int = "" +The interval in world coordinate units at which +major grid lines / tick marks will be drawn along axis 1. +If axis1_int = "", wcslab will compute this quantity. +Axis1_int will be ignored if axis1_beg and axis1_end are undefined. +.le +.ls axis2_beg = "" +The lowest value of axis 2 in world coordinates units +at which a major grid line / tick mark will be drawn. +If axis2_beg = "", wcslab will compute this quantity. +Axis2_beg will be ignored if axis2_end and axis2_int are undefined. +.le +.ls axis2_end = "" +The highest value of axis 2 in world coordinate +units at which a major grid line / tick mark will be drawn. +If axis2_end = "", wcslab will compute this quantity. +Axis2_end will be ignored if axis2_beg and axis2_int are undefined. +.le +.ls axis2_int = "" +The interval in world coordinate units at which +major grid lines / tick marks will be drawn along axis 2. +If axis2_int = "", wcslab will compute this quantity. +Axis2_int will be ignored if axis1_beg and axis1_end are undefined. +.le +.ls major_line = "solid" +The type of major grid lines to be plotted. +The permitted values are "solid", "dotted", "dashed", and "dotdash". +.le +.ls major_tick = .03 +Size of major tick marks relative to the size of the viewport. +By default the major tick marks are .03 times the size of the +viewport. +.le +.ls axis1_minor = 5 +The number of minor grid lines / tick marks that will appear between major +grid lines / tick marks for axis 1. +.le +.ls axis2_minor = 5 +The number of minor grid lines / tick marks that will appear between major +grid lines / tick marks for axis 2. +.le +.ls minor_line = "dotted" +The type of minor grid lines to be plotted. +The permitted values are "solid", "dotted", "dashed", and "dotdash". +.le +.ls minor_tick = .01 +Size of minor tick marks relative to the size of the viewport. +BY default the minor tick marks are .01 times the size of the +viewport. +.le +.ls tick_in = yes +Do tick marks point into instead of away from the graph ? +.le +.ls axis1_side = "default" +The list of viewport edges, separated by commas, on which to place the axis +1 labels. If axis1_side is "default", wcslab will choose a side. +Axis1_side may contain any combination of "left", "right", +"bottom", "top", or "default". +.le +.ls axis2_side = "default" +The list of viewport edges, separated by commas, on which to place the axis +2 labels. If axis2_side is "default", wcslab will choose a side. +Axis2_side may contain any combination of "left", "right", +"bottom", "top", or "default". +.le +.ls axis2_dir = "" +The axis 1 value at which the axis 2 labels will be written for polar graphs. +If axis2_dir is "", wcslab will compute this number. +.le +.ls justify = "default" +The direction with respect to axis 2 along which the axis 2 +labels will be drawn from the point they are labeling on polar graphs. +If justify = "", then wcslab will calculate this quantity. The permitted +values are "default", "left", "right", "top", and "bottom". +.le +.ls labout = yes +Draw the labels outside the axes ? If yes, the labels will be drawn +outside the image viewport. Otherwise, the axes labels will be drawn inside +the image border. The latter option is useful if the image fills the +display frame buffer. +.le +.ls full_label = no +Always draw all the labels in full format (h:m:s or d:m:s) if the world +coordinate system of the image is in RA and DEC ? If full_label = no, then +only certain axes will be labeled in full format. The remainder will +be labeled in minutes or seconds as appropriate. +.le +.ls rotate = yes +Permit the labels to rotate ? +If rotate = yes, then labels will be written +at an angle to match that of the major grid lines that are being +labeled. If rotate = no, then labels are always written +"normally", that is horizontally. If labout = no, then rotate is +set to "no" by default. +.le +.ls label_size = 1.0 +The size of the characters used to draw the major grid line labels. +.le +.ls title = "imtitle" +The graph title. If title = "imtitle", then a default title containing +the image name and title is created. +.le +.ls axis1_title = "" +The title for axis 1. By default no axis title is drawn. +.le +.ls axis2_title = "" +The title for axis 2. By default no axis title is drawn. +.le +.ls title_side = "top" +The side of the plot on which to place the title. +The options are "left", "right", "bottom", and "top". +.le +.ls axis1_title_side = "default" +The side of the plot on which to place the axis 1 title. +If axis1_title_side = "default", wcslab will choose a side for the title. +The permitted values are "default", "right", "left", "top", and +"bottom". +.le +.ls axis2_title_side = "default" +The side of the plot on which to place the axis 2 title. +If axis2_title_side = "default", wcslab will choose a side for the title. +The permitted values are "default", "right", "left", "top", and +"bottom". +.le +.ls title_size = 1.0 +The size of characters used to draw the title. +.le +.ls axis_title_size = 1.0 +The size of the characters used to draw the axis titles. +.le +.ls graph_type = "default" +The type of graph to be drawn. If graph_type = "default", wcslab will +choose an appropriate graph type. The permitted values are "normal", "polar", +and "near_polar". +.le + +.ih +DESCRIPTION + +WCSLAB draws a labeled world coordinate grid on the graphics device +\fIdevice\fR using world coordinate system (WCS) +information stored in the header of the IRAF image \fIimage\fR if +\fIusewcs\fR is "no", or +in \fIwcspars\fR if \fIusewcs\fR is "yes" or \fIimage\fR is "". +WCSLAB currently supports the following coordinate system types 1) +the tangent plane, sin, and arc sky projections in right ascension +and declination and 2) any linear coordinate system. + +By default WCSLAB draws on the image display device, displacing +the currently loaded image pixels with graphics pixels. Therefore in order +to register the coordinate grid plot with the image, the image must +loaded into the image display with the DISPLAY task, prior to +running WCSLAB. + +If the viewport parameters \fIvl\fR, \fIvr\fR, \fIvb\fR, and +\fIvt\fR are left undefined, WCSLAB will try to match the viewport +of the coordinate grid plot with the viewport of the currently +displayed image in the selected frame \fIframe\fR. +This scheme works well in the case where \fIimage\fR is smaller +than the display frame buffer, and in the case where \fIimage\fR is +actually a subsection of the image currently loaded into the display frame +buffer. In the case where \fIimage\fR +fills or overflows the image display frame buffer, WCSLAB +draws the appropriate coordinate grid but is not able to draw the +titles and labels which would normally appear outside the plot. +In this case the user must, either adjust the DISPLAY parameters +\fIxmag\fR, and \fIymag\fR so that the image will fit in the frame +buffer, or change the DISPLAY viewport parameters \fIxsize\fR and +\fIysize\fR so as to display only a fraction of the image. + +WCSLAB can create a new plot each time it is run, \fIappend\fR = no +and \fIoverplot\fR = no, add a new graph to an existing plot +if \fIoverplot\fR = yes and \fIappend\fR=no, +or append to an existing plot if \fIappend\fR = yes. +For new or overplots WCSLAB computes the viewport and window, otherwise it +uses the viewport and window of a previously existing plot. If \fIdevice\fR +is "stdgraph", then WCSLAB will clear the screen between each new plot. +This is not possible if \fIdevice\fR is one of the "imd" devices +since the image display graphics kernel writes directly into the display +frame buffer. In this case the user must redisplay the image and rerun +WCSLAB for each new plot. + +The parameters controlling the detailed appearance of the plot +are contained in the parameter set specified by \fIwlpars\fR. + +.ih +THE USER-DEFINED WCS + +The parameters in WCSPARS are used to define the world +coordinate system only if, 1) the parameter \fIusewcs\fR is "yes" +or, 2) the input image is undefined. +This user-defined WCS specifies the transformation from the logical coordinate +system, e.g. pixel units, to a world system, e.g. ra and dec. + +Currently IRAF supports two types of world coordinate systems: +1) linear, which provides a linear mapping from pixel units to +the world coordinate system 2) and the sky projections which provide +a mapping from pixel units to ra and dec. The parameters +\fIctype1\fR and \fIctype2\fR define which coordinate system will be in +effect. If a linear system is +desired, both \fIctype1\fR and \fIctype2\fR must be "linear". +If the tangent plane sky projection is desired, +and the first axis is ra and the +second axis is dec, then \fIcypte1\fR and \fIctype2\fR +must be "ra---tan" and "dec--tan" respectively. +To obtain the sin or arc projections "tan" is replaced with "sin" or +"arc" respectively. + +The scale factor and rotation between the logical and world coordinate +system is described by the CD matrix. Using matrix +multiplication, the logical coordinates are multiplied by the CD +matrix to produce the world coordinates. The CD matrix is represented in +the parameters as follows: + +.nf + + |---------------| + | cd1_1 cd1_2 | + | | + | cd2_1 cd2_2 | + |---------------| + +.fi + +To construct a typical CD matrix, the following definitions of the +individual matrix elements may be used: + +.nf + + cd1_1 = xscale * cos (ROT) + cd1_2 = -yscale * sin (ROT) + cd2_1 = xscale * sin (ROT) + cd2_2 = yscale * cos (ROT) + +.fi + +where xscale and yscale are the scale factors from the logical to world +systems, e.g. degrees per pixel, and ROT is the angle of rotation between +the two systems, where positive rotations are counter-clockwise. + +The ra/dec transformation is a special case. Since by convention ra +increases "to the left", opposite of standard convention, the first axis +transformation needs to be multiplied by -1. This results in the +following formulas: + +.nf + + cd1_1 = -xscale * cos (ROT) + cd1_2 = yscale * sin (ROT) + cd2_1 = xscale * sin (ROT) + cd2_2 = yscale * cos (ROT) + +.fi + +Finally, the origins of the logical and world systems must be defined. +The parameters \fIcrpix1\fR and \fIcrpix2\fR define the coordinate in +the logical space that corresponds to the coordinate in world space +defined by the parameters \fIcrval1\fR and \fIcrval2\fR. The coordinates +(crpix1, crpix2) in logical space, when transformed to world space, +become (crval1, crval2). + +The last set of parameters, log_x1, log_x2, log_y1, log_y2, define the +region in the logical space, e.g. in pixels, over which the transformation +is valid. + +.ih +AXIS SPECIFICATION + +For all \fIlinear\fR transformations axis 1 and axis 2 specify which axis in +the image is being referred to. +For example in a 2-dimensional image, the FITS image header keywords +CTYPE1, CRPIX1, CRVAL1, CDELT1, +CD1_1, and CD1_2 define the world coordinate transformation for axis 1. +Similarly the FITS image header keywords +CTYPE2, CRPIX2, CRVAL2, CDELT2, +CD2_1, CD2_2, define the world coordinate transformation for axis 2. + +THIS RULE DOES NOT APPLY TO THE TANGENT PLANE, SIN, and ARC SKY +PROJECTION WCS'S. +For this type of WCS axis 1 and axis 2 +always refer to right ascension and declination respectively, +and WCSLAB assumes that all axis 1 parameters refer to right +ascension and all axis 2 parameters refer to declination, regardless of +which axis in the image WCS actually specifies right ascension and declination. + +.ih +GRID DRAWING + +There are two types of grid lines / tick marks, "major" and +"minor". The major grid lines / tick marks are the lines / ticks +that will be labeled. The minor grid lines / tick marks are plotted +between the major marks. Whether lines or tick marks are drawn is +determined by the boolean parameters \fImajor_grid\fR and \fIminor_grid\fR. +If yes, lines are drawn; if no, tick marks are drawn. How the lines +appear is controlled by the parameters \fImajor_line\fR and \fIminor_line\fR. + +The spacing of minor marks is controlled by the parameters \fIaxis1_minor\fR +and \fIaxis2_minor\fR. These parameters specify the number of minor marks +that will appear between the major marks along the axis 1 +and axis 2 axes. + +Spacing of major marks is more complicated. WCSLAB tries to +present major marks only along "significant values" in the +coordinate system. For example, if the graph spans several hours of +right ascension, the interval between major marks will in general be an +hour and the major marks will appear at whole hours within the graph. +If what WCSLAB chooses is unacceptable, the interval and range can +be modified by the parameters \fIaxis1_int\fR, \fIaxis1_beg\fR, +\fIaxis1_end\fR for the axis 1, and \fIaxis2_int\fR, \fIaxis2_beg\fR, +and \fIaxis2_end\fR for axis 2. All three parameters must be specified for +each axis in order for the new values to take affect + +.ih +GRAPH APPEARANCE + +WCSLAB supports three types of graph: normal, polar, and near_polar. + +A normal graph is the usual Cartesian graph where lines of constant +axis 1 or 2 values cross at least two different sides of the graph. +WCSLAB will by default plot a normal type graph for any image 1) +which has no defined WCS 2) which has a linear WCS 3) where the sky +projection WCS approximates a Cartesian system. + +A polar graph is one in which the north or south pole of the +coordinate system actually appears on the graph. +Lines of constant declination are no longer approximately +straight lines, but are circles which may not intersect any +of the edges of the graph. In this type of graph, axis 1 values +are labeled all the way around the graph. +Axis 2 values are labeled within the graph +next to each circle. An attempt is made to label as many circles as +possible. However, if the WCSLAB's defaults are not agreeable, +the parameters, \fIaxis2_dir\fR and \fIjustify\fR, can be modified +to control how this labeling is done. +\fIAxis2_dir\fR specifies along which axis 1 value the +axis 2 labels should be written. \fIJustify\fR specifies on which side of +this value the label should appear. + +The near_polar graph is a cross between the normal graph and the polar +graph. In this case the pole is not on the graph, but is close enough +to significantly affect the appearance of the plot. The near_polar graph +is handled like a polar graph. + +The parameter \fIgraph_type\fR can be used to force WCSLAB +to plot a graph of the type specified, although in this case it +may be necessary to modify the values of other WLPARS parameters to +obtain pleasing results. For example trying to plot a polar graph as +Cartesian may producing a strange appearing graph. + +.ih +GRAPH LABELING + +Due to the variety of graph types that can be plotted (see above), and +the arbitrary rotation that any WCS can have, the task of labeling +the major grid lines in a coherent and pleasing manner is not trivial. + +The basic model used is the Cartesian or normal graph. Labels +normally appear on the left and bottom edges of the graph with a side +devoted solely to one of the WCS coordinate axis. For example, right +ascension might be labeled only along the bottom edge of the graph +and declination only along the left edge, or vice versa. + +If the defaults chosen by WCSLAB are unacceptable, the +parameters \fIaxis1_side\fR and \fIaxis2_side\fR, can be used to specify which +side (or sides) the labels for axis 1 and axis 2 will appear. +Either a single side or a list of sides can be specified for either +axis. If a list is specified, labels will appear on each side listed, +even if the same side appears in both of the parameters. In this way, +labels can be made to appear on the same side of the graph. + +.ih +LABEL APPEARANCE + +Due to coordinate rotations, lines of constant axis 1 or axis 2 value +may not intersect the edges +of the graph perpendicularly. To help clarify which line belongs to +which label, the labels will be drawn at an angle equal to that of the +line which is being labeled. If this is not desired, +the parameter \fIrotate\fR may be set to no, and labels will always appear +"normal", i.e. the text will not be rotated in any way. + +By default, all labels will be shortened to the smallest unit +needed to indicate the value of the labeled line. For example, if the +graph spans about 30 seconds of declination, the interval between the +labels will be approximately 5 or 10 seconds. The first label will contain the +full specification, i.e. -22:32:20. But the rest of the labels will +only be the seconds, i.e. 30, 40, 50. However, at the change in +minutes, the full format would be used again, -22:33:00, but then +again afterwards only seconds will be displayed, i.e. 10, 20, etc. +If this shortening of labels is undesirable, it +can be turned off by setting the parameter \fIfull_label\fR to yes. This +forces every label to use the full specification. + +Finally, the parameter \fIlabel_size\fR can be used to adjust the size of the +characters used in the axis labels. + +.ih +TITLES + +A graph title may specified using the parameter \fItitle\fR. If \fItitle\fR += "imtitle" a default title constructed from the image name and title +is used. The location and size of the graph title are controlled by +the parameters \fItitle_side\fR and \fItitle_size\fR. +Similarly the content, placement and size of the axis titles are +controlled by the parameters \fIaxis1_title\fR, \fIaxis2_title\fR, +\fIaxis1_title_side\fR, \fIaxis2_title_side\fR, and +\fIaxis_title_size\fR. + +.ih +OUTPUT FORMATS + +If \fIremember\fR = yes, the coordinates are output to the parameter set +WLPARS in a form suitable for the type of system the coordinates +represent. For example right +ascensions are output in HH:MM:SS (hours:minutes:seconds) and +declinations are output in DD:MM:SS (degrees:minutes:seconds). +If the input parameters are changed, for example axis1_int, their values +must be input in the same format. +If the WCS is linear, then the parameters will not be formatted in any special +way; i.e. no assumptions are made about units, etc. + +.ih +EXAMPLES + +1. Display the 512 pixel square IRAF test image dev$pix in an 800 square +display window and overlay it with a labeled coordinate grid. Since +dev$pix does not have a defined WCS a pixel coordinate grid will appear. + +.nf + cl> display dev$pix 1 + + ... display the image in frame 1 + + cl> wcslab dev$pix 1 + + ... the coordinate grid in green will be plotted on the display +.fi + +2. Redisplay the previous image and by overlay the labeled +coordinate grid on the inner 100 by 400 pixels in x and y. + +.nf + cl> display dev$pix 1 + + ... erase the graphics by redisplaying the image + + cl> wcslab dev$pix[100:400,100:400] 1 +.fi + +3. Display an 800 square image which has a defined linear WCS in an 800 square +display window and overlay it with the coordinate grid. Reduce +the display viewport in order to leave space around the edge of the +displayed image for the labels and titles. + +.nf + cl> display image 1 xsize=0.8 ysize=0.8 fill+ + cl> wcslab image 1 vl=.1 vr=.9 vb=.1 vt=.9 +.fi + +4. Repeat the previous example using a different combination of display +and wcslab parameters to achieve the same goal. + +.nf + cl> display image 1 xmag=0.8 ymag=0.8 + cl> wcslab image 1 +.fi + +5. Display a section of the previous image and overlay it with a +coordinate grid. Note that the same section should be specified in +both cases. + +.nf + cl> display image[101:700,101:700] 1 + cl> wcslab image[101:700,101:700] 1 +.fi + +6. Display a 512 square image with a defined tangent plane sky projection +in an 800 square frame buffer and overlay the labeled coordinate grid. The +standard FITS keywords shown below define the WCS. This WCS is +approximately correct for the IRAF test image dev$pix. + +.nf + # IRAF image header keywords which define the WCS + + CRPIX1 = 257.75 + CRPIX2 = 258.93 + CRVAL1 = 201.94541667302 # RA is stored in degrees ! + CRVAL2 = 47.45444 + CTYPE1 = 'RA---TAN' + CTYPE2 = 'DEC--TAN' + CDELT1 = -2.1277777E-4 + CDELT2 = 2.1277777E-4 + + + cl> display dev$pix 1 + + cl> wcslab dev$pix 1 +.fi + +7. Display a 512 square image with a defined tangent plane sky projection +approximately centered on the north celestial pole in an 800 square frame +buffer. The FITS keywords shown below define the WCS. + + +.nf + # IRAF image header keywords which define the WCS + + CRPIX1 = 257.75 + CRPIX2 = 258.93 + CRVAL1 = 201.94541667302 # RA is stored in degrees ! + CRVAL2 = 90.00000 + CTYPE1 = 'RA---TAN' + CTYPE2 = 'DEC--TAN' + CDELT1 = -2.1277777E-4 + CDELT2 = 2.1277777E-4 + + cl> display northpole 1 + + cl> wcslab northpole 1 +.fi + +8. Display and label a 512 square image which has no WCS information +using the values of the parameters in wcspars. The center pixel (256.0, 256.0) +is located at (9h 22m 30.5s, -15o 05m 42s), the pixels are .10 +arcseconds in size, and are rotated 30.0 degrees counter-clockwise. + +.nf + + cl> lpar wcspars + + ctype1 = 'ra---tan' + ctype2 = 'dec--tan' + crpix1 = 256.0 + crpix2 = 256.0 + crval1 = 140.62708 + crval2 = -15.09500 + cd1_1 = -2.405626e-5 + cd1_2 = 1.388889e-5 + cd2_1 = 1.388889e-5 + cd2_2 = 2.405626e-5 + log_x1 = 1. + log_x2 = 512. + log_y1 = 1. + log_y2 = 512. + + cl> display image 1 + + cl> wcslab image usewcs+ + +.fi +.ih +AUTHORS +The WCSLAB task was written by members of the STScI SDAS programming group +and integrated into the IRAF DISPLAY package by members of the IRAF +programming group for version 2.10 IRAF. +.ih +SEE ALSO +display, gcur, imdkern +.endhelp diff --git a/pkg/images/tv/eimexam.par b/pkg/images/tv/eimexam.par new file mode 100644 index 00000000..a67e4322 --- /dev/null +++ b/pkg/images/tv/eimexam.par @@ -0,0 +1,24 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +xlabel,s,h,"Column",,,"X-axis label" +ylabel,s,h,"Line",,,"Y-axis label" + +ncolumns,i,h,21,2,,Number of columns +nlines,i,h,21,2,,Number of lines +floor,r,h,INDEF,,,"minimum value to be contoured (0 if none)" +ceiling,r,h,INDEF,,,"maximum value to be contoured (0 if none)" +zero,r,h,0.,,,"greyscale value of zero contour" +ncontours,i,h,5,,,"number of contours to be drawn (0 for default)" +interval,r,h,0.,,,"contour interval (0 for default)" +nhi,i,h,-1,,,"hi/low marking option: -1=omit, 0=mark h/l, 1=mark each pix" +dashpat,i,h,528,,,"bit pattern for generating dashed lines" +label,b,h,no,,,"label major contours with their values?" + +box,b,h,yes,,,draw box around periphery of window +ticklabels,b,h,yes,,,label tick marks +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values? +fill,b,h,no,,,fill viewport vs enforce unity aspect ratio? diff --git a/pkg/images/tv/himexam.par b/pkg/images/tv/himexam.par new file mode 100644 index 00000000..7a35a911 --- /dev/null +++ b/pkg/images/tv/himexam.par @@ -0,0 +1,29 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +xlabel,s,h,"Pixel Bin",,,"X-axis label" +ylabel,s,h,"Count",,,"Y-axis label" + +ncolumns,i,h,21,2,,Number of columns +nlines,i,h,21,2,,Number of lines +nbins,i,h,512,1,,Number of bins in histogram +z1,r,h,INDEF,,,Minimum histogram intensity +z2,r,h,INDEF,,,Maximum histogram intensity +autoscale,b,h,yes,,,Adjust nbins and z2 for integer data? +top_closed,b,h,no,,,Include z2 in the top bin? + +x1,r,h,INDEF,,,X-axis window limit +x2,r,h,INDEF,,,X-axis window limit +y1,r,h,0.,,,Y-axis window limit +y2,r,h,INDEF,,,Y-axis window limit +pointmode,b,h,no,,,plot points instead of lines? +marker,s,h,"plus",,,point marker character? +szmarker,r,h,1.,,,marker size +logx,b,h,no,,,log scale x-axis +logy,b,h,yes,,,log scale y-axis +box,b,h,yes,,,draw box around periphery of window +ticklabels,b,h,yes,,,label tick marks +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values? diff --git a/pkg/images/tv/iis/README b/pkg/images/tv/iis/README new file mode 100644 index 00000000..1562fd6f --- /dev/null +++ b/pkg/images/tv/iis/README @@ -0,0 +1,3 @@ +CV -- Control video package. This is a prototype package, used to load images +into the image display (currently only the IIS), as well as to control the +display and read the display memory. diff --git a/pkg/images/tv/iis/blink.cl b/pkg/images/tv/iis/blink.cl new file mode 100644 index 00000000..5cc437e5 --- /dev/null +++ b/pkg/images/tv/iis/blink.cl @@ -0,0 +1,19 @@ +#{ BLINK -- Blink 2, 3, or 4 frames. + +# frame1,i,a,,,,Frame1 +# frame2,i,a,,,,Frame2 +# frame3,i,a,,,,Frame3 +# frame4,i,a,,,,Frame4 +# rate,r,h,1.,,,Blink rate (sec per frame) + +{ + if ($nargs == 3) { + _dcontrol (alternate = frame1 // " " // frame2 // " " // + frame3, blink+, rate=rate) + } else if ($nargs == 4) { + _dcontrol (alternate = frame1 // " " // frame2 // " " // + frame3 // " " // frame4, blink+, rate=rate) + } else { + _dcontrol (alternate = frame1 // " " // frame2, blink+, rate=rate) + } +} diff --git a/pkg/images/tv/iis/blink.par b/pkg/images/tv/iis/blink.par new file mode 100644 index 00000000..bccfa8f2 --- /dev/null +++ b/pkg/images/tv/iis/blink.par @@ -0,0 +1,5 @@ +frame1,i,a,,,,Frame1 +frame2,i,a,,,,Frame2 +frame3,i,a,,,,Frame3 +frame4,i,a,,,,Frame4 +rate,r,h,1.,,,Blink rate (sec per frame) diff --git a/pkg/images/tv/iis/cv.par b/pkg/images/tv/iis/cv.par new file mode 100644 index 00000000..c33dd032 --- /dev/null +++ b/pkg/images/tv/iis/cv.par @@ -0,0 +1,4 @@ +# Package parameters for CV. + +snap_file,f,a,,,,output file for snap image +textsize,r,a,1.0,,,character size diff --git a/pkg/images/tv/iis/cvl.par b/pkg/images/tv/iis/cvl.par new file mode 100644 index 00000000..c2eb9fab --- /dev/null +++ b/pkg/images/tv/iis/cvl.par @@ -0,0 +1,25 @@ +# Package parameters for CVL. +# All are from "display.par" + +image,f,a,,,,image to be displayed +frame,i,a,1,1,4,frame to be written into +border_erase,b,h,no,,,erase unfilled area of window +erase,b,h,yes,,,display frame being loaded +select_frame,b,h,yes,,,display frame being loaded +#repeat,b,h,no,,,repeat previous display parameters +fill,b,h,no,,,scale image to fit display window +zscale,b,h,yes,,,display range of greylevels near median +contrast,r,h,0.25,,,contrast adjustment for zscale algorithm +zrange,b,h,yes,,,display full image intensity range +nsample_lines,i,h,5,,,number of sample lines +xcenter,r,h,0.5,0,1,display window horizontal center +ycenter,r,h,0.5,0,1,display window vertical center +xsize,r,h,1,0,1,display window horizontal size +ysize,r,h,1,0,1,display window vertical size +xmag,r,h,1.,,,display window horizontal magnification +ymag,r,h,1.,,,display window vertical magnification +z1,r,h,,,,minimum greylevel to be displayed +z2,r,h,,,,maximum greylevel to be displayed +ztrans,s,h,linear,,,greylevel transformation (linear|log|none) +lutfile,f,h,"",,,name of textfile with user's transformation table +version,s,h,"14May85" diff --git a/pkg/images/tv/iis/doc/Cv.spc.hlp b/pkg/images/tv/iis/doc/Cv.spc.hlp new file mode 100644 index 00000000..0b30ae1c --- /dev/null +++ b/pkg/images/tv/iis/doc/Cv.spc.hlp @@ -0,0 +1,286 @@ +.help cv Jan86 tv.cv +The \fIcv\fR program is used to control the image display from within +\fIIRAF\fR. It differs from most \fIIRAF\fR programs since it has its +own prompt and its own internal "language". Each of the available commands +is described in the following paragraphs, but first a few comments on the +command structure seem in order. Commands are distinguished by their +first letter, except for a few instances where the second letter is needed. +The rest of the command name can be typed if you wish. Commands often +require specification of frames numbers, colors, quadrants, or numeric +values. In most cases, the order is unimportant, but, zoom, for instance, +does require the zoom power right after the command name. The order given +in the \fIhelp\fR command will always work. + +A frame list is indicated in the \fIhelp\fR listing with an \fBF\fR. This +is to be replaced in the typed command by an \fBf\fR followed (no spaces) +with a list of the pertinent image planes. Thus, \fBf1\fR means +\fIframe 1\fR while \fBf42\fR means \fIframes 4\fR +and \fI2\fR. In most cases, the leading \fBf\fR can be omitted. +The specification \fBfa\fR means \fIall frames\fR. In those +cases in the \fIhelp\fR menu where the frame specification is optional, +omitting the frame list is the same as typing \fBfa\fR; that is, operate +on \fIall\fR frames. + +A color specification is a \fBc\fR followed by a set of letters. +The letter \fBa\fR means \fIall\fR, just as in the frame specification. +The letters \fBr, b,\fR and \fBg\fR are the other possibilities for all +commands other than \fIdg\fR and \fIsnap\fR. For displaying graphics +planes (\fBdg\fR), the other possibilities are \fBy, p, m, w\fR which +stand for \fIyellow, purple, mauve,\fR and \fIwhite\fR. (\fIMauve\fR is +the wrong name and will get changed.) The \fIsnap\fR command accepts, in +addition to the standard three colors, \fBm, bw,\fR and \fBrgb\fR, which +stand for \fImonochrome, black and white,\fR and \fIfull color\fR. (See +the discussion under \fIsnap\fR for further explanation.) +An omitted color specification is the same as \fIall colors\fR. + +Quadrants are given by a \fBq\fR followed by numbers from the set one through +four, or the letter \fBa\fR as in the frame and color cases. Quadrants are +numbered in the standard way, with the upper right being \fI1\fR, the upper +left \fI2\fR, etc. Adjacent quadrants may be referenced by \fBt, b, l,\fR +and \fBr\fR, standing for \fItop, bottom, left,\fR and \fIright\fR. An +omitted quadrant specification is the same as \fIall quadrants\fR. Quadrants +are effective only if the split screen command has set the split point to +something other than the "origin". + +.ls \fBblink\fR N F (C Q) (F C Q) +The blink rate is given by \fBN\fR, which is in tenths of a second. Although +current timing routines in \fIIRAF\fR do not recognize partial seconds, +for the NOAO 4.2BSD UNIX implementation, a non-portable timing routine is +used so that tenth seconds are usable. +Erratic timing is pretty much the rule when the system load is large. +One frame must be given, +followed by any color or quadrant specification, and then +optionally followed by any number of similar triads. A specification of +\fI10 f12 f3 f3 f4\fR would display frames one and two for one second, then +frame three for two one second intervals, then frame 4, and then recycle. +The first blink cycle may appear somewhat odd as the code "settles in", +but the sequence should become regular after that (except for timing +problems due to system load). In split screen mode, it is necessary to +specify all the frames together with quadrants, which leads to a lot of +typing: The reason is that blink simply cycles through a series of +\fBdi\fR commands, and hence it requires the same information as that +command. +.le +.ls \fBcursor\fR [on off F] +This command is used to turn the cursor on or off, and to read coordinates +and pixel values from a frame. Pixel coordinates for a feature are those +of the image as loaded into the display, and do not change as the image +is panned or zoomed. Fractional pixel positions are given for zoomed +images, with a minimum number of decimal places printed (but the same number +for both the \fIx\fR and \fIy\fR coordinates). +For an unpanned, unzoomed image plane, the lower left corner +of the \fIscreen\fR is (1,1) +even if the image you loaded is smaller than 512x512, occupies only +a portion of the display screen, and does not extend to the lower left +corner of the screen. This defect will likely be remedied +when the \fIcv\fR package is properly integrated into \fIIRAF\fR. +Pixel information can be read from a frame that is not being displayed. +.le +.ls \fBdi\fR F (C Q) [on off] +The \fId\fRisplay \fIi\fRmage command turns specified frames on (or off). +Turning a frame off does not erase it. A frame need not have all colors +turned on, nor appear in all quadrants of a split screen display. +.le +.ls \fBdg\fR C (F Q) [on off] +The \fId\fRisplay \fIg\fRraphics command turns specific graphics planes +on or off. For the IIS display, neither the frame nor the quadrant +parameters are relevant. A side-effect of this command is that it +resets the graphics hardware to the \fIcv\fR standard: red cursor and +seven graphics planes, each colored differently. If the display is in +a "weird" state that is not cured with the \fIreset r/t\fR commands, +and a \fIreset i\fR would destroy images of interest, try a \fIdg ca on\fR +command followed by \fIdg ca off\fR. +.le +.ls \fBerase\fR [F all graphics] +This command erases the specified frame, or all the graphics planes, or +all data planes. The command \fBclear\fR is a synonym. +.le +.ls \fBmatch\fR (o) (F) (C) (to) (F) (C) +This command allows the user to copy a look-up table to a specified set +of tables, and hence, to match the mapping function of frames (and/or +colors) to a reference table. If the \fBo\fR parameter is omitted, the +match is among the look-up tables associated with particular frames; +otherwise, the \fIouput\fR tables are used (hence, the \fBo\fR). In the +latter case, only colors are important; the frame information should +be omitted. For the individual frame tables, colors can be omitted, in +which case a match of frame one to two means to copy the three tables +of frame two (red, green, and blue) to those of frame one. Only one +reference frame or color should be given, but \fImatch f23 cgb f1 cr\fR +is legal and means to match the green and blue color tables of both +frames two and three to the red table of frame one. +.le +.ls \fBoffset\fR C N +The value N, which can range from -4095 to +4095 is added to the data +pipeline for color \fBC\fR, thus offsetting the data. This is useful +if one needs to change the data range that is mapped into the useful part +of the output tables. +.le +.ls \fBpan\fR (F) +When invoked, this command connects the trackball to the specified frames +and allows the user to move (pan/roam/scroll) the image about the screen. +This function is automatically invoked whenever the zoom factor is changed. +.le +.ls \fBpseudo\fR (o) (F C) (rn sn) +Look-up tables are changed with the \fIwindow\fR and the \fIpseudocolor\fR +commands. Windowing provides linear functions and is discussed under that +command; \fIpseudo\fR provides pseudo-coloring capabilities. Pseudo-color +maps are usually best done in the output tables, rather than in the +look-up tables associated with particular frames; hence, \fBps o\fR is +the more likely invocation of the start of the command line. A color +(or colors) can be specified for "output" pseudocolor, in which case, only +those colors will be affected. For frame look-up tables, +the frame must be specified. + +Two mappings are provided. One uses a set of randomly selected colors +mapped to a specified number of pixel value ranges. The other uses +triangle color mappings. The former is invoked with the \fI(rn sn)\fR +options. In this case, the number following \fBr\fR gives the number of +ranges/levels into which the input data range is to be divided; to +each such range, a randomly selected color is assigned. The number +following \fBs\fR is a seed for the random number generator; changing +this while using the same number of levels gives different color mappings. +The default seed is the number of levels. If only the seed is given (\fBr\fR +omitted), the default number of levels is 8. This mapping is used when +a contour type display is desired: each color represents an intensity range +whose width is inversely proportional to the number of levels. + +The triangle mapping uses a different triangle in each of the three look-up +tables (either the sets associated with the specified frames, or the output +tables). The initial tables map low intensity to blue, middle values to +green, and high values to red, as shown in the diagram. (The red and blue +triangles are truncated as their centers are on a table boundary.) + +Once invoked, the program then allows the user to adjust the triangle +mapping. In +response to the prompt line, select the color to be changed and move the +trackball: the center of the triangle is given by the \fIx\fR cursor +coordinate and the width by the \fIy\fR coordinate. Narrow functions +(small \fIy\fR) allow one to map colors to a limited range of intensity. +When the mapping is satisfactory, a press of any button "fixes" the +mapping and the user may then either select another color or exit. +Before selecting a color, place the cursor at approximately the default +position for the mapping (or where it was for the last mapping of that +color under the current command); otherwise, the color map will change +suddenly when the color is selected via the trackball buttons. +.le +.ls \fBrange\fR N (C) (N C ...) +This command changes the range function in the specified color pipeline +so that the data is scaled by (divided by) the value \fBN\fR. For the +IIS, useful range values are 1,2,4 and 8; anything else will be changed +to the next lowest legal value. +.le +.ls \fBreset\fR [r i t a] +Various registers and tables are reset with this command. If the \fBr\fR +option is used, the registers are reset. This means that zoom is set to +one, all images are centered, split screen is removed, the range values are +set to one and the offset values are set to zero. Also, the cursor is +turned on and its shape is set. Option \fBi\fR causes all the image and +graphics planes to be erased and turned off. Option \fBt\fR resets all +the look-up tables to their default linear, positive slope, form, and +removes any color mappings by making all the output tables the same, and +all the frame specific tables the same. Option \fBa\fR does \fIall\fR +the above. +.le +.ls \fBsnap\fR (C) +This command creates an \fIIRAF\fR image file whose contents are a +512x512 digital snapshot of the image display screen. If no color +is specified, +or if \fIcm\fR (color monochromatic) is given, +the snapshot is of the \fIblue\fR image, which, if you +have a black and white image, is the same as the red or the green +image. Specifying \fBcg\fR for instance will take a snapshot of the +image that you would get had you specified \fIcg\fR for each frame +turned on by the \fIdi\fR command. Color is of interest only when +the window or pseudo color commands have made the three colors distinguishable. +If the "snapped" image is intended to be fed to the Dicomed film +recorder, a black and white image is all that is usually provided and so +a color snap is probably not appropriate. +In the case of the "no color/monochromatic" snap, the graphics planes are +all added together, while, if a real color is given, only the graphics +planes that have some of that color are included in the image. +The color \fBrgb\fR can be +given, in which case the red, green, and blue images are weighted equally +to produce a single image file. This image does not represent well what +you see, partly because of the equal weight given all colors: some +mapping of eye sensitivity is probably what is required, but it is not +implemented. + +The program operates by first determining zoom, pan, offset, tables, etc, +and, for each quadrant of the split screen, which images planes are active. +Then, for each line of the display, those images are read out from the display's +memory and the transformations done in hardware are duplicated pixel by pixel +in software. The word "active" needs a bit of explanation. Any image plane +whose pixels are contributing to the image is active. No image is active if +it has been turned off (by the \fIdi\fR) command (or if all images were +turned off and the one of interest not subsequently turned back on). If the +image is all zeroes, or if it is not but split screen is active and the +part of the image being displayed is all zeroes, it is not contributing to +the output. However, the snap program cannot tell that an active image is +not contributing anything useful, +and so it dutifully reads out each pixel and adds zeroes to the output. +The moral of this is that frames of no interest should be (turned) off before +snap is called (unless you don't have anything better to do than wait for +computer prompts). When split screen is active, frames are read only for +the quadrants in which they are active. + +The fastest snaps are for single images that are zoomed but not panned +and which are displayed (and snapped) in black and white, or snapped +in a single color. +.le +.ls \fBsplit\fR [c o px,y nx,y] +This command sets the split screen point. Option \fBc\fR is shorthand for +\fIcenter\fR, which is the normal selection. Option \fBo\fR stands for +\fIorigin\fR, and is the split position that corresponds to no split screen. +If you wish to specify the split point in pixels, use the \fBpx,y\fR form, in +which the coordinates are given as integers. If you prefer to specify +the point in NDC (which range from 0 though 1.0), use the \fBnx,y\fR form +in which the coordinates are decimal fractions. + +A peculiarity of the IIS hardware is that if no split screen is desired, +the split point must be moved to the upper left corner of the display, rather +than to the lower left (the \fIIRAF\fR 1,1 position). This means that no +split screen (the \fBo\fR option, or what you get after \fBre r\fR) is really +split screen with only quadrant \fBfour\fR displayed: if you use the \fIdi\fR +command with quadrant specification, only quadrant 4 data will be seen. +.le +.ls \fBtell\fR +This command displays what little it knows about the display status. At +present, all it can say is whether any image plane is being displayed, and +if any are, what is the number of one of them. This rather weak performance +is the result of various design decisions both within \fIcv\fR and the +\fIIRAF\fR display code, and may be improved. +.le +.ls \fBwindow\fR (o) (F C) +This command operates just as the \fIpseudo\fR command, except that it +applies a linear mapping to the output look-up tables (if option \fBo\fR +is used) or to the frame specific tables. The mapping is controlled by +the trackball, with the \fIy\fR cursor coordinate supplying the slope +of the map, and \fIx\fR the offset. If different mappings are given to +each color, a form of pseudo-color is generated. +.le +.ls \fBwrite\fR [F C] text +This command writes the given text into either an image plane (or planes) +or into the specified color graphics bit plane(s). The user is prompted +to place the cursor at the (lower left) corner of the text, which is +then written to the right in roman font. The user is also asked for +a text size (default 1.0). If the text is written into a graphics +plane, and a \fBsnap\fR is requested with no color specification, then +text in any graphics plane will be included in the image. A color snap, +on the other hand, will include graphics text to the extent that the +text is displayed in that color. +Text written into an image plane +will have the same appearance as any "full on" pixel; that is, text +in an image plane is written at maximum intensity, +overwrites the image data, +and is affected by look-up tables, offsets, +and so forth, like any other image pixels. +.le +.ls \fBzoom\fR N (F) +This command zooms the display to the power given by \fBN\fR. For the +IIS, the power must be 1,2,4, or 8; anything else is changed to the next +lower legal value. The model 70 zooms all planes together. The center +of the zoom is determined by the cursor position relative to the first +frame specified (if none, the lowest numbered active one). Once the zoom +has taken place, the \fIpan\fR routine is called for the specified frames. +.le +.endhelp diff --git a/pkg/images/tv/iis/doc/blink.hlp b/pkg/images/tv/iis/doc/blink.hlp new file mode 100644 index 00000000..f1440ebf --- /dev/null +++ b/pkg/images/tv/iis/doc/blink.hlp @@ -0,0 +1,46 @@ +.help blink Jan86 images.tv.iis +.ih +NAME +blink -- Blink frames in the image display +.ih +USAGE +blink frame1 frame2 [frame3 [frame4]] +.ih +PARAMETERS +.ls frame1 +First frame in blink sequence. +.le +.ls frame2 +Second frame in blink sequence. +.le +.ls frame3 +Third frame in blink sequence. +.le +.ls frame4 +Fourth frame in blink sequence. +.le +.ls rate = 1. +Blink rate in seconds per frame. May be any fraction of a second. +.le +.ih +DESCRIPTION +Two or more frames are alternately displayed on the image display monitor +("stdimage") at a specified rate per frame. +.ih +EXAMPLES +To blink two frames: + + cl> blink 1 2 + +To blink three frames at a rate of 2 seconds per frame: + + cl> blink 3 1 2 rate=2 +.ih +BUGS +The blink rate is measured in +software and, therefore, will not be exactly even in a time sharing +environment. +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/doc/cv.doc b/pkg/images/tv/iis/doc/cv.doc new file mode 100644 index 00000000..d34ccaa0 --- /dev/null +++ b/pkg/images/tv/iis/doc/cv.doc @@ -0,0 +1,332 @@ +.TL +The "cv" Display Package +.AU +Richard Wolff +.DA +.PP +The \fIcv\fR program is used to control the image display from within +\fIIRAF\fR. It differs from most \fIIRAF\fR programs since it has its +own prompt and its own internal "language". Each of the available commands +is described in the following paragraphs, but first a few comments on the +command structure seem in order. Commands are distinguished by their +first letter, except for a few instances where the second letter is needed. +The rest of the command name can be typed if you wish. Commands often +require specification of frames numbers, colors, quadrants, or numeric +values. In most cases, the order is unimportant, but, zoom, for instance, +does require the zoom power right after the command name. The order given +in the \fIhelp\fR command will always work. +.PP +A frame list is indicated in the \fIhelp\fR listing with an \fBF\fR. This +is to be replaced in the typed command by an \fBf\fR followed (no spaces) +with a list of the pertinent image planes. Thus, \fBf1\fR means +.I "frame 1" +while \fBf42\fR means +.I "frames 4" +and \fI2\fR. In most cases, the leading \fBf\fR can be omitted. +The specification \fBfa\fR means \fIall frames\fR. In those +cases in the \fIhelp\fR menu where the frame specification is optional, +omitting the frame list is the same as typing \fBfa\fR; that is, operate +on \fIall\fR frames. +.PP +A color specification is a \fBc\fR followed by a set of letters. +The letter \fBa\fR means \fIall\fR, just as in the frame specification. +The letters \fBr, b,\fR and \fBg\fR are the other possibilities for all +commands other than \fIdg\fR and \fIsnap\fR. For displaying graphics +planes (\fBdg\fR), the other possibilities are \fBy, p, m, w\fR which +stand for \fIyellow, purple, mauve,\fR and \fIwhite\fR. (\fIMauve\fR is +the wrong name and will get changed.) The \fIsnap\fR command accepts, in +addition to the standard three colors, \fBm, bw,\fR and \fBrgb\fR, which +stand for \fImonochrome, black and white,\fR and \fIfull color\fR. (See +the discussion under \fIsnap\fR for further explanation.) +An omitted color specification is the same as \fIall colors\fR. +.PP +Quadrants are given by a \fBq\fR followed by numbers from the set one through +four, or the letter \fBa\fR as in the frame and color cases. Quadrants are +numbered in the standard way, with the upper right being \fI1\fR, the upper +left \fI2\fR, etc. Adjacent quadrants may be referenced by \fBt, b, l,\fR +and \fBr\fR, standing for \fItop, bottom, left,\fR and \fIright\fR. An +omitted quadrant specification is the same as \fIall quadrants\fR. Quadrants +are effective only if the split screen command has set the split point to +something other than the "origin". +.sp +.SH +\fBblink\fR N F (C Q) (F C Q) +.IP +The blink rate is given by \fBN\fR, which is in tenths of a second. Although +current timing routines in \fIIRAF\fR do not recognize partial seconds, +for the NOAO 4.2BSD UNIX implementation, a non-portable timing routine is +used so that tenth seconds are usable. +Erratic timing is pretty much the rule when the system load is large. +One frame must be given, +followed by any color or quadrant specification, and then +optionally followed by any number of similar triads. A specification of +\fI10 f12 f3 f3 f4\fR would display frames one and two for one second, then +frame three for two one second intervals, then frame 4, and then recycle. +The first blink cycle may appear somewhat odd as the code "settles in", +but the sequence should become regular after that (except for timing +problems due to system load). In split screen mode, it is necessary to +specify all the frames together with quadrants, which leads to a lot of +typing: The reason is that blink simply cycles through a series of +\fBdi\fR commands, and hence it requires the same information as that +command. +.SH +\fBcursor\fR [on off F] +.IP +This command is used to turn the cursor on or off, and to read coordinates +and pixel values from a frame. Pixel coordinates for a feature are those +of the image as loaded into the display, and do not change as the image +is panned or zoomed. Fractional pixel positions are given for zoomed +images, with a minimum number of decimal places printed (but the same number +for both the \fIx\fR and \fIy\fR coordinates). +For an unpanned, unzoomed image plane, the lower left corner +of the \fIscreen\fR is (1,1) +even if the image you loaded is smaller than 512x512, occupies only +a portion of the display screen, and does not extend to the lower left +corner of the screen. This defect will likely be remedied +when the \fIcv\fR package is properly integrated into \fIIRAF\fR. +Pixel information can be read from a frame that is not being displayed. +.SH +\fBdi\fR F (C Q) [on off] +.IP +The \fId\fRisplay \fIi\fRmage command turns specified frames on (or off). +Turning a frame off does not erase it. A frame need not have all colors +turned on, nor appear in all quadrants of a split screen display. +.SH +\fBdg\fR C (F Q) [on off] +.IP +The \fId\fRisplay \fIg\fRraphics command turns specific graphics planes +on or off. For the IIS display, neither the frame nor the quadrant +parameters are relevant. A side-effect of this command is that it +resets the graphics hardware to the \fIcv\fR standard: red cursor and +seven graphics planes, each colored differently. If the display is in +a "weird" state that is not cured with the \fIreset r/t\fR commands, +and a \fIreset i\fR would destroy images of interest, try a \fIdg ca on\fR +command followed by \fIdg ca off\fR. +.SH +\fBerase\fR [F all graphics] +.IP +This command erases the specified frame, or all the graphics planes, or +all data planes. The command \fBclear\fR is a synonym. +.SH +\fBmatch\fR (o) (F) (C) (to) (F) (C) +.IP +This command allows the user to copy a look-up table to a specified set +of tables, and hence, to match the mapping function of frames (and/or +colors) to a reference table. If the \fBo\fR parameter is omitted, the +match is among the look-up tables associated with particular frames; +otherwise, the \fIouput\fR tables are used (hence, the \fBo\fR). In the +latter case, only colors are important; the frame information should +be omitted. For the individual frame tables, colors can be omitted, in +which case a match of frame one to two means to copy the three tables +of frame two (red, green, and blue) to those of frame one. Only one +reference frame or color should be given, but \fImatch f23 cgb f1 cr\fR +is legal and means to match the green and blue color tables of both +frames two and three to the red table of frame one. +.SH +\fBoffset\fR C N +.IP +The value N, which can range from -4095 to +4095 is added to the data +pipeline for color \fBC\fR, thus offsetting the data. This is useful +if one needs to change the data range that is mapped into the useful part +of the output tables. +.SH +\fBpan\fR (F) +.IP +When invoked, this command connects the trackball to the specified frames +and allows the user to move (pan/roam/scroll) the image about the screen. +This function is automatically invoked whenever the zoom factor is changed. +.SH +\fBpseudo\fR (o) (F C) (rn sn) +.IP +Look-up tables are changed with the \fIwindow\fR and the \fIpseudocolor\fR +commands. Windowing provides linear functions and is discussed under that +command; \fIpseudo\fR provides pseudo-coloring capabilities. Pseudo-color +maps are usually best done in the output tables, rather than in the +look-up tables associated with particular frames; hence, \fBps o\fR is +the more likely invocation of the start of the command line. A color +(or colors) can be specified for "output" pseudocolor, in which case, only +those colors will be affected. For frame look-up tables, +the frame must be specified. +.IP +Two mappings are provided. One uses a set of randomly selected colors +mapped to a specified number of pixel value ranges. The other uses +triangle color mappings. The former is invoked with the \fI(rn sn)\fR +options. In this case, the number following \fBr\fR gives the number of +ranges/levels into which the input data range is to be divided; to +each such range, a randomly selected color is assigned. The number +following \fBs\fR is a seed for the random number generator; changing +this while using the same number of levels gives different color mappings. +The default seed is the number of levels. If only the seed is given (\fBr\fR +omitted), the default number of levels is 8. This mapping is used when +a contour type display is desired: each color represents an intensity range +whose width is inversely proportional to the number of levels. +.IP +The triangle mapping uses a different triangle in each of the three look-up +tables (either the sets associated with the specified frames, or the output +tables). The initial tables map low intensity to blue, middle values to +green, and high values to red, as shown in the diagram. (The red and blue +triangles are truncated as their centers are on a table boundary.) +.sp +.KS +.PS +B: box +move +G: box +move +R: box +move to B.sw left 0.375 +line dotted to B.nw +line dashed to B.s +move to G.sw +line dashed to G.n +line dashed to G.se +move to R.s +line dashed to R.ne +line dotted to R.se right 0.375 +"blue" at B.s below +"green" at G.s below +"red" at R.s below +.PE +.sp +.KE +.IP +Once invoked, the program then allows the user to adjust the triangle +mapping. In +response to the prompt line, select the color to be changed and move the +trackball: the center of the triangle is given by the \fIx\fR cursor +coordinate and the width by the \fIy\fR coordinate. Narrow functions +(small \fIy\fR) allow one to map colors to a limited range of intensity. +When the mapping is satisfactory, a press of any button "fixes" the +mapping and the user may then either select another color or exit. +Before selecting a color, place the cursor at approximately the default +position for the mapping (or where it was for the last mapping of that +color under the current command); otherwise, the color map will change +suddenly when the color is selected via the trackball buttons. +.SH +\fBrange\fR N (C) (N C ...) +.IP +This command changes the range function in the specified color pipeline +so that the data is scaled by (divided by) the value \fBN\fR. For the +IIS, useful range values are 1,2,4 and 8; anything else will be changed +to the next lowest legal value. +.SH +\fBreset\fR [r i t a] +.IP +Various registers and tables are reset with this command. If the \fBr\fR +option is used, the registers are reset. This means that zoom is set to +one, all images are centered, split screen is removed, the range values are +set to one and the offset values are set to zero. Also, the cursor is +turned on and its shape is set. Option \fBi\fR causes all the image and +graphics planes to be erased and turned off. Option \fBt\fR resets all +the look-up tables to their default linear, positive slope, form, and +removes any color mappings by making all the output tables the same, and +all the frame specific tables the same. Option \fBa\fR does \fIall\fR +the above. +.SH +\fBsnap\fR (C) +.IP +This command creates an \fIIRAF\fR image file whose contents are a +512x512 digital snapshot of the image display screen. If no color +is specified, +or if \fIcm\fR (color monochromatic) is given, +the snapshot is of the \fIblue\fR image, which, if you +have a black and white image, is the same as the red or the green +image. Specifying \fBcg\fR for instance will take a snapshot of the +image that you would get had you specified \fIcg\fR for each frame +turned on by the \fIdi\fR command. Color is of interest only when +the window or pseudo color commands have made the three colors distinguishable. +If the "snapped" image is intended to be fed to the Dicomed film +recorder, a black and white image is all that is usually provided and so +a color snap is probably not appropriate. +In the case of the "no color/monochromatic" snap, the graphics planes are +all added together, while, if a real color is given, only the graphics +planes that have some of that color are included in the image. +The color \fBrgb\fR can be +given, in which case the red, green, and blue images are weighted equally +to produce a single image file. This image does not represent well what +you see, partly because of the equal weight given all colors: some +mapping of eye sensitivity is probably what is required, but it is not +implemented. +.IP +The program operates by first determining zoom, pan, offset, tables, etc, +and, for each quadrant of the split screen, which images planes are active. +Then, for each line of the display, those images are read out from the display's +memory and the transformations done in hardware are duplicated pixel by pixel +in software. The word "active" needs a bit of explanation. Any image plane +whose pixels are contributing to the image is active. No image is active if +it has been turned off (by the \fIdi\fR) command (or if all images were +turned off and the one of interest not subsequently turned back on). If the +image is all zeroes, or if it is not but split screen is active and the +part of the image being displayed is all zeroes, it is not contributing to +the output. However, the snap program cannot tell that an active image is +not contributing anything useful, +and so it dutifully reads out each pixel and adds zeroes to the output. +The moral of this is that frames of no interest should be (turned) off before +snap is called (unless you don't have anything better to do than wait for +computer prompts). When split screen is active, frames are read only for +the quadrants in which they are active. +.IP +The fastest snaps are for single images that are zoomed but not panned +and which are displayed (and snapped) in black and white, or snapped +in a single color. +.SH +\fBsplit\fR [c o px,y nx,y] +.IP +This command sets the split screen point. Option \fBc\fR is shorthand for +\fIcenter\fR, which is the normal selection. Option \fBo\fR stands for +\fIorigin\fR, and is the split position that corresponds to no split screen. +If you wish to specify the split point in pixels, use the \fBpx,y\fR form, in +which the coordinates are given as integers. If you prefer to specify +the point in NDC (which range from 0 though 1.0), use the \fBnx,y\fR form +in which the coordinates are decimal fractions. +.IP +A peculiarity of the IIS hardware is that if no split screen is desired, +the split point must be moved to the upper left corner of the display, rather +than to the lower left (the \fIIRAF\fR 1,1 position). This means that no +split screen (the \fBo\fR option, or what you get after \fBre r\fR) is really +split screen with only quadrant \fBfour\fR displayed: if you use the \fIdi\fR +command with quadrant specification, only quadrant 4 data will be seen. +.SH +\fBtell\fR +.IP +This command displays what little it knows about the display status. At +present, all it can say is whether any image plane is being displayed, and +if any are, what is the number of one of them. This rather weak performance +is the result of various design decisions both within \fIcv\fR and the +\fIIRAF\fR display code, and may be improved. +.SH +\fBwindow\fR (o) (F C) +.IP +This command operates just as the \fIpseudo\fR command, except that it +applies a linear mapping to the output look-up tables (if option \fBo\fR +is used) or to the frame specific tables. The mapping is controlled by +the trackball, with the \fIy\fR cursor coordinate supplying the slope +of the map, and \fIx\fR the offset. If different mappings are given to +each color, a form of pseudo-color is generated. +.SH +\fBwrite\fR [F C] text +.IP +This command writes the given text into either an image plane (or planes) +or into the specified color graphics bit plane(s). The user is prompted +to place the cursor at the (lower left) corner of the text, which is +then written to the right in roman font. The user is also asked for +a text size (default 1.0). If the text is written into a graphics +plane, and a \fBsnap\fR is requested with no color specification, then +text in any graphics plane will be included in the image. A color snap, +on the other hand, will include graphics text to the extent that the +text is displayed in that color. +Text written into an image plane +will have the same appearance as any "full on" pixel; that is, text +in an image plane is written at maximum intensity, +overwrites the image data, +and is affected by look-up tables, offsets, +and so forth, like any other image pixels. +.SH +\fBzoom\fR N (F) +.IP +This command zooms the display to the power given by \fBN\fR. For the +IIS, the power must be 1,2,4, or 8; anything else is changed to the next +lower legal value. The model 70 zooms all planes together. The center +of the zoom is determined by the cursor position relative to the first +frame specified (if none, the lowest numbered active one). Once the zoom +has taken place, the \fIpan\fR routine is called for the specified frames. diff --git a/pkg/images/tv/iis/doc/cv.hlp b/pkg/images/tv/iis/doc/cv.hlp new file mode 100644 index 00000000..6f90d74d --- /dev/null +++ b/pkg/images/tv/iis/doc/cv.hlp @@ -0,0 +1,341 @@ +.help cv Jan86 images.tv.iis +.ih +NAME +cv -- Control image device and take snapshots +.ih +USAGE +cv +.ih +PARAMETERS +.ls snap_file +Output file for snap image. +.le +.ls textsize +Character size for added text strings. +.le +.ih +COMMANDS +The following commands are available. This list is also available when +running the task with the commands h(elp) or ?. + +.nf +--- () : optional; [] : select one; N : number; C/F/Q : see below +b(link) N F (C Q) (F (C Q)..) blink (N = 10 is one second) +c(ursor) [on off F] cursor +di F (C Q) [on off] display image +dg C (F Q) [on off] display graphics +e(rase) [N a(ll) g(raphics) F] erase (clear) +m(atch) (o) F (C) (to) (F) (C) match (output) lookup table +o(ffset) C N offset color (N: 0 to +- 4095) +p(an) (F) pan images +ps(eudo) (o) (F C) (rn sn) pseudo color mapping + rn/sn: random n/seed n +r(ange) N (C) (N C ...) scale image (N: 1-8) +re(set) [r i t a] reset display + registers/image/tables/all +sn(ap) (C) snap a picture +s(plit) [c o px,y nx,y] split picture +t(ell) tell display state +w(indow) (o) (F C) window (output) frames +wr(ite) [F C] text write text to frame/graphics +z(oom) N (F) zoom frames (N: 1-8) +x or q exit/quit +--- C: letter c followed by r/g/b/a or, for snap r,g,b,m,bw,rgb, +--- or for dg r/g/b/y/p/m/w, as 'cr', 'ca', or 'cgb' +--- F: f followed by a frame number or 'a' for all +--- Q: q followed by quadrant number or t,b,l,r for top, bottom,... +.fi +.ih +DESCRIPTION +The \fIcv\fR program is used to control the image display from within +\fIIRAF\fR. It differs from most \fIIRAF\fR programs since it has its +own prompt and its own internal "language". Each of the available commands +is described in the following paragraphs, but first a few comments on the +command structure seem in order. Commands are distinguished by their +first letter, except for a few instances where the second letter is needed. +The rest of the command name can be typed if you wish. Commands often +require specification of frames numbers, colors, quadrants, or numeric +values. In most cases, the order is unimportant, but, zoom, for instance, +does require the zoom power right after the command name. The order given +in the \fIhelp\fR command will always work. + +A frame list is indicated in the \fIhelp\fR listing with an \fBF\fR. This +is to be replaced in the typed command by an \fBf\fR followed (no spaces) +with a list of the pertinent image planes. Thus, \fBf1\fR means +\fIframe 1\fR while \fBf42\fR means \fIframes 4\fR +and \fI2\fR. In most cases, the leading \fBf\fR can be omitted. +The specification \fBfa\fR means \fIall frames\fR. In those +cases in the \fIhelp\fR menu where the frame specification is optional, +omitting the frame list is the same as typing \fBfa\fR; that is, operate +on \fIall\fR frames. + +A color specification is a \fBc\fR followed by a set of letters. +The letter \fBa\fR means \fIall\fR, just as in the frame specification. +The letters \fBr, b,\fR and \fBg\fR are the other possibilities for all +commands other than \fIdg\fR and \fIsnap\fR. For displaying graphics +planes (\fBdg\fR), the other possibilities are \fBy, p, m, w\fR which +stand for \fIyellow, purple, mauve,\fR and \fIwhite\fR. (\fIMauve\fR is +the wrong name and will get changed.) The \fIsnap\fR command accepts, in +addition to the standard three colors, \fBm, bw,\fR and \fBrgb\fR, which +stand for \fImonochrome, black and white,\fR and \fIfull color\fR. (See +the discussion under \fIsnap\fR for further explanation.) +An omitted color specification is the same as \fIall colors\fR. + +Quadrants are given by a \fBq\fR followed by numbers from the set one through +four, or the letter \fBa\fR as in the frame and color cases. Quadrants are +numbered in the standard way, with the upper right being \fI1\fR, the upper +left \fI2\fR, etc. Adjacent quadrants may be referenced by \fBt, b, l,\fR +and \fBr\fR, standing for \fItop, bottom, left,\fR and \fIright\fR. An +omitted quadrant specification is the same as \fIall quadrants\fR. Quadrants +are effective only if the split screen command has set the split point to +something other than the "origin". + +.ls \fBblink\fR N F (C Q) (F C Q) +The blink rate is given by \fBN\fR, which is in tenths of a second. Although +current timing routines in \fIIRAF\fR do not recognize partial seconds, +for the NOAO 4.2BSD UNIX implementation, a non-portable timing routine is +used so that tenth seconds are usable. +Erratic timing is pretty much the rule when the system load is large. +One frame must be given, +followed by any color or quadrant specification, and then +optionally followed by any number of similar triads. A specification of +\fI10 f12 f3 f3 f4\fR would display frames one and two for one second, then +frame three for two one second intervals, then frame 4, and then recycle. +The first blink cycle may appear somewhat odd as the code "settles in", +but the sequence should become regular after that (except for timing +problems due to system load). In split screen mode, it is necessary to +specify all the frames together with quadrants, which leads to a lot of +typing: The reason is that blink simply cycles through a series of +\fBdi\fR commands, and hence it requires the same information as that +command. +.le +.ls \fBcursor\fR [on off F] +This command is used to turn the cursor on or off, and to read coordinates +and pixel values from a frame. Pixel coordinates for a feature are those +of the image as loaded into the display, and do not change as the image +is panned or zoomed. Fractional pixel positions are given for zoomed +images, with a minimum number of decimal places printed (but the same number +for both the \fIx\fR and \fIy\fR coordinates). +For an unpanned, unzoomed image plane, the lower left corner +of the \fIscreen\fR is (1,1) +even if the image you loaded is smaller than 512x512, occupies only +a portion of the display screen, and does not extend to the lower left +corner of the screen. This defect will likely be remedied +when the \fIcv\fR package is properly integrated into \fIIRAF\fR. +Pixel information can be read from a frame that is not being displayed. +.le +.ls \fBdi\fR F (C Q) [on off] +The \fId\fRisplay \fIi\fRmage command selects frames to be displayed on the +monitor. If neither \fIon\fR or \fIoff\fR is given, the specified frames +are turned on and all others are turned off. Turning a frame on with +the \fIon\fR specification displays the frames along with whatever else +is present; that is the new frame is added to the display. Note that +turning a frame off does not erase it. A frame need not have all colors +turned on, nor appear in all quadrants of a split screen display. +.le +.ls \fBdg\fR C (F Q) [on off] +The \fId\fRisplay \fIg\fRraphics command turns specific graphics planes +on or off. For the IIS display, neither the frame nor the quadrant +parameters are relevant. A side-effect of this command is that it +resets the graphics hardware to the \fIcv\fR standard: red cursor and +seven graphics planes, each colored differently. If the display is in +a "weird" state that is not cured with the \fIreset r/t\fR commands, +and a \fIreset i\fR would destroy images of interest, try a \fIdg ca on\fR +command followed by \fIdg ca off\fR. +.le +.ls \fBerase\fR [F all graphics] +This command erases the specified frame, or all the graphics planes, or +all data planes. The command \fBclear\fR is a synonym. +.le +.ls \fBmatch\fR (o) (F) (C) (to) (F) (C) +This command allows the user to copy a look-up table to a specified set +of tables, and hence, to match the mapping function of frames (and/or +colors) to a reference table. If the \fBo\fR parameter is omitted, the +match is among the look-up tables associated with particular frames; +otherwise, the \fIouput\fR tables are used (hence, the \fBo\fR). In the +latter case, only colors are important; the frame information should +be omitted. For the individual frame tables, colors can be omitted, in +which case a match of frame one to two means to copy the three tables +of frame two (red, green, and blue) to those of frame one. Only one +reference frame or color should be given, but \fImatch f23 cgb f1 cr\fR +is legal and means to match the green and blue color tables of both +frames two and three to the red table of frame one. +.le +.ls \fBoffset\fR C N +The value N, which can range from -4095 to +4095 is added to the data +pipeline for color \fBC\fR, thus offsetting the data. This is useful +if one needs to change the data range that is mapped into the useful part +of the output tables. +.le +.ls \fBpan\fR (F) +When invoked, this command connects the trackball to the specified frames +and allows the user to move (pan/roam/scroll) the image about the screen. +This function is automatically invoked whenever the zoom factor is changed. +.le +.ls \fBpseudo\fR (o) (F C) (rn sn) +Look-up tables are changed with the \fIwindow\fR and the \fIpseudocolor\fR +commands. Windowing provides linear functions and is discussed under that +command; \fIpseudo\fR provides pseudo-coloring capabilities. Pseudo-color +maps are usually best done in the output tables, rather than in the +look-up tables associated with particular frames; hence, \fBps o\fR is +the more likely invocation of the start of the command line. A color +(or colors) can be specified for "output" pseudocolor, in which case, only +those colors will be affected. For frame look-up tables, +the frame must be specified. + +Two mappings are provided. One uses a set of randomly selected colors +mapped to a specified number of pixel value ranges. The other uses +triangle color mappings. The former is invoked with the \fI(rn sn)\fR +options. In this case, the number following \fBr\fR gives the number of +ranges/levels into which the input data range is to be divided; to +each such range, a randomly selected color is assigned. The number +following \fBs\fR is a seed for the random number generator; changing +this while using the same number of levels gives different color mappings. +The default seed is the number of levels. If only the seed is given (\fBr\fR +omitted), the default number of levels is 8. This mapping is used when +a contour type display is desired: each color represents an intensity range +whose width is inversely proportional to the number of levels. + +The triangle mapping uses a different triangle in each of the three look-up +tables (either the sets associated with the specified frames, or the output +tables). The initial tables map low intensity to blue, middle values to +green, and high values to red, as shown in the diagram. (The red and blue +triangles are truncated as their centers are on a table boundary.) + +Once invoked, the program then allows the user to adjust the triangle +mapping. In +response to the prompt line, select the color to be changed and move the +trackball: the center of the triangle is given by the \fIx\fR cursor +coordinate and the width by the \fIy\fR coordinate. Narrow functions +(small \fIy\fR) allow one to map colors to a limited range of intensity. +When the mapping is satisfactory, a press of any button "fixes" the +mapping and the user may then either select another color or exit. +Before selecting a color, place the cursor at approximately the default +position for the mapping (or where it was for the last mapping of that +color under the current command); otherwise, the color map will change +suddenly when the color is selected via the trackball buttons. +.le +.ls \fBrange\fR N (C) (N C ...) +This command changes the range function in the specified color pipeline +so that the data is scaled by (divided by) the value \fBN\fR. For the +IIS, useful range values are 1,2,4 and 8; anything else will be changed +to the next lowest legal value. +.le +.ls \fBreset\fR [r i t a] +Various registers and tables are reset with this command. If the \fBr\fR +option is used, the registers are reset. This means that zoom is set to +one, all images are centered, split screen is removed, the range values are +set to one and the offset values are set to zero. Also, the cursor is +turned on and its shape is set. Option \fBi\fR causes all the image and +graphics planes to be erased and turned off. Option \fBt\fR resets all +the look-up tables to their default linear, positive slope, form, and +removes any color mappings by making all the output tables the same, and +all the frame specific tables the same. Option \fBa\fR does \fIall\fR +the above. +.le +.ls \fBsnap\fR (C) +This command creates an \fIIRAF\fR image file whose contents are a +512x512 digital snapshot of the image display screen. If no color +is specified, +or if \fIcm\fR (color monochromatic) is given, +the snapshot is of the \fIblue\fR image, which, if you +have a black and white image, is the same as the red or the green +image. Specifying \fBcg\fR for instance will take a snapshot of the +image that you would get had you specified \fIcg\fR for each frame +turned on by the \fIdi\fR command. Color is of interest only when +the window or pseudo color commands have made the three colors distinguishable. +If the "snapped" image is intended to be fed to the Dicomed film +recorder, a black and white image is all that is usually provided and so +a color snap is probably not appropriate. +In the case of the "no color/monochromatic" snap, the graphics planes are +all added together, while, if a real color is given, only the graphics +planes that have some of that color are included in the image. +The color \fBrgb\fR can be +given, in which case the red, green, and blue images are weighted equally +to produce a single image file. This image does not represent well what +you see, partly because of the equal weight given all colors: some +mapping of eye sensitivity is probably what is required, but it is not +implemented. + +The program operates by first determining zoom, pan, offset, tables, etc, +and, for each quadrant of the split screen, which images planes are active. +Then, for each line of the display, those images are read out from the display's +memory and the transformations done in hardware are duplicated pixel by pixel +in software. The word "active" needs a bit of explanation. Any image plane +whose pixels are contributing to the image is active. No image is active if +it has been turned off (by the \fIdi\fR) command (or if all images were +turned off and the one of interest not subsequently turned back on). If the +image is all zeroes, or if it is not but split screen is active and the +part of the image being displayed is all zeroes, it is not contributing to +the output. However, the snap program cannot tell that an active image is +not contributing anything useful, +and so it dutifully reads out each pixel and adds zeroes to the output. +The moral of this is that frames of no interest should be (turned) off before +snap is called (unless you don't have anything better to do than wait for +computer prompts). When split screen is active, frames are read only for +the quadrants in which they are active. + +The fastest snaps are for single images that are zoomed but not panned +and which are displayed (and snapped) in black and white, or snapped +in a single color. +.le +.ls \fBsplit\fR [c o px,y nx,y] +This command sets the split screen point. Option \fBc\fR is shorthand for +\fIcenter\fR, which is the normal selection. Option \fBo\fR stands for +\fIorigin\fR, and is the split position that corresponds to no split screen. +If you wish to specify the split point in pixels, use the \fBpx,y\fR form, in +which the coordinates are given as integers. If you prefer to specify +the point in NDC (which range from 0 though 1.0), use the \fBnx,y\fR form +in which the coordinates are decimal fractions. + +A peculiarity of the IIS hardware is that if no split screen is desired, +the split point must be moved to the upper left corner of the display, rather +than to the lower left (the \fIIRAF\fR 1,1 position). This means that no +split screen (the \fBo\fR option, or what you get after \fBre r\fR) is really +split screen with only quadrant \fBfour\fR displayed: if you use the \fIdi\fR +command with quadrant specification, only quadrant 4 data will be seen. +.le +.ls \fBtell\fR +This command displays what little it knows about the display status. At +present, all it can say is whether any image plane is being displayed, and +if any are, what is the number of one of them. This rather weak performance +is the result of various design decisions both within \fIcv\fR and the +\fIIRAF\fR display code, and may be improved. +.le +.ls \fBwindow\fR (o) (F C) +This command operates just as the \fIpseudo\fR command, except that it +applies a linear mapping to the output look-up tables (if option \fBo\fR +is used) or to the frame specific tables. The mapping is controlled by +the trackball, with the \fIy\fR cursor coordinate supplying the slope +of the map, and \fIx\fR the offset. If different mappings are given to +each color, a form of pseudo-color is generated. +.le +.ls \fBwrite\fR [F C] text +This command writes the given text into either an image plane (or planes) +or into the specified color graphics bit plane(s). The user is prompted +to place the cursor at the (lower left) corner of the text, which is +then written to the right in roman font. The user is also asked for +a text size (default 1.0). If the text is written into a graphics +plane, and a \fBsnap\fR is requested with no color specification, then +text in any graphics plane will be included in the image. A color snap, +on the other hand, will include graphics text to the extent that the +text is displayed in that color. +Text written into an image plane +will have the same appearance as any "full on" pixel; that is, text +in an image plane is written at maximum intensity, +overwrites the image data, +and is affected by look-up tables, offsets, +and so forth, like any other image pixels. +.le +.ls \fBzoom\fR N (F) +This command zooms the display to the power given by \fBN\fR. For the +IIS, the power must be 1,2,4, or 8; anything else is changed to the next +lower legal value. The model 70 zooms all planes together. The center +of the zoom is determined by the cursor position relative to the first +frame specified (if none, the lowest numbered active one). Once the zoom +has taken place, the \fIpan\fR routine is called for the specified frames. +.le +.ih +SEE ALSO +cvl +.endhelp diff --git a/pkg/images/tv/iis/doc/cv.ms b/pkg/images/tv/iis/doc/cv.ms new file mode 100644 index 00000000..d34ccaa0 --- /dev/null +++ b/pkg/images/tv/iis/doc/cv.ms @@ -0,0 +1,332 @@ +.TL +The "cv" Display Package +.AU +Richard Wolff +.DA +.PP +The \fIcv\fR program is used to control the image display from within +\fIIRAF\fR. It differs from most \fIIRAF\fR programs since it has its +own prompt and its own internal "language". Each of the available commands +is described in the following paragraphs, but first a few comments on the +command structure seem in order. Commands are distinguished by their +first letter, except for a few instances where the second letter is needed. +The rest of the command name can be typed if you wish. Commands often +require specification of frames numbers, colors, quadrants, or numeric +values. In most cases, the order is unimportant, but, zoom, for instance, +does require the zoom power right after the command name. The order given +in the \fIhelp\fR command will always work. +.PP +A frame list is indicated in the \fIhelp\fR listing with an \fBF\fR. This +is to be replaced in the typed command by an \fBf\fR followed (no spaces) +with a list of the pertinent image planes. Thus, \fBf1\fR means +.I "frame 1" +while \fBf42\fR means +.I "frames 4" +and \fI2\fR. In most cases, the leading \fBf\fR can be omitted. +The specification \fBfa\fR means \fIall frames\fR. In those +cases in the \fIhelp\fR menu where the frame specification is optional, +omitting the frame list is the same as typing \fBfa\fR; that is, operate +on \fIall\fR frames. +.PP +A color specification is a \fBc\fR followed by a set of letters. +The letter \fBa\fR means \fIall\fR, just as in the frame specification. +The letters \fBr, b,\fR and \fBg\fR are the other possibilities for all +commands other than \fIdg\fR and \fIsnap\fR. For displaying graphics +planes (\fBdg\fR), the other possibilities are \fBy, p, m, w\fR which +stand for \fIyellow, purple, mauve,\fR and \fIwhite\fR. (\fIMauve\fR is +the wrong name and will get changed.) The \fIsnap\fR command accepts, in +addition to the standard three colors, \fBm, bw,\fR and \fBrgb\fR, which +stand for \fImonochrome, black and white,\fR and \fIfull color\fR. (See +the discussion under \fIsnap\fR for further explanation.) +An omitted color specification is the same as \fIall colors\fR. +.PP +Quadrants are given by a \fBq\fR followed by numbers from the set one through +four, or the letter \fBa\fR as in the frame and color cases. Quadrants are +numbered in the standard way, with the upper right being \fI1\fR, the upper +left \fI2\fR, etc. Adjacent quadrants may be referenced by \fBt, b, l,\fR +and \fBr\fR, standing for \fItop, bottom, left,\fR and \fIright\fR. An +omitted quadrant specification is the same as \fIall quadrants\fR. Quadrants +are effective only if the split screen command has set the split point to +something other than the "origin". +.sp +.SH +\fBblink\fR N F (C Q) (F C Q) +.IP +The blink rate is given by \fBN\fR, which is in tenths of a second. Although +current timing routines in \fIIRAF\fR do not recognize partial seconds, +for the NOAO 4.2BSD UNIX implementation, a non-portable timing routine is +used so that tenth seconds are usable. +Erratic timing is pretty much the rule when the system load is large. +One frame must be given, +followed by any color or quadrant specification, and then +optionally followed by any number of similar triads. A specification of +\fI10 f12 f3 f3 f4\fR would display frames one and two for one second, then +frame three for two one second intervals, then frame 4, and then recycle. +The first blink cycle may appear somewhat odd as the code "settles in", +but the sequence should become regular after that (except for timing +problems due to system load). In split screen mode, it is necessary to +specify all the frames together with quadrants, which leads to a lot of +typing: The reason is that blink simply cycles through a series of +\fBdi\fR commands, and hence it requires the same information as that +command. +.SH +\fBcursor\fR [on off F] +.IP +This command is used to turn the cursor on or off, and to read coordinates +and pixel values from a frame. Pixel coordinates for a feature are those +of the image as loaded into the display, and do not change as the image +is panned or zoomed. Fractional pixel positions are given for zoomed +images, with a minimum number of decimal places printed (but the same number +for both the \fIx\fR and \fIy\fR coordinates). +For an unpanned, unzoomed image plane, the lower left corner +of the \fIscreen\fR is (1,1) +even if the image you loaded is smaller than 512x512, occupies only +a portion of the display screen, and does not extend to the lower left +corner of the screen. This defect will likely be remedied +when the \fIcv\fR package is properly integrated into \fIIRAF\fR. +Pixel information can be read from a frame that is not being displayed. +.SH +\fBdi\fR F (C Q) [on off] +.IP +The \fId\fRisplay \fIi\fRmage command turns specified frames on (or off). +Turning a frame off does not erase it. A frame need not have all colors +turned on, nor appear in all quadrants of a split screen display. +.SH +\fBdg\fR C (F Q) [on off] +.IP +The \fId\fRisplay \fIg\fRraphics command turns specific graphics planes +on or off. For the IIS display, neither the frame nor the quadrant +parameters are relevant. A side-effect of this command is that it +resets the graphics hardware to the \fIcv\fR standard: red cursor and +seven graphics planes, each colored differently. If the display is in +a "weird" state that is not cured with the \fIreset r/t\fR commands, +and a \fIreset i\fR would destroy images of interest, try a \fIdg ca on\fR +command followed by \fIdg ca off\fR. +.SH +\fBerase\fR [F all graphics] +.IP +This command erases the specified frame, or all the graphics planes, or +all data planes. The command \fBclear\fR is a synonym. +.SH +\fBmatch\fR (o) (F) (C) (to) (F) (C) +.IP +This command allows the user to copy a look-up table to a specified set +of tables, and hence, to match the mapping function of frames (and/or +colors) to a reference table. If the \fBo\fR parameter is omitted, the +match is among the look-up tables associated with particular frames; +otherwise, the \fIouput\fR tables are used (hence, the \fBo\fR). In the +latter case, only colors are important; the frame information should +be omitted. For the individual frame tables, colors can be omitted, in +which case a match of frame one to two means to copy the three tables +of frame two (red, green, and blue) to those of frame one. Only one +reference frame or color should be given, but \fImatch f23 cgb f1 cr\fR +is legal and means to match the green and blue color tables of both +frames two and three to the red table of frame one. +.SH +\fBoffset\fR C N +.IP +The value N, which can range from -4095 to +4095 is added to the data +pipeline for color \fBC\fR, thus offsetting the data. This is useful +if one needs to change the data range that is mapped into the useful part +of the output tables. +.SH +\fBpan\fR (F) +.IP +When invoked, this command connects the trackball to the specified frames +and allows the user to move (pan/roam/scroll) the image about the screen. +This function is automatically invoked whenever the zoom factor is changed. +.SH +\fBpseudo\fR (o) (F C) (rn sn) +.IP +Look-up tables are changed with the \fIwindow\fR and the \fIpseudocolor\fR +commands. Windowing provides linear functions and is discussed under that +command; \fIpseudo\fR provides pseudo-coloring capabilities. Pseudo-color +maps are usually best done in the output tables, rather than in the +look-up tables associated with particular frames; hence, \fBps o\fR is +the more likely invocation of the start of the command line. A color +(or colors) can be specified for "output" pseudocolor, in which case, only +those colors will be affected. For frame look-up tables, +the frame must be specified. +.IP +Two mappings are provided. One uses a set of randomly selected colors +mapped to a specified number of pixel value ranges. The other uses +triangle color mappings. The former is invoked with the \fI(rn sn)\fR +options. In this case, the number following \fBr\fR gives the number of +ranges/levels into which the input data range is to be divided; to +each such range, a randomly selected color is assigned. The number +following \fBs\fR is a seed for the random number generator; changing +this while using the same number of levels gives different color mappings. +The default seed is the number of levels. If only the seed is given (\fBr\fR +omitted), the default number of levels is 8. This mapping is used when +a contour type display is desired: each color represents an intensity range +whose width is inversely proportional to the number of levels. +.IP +The triangle mapping uses a different triangle in each of the three look-up +tables (either the sets associated with the specified frames, or the output +tables). The initial tables map low intensity to blue, middle values to +green, and high values to red, as shown in the diagram. (The red and blue +triangles are truncated as their centers are on a table boundary.) +.sp +.KS +.PS +B: box +move +G: box +move +R: box +move to B.sw left 0.375 +line dotted to B.nw +line dashed to B.s +move to G.sw +line dashed to G.n +line dashed to G.se +move to R.s +line dashed to R.ne +line dotted to R.se right 0.375 +"blue" at B.s below +"green" at G.s below +"red" at R.s below +.PE +.sp +.KE +.IP +Once invoked, the program then allows the user to adjust the triangle +mapping. In +response to the prompt line, select the color to be changed and move the +trackball: the center of the triangle is given by the \fIx\fR cursor +coordinate and the width by the \fIy\fR coordinate. Narrow functions +(small \fIy\fR) allow one to map colors to a limited range of intensity. +When the mapping is satisfactory, a press of any button "fixes" the +mapping and the user may then either select another color or exit. +Before selecting a color, place the cursor at approximately the default +position for the mapping (or where it was for the last mapping of that +color under the current command); otherwise, the color map will change +suddenly when the color is selected via the trackball buttons. +.SH +\fBrange\fR N (C) (N C ...) +.IP +This command changes the range function in the specified color pipeline +so that the data is scaled by (divided by) the value \fBN\fR. For the +IIS, useful range values are 1,2,4 and 8; anything else will be changed +to the next lowest legal value. +.SH +\fBreset\fR [r i t a] +.IP +Various registers and tables are reset with this command. If the \fBr\fR +option is used, the registers are reset. This means that zoom is set to +one, all images are centered, split screen is removed, the range values are +set to one and the offset values are set to zero. Also, the cursor is +turned on and its shape is set. Option \fBi\fR causes all the image and +graphics planes to be erased and turned off. Option \fBt\fR resets all +the look-up tables to their default linear, positive slope, form, and +removes any color mappings by making all the output tables the same, and +all the frame specific tables the same. Option \fBa\fR does \fIall\fR +the above. +.SH +\fBsnap\fR (C) +.IP +This command creates an \fIIRAF\fR image file whose contents are a +512x512 digital snapshot of the image display screen. If no color +is specified, +or if \fIcm\fR (color monochromatic) is given, +the snapshot is of the \fIblue\fR image, which, if you +have a black and white image, is the same as the red or the green +image. Specifying \fBcg\fR for instance will take a snapshot of the +image that you would get had you specified \fIcg\fR for each frame +turned on by the \fIdi\fR command. Color is of interest only when +the window or pseudo color commands have made the three colors distinguishable. +If the "snapped" image is intended to be fed to the Dicomed film +recorder, a black and white image is all that is usually provided and so +a color snap is probably not appropriate. +In the case of the "no color/monochromatic" snap, the graphics planes are +all added together, while, if a real color is given, only the graphics +planes that have some of that color are included in the image. +The color \fBrgb\fR can be +given, in which case the red, green, and blue images are weighted equally +to produce a single image file. This image does not represent well what +you see, partly because of the equal weight given all colors: some +mapping of eye sensitivity is probably what is required, but it is not +implemented. +.IP +The program operates by first determining zoom, pan, offset, tables, etc, +and, for each quadrant of the split screen, which images planes are active. +Then, for each line of the display, those images are read out from the display's +memory and the transformations done in hardware are duplicated pixel by pixel +in software. The word "active" needs a bit of explanation. Any image plane +whose pixels are contributing to the image is active. No image is active if +it has been turned off (by the \fIdi\fR) command (or if all images were +turned off and the one of interest not subsequently turned back on). If the +image is all zeroes, or if it is not but split screen is active and the +part of the image being displayed is all zeroes, it is not contributing to +the output. However, the snap program cannot tell that an active image is +not contributing anything useful, +and so it dutifully reads out each pixel and adds zeroes to the output. +The moral of this is that frames of no interest should be (turned) off before +snap is called (unless you don't have anything better to do than wait for +computer prompts). When split screen is active, frames are read only for +the quadrants in which they are active. +.IP +The fastest snaps are for single images that are zoomed but not panned +and which are displayed (and snapped) in black and white, or snapped +in a single color. +.SH +\fBsplit\fR [c o px,y nx,y] +.IP +This command sets the split screen point. Option \fBc\fR is shorthand for +\fIcenter\fR, which is the normal selection. Option \fBo\fR stands for +\fIorigin\fR, and is the split position that corresponds to no split screen. +If you wish to specify the split point in pixels, use the \fBpx,y\fR form, in +which the coordinates are given as integers. If you prefer to specify +the point in NDC (which range from 0 though 1.0), use the \fBnx,y\fR form +in which the coordinates are decimal fractions. +.IP +A peculiarity of the IIS hardware is that if no split screen is desired, +the split point must be moved to the upper left corner of the display, rather +than to the lower left (the \fIIRAF\fR 1,1 position). This means that no +split screen (the \fBo\fR option, or what you get after \fBre r\fR) is really +split screen with only quadrant \fBfour\fR displayed: if you use the \fIdi\fR +command with quadrant specification, only quadrant 4 data will be seen. +.SH +\fBtell\fR +.IP +This command displays what little it knows about the display status. At +present, all it can say is whether any image plane is being displayed, and +if any are, what is the number of one of them. This rather weak performance +is the result of various design decisions both within \fIcv\fR and the +\fIIRAF\fR display code, and may be improved. +.SH +\fBwindow\fR (o) (F C) +.IP +This command operates just as the \fIpseudo\fR command, except that it +applies a linear mapping to the output look-up tables (if option \fBo\fR +is used) or to the frame specific tables. The mapping is controlled by +the trackball, with the \fIy\fR cursor coordinate supplying the slope +of the map, and \fIx\fR the offset. If different mappings are given to +each color, a form of pseudo-color is generated. +.SH +\fBwrite\fR [F C] text +.IP +This command writes the given text into either an image plane (or planes) +or into the specified color graphics bit plane(s). The user is prompted +to place the cursor at the (lower left) corner of the text, which is +then written to the right in roman font. The user is also asked for +a text size (default 1.0). If the text is written into a graphics +plane, and a \fBsnap\fR is requested with no color specification, then +text in any graphics plane will be included in the image. A color snap, +on the other hand, will include graphics text to the extent that the +text is displayed in that color. +Text written into an image plane +will have the same appearance as any "full on" pixel; that is, text +in an image plane is written at maximum intensity, +overwrites the image data, +and is affected by look-up tables, offsets, +and so forth, like any other image pixels. +.SH +\fBzoom\fR N (F) +.IP +This command zooms the display to the power given by \fBN\fR. For the +IIS, the power must be 1,2,4, or 8; anything else is changed to the next +lower legal value. The model 70 zooms all planes together. The center +of the zoom is determined by the cursor position relative to the first +frame specified (if none, the lowest numbered active one). Once the zoom +has taken place, the \fIpan\fR routine is called for the specified frames. diff --git a/pkg/images/tv/iis/doc/cvl.hlp b/pkg/images/tv/iis/doc/cvl.hlp new file mode 100644 index 00000000..cda07b07 --- /dev/null +++ b/pkg/images/tv/iis/doc/cvl.hlp @@ -0,0 +1,287 @@ +.help cvl Jul87 images.tv.iis +.ih +NAME +cvl -- load images in image display +.ih +USAGE +cvl image frame +.ih +PARAMETERS +.ls image +Image to be loaded. +.le +.ls frame +Display frame to be loaded. +.le +.ls erase = yes +Erase frame before loading image? +.le +.ls border_erase = no +Erase unfilled area of window in display frame if the whole frame is not +erased? +.le +.ls select_frame = yes +Display the frame to be loaded? +.le +.ls fill = no +Interpolate or block average the image to fit the display window? +.le +.ls zscale = yes +Apply an automatic intensity mapping algorithm when loading the image? +.le +.ls contrast = 0.25 +Contrast factor for the automatic intensity mapping algorithm. +.le +.ls zrange = yes +If not using the automatic mapping algorithm (\fIzscale = no\fR) map the +full range of the image intensity to the full range of the display? +.le +.ls nsample_lines = 5 +Number of sample lines to use in the automatic intensity mapping algorithm. +.le +.ls xcenter = 0.5, ycenter = 0.5 +Horizontal and vertical centers of the display window in normalized +coordinates measured from the left and bottom respectively. +.le +.ls xsize = 1, ysize = 1 +Horizontal and vertical sizes of the display window in normalized coordinates. +.le +.ls xmag = 1., ymag = 1. +Horizontal and vertical image magnifications when not filling the display +window. Magnifications greater than 1 map image pixels into more than 1 +display pixel and magnifications less than 1 map more than 1 image pixel +into a display pixel. +.le +.ls z1, z2 +Minimum and maximum image intensity to be mapped to the minimum and maximum +display levels. These values apply when not using the automatic or range +intensity mapping methods. +.le +.ls ztrans = "linear" +Transformation of the image intensity levels to the display levels. The +choices are: +.ls "linear" +Map the minimum and maximum image intensities linearly to the minimum and +maximum display levels. +.le +.ls "log" +Map the minimum and maximum image intensities linearly to the range 1 to 1000, +take the logarithm (base 10), and then map the logarithms to the display +range. +.le +.ls "none" +Apply no mapping of the image intensities (regardless of the values of +\fIzscale, zrange, z1, and z2\fR). For most image displays, values exceeding +the maximum display value are truncated by masking the highest bits. +This corresponds to applying a modulus operation to the intensity values +and produces "wrap-around" in the display levels. +.le +.ls "user" +User supplies a look up table of intensities and their corresponding +greyscale values. +.le +.le +.ls lutfile = "" +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 +.ih +DESCRIPTION +The specified image is loaded into the specified frame of the standard +image display device ("stdimage"). For devices with more than one +frame it is possible to load an image in a frame different than that +displayed on the monitor. An option allows the loaded frame to become +the displayed frame. The previous contents of the frame may be erased +(which can be done very quickly on most display devices) before the +image is loaded. Without erasing, the image replaces only those pixels +in the frame defined by the display window and spatial mapping +described below. This allows displaying more than one image in a +frame. An alternate erase option erases only those pixels in the +defined display window which are not occupied by the image being +loaded. This is generally slower than erasing the entire frame and +should be used only if a display window is smaller than the entire +frame. + +The image is mapped both in intensity and in space. The intensity is +mapped from the image pixel values to the range of display values in +the device. Spatial interpolation maps the image pixel coordinates +into a part of the display frame called the display window. Many of +the parameters of this task are related to these two transformations. + +A display window is defined in terms of the full frame. The lower left +corner of the frame is (0, 0) and the upper right corner is (1, 1) as viewed on +the monitor. The display window is specified by a center (defaulted to the +center of the frame (0.5, 0.5)) and a size (defaulted to the full size of +the frame, 1 by 1). The image is loaded only within the display window and +does not affect data outside the window; though, of course, an initial +frame erase erases the entire frame. By using different windows one may +load several images in various parts of the display frame. + +If the option \fIfill\fR is selected the image is spatially interpolated +to fill the display window in its largest dimension (with an aspect +ratio of 1:1). When the display window is not automatically filled +the image is scaled by the magnification factors (which need not be +the same) and centered in the display window. If the number of image +pixels exceeds the number of display pixels in the window only the central +portion of the image which fills the window is loaded. By default +the display window is the full frame, the image is not interpolated +(no filling and magnification factors of 1), and is centered in the frame. +The spatial interpolation algorithm is described in the section +MAGNIFY AND FILL ALGORITHM. + +There are several options for mapping the pixel values to the display +values. There are two steps; mapping a range of image intensities to +the full display range and selecting the mapping function or +transformation. The mapping transformation is set by the parameter +\fIztrans\fR. The most direct mapping is "none" which loads the image +pixel values directly without any transformation or range mapping. +Most displays only use the lowest bits resulting in a wrap-around +effect for images with a range exceeding the display range. This is +sometimes desirable because it produces a contoured image which is not +saturated at the brightest or weakest points. This transformation is +also the fastest. Another transformation, "linear", maps the selected +image range linearly to the full display range. The logarithmic +transformation, "log", maps the image range linearly between 1 and 1000 +and then maps the logarithm (base 10) linearly to the full display +range. In the latter transformations pixel values greater than +selected maximum display intensity are set to the maximum display value +and pixel values less than the minimum intensity are set to the minimum +display value. + +Methods for setting of the range of image pixel values, \fIz1\fR and +\fIz2\fR, to be mapped to the full display range are arranged in a +hierarchy from an automatic mapping which gives generally good result +for typical astronomical images to those requiring the user to specify +the mapping in detail. The automatic mapping is selected with the +parameter \fIzscale\fR. The automatic mapping algorithm is described +in the section ZSCALE ALGORITHM and has two parameters, +\fInsample_lines\fR and \fIcontrast\fR. + +When \fIztrans\fR = user, a look up table of intensity values and their +corresponding greyscale levels is read from the file specified by the +\fIlutfile\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. When \fIztrans\fR = user, parameters \fIzscale\fR, +\fIzrange\fR and \fIzmap\fR are ignored. + +If the zscale algorithm is not selected the \fIzrange\fR parameter is +examined. If \fIzrange\fR is yes then \fIz1\fR and \fIz2\fR are set to +the minimum and maximum image pixels values, respectively. This insures +that the full range of the image is displayed but is generally slower +than the zscale algorithm (because all the image pixels must be examined) +and, for images with a large dynamic range, will generally show only the +brightest parts of the image. + +Finally, if the zrange algorithm is not selected the user specifies the +values of \fIz1\fR and \fIz2\fR directly. +.ih +ZSCALE ALGORITHM +The zscale algorithm is designed to display the image values near the median +image value without the time consuming process of computing a full image +histogram. This is particularly useful for astronomical images which +generally have a very peaked histogram corresponding to the background +sky in direct imaging or the continuum in a two dimensional spectrum. + +A subset of the image is examined. Approximately 600 pixels are +sampled evenly over the image. The number of lines is a user parameter, +\fInsample_lines\fR. The pixels are ranked in brightness to +form the function I(i) where i is the rank of the pixel and I is its value. +Generally the midpoint of this function (the median) is very near the peak +of the image histogram and there is a well defined slope about the midpoint +which is related to the width of the histogram. At the ends of the +I(i) function there are a few very bright and dark pixels due to objects +and defects in the field. To determine the slope a linear function is fit +with iterative rejection; + + I(i) = intercept + slope * (i - midpoint) + +If more than half of the points are rejected +then there is no well defined slope and the full range of the sample +defines \fIz1\fR and \fIz2\fR. Otherwise the endpoints of the linear +function are used (provided they are within the original range of the +sample): + +.nf + z1 = I(midpoint) + (slope / contrast) * (1 - midpoint) + z2 = I(midpoint) + (slope / contrast) * (npoints - midpoint) +.fi + +As can be seen, the parameter \fIcontrast\fR may be used to adjust the contrast +produced by this algorithm. +.ih +MAGNIFY AND FILL ALGORITHM +The spatial interpolation algorithm magnifies (or demagnifies) the +image along each axis by the desired amount. The fill option is a +special case of magnification in that the magnification factors are set +by the requirement that the image just fit the display window in its +maximum dimension with an aspect ratio (ratio of magnifications) of 1. +There are two requirements on the interpolation algorithm; all the +image pixels must contribute to the interpolated image and the +interpolation must be time efficient. The second requirement means that +simple linear interpolation is used. If more complex interpolation is +desired then tasks in the IMAGES package must be used to first +interpolate the image to the desired size before loading the display +frame. + +If the magnification factors are greater than 0.5 (sampling step size +less than 2) then the image is simply interpolated. However, if the +magnification factors are less than 0.5 (sampling step size greater +than 2) the image is first block averaged by the smallest amount such +that magnification in the reduced image is again greater than 0.5. +Then the reduced image is interpolated to achieve the desired +magnifications. The reason for block averaging rather than simply +interpolating with a step size greater than 2 is the requirement that +all of the image pixels contribute to the displayed image. If this is +not desired then the user can explicitly subsample using image +sections. The effective difference is that with subsampling the +pixel-to-pixel noise is unchanged and small features may be lost due to +the subsampling. With block averaging pixel-to-pixel noise is reduced +and small scale features still contribute to the displayed image. +.ih +EXAMPLES +For the purpose of these examples we assume a display with four frames, +512 x 512 in size, and a display range of 0 to 255. Also consider two +images, image1 is 100 x 200 with a range 200 to 2000 and image2 is +2000 x 1000 with a range -1000 to 1000. To load the images with the +default parameters: + +.nf + cl> cvl image1 1 + cl> cvl image2 2 +.fi + +The image frames are first erased and image1 is loaded in the center of +display frame 1 without spatial interpolation and with the automatic intensity +mapping. Only the central 512x512 area of image2 is loaded in display frame 2 + +To load the display without any intensity transformation: + + cl> cvl image1 1 ztrans=none + +The next example interpolates image2 to fill the full 512 horizontal range +of the frame and maps the full image range into the display range. Note +that the spatial interpolation first block averages by a factor of 2 and then +magnifies by 0.512. + + cl> cvl image2 3 fill+ zscale- + +The next example makes image1 square and sets the intensity range explicitly. + + cl> cvl image1 4 zscale- zrange- z1=800 z2=1200 xmag=2 + +The next example loads the two images in the same frame side-by-side. + +.nf + cl> cvl.xsize=0.5 + cl> cvl image1 fill+ xcen=0.25 + cl> cvl image2 erase- fill+ xcen=0.75 +.fi +.ih +SEE ALSO +display, magnify +.endhelp diff --git a/pkg/images/tv/iis/doc/erase.hlp b/pkg/images/tv/iis/doc/erase.hlp new file mode 100644 index 00000000..6a3548e6 --- /dev/null +++ b/pkg/images/tv/iis/doc/erase.hlp @@ -0,0 +1,26 @@ +.help erase Jan86 images.tv.iis +.ih +NAME +erase -- erase display frame +.ih +USAGE +erase frame +.ih +PARAMETERS +.ls frame +Frame to be erased. +.le +.ih +DESCRIPTION +The specified frame in the image display ("stdimage") is erased. +Note that the erased frame can be different than the frame currently +being displayed on the monitor. The graphics frame is not erased. +.ih +EXAMPLES +To erase frame 3: + + cl> erase 3 +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/doc/frame.hlp b/pkg/images/tv/iis/doc/frame.hlp new file mode 100644 index 00000000..ec3a9059 --- /dev/null +++ b/pkg/images/tv/iis/doc/frame.hlp @@ -0,0 +1,24 @@ +.help frame Jan86 images.tv.iis +.ih +NAME +frame -- select frame to be displayed on the image display +.ih +USAGE +frame frame +.ih +PARAMETERS +.ls frame +Frame to be displayed. +.le +.ih +DESCRIPTION +The specified frame is displayed on the image display monitor ("stdimage"). +.ih +EXAMPLES +To display frame 3: + + cl> frame 3 +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/doc/lumatch.hlp b/pkg/images/tv/iis/doc/lumatch.hlp new file mode 100644 index 00000000..95e6f800 --- /dev/null +++ b/pkg/images/tv/iis/doc/lumatch.hlp @@ -0,0 +1,28 @@ +.help lumatch Jan86 images.tv.iis +.ih +NAME +lumatch -- match lookup tables for two display frames +.ih +USAGE +lumatch frame ref_frame +.ih +PARAMETERS +.ls frame +Frame whose lookup table is to be adjusted. +.le +.ls ref_frame +Frame whose lookup table is to be matched. +.le +.ih +DESCRIPTION +The lookup tables mapping the display frame values to the grey levels +on the display monitor are matched in one frame to a reference frame. +.ih +EXAMPLES +To match the lookup tables in frame 3 to those in frame 1: + + cl> lumatch 3 1 +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/doc/monochrome.hlp b/pkg/images/tv/iis/doc/monochrome.hlp new file mode 100644 index 00000000..70cc7aee --- /dev/null +++ b/pkg/images/tv/iis/doc/monochrome.hlp @@ -0,0 +1,18 @@ +.help monochrome Jan86 images.tv.iis +.ih +NAME +monochrome -- select monochrome enhancement +.ih +USAGE +monochrome +.ih +DESCRIPTION +Set the display monitor to display monochrome grey levels by setting +the lookup tables for each color gun to the same values. +.ih +EXAMPLES + cl> monochrome +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/doc/pseudocolor.hlp b/pkg/images/tv/iis/doc/pseudocolor.hlp new file mode 100644 index 00000000..1c7bb70a --- /dev/null +++ b/pkg/images/tv/iis/doc/pseudocolor.hlp @@ -0,0 +1,41 @@ +.help pseudocolor Jan86 images.tv.iis +.ih +NAME +pseudocolor -- select pseudocolor enhancement +.ih +USAGE +pseudocolor +.ih +PARAMETERS +.ls enhancement +Type of pseudocolor enhancement. The types are: +.ls "random" +A randomly chosen color is assigned to each display level. +.le +.ls "linear" +The display levels are mapped into a spectrum. +.le +.ls "8color" +Eight colors are chosen at random over the range of the display levels. +.le +.le +.ls window = yes +Window the lookup table for the frame after enabling the pseudocolor? +.le +.ih +DESCRIPTION +The display levels from the lookup table are mapped into various saturated +colors to enhance an image. There is a choice of three color mappings. +After the pseudocolor enhancement is enabled on the display monitor the +user may, optionally, adjust the frame lookup table. +.ih +EXAMPLES +.nf + cl> pseudocolor random + cl> pseudocolor 8color + cl> pseudocolor linear +.fi +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/doc/rgb.hlp b/pkg/images/tv/iis/doc/rgb.hlp new file mode 100644 index 00000000..1bd9aa13 --- /dev/null +++ b/pkg/images/tv/iis/doc/rgb.hlp @@ -0,0 +1,33 @@ +.help rgb Jan86 images.tv.iis +.ih +NAME +rgb - select true color mode (red, green, and blue frames) +.ih +USAGE +rgb red_frame green_frame blue_frame +.ih +PARAMETERS +.ls red_frame +Frame to use for the red component. +.le +.ls green_frame +Frame to use for the green component. +.le +.ls blue_frame +Frame to use for the blue component. +.le +.ls window = no +Window the rgb lookup tables? +.le +.ih +DESCRIPTION +Set the display monitor to display rgb colors by using three frames to +drive the red, green, and blue guns of the color display monitor. +Optionally, window the rgb lookup tables. +.ih +EXAMPLES + cl> rgb 1 2 3 +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/doc/window.hlp b/pkg/images/tv/iis/doc/window.hlp new file mode 100644 index 00000000..f98130c3 --- /dev/null +++ b/pkg/images/tv/iis/doc/window.hlp @@ -0,0 +1,38 @@ +.help window Jan86 images.tv.iis +.ih +NAME +window -- adjust the contrast and dc offset of the current frame +.ih +USAGE +window +.ih +DESCRIPTION +The lookup table between the display frame values and the values sent +to the display monitor is adjusted interactively to enhance the display. +The mapping is linear with two adjustable parameters; the intercept +and the slope. The two values are set with the image display cursor +in the two dimensional plane of the display. The horizontal position +of the cursor sets the intercept or zero point of the transformation. +Moving the cursor to the left lowers the zero point while moving the cursor to +the right increases the zero point. The vertical position of the cursor +sets the slope of the transformation. The middle of the display is zero +slope (all frame values map into the same output value) while points above +the middle have negative slope and points below the middle have positive +slope. Positions near the middle have low contrast while positions near +the top and bottom have very high contrast. By changing the slope from +positive to negative the image may be displayed as positive or negative. + +The interactive loop is exited by pressing any button on the cursor control. +.ih +EXAMPLES +.nf + cl> window + Window the display and push any button to exit: +.fi +.ih +BUGS +It may be necessary to execute FRAME before windowing. +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/doc/zoom.hlp b/pkg/images/tv/iis/doc/zoom.hlp new file mode 100644 index 00000000..85a0b604 --- /dev/null +++ b/pkg/images/tv/iis/doc/zoom.hlp @@ -0,0 +1,31 @@ +.help zoom Jan86 images.tv.iis +.ih +NAME +zoom - zoom in on the image (change magnification) +.ih +USAGE +zoom +.ls zoom_factor +Zoom factor by the display is to be expanded. The factors are powers +of 2; 1 = no zoom, 2 = factor of 2, 3 = factor of 4, and 4 = factor of 8. +.le +.ls window = no +Window the enlarged image? +.le +.ih +DESCRIPTION +The display is zoomed by the specified factor. A zoom factor of 1 is no +magnification and higher factors correspond to factors of 2. The zoom +replicates pixels on the monitor and only a part of the display frame +centered on the display cursor is visible. The window option allows +the user to adjust interactively with the cursor the part of the zoomed +frame. +.ih +EXAMPLES +To magnify the displayed frame by a factor of 2: + + cl> zoom 2 +.ih +SEE ALSO +cv +.endhelp diff --git a/pkg/images/tv/iis/erase.cl b/pkg/images/tv/iis/erase.cl new file mode 100644 index 00000000..4da666bc --- /dev/null +++ b/pkg/images/tv/iis/erase.cl @@ -0,0 +1,10 @@ +#{ ERASE -- Erase a greyscale display frame. + +# frame,i,a,1,1,4,frame to be erased +# saveframe,i,h + +{ + saveframe = _dcontrol.frame + _dcontrol (frame=frame, erase=yes) + _dcontrol (frame = saveframe) +} diff --git a/pkg/images/tv/iis/erase.par b/pkg/images/tv/iis/erase.par new file mode 100644 index 00000000..0f84180f --- /dev/null +++ b/pkg/images/tv/iis/erase.par @@ -0,0 +1,2 @@ +frame,i,a,1,1,4,frame to be erased +saveframe,i,h diff --git a/pkg/images/tv/iis/frame.cl b/pkg/images/tv/iis/frame.cl new file mode 100644 index 00000000..1252f7da --- /dev/null +++ b/pkg/images/tv/iis/frame.cl @@ -0,0 +1,5 @@ +#{ FRAME -- Select the frame to be displayed. + +{ + _dcontrol (type="frame", frame=frame) +} diff --git a/pkg/images/tv/iis/giis.par b/pkg/images/tv/iis/giis.par new file mode 100644 index 00000000..5e000c89 --- /dev/null +++ b/pkg/images/tv/iis/giis.par @@ -0,0 +1,7 @@ +input,s,a,,,,input metacode file +device,s,h,"stdimage",,,output device +generic,b,h,no,,,ignore remaining kernel dependent parameters +debug,b,h,no,,,print decoded graphics instructions during processing +verbose,b,h,no,,,"print elements of polylines, cell arrays, etc. in debug mode" +gkiunits,b,h,no,,,print coordinates in GKI rather than NDC units +txquality,s,h,"normal","normal|low|medium|high",,character generator quality diff --git a/pkg/images/tv/iis/ids/doc/Imdis.hlp b/pkg/images/tv/iis/ids/doc/Imdis.hlp new file mode 100644 index 00000000..0ddd46e5 --- /dev/null +++ b/pkg/images/tv/iis/ids/doc/Imdis.hlp @@ -0,0 +1,793 @@ +.help imdis Dec84 "Image Display I/O" +.ce +\fBImage display I/O Design\fR +.ce +Richard Wolff +.ce +May 1985 +.sp 1 +.nh +Introduction + + The image display i/o interface uses the features of the GIO interface +to provide for the reading and writing of images and for the control of +the various subunits of a typical image display device. The cell array +calls of GIO are used for the image data, while the text and polyline +functions handle the text and line generation. Cursor reads are also +done with standard GIO calls. However, all the other display functions +are implemented through a series of GIO escape sequences, which are +described in this document. +.sp +.nh +Escape sequences + + Each sequence is described here, giving first a line with the count +of the number of words in the escape "instruction", followed by the data. +Since most of the data items might be more rationally considered arrays, +they are so indicated here. This means that in most cases, the number of +words in the escape instruction cannot be determined until run-time; an +indication of this is the use of "sizeof(arrays)" to indicate the number +of words in all the pseudo arrays. +.sp +Escape 10 -- reset +.ls +.tp 5 +1 hard/medium/soft +.ls +.nf +hard Clear image and graphics planes +medium reset all (lookup) tables to linear +soft reset scroll, zoom, cursor, alu, etc. +.fi +.le +.le +.sp +This sequence is used to preform various reset commands. These are not +done at GKOPENWS time because the user will not necessarily want to +upset the existing display when the image kernel is started up. +.sp +Escape 11 -- set image plane +.ls +.tp 4 +sizeof(arrays) IFA IBPL +.ls +.nf +IFA(i) image frame array +IBPL(i) image bit plane array +.fi +.le +.le +.sp +This sequence is essentially a header to the getcell/putcell calls. It +identifies both the frame(s) and bit plane(s) to be read or written. IFA +is an array of (short) integers, each of which specifies a plane (using +one indexing), the last element of the array being the integer IDS_EOD +to flag the End Of Data. IDS_EOD is a defined to be (-2). IBPL represents +the bit planes that are to be read or written for all the frames in IFA. +The data is IBPL is terminated with IDS_EOD. If the first element of IFA (or +IBPL) is IDS_EOD, all image frames (all bit planes) are involved in the I/O. +All "array" data are expected to be terminated with IDS_EOD, and the general +convention is maintained that IDS_EOD with no preceding data implies all +"frames", "colors", or whatever. +.sp +Escape 12 -- set graphics plane +.ls +.tp 4 +sizeof(arrays) GFA GBPL +.ls +.nf +GFA(i) graphics frame array +GBPL(i) graphics bit plane array +.fi +.le +.le +.sp +This sequence is identical to escape 11, but refers to graphics planes +instead of image planes. Generally, each graphics bit plane will refer to +a particular color, or perhaps, to a particular image plane. But there is +no enforced correspondence between graphics planes and image planes or colors. +The GFA specifies a set of graphics planes, and is probably unnecessary as the +bitplane array carries adequate information. Including it, however, retains +symmetry with escape 11. Thus, GFA cannot be omitted, for otherwise the +kernel would not know where GBPL started, but is set to IDS_EOD, and the +kernel can then find and ignore it. +.sp +Escape 13 -- display image +.ls +.tp 6 +1+sizeof(arrays) ON/OFF IFA ICOLOR IQUAD +.ls +.nf +ON/OFF turn frame on or off +IFA(i) image frame array +ICOLOR(i) image color array +IQUAD(i) image quadrant array (for split screen mode) +.fi +.le +.le +.sp +The specified image planes are all to be displayed in all the colors given +by ICOLOR. If ICOLOR(1) is IDS_EOD, a full color display is implied. +The quadrant value specifies which quadrant the frames are +to appear in--this is needed only when the split screen mode is in effect; +otherwise, IQUAD[1] = IDS_EOD. +.sp +Escape 14 -- display graphics +.ls +.tp 6 +1+sizeof(arrays) ON/OFF GBPL GCOLOR GQUAD +.ls +.nf +ON/OFF turn referenced planes on or off +GBPL(i) graphics bit plane array +GCOLOR(i) graphics color array +GQUAD(i) graphics quadrant array (for split screen mode) +.fi +.le +.le +.sp +This sequence is identical to escape 13, except for the substitution of +a bitplane array for frames, since graphics are usually treated bit by bit. +[With the IIS systems, for instance, this call requires manipulation of +the color-graphics lookup table.] +.sp +Escape 15 -- save device state +.ls +.tp 5 +1+sizeof(arrays) FD IFA GFA +.ls +.nf +FD file descriptor for save file +IFA(i) image frame array +GFA(i) graphics frame array +.fi +.le +.le +.sp +Saves the specified image frames and graphics planes and all the device +dependent status information in the file referenced by FD. Not implemented +in the Kernel (yet). +.sp +Escape 16 -- restore device state +.ls +.tp 5 +1+sizeof(arrays) FD IFA GFA +.ls +.nf +FD file descriptor for restore file +IFA(i) image frame array +GFA(i) graphics frame array +.fi +.le +.le +.sp +Restores the specified image frames and graphics planes and all the device +dependent status information from the file referenced by FD. Not implemented +in the Kernel (yet). +.sp +Escape 17 -- control +.ls +.tp 9 +4+sizeof(arrays) REG RW N FRAME COLOR OFFSET DATA +.ls +.nf +REG(i) control register or function +RW(i) read or write (write is 0, read 1, wait/read is 2) +N(i) Number of data values +FRAME(i) frame array +COLOR(i) color array +OFFSET(i) offset or other datum +DATA(Ni) array of data +.fi +.le +.le +.sp +Escape 18 is a very general sequence for writing any device +control register. Such "registers" include such generally available +capabilities as look-up tables, as well as specifics, such as min/max +registers. The upper level code may have to consult an "imagecap" +file to determine what it can request. + +FRAME, OFFSET, and COLOR, may not be needed for a particular operation, +but these arrays cannot be omitted; rather, use a one element array with +the value IDS_EOD. Should additional information be needed for an operation, +it can be transmitted in DATA. +.sp +.nh +Examples + +.sp +To clear all frames, one would issue the following sequence +.ls +.tp 4 +.nf +GKI_ESCAPE 11 IFA[1] = IDS_EOD IBPL[1] = IDS_EOD +GKI_CLEARWS +GKI_ESCAPE 12 IFA[1] = IDS_EOD IBPL[1] = IDS_EOD +GKI_CLEARWS +.fi +.le +.sp +To write an image to frame 2 ( IIS internal frame number 1 ) +.ls +.tp 2 +.nf +GKI_ESCAPE 11 IFA[1] = 2 IFA[2] = IDS_EOD IBPL[1] = IDS_EOD +GKI_PCELL data +.fi +.le +.sp +To activate frame 1 in red and green +.ls +.tp 2 +.nf +GKI_ESCAPE 13 IFA[1] = 1 IFA[2] = IDS_EOD ICOLOR[1] = IDS_RED + ICOLOR[2] = IDS_GREEN ICOLOR[3] = IDS_EOD + IQUAD[1] = IDS_EOD +.fi +.le +.sp +.bp +.nh +Defines + +This section presents the value and intended use of each of the various +defined constants. This list is likely to expand. + +.nf +define IDS_EOD (-2) # flag for end of data + +define IDS_RESET 10 # escape 10 +define IDS_R_HARD 0 # hard reset +define IDS_R_MEDIUM 1 # medium +define IDS_R_SOFT 2 +define IDS_R_SNAPDONE 3 # end snap + +define IDS_SET_IP 11 # escape 11 +define IDS_SET_GP 12 # escape 12 +define IDS_DISPLAY_I 13 # escape 13 +define IDS_DISPLAY_G 14 # escape 14 +define IDS_SAVE 15 # escape 15 +define IDS_RESTORE 16 # escape 16 + +# max sizes + +define IDS_MAXIMPL 16 # maximum number of image planes +define IDS_MAXGRPL 16 # maximum number of graphics planes +define IDS_MAXBITPL 16 # maximum bit planes per frame +define IDS_MAXGCOLOR 8 # maximum number of colors (graphics) +define IDS_MAXDATA 8192 # maximum data structure in display + +define IDS_RED 1 +define IDS_GREEN 2 +define IDS_BLUE 3 +define IDS_YELLOW 4 +define IDS_RDBL 5 +define IDS_GRBL 6 +define IDS_WHITE 7 +define IDS_BLACK 8 + +define IDS_QUAD_UR 1 # upper right quad.: split screen mode +define IDS_QUAD_UL 2 +define IDS_QUAD_LL 3 +define IDS_QUAD_LR 4 + +define IDS_CONTROL 17 # escape 17 +define IDS_CTRL_LEN 6 +define IDS_CTRL_REG 1 # what to control +define IDS_CTRL_RW 2 # read/write field in control instr. +define IDS_CTRL_N 3 # count of DATA items +define IDS_CTRL_FRAME 4 # pertinent frame(s) +define IDS_CTRL_COLOR 5 # and color +define IDS_CTRL_OFFSET 6 # generalized "register" +define IDS_CTRL_DATA 7 # data array + +define IDS_WRITE 0 # write command +define IDS_READ 1 # read command +define IDS_READ_WT 2 # wait for action, then read +define IDS_OFF 1 # turn whatever off +define IDS_ON 2 +define IDS_CBLINK 3 # cursor blink +define IDS_CSHAPE 4 # cursor shape + +define IDS_CSTEADY 1 # cursor blink - steady (no blink) +define IDS_CFAST 2 # cursor blink - fast +define IDS_CMEDIUM 3 # cursor blink - medium +define IDS_CSLOW 4 # cursor blink - slow + +define IDS_FRAME_LUT 1 # look-up table for image frame +define IDS_GR_MAP 2 # graphics color map...lookup table per + # se makes little sense for bit plane +define IDS_INPUT_LUT 3 # global input lut +define IDS_OUTPUT_LUT 4 # final lut +define IDS_SPLIT 5 # split screen coordinates +define IDS_SCROLL 6 # scroll coordinates +define IDS_ZOOM 7 # zoom magnification +define IDS_OUT_OFFSET 8 # output bias +define IDS_MIN 9 # data minimum +define IDS_MAX 10 # data maximum +define IDS_RANGE 11 # output range select +define IDS_HISTOGRAM 12 # output data histogram +define IDS_ALU_FCN 13 # arithmetic feedback function +define IDS_FEEDBACK 14 # feedback control +define IDS_SLAVE 15 # auxiliary host or slave processor + +define IDS_CURSOR 20 # cursor control - on/off/blink/shape +define IDS_TBALL 21 # trackball control - on/off +define IDS_DIGITIZER 22 # digitizer control - on/off + +define IDS_BLINK 23 # for blink request +define IDS_SNAP 24 # snap function +define IDS_MATCH 25 # match lookup tables + +# snap codes ... just reuse color codes from above. +define IDS_SNAP_RED IDS_RED # snap the blue image +define IDS_SNAP_GREEN IDS_GREEN # green +define IDS_SNAP_BLUE IDS_BLUE # blue +define IDS_SNAP_RGB IDS_BLACK # rgb image --- do all three +define IDS_SNAP_MONO IDS_WHITE # do just one + +# cursor parameters + +define IDS_CSET 128 # number of cursors per "group" + +define IDS_CSPECIAL 4097 # special "cursors" + # must be > (IDS_CSET * number of cursor groups) +define IDS_CRAW IDS_CSPECIAL # raw cursor read +define IDS_BUT_RD 4098 # "cursor number" for read buttons cmd +define IDS_BUT_WT 4099 # wait for button press, then read +define IDS_CRAW2 4100 # a second "raw" cursor +.fi +.nh +Explanation + + Most of the control functions of an image display do not fit within +the standard GIO protocols, which is why the escape function is provided. +However, image displays exhibit a wide range of functionality, and some +balance must be achieved between code portability/device independence and +use of (possibly peculiar) capabilities of a particular device. The control +functions (such as IDS_FRAME_LUT, IDS_CURSOR, IDS_SLAVE) "selected" here +are, for the most part, general functions, but the code was written with +the IIS Model 70 at hand (and in mind), and some "defines" reflect this. + + The model of the display is a device with some number of image frames, +each of which has associated with it an INPUT look-up table, used for +scaling or bit selection as data is written into the image frame; +a FRAME look-up table for each of the three primary colors, used to +alter the video stream from the image frame; combining logic that sums the +output of the various FRAME tables, forming three data streams, one for +each color; an OUTPUT look-up table that forms a final transformation +on each color prior to the data being converted to analog form; and +possibly, bias (OUT_OFFSET) and RANGE scaling applied somewhere in the +data stream (most likely near the OUTPUT look-up tables). + + Each image plane can be SCROLLed and ZOOMed independently (though +of course, not all devices can do this), and there may be SPLIT screen +capability, with the possibility of displaying parts of four images +simultaneously. + + Hooks have been provided in case there is a ALU or FEEDBACK hardware, +or there is a SLAVE processor, but use of these functions is likely to +be quite device dependent. The IIS can return to the user the MINimum +and MAXimum of a color data stream, and can also run a histogram on +selected areas of the display: There are "defines" pointing to these +functions, but their use is not yet specified and there is not yet +a clean way, within the GIO protocols, for reading back such data. + + Three functions that not so hardware oriented have "defines": +BLINK, MATCH and SNAP. The first is used if the hardware supports +blink. MATCH allows the kernel code to copy look-up tables---something +the upper level code could do were there a well defined mechanism for +reading non-image data back. SNAP is used to set-up the kernel so that +a subsequent set of get_cellarray calls can be used to return a data +stream that represents the digital data arriving at the +digital-to-analog converters: the kernel mimics the hardware and so +provides a digital snapshot of the image display screen. + + Images are loaded by a series of put_cellarray calls, preceded +by one IDS_SET_IP escape to configure the kernel to write the put_cell +data into the correct image planes (and optionally, specific bit planes). +The graphics planes are written to in the same manner, except that +IDS_SET_GP is used. It is not guaranteed that the SET_IP and SET_GP +are independent, and so the appropriate one should be given before +each put_cell sequence. Put_cells can be done for any arbitrary +rectangular array; they are turned into a series of writes to a +sequence of image rows by the GIO interface code. + + Calls to put_cell require the mapping of pixel coordinates +to NDC, which is made more complex than one might first +guess by the fact that the cell array operations are specified +by *inclusive* end points...See the write-up in "Note.pixel". + + Images planes are erased by the standard GIO gclear call, which +must be preceded by a SET_IP (or SET_GP for graphics). This is +perceived as reasonably consistent with the image loading as erasure +is loading with zeros, but presumably can be done far more efficiently +in most devices than with a series of put_cell calls. + + Images planes are turned on and off with IDS_DISPLAY_I, and graphics +planes with IDS_DISPLAY_G. Color and quadrant information must be +supplied as mentioned in the descriptions for escapes 13 and 14. + + The look-up tables are specified to the lower level code by giving +the end points of the line segments which describe the table function. +The end points are specified in NDC. This makes for a +simple, and device independent, upper level code. However, there is no +obvious (to the writer at least) code to invert the process, and return +end points for the simplest line segments that would describe a given +look-up table. (Moreover, there is no mechanism to return such information +to the upper level.) Therefore, the kernel code is asymmetric, in that +writes to the tables are fed data in the form of end points, but reads from +the tables (needed for the kernel implementation of SNAP) return the +requested number data values as obtained from the hardware. + + The control sequence for the ZOOM function requires, in addition to +the usual frame/color information, a zoom power followed by the GKI +coordinates of the pixel to be placed at the screen center. Likewise, +the SCROLL and SPLIT screen functions require GKI center coordinates. + + The OFFSET and RANGE sequences provide for bias and scaling of the +image data. Where they take effect is not specified. Offset requires +a signed number to be added to the referenced data; range is specified +by a small integer which selects the "range" of the data. + + Control of hardware cursors, trackballs, etc is provided: CURSOR +can be used to select cursor shape, blink rate, etc. Devices such as +(trackball) buttons are interrogated as if they are cursors, with a +cursor number that is greater than to IDS_CSPECIAL. The "key" value +returned by a "read" call to devices such as the trackball buttons will +be zero if no button was pressed or some positive number to represent +the activated device. Any "read" may be instructed to return +immediately (IDS_READ) or wait for some action (IDS_READ_WT); for +buttons, there are special IDS_BUT_RD/IDS_BUT_WT. + + Cursors are read and written through the standard GIO interface. +The cursor number ranges from 1 up through IDS_CSPECIAL-1. Each +frame has a set of set of cursors associated with it: frame n has +cursors numbered n, IDS_CSET+n, 2*IDS_CSET+n, etc. Currently, +IDS_CSPECIAL is 4097, and IDS_CSET is 128, so there can be 128 +different frames, each with 32 cursors. The coordinates associated +with a given cursor, and hence frame, are NDC for the pixel on which +the cursor is positioned. If a frame is not being displayed, a cursor +read for that frame will return NDC for the pixel that would appear at +the current cursor position if the frame were enabled. Note that the +NDC used in the cursor_set and cursor_read calls are relative to +the image planes in the display device; the fact the image data may +have come from a much larger user "world" is not, and can not be, +of any concern to the kernel code. + + Cursor 0 is special, and is not associated with a particular frame; +rather, the kernel is allowed to choose which frame to associate with +each cursor zero read or write. The IIS code picks the lowest numbered +frame that is on (being displayed). With split screen activated, a +frame can be "on" and not be seen; for cursor zero, what matters is +whether the frame video is active, not whether the split position +happens to be hiding the frame. The "key" value returned by the cursor +read routine is the frame number selected by the kernel. Cursor +IDS_CSPECIAL is also unusual, since it refers to the screen coordinates +and returns NDC for the screen. It is referred in the code as IDS_CRAW +(a "raw" cursor) and is needed for positioning the cursor at specific +points of the screen. + + The MATCH function requires that the frame and color information +of the control escape sequence point to the reference table; the +tables to be changed are given in the "data" part with the (IDS_EOD +terminated) frame sequence preceding the color information. The RW +field specifies which type of look-up table is to be changed. +.sp +.nh +Interface Routines + + The routines listed here are those used to implement the video +control package, and are found in the file "cvutil.x". +Arguments relating to image frames, image colors, display quadrants, +offset, range, and look-up table data are short integer arrays, +terminated by IDS_EOD. Cursor position (x and y) are NDC (hence, real). +All other arguments are integers. + +.ls cvclearg (frame, color) +Clears (erases) the given color (or colors) in the graphics frame given +by the argument "frame". For the IIS display, the "frame" argument +is not relevant, there being only one set of graphics frames. +.le +.ls cvcleari (frames) +Clears (erases) all bits in the given image display frames. +.le +.ls cv_rdbut +Reads the buttons on whatever device the kernel code associates with +this call, and returns an integer representing the button most recently +pressed. If none pressed, returns zero. +.le +.ls cv_wtbut +Same as cv_rdbut, but if no button pressed, waits until one is. This +routine will, therefore, always return a non-zero (positive) integer. +.le +.ls cv_rcur (cnum, x, y) +Reads the cursor "cnum" returning the NDC coordinates in x and y. The +mapping of cursor number to frame is described in the preceding +section: for cursors with numbers below IDS_CSET (128), the cursor +refers to the frame (cnum equal 5 means frame 5). +.le +.ls cv_scur (cnum, x, y) +Sets the cursor to the NDC given by x and y for the frame referenced by +cnum. +.le +.ls cv_scraw (x, y) +Sets the "raw cursor" to position (x,y). +.le +.ls cv_rcraw (x, y) +Reads the "raw cursor" position in (screen) NDC. +.le +.ls cvcur (cmd) +Turns the cursor on (cmd is IDS_ON) or off (IDS_OFF). +.le +.ls cvdisplay (instruction, device, frame, color, quad) +Turns on ("instruction" equals IDS_ON) image plane ("device" equals +IDS_DISPLAY_I) frame (or frames) in specified colors and quadrants. +Turn them off if "instruction" equals IDS_OFF. Manipulates graphics +planes instead if "device" equals IDS_DISPLAY_G. +.le +.ls cvmatch (type, refframe, refcolor, frames, color) +Copies the reference frame and reference color into the given frames +and color. For the IIS, "type" is either IDS_FRAME_LUT, referring to the +look-up tables associated with each frame, or IDS_OUTPUT_LUT, referring +to the global Output Function Memory tables. +.le +.ls cvoffset (color, data) +Sets the offset constants for the specified colors to values given in +"data"; if there are more colors given than corresponding data items, +the kernel will reuse the last data item as often as necessary. +.le +.ls cvpan (frames, x, y) +Moves the given frames so that the NDC position (x,y) is at the center +of the display. +.le +.ls cvrange (color, range) +Scales the output for the given colors; if there are more colors given +than corresponding range items, the kernel will reuse the last data item +as often as necessary. Range is a small number which specifies which +range the data is to be "put" in. For the IIS, there are only 4 useful +values (1,2,4, and 8); the kernel will map the requested value to the +next smallest legitimate one. +.le +.ls cvreset (code) +Resets the part of the display referenced by "code". For the IIS, a code +of IDS_R_HARD refers to (erasing) the image and graphics planes, IDS_R_MEDIUM +resets the various look-up tables, and IDS_R_SOFT resets the various registers +(such as zoom, scroll, range, split screen, and so forth). +.le +.ls cvsnap (filename, snap_color) +Creates an IRAF image file, named "filename", which represents the image +display video output for the specified color (IDS_SNAP_RED, IDS_SNAP_MONO, +etc). "filename" is a "char" array. The image is of the full display, +though, since the data is obtained from the kernel line by line via +get_cellarray calls, partial snapshots can be implemented easily. +.le +.ls cvsplit (x,y) +Sets the split screen point at NDC position (x,y). +.le +.ls cvtext (x, y, text, size) +Writes the given text at NDC position (x,y) in the specified size. +Currently, font and text direction are set to NORMAL. +.le +.ls cvwhich (frame) +Tells which frames are on. In the current implementation, this relies +on reading cursor 0: in this special case, the cursor variable passed +to ggcur() is changed by the kernel to reflect which frame it selected +(or ERR if no frame is active). +.le +.ls cvwlut (device, frames, color, data, n) +Writes the look-up tables associated with "frames" and "color". "device" +is IDS_FRAME_LUT or IDS_OUTPUT_LUT. The data to be written is given as +a series of line segments, and hence is described as a series of GKI +(x,y) pairs representing the line end points. For connected lines, +the first pair gives the first line segment starting coordinates, and all +following pairs the endpoints. The variable "n" gives the number of +values in "data"; there is no terminating IDS_EOD. +.le +.ls cvzoom (frames, power, x, y) +Zooms, to the given power, the specified frames with each frame +centered, after the zoom, at the given NDC position. +.le + + The following two support routines are included in the interface +package. +.ls cv_move (in, out) +Copies the short array "in" into the short array "out", up to and +including a trailing IDS_EOD. This procedure returns the number of +items copied. +.le +.ls cv_iset (frames) +Implements the image display escape sequence, with the bitplane +argument to that escape sequence set to "all". +.le +.ls cv_gset (colors) +Implements the graphics display escape sequence, with the image +argument to that escape sequence set to "all". +.le +.sp +.nh +Example + + The following code is used to pan (scroll) the image in response +to a changing cursor position. It is assumed that the "frame" array +consists of a list of frames to be panned together, terminated, as +is almost everything in this code, by IDS_EOD. +.nf + +# Pan subroutine + +procedure pansub (frames) + +short frames[ARB] # frames to pan + +int button +int cnum, cv_rdbut() +real x,y, xc, yc +real oldx, oldy + +begin + button = cv_rdbut() # clear buttons by reading them + call eprintf ("Press any button when done\n") + + # Where is cursor now? + # cv_rcraw uses the "RAW CURSOR" which reads and writes in + # screen (NDC) coordinates instead of image NDC. + + call cv_rcraw (xc,yc) + + # Pixel to NDC transformation is discussed in the file + # "Note.pixel" + + x = x_screen_center_in_NDC + y = y_screen_center_in_NDC + + call cv_scraw (x, y) # put cursor at screen center + + # Select a cursor---at least one per frame (conceptually at least) + + cnum = frames[1] + + # If cnum == IDS_EOD, the calling code did not select a frame. So, + # if cnum is 0, the kernel will select an active frame as the + # one to use when mapping NDC cursor positions to screen + # coordinates. + + if (cnum == IDS_EOD) + cnum = 0 + + # Determine NDC at screen center (where cursor was moved to) + # for frame of interest + call cv_rcur (cnum, x, y) + + # Restore cursor to original position + call cv_scraw (xc, yc) + + repeat { + oldx = xc + oldy = yc + repeat { + call cv_rcraw (xc, yc) + button = cv_rdbut() + } until ( (xc != oldx) || (yc != oldy) || (button > 0)) + # Determine change and reflect it about current screen + # center so image moves in direction cursor moves. + x = x - (xc - oldx) + y = y - (yc - oldy) + # If x or y are <0 or > 1.0, add or subtract 1.0 + "adjust x,y" + call cvpan (frames, x, y) + } until (button > 0) +end +.fi + [The call to cvpan may in fact need to be a series of calls, with +the array "frames" specifying one frame at a time, and (x,y) being the +new cursor position for that particular frame, so that differently panned +frames retain their relative offsets.] + The cursor and button routines are given here. +.nf + +# CV_RDBUT -- read button on trackball (or whatever) +# if none pressed, will get zero back + +int procedure cv_rdbut() + +int oldcnum +real x, y +int button +int gstati + +include "cv.com" + +begin + oldcnum = gstati (cv_gp, G_CURSOR) + call gseti (cv_gp, G_CURSOR, IDS_BUT_RD) + call ggcur (cv_gp, x, y, button) + call gseti (cv_gp, G_CURSOR, oldcnum) + return(button) +end + +# CV_RCUR -- read cursor. The cursor read/set routines do not restore +# the cursor number...this to avoid numerous stati/seti calls that +# usually are not needed. + +procedure cv_rcur (cnum, x, y) + +int cnum +real x,y +int junk + +include "cv.com" + +begin + call gseti (cv_gp, G_CURSOR, cnum) + call ggcur (cv_gp, x, y, junk) +end + +# CV_SCUR -- set cursor + +procedure cv_scur (cnum, x, y) + +int cnum +real x,y + +include "cv.com" + +begin + call gseti (cv_gp, G_CURSOR, cnum) + call gscur (cv_gp, x, y) +end + +# CV_SCRAW -- set raw cursor + +procedure cv_scraw (x, y) + +real x,y + +begin + call cv_scur (IDS_CRAW, x, y) +end +.fi + + The routine cv_move copies its first argument to the second up through +the required IDS_EOD termination, returning the number of items copied. +"cv_stack" is a pointer to a pre-allocated stack area that is used to +build the data array passed to the GIO escape function. + +.nf +# cvpan -- move the image(s) around + +procedure cvpan (frames, x, y) + +short frames[ARB] +real x,y # position in NDC +int count, cv_move() + +include "cv.com" + +begin + Mems[cv_stack] = IDS_SCROLL # Control Unit + Mems[cv_stack+1] = IDS_WRITE # Read/Write + + # Three is the number of data items (two coordinates) plus the + # terminating IDS_EOD. In many escape sequences, this number + # must be determined from the data rather than known in advance. + + Mems[cv_stack+2] = 3 + + # Move the frame data, which is of "unknown" length + + count = cv_move (frames, Mems[cv_stack+3]) + + # Color is unimportant here, but the color data must exist. The + # simplest solution is to use IDS_EOD by itself. + + Mems[cv_stack+3+count] = IDS_EOD # default to all colors + Mems[cv_stack+4+count] = 1 # (unused) offset + Mems[cv_stack+5+count] = x * GKI_MAXNDC + Mems[cv_stack+6+count] = y * GKI_MAXNDC + Mems[cv_stack+7+count] = IDS_EOD # for all frames + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], count+8) +end +.fi +.endhelp diff --git a/pkg/images/tv/iis/ids/doc/Note.misc b/pkg/images/tv/iis/ids/doc/Note.misc new file mode 100644 index 00000000..4b3a22de --- /dev/null +++ b/pkg/images/tv/iis/ids/doc/Note.misc @@ -0,0 +1,8 @@ +To implement a full device save/restore, we need: +zdev_restore(fd) +zdev_save(fd) +zim_save(fd,ipl) +zgr_save(fd,gpl) +zim_restore(fd,ipl) +zgr_restore(fd,gpl) +...zgr are just entry points into zim_{save,restore}(fd,pl) diff --git a/pkg/images/tv/iis/ids/doc/Note.pixel b/pkg/images/tv/iis/ids/doc/Note.pixel new file mode 100644 index 00000000..91c0338f --- /dev/null +++ b/pkg/images/tv/iis/ids/doc/Note.pixel @@ -0,0 +1,106 @@ + Herein is described how pixel coordinates should be encoded into +GKI metacode units and how this data is then converted back to pixel numbers +by the "lower level" code. For concreteness, the discussion is based on +a 512 x 512 display, where the pixels are numbered from 1 to 512 (one-based) +or 0 to 511 ( zero based). Only the X axis is discussed, the Y axis +being treated identically. + GKI metacode ranges from 0 through 32767, for a total of 32768 +values. In NDC coordinates, the range is from 0.0 through 1.0. +These coordinates are show in the diagram following. +.sp +.nf +last GKI coordinate of pixel + 63 127 191 255 319 32703 32767(!) +pixel | | | | | | | +extent-- |<-->||<-->||<-->||<-->||<-->|| ... |<-->||<--->| + | | | | | | | +the |-----|-----|-----|-----|-----| ... |-----|-----| +pixels | | | | | | ... | | | + |-----|-----|-----|-----|-----| ... |-----|-----| +num- (1-b) 1 2 3 4 5 511 512 +bers (0-b) 0 1 2 3 4 510 511 + | | | | | | ... | | | +GKI 0 64 128 192 256 320 32640 32704 32767(!) + | | | | | | ... | | | +NDC 0.0 1/512 2/512 3/512 4/512 5/512 511/512 1.0 +.fi +.sp + The pixels are not points, but rather, in GKI/NDC space, have +"physical" extent. In NDC coordinates, the pixel boundaries are +easily calculated as (left boundary = zero-based pixel number / 512) +and (right boundary = 1-based pixel number / 512). In GKI coordinates, +each pixel spans 64 GKI units, with the left boundary given by +"zero-based pixel number times 64". The right boundary is then the +left boundary plus 64 and then actually references the next pixel. +That is, the left boundary is included in the pixel, while the right +boundary is not. +(Pixel 0 goes from 0 through 63, pixel one from 64 through 127, etc.) +This works for all pixels except the last one, which would have a +right boundary of 32768; in this special case, the right boundary +is defined to be 32767. As will be seen later on, this should cause +no difficulties. + Explicit reference to a particular pixel should, in GKI +coordinates, refer to the pixel's left (or for Y, lower) edge. Thus, +pixel 7 (one-based system) is, in GKI, 6*64 or 384. + Cell arrays are denoted by their lower-left and upper-right +corners, with the understanding that all pixels WITHIN this rectangle +are to be read/written. Thus, an array that covers (one-based) +(4,10) to (18, 29) implies that, in X, pixels 4 through 17 are referenced. +Therefore, the GKI coordinate range is from 3*64 up to 17*64, where +3*64 is the GKI coordinate for the left edge of pixel 4 and 17*64 is +the GKI coordinate for the right edge of pixel 17. (Remember, the +right edge of pixel 512 is 32767, not 32768.) + The (real) NDC coordinate that is then passed to the interface code +is determined by dividing the GKI coordinate by 32767. The interface +code will, ultimately, multiply by 32767 to give the GKI coordinates +passed to the lower level. + The lower level code translates the GKI coordinate values into +zero-based pixel numbers by multiplying by 512/32768 ( not 32767). +The (real) pixel numbers so determined are then truncated, and become +the ones to scroll to, zoom to, or put the cursor on. Therefore, +when refering to single pixels for such operations, use the left +boundary of the pixel as the desired GKI/NDC coordinate. + Pixel computation for cell arrays is somewhat more complicated. +The right boundary of a cell array can be the left boundary for +an adjacent cell array; if the simple truncation scheme were used, that +coordinate would be included in both cell array operations, which is not +acceptable (especially for hard copy devices where the resultant overplotting +would be, at best, objectionable). This problem gives rise to the following +algorithm. Left (and lower) positions are rounded up to the next pixel +boundary if the fractional position is greater than or equal 0.5. Right +(and upper) positions are rounded down to the next pixel boundary if the +fractional position is less than 0.5; since a fractional pixel value of 0.0 +is less than 0.5, the right/upper pixel will be decreased even if it is +already on a boundary. The truncated values are then used as the +INCLUSIVE range of pixels to read or write. (If the positions lie +within the same pixel, that pixel becomes the X (or Y) range. If the +positions are in adjacent pixels, the right pixel operation is +not done if the left pixel moves into the same pixel as the right one.) + With this algorithm, the right edge of the display (NDC=1.0, +GKI=32767) becomes position 511.98, which is not rounded down as the +fractional part is >= 0.5, and, which, when truncated, turns into 511 +which is what is desired as the (last) included pixel in the range. + + For zoomed (image) displays, fractional pixel coordinates are +possible in the sense that, for a zoom of 4, pixels 16.0, 16.25, +16.50, and 16.75, all refer to the same datum. When setting the cursor, +the lower level code must distinguish all these cases, which have GKI +values (from a one-based coordinate system) 960, 976, 992, and 1008. +The lower level code will return these fractional pixel values when reading +the cursor, but the integral value is the real reference to the data +point. However, calls to the getcell and putcell routines should use +16 (aka 960) or the cell array rounding will interfere with what is +wanted. This does restrict getcell calls from starting/ending in the middle +of a zoomed (replicated) pixel, but makes the behavior of getcell +the same as putcell, which cannot write into the middle of a zoomed pixel. + + In summary, users should reference individual pixels by +specifying their left (or lower) boundaries in GKI/NDC. For cursor +reference on zoomed displays, fractional (in the sense outlined above) +pixels may be referenced. Right (or upper) boundaries are used only +for cell arrays, and except for the very right-most, are determined by +the user in an operation similar to that for the left boundaries. GKI +coordinates that are a little too large (not more than 31 units for a +512 resolution device) will be rounded/truncated to the desired +coordinate. For cell array operations only, ones a little too small +will still address the correct pixel. diff --git a/pkg/images/tv/iis/ids/doc/file.doc b/pkg/images/tv/iis/ids/doc/file.doc new file mode 100644 index 00000000..504a8330 --- /dev/null +++ b/pkg/images/tv/iis/ids/doc/file.doc @@ -0,0 +1,90 @@ +Some notes on the fio system. + Binary files. + open the binary file with + fio_fd = fopnbf(dev_name, mode, zopn_dev, zard_dev, zawr_dev, + zawt_dev, zstt_dev, zcl_dev) + where dev_name is a char string, terminated with EOS, + mode is READ_ONLY, READ_WRITE, WRITE_ONLY, NEW_FILE, APPEND, + TEMP_FILE, NEW_COPY + and the z routines are for open, read, write, wait, get status, + and close ( see system interface reference manual). + + The fio_fd that is returned is then used in calls to read, write, and flush. + They have the form write(fio_fd, buffer, #_of_chars) + read (fio_fd, buffer, #_of_chars) + flush(fio_fd) + seek (fio_fd, loffset) + long = note (fio_fd) + The output data will be buffered in a buffer of CHAR size as set by + a kernel call to zstt(). This can be overridden by + fsetl(fio_fd, F_BUFSIZE, buffer_size_in_char) + Partially filled buffers can be forced out by "flush". + Input data is buffered up before being made available to the + user; if an i/o call is needed to fill the buffer and it returns with + an inadequate number of data items, then the read returns with fewer + than requested itmes. + The file system can be made to use an external (local) buffer by + fseti(fio_fd, F_BUFPTR, new_buffer) + For general image i/o, it is desirable to set the ASYNC parameter to YES + fseti(fio_fd, F_ASYNC, YES) + If the device has a specific block size, this can be set by + fseti(fio_fd, F_BLKSIZE, value); + the file system will use this value for checking validity of block offsets + in reads and writes. If the value is zero, the device is considered a + "streaming" device, and no checks are done. + +(from Doug) +The device block size parameter is set at open time by all call to ZSTT__. +FIO is permissive and allows one to set almost anything with FSET, but some +of the parameters are best considered read only. This is documented at the +parameter level in <fset.h>. + +Image displays are NOT streaming devices, they are random access, block +structured devices. If you wish to defeat block alignment checking then +ZSTT__ may return a block size of 1 char. Note that not all image displays +are addressable at the pixel level. Even those that are are may be most +efficiently accessed using line at a time i/o (block size equals 1 line). + +If the block size is set to 1 FIO will still access the device in chunks +the size of the FIO buffer. The file area is partitioned up into a series +of "pages" the size of the FIO buffer and FIO will fault these pages in and +out when doing i/o. The only advantages of a block size of 1 are that the +FIO buffers may be any size (not much of an advantage), and more significantly, +AREAD and AWRITE calls may be used to randomly access the device. The latter +are asynchronous and are not buffered, and are the lowest level of i/o +provided by FIO. + + The form for the z routines is + zopn_dev(dev_name, mode, channel) + zard_dev(channel, buffer, length, offset) + zawr_dev(channel, buffer, length, offset) + zawt_dev(channel, bytes_read/written) + zstt_dev(channel, what, lvalue) + zcl_dev (channel, status) + + where channel is some number to be used however the z routines want, but + in the simplest case and under UNIX, would be the file descriptor of the + open file as determined by zopn_dev, or, in case of error, is ERR. + length and offset are in BYTES. zstt_dev() will be handled locally. + +Bytes, yes, but the file offsets are one-indexed. See the System Interface +reference manual. + + Each of the z*_dev routines above, with the exception of zstt_dev, will + ultimately result in a call to one of the system z routines for binary + files: zopnbf, zardbf, zawrbf, zawtbf, zclsbf. These routines take + the same arguments as the z*_dev routines, with the exception that + unix_fd is to be substituted for channel. "unix_fd" is the actual + file descriptor that results from the "real" open of the device by + zopnbf. It does not need to be visible above the z*_dev routines. + +The FIO z-routines for a device do not necessarily resolve into calls to the +ZFIOBF driver. It is desirable to structure things this way if we can since +it reduces the size of the kernel, but if necessary the z-routines can be +system dependent. Since the IIS is data driven and is interfaced in UNIX +as a file we were able to use the existing ZFIOBF driver, resulting in a +very clean interface. New devices should also be interfaced this way if +possible. For various reasons a data stream interface is almost always +preferable to a control interface (like Sebok's Peritek driver). I would +seriously consider adding a layer on a control driven device driver to make +it appear to be data driven, if the driver itself could not be modified. diff --git a/pkg/images/tv/iis/ids/doc/iis.doc b/pkg/images/tv/iis/ids/doc/iis.doc new file mode 100644 index 00000000..450de91a --- /dev/null +++ b/pkg/images/tv/iis/ids/doc/iis.doc @@ -0,0 +1,172 @@ +.TL +The IIS Image Display +.AU +Richard Wolff +.br +Central Computer Services +National Optical Astronomy Observatories +Tucson, Arizona +.DA +.PP +The International Imaging Systems (IIS) Model 70f is a reasonably +flexible image display with some more advanced capabilities than the IPPS, +(and, sad to say, some less advanced ones as well). This note describes +the hardware so that the user can use the device to best advantage. +The Model 75, which is in use at CTIO, is more elaborate still, but its +fundamental properties are the same as the 70f boxes in use at NOAO. +.PP +The image display has four image planes (frames, memories), each of which +can hold a 512 x 512 8 bit image. (The hardware can support 12 such planes, +but only four are installed in the NOAO units.) These planes are loaded +directly from the host computer; while there is hardware to support a +13-bit input/8-bit output mapping during load, this is not currently used +at NOAO. The frames are numbered 1 through 4 and there is nothing to +distinguish one from another. More than one image plane may be displayed +at one time; this may create a rather messy screen image, but, of course, +the hardware doesn't care. +.PP +The image is generated by hardware that +addresses each pixel in turn, and sends the data at that location to the +video display. Panning (scrolling/roaming) is accomplished simply by +starting the address generation somewhere other than at the normal starting +place. +Each plane has its own starting address, which just means that each +plane can be panned independently. In contrast, on the model 70, +all planes zoom together. Zooming is done by pixel replication: +The master address generator +"stutters", duplicating an address 2, 4, or 8 times before moving on to +the next pixel (and duplicating each line 2, 4, or 8 times--an additional +complication, but a necessary one, which is of interest only to hardware types). +The master address is then added to the per-image start address +and the resulting address streams are used to generate +the per-image data streams, which are added together to form the final image. +The net result of this is an image on the screen, with user control of the +placement of each image plane, and with one overall "magnification" factor. +.PP +If more than one image is active, the pixel values for a given screen +position are \fBadded\fR together. Thus, with four image planes, each of +which has pixels that can range in value from 0 through 255, the output +image can have pixel values that range from 0 through 3060. Unfortunately, +the output hardware can handle only values from 0 through 1023. But, +fortunately, hardware has been included to allow the use to offset and +scale the data back to the allowed output range. We will look at that +in more detail later. +.PP +The hardware that determines which frames are to be displayed consists +of "gates" that enable or disable the frame output to the image screen. +These "gates" are controlled by various data bits in the hardware. +Conceptually, given the description in the previous paragraphs, one can +imagine one bit (on or off) for each image frame, and it is these +bits that the \fBdi\fR command turns on and off. However, there are +complications, one of which is the split screen mode. Split screen +hardware allows the user to specify a point, anywhere on the screen, +where the screen will be divided into (generally, unequally sized) quadrants. +The display control bits specify not only which images will be active, +but in which of the four quadrants they will be active. +There are four control bits per image plane, and so, any image can +be displayed in any number of quadrants (including none, which means the +image is "off"). +.PP +If one imagines the split screen point in the middle of the screen, then +four quadrants are visible, number 1 being the upper right, number 4 the bottom +right, etc. As the split screen point is moved to the upper left, quadrant +four increases in size and the other three decrease. When the split point +reaches the top left corner (\fIIRAF\fR coordinate (1,512)), only quadrant +four is left. Due to a hardware decision, this is the normal, non-split, +screen configuration, the one you get when you type the \fBs o\fR command. +It would make more sense to set the non-split position so the screen was +filled with quadrant one, but the hardware won't allow it. So, be +warned, if you have a split screen display, +and then reset the split point to the "unsplit" point, +what you see will be only what you had displayed in quadrant 4. +.PP +The model 70f is a color display, not monochrome, and this adds more +complexity. What happens is that the data from each enabled image plane +is replicated and sent to three \fIcolor pipelines\fR, +one for the \fIred\fR gun of the monitor, one for the \fIgreen\fR, +and one for the \fIblue\fR. If the pipeline data streams are +the same, we get a black and white image. If they differ, the +final screen image is colored. Since there are really three data streams +leaving each image plane, it should not be surprising that there are +display control bits for each color, as well as each quadrant, of each +image. Thus (and finally) there are 12 control bits, three colors in each +of four quadrants, for each image plane. One can set up a display with +different images in different quadrants, and each colored differently! +Of course, the coloration is somewhat primative as the choices are limited +to red on or off, green on or off, both red and green on (yellow), blue on +or off, etc. More control comes with look-up tables. +.PP +The data from the combined image planes is added together in the pipelines. +There are offset and range registers for each pipeline which allow you to +bias and scale the data. Offset allows you to add or subtract a 13 bit +number (+-4095) and range scales the data by a factor of 1,2,4, or 8. +These are of interest mostly when more than one image is combined; in this +case, the resulting stream of data should be adjusted so that it +has its most interesting data in the range 0 through 1023. +.PP +Why 1023? The reason is that after offset and range have taken their +toll, the data is "passed through" a 10 bit in/10 bit out look-up table. +Look-up tables are digital functions in which each input datum is used +as an index into a table and the resultant value that is thus "looked-up" +replaces the datum in the data stream. The look-up tables here +are known as the \fIoutput\fR +tables (or, as IIS would have it, the "Output Function Memories"). +There is one for +each of the three pipelines, and each accepts an input value of 10 bits, +which limits the data stream to 0 through 1023, +If the image data in the three pipelines are the same, and the output +tables are too, then a black and white image results. If, however, the +pipelines are identical but the tables are different, a colored image +results. Since this image is not a true color image, +but simply results from manipulating the three identical color +pipelines in differing ways, the result is called a pseudo-color image. +.PP +The simplest look-up table is a linear function, whose input values run +from 0 through 1023 and whose output values do the same. The trouble +with such a linear output table is that the usual case is a single image +being displayed, in which case the pipeline data is never more than 255. +With the unit slope table, the maximum output would be 255, which is +one-quarter of full intensity. A better table in this case would be one of +slope 4, so 255 would map to 1023 (maximum output). This is what the +default is, and above 255 input, all values are mapped to 1023. If, +however, two images are being displayed, then data values may be larger +than 255 (at overlap points), and as these all map to 1023, only full white +results. The range/offset registers may be of use here, or a different +output table should be used. +.PP +The output of the "output" tables is combined with the graphics and cursor +data and sent to the display screen. The graphics planes are one bit +deep; there are seven of them, and together with the cursor, they form +an "image" 8 bits deep. In this sense, the graphics planes are just +like image data, and in particular, they pan and zoom just as the +image planes do. Of course, the cursor is different. The graphics +planes are sent through a look-up table of their own, which determines +what happens when one graphics plane crosses/overlaps others and/or the +cursor. The resultant data replaces the pipeline data. The graphics +data can be added to the pipeline data instead of replacing it, but this +feature is not available in \fIcv\fR at this time. The cursor is really +a writable 46x64 bit array; thus, its shape can be changed, a feature +that may be made available to users. Note that there is no quadrant/split +screen control for the graphics planes. +.PP +The final complication, at least as far as the current software is +concerned, is that each image plane has its own set of three look-up +tables, one for each color. Thus, there are 4x3 frame look-up tables +and three output tables. The image tables affect only the data from +the associated image plane. It is the output of these tables that +forms the input to the three color pipelines. Each table is an 8 bit in/9 +bit out table, with the output being treated as a signed number (255 to +-256). (Combining 12 9 bit numbers (a full model 70f) can produce a 13 bit +number, which is why the offset hardware accepts 13 bit numbers.) In +the \fIcv\fR software, only positive numbers are used as output from +the tables. Typically, the image tables are loaded with linear +functions of varying slope and intercept. +.PP +With the two sets of tables, image and output, it is possible to create +all sorts of interesting pseudo-color images. One possibility is to +place the appropriate three mappings in the output tables so as to create +the color (for instance, red can be used only for pixels with large +values, blue for low values, green for middling ones). Then the image +tables can be set to adjust the contrast/stretch of the each image +individually, producing, one assumes, useful and/or delightful +pseudo-color images. diff --git a/pkg/images/tv/iis/ids/font.com b/pkg/images/tv/iis/ids/font.com new file mode 100644 index 00000000..ec1b0ec9 --- /dev/null +++ b/pkg/images/tv/iis/ids/font.com @@ -0,0 +1,207 @@ +# CHRTAB -- Table of strokes for the printable ASCII characters. Each character +# is encoded as a series of strokes. Each stroke is expressed by a single +# integer containing the following bitfields: +# +# 2 1 +# 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 +# | | | | | | | +# | | | +---------+ +---------+ +# | | | | | +# | | | X Y +# | | | +# | | +-- pen up/down +# | +---- begin paint (not used at present) +# +------ end paint (not used at present) +# +#------------------------------------------------------------------------------ + +# Define the database. + +short chridx[96] # character index in chrtab +short chrtab[800] # stroke data to draw the characters + +# Index into CHRTAB of each printable character (starting with SP). + +data (chridx(i), i=01,05) / 1, 3, 12, 21, 30/ +data (chridx(i), i=06,10) / 45, 66, 79, 85, 92/ +data (chridx(i), i=11,15) / 99, 106, 111, 118, 121/ +data (chridx(i), i=16,20) / 128, 131, 141, 145, 154/ +data (chridx(i), i=21,25) / 168, 177, 187, 199, 203/ +data (chridx(i), i=26,30) / 221, 233, 246, 259, 263/ +data (chridx(i), i=31,35) / 268, 272, 287, 307, 314/ +data (chridx(i), i=36,40) / 327, 336, 344, 352, 359/ +data (chridx(i), i=41,45) / 371, 378, 385, 391, 398/ +data (chridx(i), i=46,50) / 402, 408, 413, 425, 433/ +data (chridx(i), i=51,55) / 445, 455, 468, 473, 480/ +data (chridx(i), i=56,60) / 484, 490, 495, 501, 506/ +data (chridx(i), i=61,65) / 511, 514, 519, 523, 526/ +data (chridx(i), i=66,70) / 529, 543, 554, 563, 574/ +data (chridx(i), i=71,75) / 585, 593, 607, 615, 625/ +data (chridx(i), i=76,80) / 638, 645, 650, 663, 671/ +data (chridx(i), i=81,85) / 681, 692, 703, 710, 723/ +data (chridx(i), i=86,90) / 731, 739, 743, 749, 754/ +data (chridx(i), i=91,95) / 759, 764, 776, 781, 793/ +data (chridx(i), i=96,96) / 801/ + +# Stroke data. + +data (chrtab(i), i=001,005) / 36, 1764, 675, 29328, 585/ +data (chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/ +data (chrtab(i), i=011,015) / 1764, 355, 29023, 351, 29027/ +data (chrtab(i), i=016,020) / 931, 29599, 927, 29603, 1764/ +data (chrtab(i), i=021,025) / 603, 29066, 842, 29723, 1302/ +data (chrtab(i), i=026,030) / 28886, 143, 29839, 1764, 611/ +data (chrtab(i), i=031,035) / 29256, 78, 20810, 21322, 21581/ +data (chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/ +data (chrtab(i), i=041,045) / 20833, 21345, 29789, 1764, 419/ +data (chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/ +data (chrtab(i), i=051,055) / 21022, 21025, 20899, 1187, 28744/ +data (chrtab(i), i=056,060) / 717, 21194, 21320, 21512, 21642/ +data (chrtab(i), i=061,065) / 21645, 21519, 21327, 21197, 1764/ +data (chrtab(i), i=066,070) / 1160, 20700, 20704, 20835, 21027/ +data (chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/ +data (chrtab(i), i=076,080) / 21192, 29841, 1764, 611, 21023/ +data (chrtab(i), i=081,085) / 21087, 21155, 21091, 1764, 739/ +data (chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/ +data (chrtab(i), i=091,095) / 1764, 547, 21151, 21210, 21201/ +data (chrtab(i), i=096,100) / 21132, 29192, 1764, 93, 29774/ +data (chrtab(i), i=101,105) / 608, 29259, 78, 29789, 1764/ +data (chrtab(i), i=106,110) / 604, 29260, 84, 29780, 1764/ +data (chrtab(i), i=111,115) / 516, 21062, 21065, 21001, 21000/ +data (chrtab(i), i=116,120) / 21064, 1764, 84, 29780, 1764/ +data (chrtab(i), i=121,125) / 585, 21063, 21191, 21193, 21065/ +data (chrtab(i), i=126,130) / 21191, 1764, 72, 29859, 1764/ +data (chrtab(i), i=131,135) / 419, 20573, 20558, 20872, 21320/ +data (chrtab(i), i=136,140) / 21646, 21661, 21347, 20899, 1764/ +data (chrtab(i), i=141,145) / 221, 21155, 29320, 1764, 95/ +data (chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/ +data (chrtab(i), i=151,155) / 20552, 29832, 1764, 95, 20899/ +data (chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/ +data (chrtab(i), i=161,165) / 854, 5266, 21644, 21320, 20872/ +data (chrtab(i), i=166,170) / 28749, 1764, 904, 21411, 21283/ +data (chrtab(i), i=171,175) / 20561, 20559, 21391, 911, 13455/ +data (chrtab(i), i=176,180) / 1764, 136, 21320, 21645, 21652/ +data (chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/ +data (chrtab(i), i=186,190) / 1764, 83, 20888, 21336, 21651/ +data (chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/ +data (chrtab(i), i=196,200) / 20635, 29347, 1764, 99, 21667/ +data (chrtab(i), i=201,205) / 29064, 1764, 355, 20575, 20570/ +data (chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/ +data (chrtab(i), i=211,215) / 21644, 21650, 21398, 20822, 918/ +data (chrtab(i), i=216,220) / 5274, 21663, 21411, 20835, 1764/ +data (chrtab(i), i=221,225) / 648, 21584, 21656, 21662, 21347/ +data (chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/ +data (chrtab(i), i=231,235) / 21656, 1764, 602, 21210, 21207/ +data (chrtab(i), i=236,240) / 21079, 21082, 21207, 592, 21069/ +data (chrtab(i), i=241,245) / 21197, 21200, 21072, 21197, 1764/ +data (chrtab(i), i=246,250) / 602, 21146, 21143, 21079, 21082/ +data (chrtab(i), i=251,255) / 21143, 585, 21132, 21136, 21072/ +data (chrtab(i), i=256,260) / 21071, 21135, 1764, 988, 20628/ +data (chrtab(i), i=261,265) / 29644, 1764, 1112, 28824, 144/ +data (chrtab(i), i=266,270) / 29776, 1764, 156, 21460, 28812/ +data (chrtab(i), i=271,275) / 1764, 221, 20704, 20899, 21218/ +data (chrtab(i), i=276,280) / 21471, 21466, 21011, 21007, 521/ +data (chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/ +data (chrtab(i), i=286,290) / 1764, 908, 20812, 20560, 20571/ +data (chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/ +data (chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/ +data (chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/ +data (chrtab(i), i=306,310) / 1764, 72, 20963, 21219, 29768/ +data (chrtab(i), i=311,315) / 210, 5074, 1764, 99, 21411/ +data (chrtab(i), i=316,320) / 21663, 21658, 21398, 20566, 918/ +data (chrtab(i), i=321,325) / 5266, 21644, 21384, 20552, 20579/ +data (chrtab(i), i=326,330) / 1764, 1165, 21320, 20872, 20557/ +data (chrtab(i), i=331,335) / 20574, 20899, 21347, 29854, 1764/ +data (chrtab(i), i=336,340) / 99, 21347, 21662, 21645, 21320/ +data (chrtab(i), i=341,345) / 20552, 20579, 1764, 99, 20552/ +data (chrtab(i), i=346,350) / 29832, 86, 13078, 99, 29859/ +data (chrtab(i), i=351,355) / 1764, 99, 20552, 86, 13078/ +data (chrtab(i), i=356,360) / 99, 29859, 1764, 722, 21650/ +data (chrtab(i), i=361,365) / 29832, 1165, 4936, 20872, 20557/ +data (chrtab(i), i=366,370) / 20574, 20899, 21347, 29854, 1764/ +data (chrtab(i), i=371,375) / 99, 28744, 85, 5269, 1160/ +data (chrtab(i), i=376,380) / 29859, 1764, 291, 29603, 611/ +data (chrtab(i), i=381,385) / 4680, 328, 29576, 1764, 77/ +data (chrtab(i), i=386,390) / 20872, 21256, 21581, 29795, 1764/ +data (chrtab(i), i=391,395) / 99, 28744, 1160, 20887, 82/ +data (chrtab(i), i=396,400) / 13475, 1764, 99, 20552, 29832/ +data (chrtab(i), i=401,405) / 1764, 72, 20579, 21077, 21603/ +data (chrtab(i), i=406,410) / 29768, 1764, 72, 20579, 21640/ +data (chrtab(i), i=411,415) / 29859, 1764, 94, 20899, 21347/ +data (chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/ +data (chrtab(i), i=421,425) / 20574, 862, 29859, 1764, 72/ +data (chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/ +data (chrtab(i), i=431,435) / 20564, 1764, 94, 20557, 20872/ +data (chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/ +data (chrtab(i), i=441,445) / 20574, 536, 29828, 1764, 72/ +data (chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/ +data (chrtab(i), i=451,455) / 20566, 918, 13448, 1764, 76/ +data (chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/ +data (chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/ +data (chrtab(i), i=466,470) / 29855, 1764, 648, 21155, 99/ +data (chrtab(i), i=471,475) / 29923, 1764, 99, 20557, 20872/ +data (chrtab(i), i=476,480) / 21320, 21645, 29859, 1764, 99/ +data (chrtab(i), i=481,485) / 21064, 29795, 1764, 99, 20808/ +data (chrtab(i), i=486,490) / 21141, 21448, 29923, 1764, 99/ +data (chrtab(i), i=491,495) / 29832, 72, 29859, 1764, 99/ +data (chrtab(i), i=496,500) / 21079, 29256, 599, 13411, 1764/ +data (chrtab(i), i=501,505) / 99, 21667, 20552, 29832, 1764/ +data (chrtab(i), i=506,510) / 805, 20965, 20935, 29447, 1764/ +data (chrtab(i), i=511,515) / 99, 29832, 1764, 421, 21221/ +data (chrtab(i), i=516,520) / 21191, 29063, 1764, 288, 21091/ +data (chrtab(i), i=521,525) / 29600, 1764, 3, 29891, 1764/ +data (chrtab(i), i=526,530) / 547, 29341, 1764, 279, 21207/ +data (chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/ +data (chrtab(i), i=536,540) / 20558, 20753, 21201, 21391, 907/ +data (chrtab(i), i=541,545) / 13447, 1764, 99, 28744, 76/ +data (chrtab(i), i=546,550) / 4424, 21256, 21516, 21523, 21271/ +data (chrtab(i), i=551,555) / 20823, 20563, 1764, 981, 21271/ +data (chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/ +data (chrtab(i), i=561,565) / 29642, 1764, 1043, 4887, 20823/ +data (chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=571,575) / 1032, 29731, 1764, 80, 5136/ +data (chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/ +data (chrtab(i), i=581,585) / 20808, 21256, 29707, 1764, 215/ +data (chrtab(i), i=586,590) / 29591, 456, 20958, 21153, 21409/ +data (chrtab(i), i=591,595) / 29727, 1764, 67, 20800, 21248/ +data (chrtab(i), i=596,600) / 21508, 29719, 1043, 21271, 20823/ +data (chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=606,610) / 1764, 99, 28744, 83, 4439/ +data (chrtab(i), i=611,615) / 21271, 21523, 29704, 1764, 541/ +data (chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/ +data (chrtab(i), i=621,625) / 533, 21077, 29256, 1764, 541/ +data (chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/ +data (chrtab(i), i=631,635) / 533, 21077, 21058, 20928, 20736/ +data (chrtab(i), i=636,640) / 28802, 1764, 99, 28744, 84/ +data (chrtab(i), i=641,645) / 29530, 342, 13320, 1764, 483/ +data (chrtab(i), i=646,650) / 21089, 21066, 29384, 1764, 87/ +data (chrtab(i), i=651,655) / 28744, 584, 21076, 84, 4375/ +data (chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/ +data (chrtab(i), i=661,665) / 29768, 1764, 87, 28744, 83/ +data (chrtab(i), i=666,670) / 20823, 21271, 21523, 29704, 1764/ +data (chrtab(i), i=671,675) / 83, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=676,680) / 21523, 21271, 20823, 20563, 1764/ +data (chrtab(i), i=681,685) / 87, 28736, 83, 20823, 21271/ +data (chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/ +data (chrtab(i), i=691,695) / 1764, 1047, 29696, 1036, 21256/ +data (chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/ +data (chrtab(i), i=701,705) / 21523, 1764, 87, 28744, 83/ +data (chrtab(i), i=706,710) / 20823, 21271, 29716, 1764, 74/ +data (chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/ +data (chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/ +data (chrtab(i), i=721,725) / 21461, 1764, 279, 29591, 970/ +data (chrtab(i), i=726,730) / 21320, 21128, 21002, 21025, 1764/ +data (chrtab(i), i=731,735) / 87, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=736,740) / 1032, 29719, 1764, 151, 21064/ +data (chrtab(i), i=741,745) / 29719, 1764, 87, 20808, 21077/ +data (chrtab(i), i=746,750) / 21320, 29783, 1764, 151, 29704/ +data (chrtab(i), i=751,755) / 136, 29719, 1764, 87, 21064/ +data (chrtab(i), i=756,760) / 320, 29783, 1764, 151, 21527/ +data (chrtab(i), i=761,765) / 20616, 29704, 1764, 805, 21157/ +data (chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/ +data (chrtab(i), i=771,775) / 21011, 21001, 21127, 21255, 1764/ +data (chrtab(i), i=776,780) / 611, 29273, 594, 29256, 1764/ +data (chrtab(i), i=781,785) / 485, 21093, 21218, 21209, 21271/ +data (chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/ +data (chrtab(i), i=791,795) / 29127, 1764, 83, 20758, 20950/ +data (chrtab(i), i=796,800) / 21265, 21457, 29844, 1764, 0/ diff --git a/pkg/images/tv/iis/ids/font.h b/pkg/images/tv/iis/ids/font.h new file mode 100644 index 00000000..c33dc6ee --- /dev/null +++ b/pkg/images/tv/iis/ids/font.h @@ -0,0 +1,29 @@ +# NCAR font definitions. + +define CHARACTER_START 32 +define CHARACTER_END 126 +define CHARACTER_HEIGHT 26 +define CHARACTER_WIDTH 17 + +define FONT_LEFT 0 +define FONT_CENTER 9 +define FONT_RIGHT 27 +define FONT_TOP 36 +define FONT_CAP 34 +define FONT_HALF 23 +define FONT_BASE 9 +define FONT_BOTTOM 0 +define FONT_WIDTH 27 +define FONT_HEIGHT 36 + +define COORD_X_START 7 +define COORD_Y_START 1 +define COORD_PEN_START 13 +define COORD_X_LEN 6 +define COORD_Y_LEN 6 +define COORD_PEN_LEN 1 + +define PAINT_BEGIN_START 14 +define PAINT_END_START 15 +define PAINT_BEGIN_LEN 1 +define PAINT_END_LEN 1 diff --git a/pkg/images/tv/iis/ids/idscancel.x b/pkg/images/tv/iis/ids/idscancel.x new file mode 100644 index 00000000..b03aac61 --- /dev/null +++ b/pkg/images/tv/iis/ids/idscancel.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <fset.h> +include "../lib/ids.h" + +# IDS_CANCEL -- Cancel any buffered output. + +procedure ids_cancel (dummy) + +int dummy # not used at present +include "../lib/ids.com" + +begin + if (i_kt == NULL) + return + + # Just cancel any output in the FIO stream + call fseti (i_out, F_CANCEL, OK) +end diff --git a/pkg/images/tv/iis/ids/idschars.x b/pkg/images/tv/iis/ids/idschars.x new file mode 100644 index 00000000..4a53ad56 --- /dev/null +++ b/pkg/images/tv/iis/ids/idschars.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDSCHARS -- Write characters in the current plane + +procedure idschars (xs, ys, data, length, size, orien) + +int xs, ys # starting coordinates, GKI +char data[ARB] # the characters +int length # how many +int size # how big +int orien # character orientation + + +include "../lib/ids.com" + +begin + # Not implemented yet. +end diff --git a/pkg/images/tv/iis/ids/idsclear.x b/pkg/images/tv/iis/ids/idsclear.x new file mode 100644 index 00000000..6b6488d4 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsclear.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_CLEAR -- Clear an image frame. + +procedure ids_clear (dummy) + +int dummy # not used at present +include "../lib/ids.com" + +begin + if (i_kt == NULL) + return + call zclear(Mems[IDS_FRAME(i_kt)], Mems[IDS_BITPL(i_kt)], i_image) +end diff --git a/pkg/images/tv/iis/ids/idsclose.x b/pkg/images/tv/iis/ids/idsclose.x new file mode 100644 index 00000000..d77ade09 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsclose.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_CLOSE -- Close the image display kernel. +# Free up storage. + +procedure ids_close() + +include "../lib/ids.com" + +begin + call close(i_out) + call mfree (IDS_FRAME(i_kt), TY_SHORT) + call mfree (IDS_BITPL(i_kt), TY_SHORT) + call mfree (IDS_SBUF(i_kt), TY_CHAR) + call mfree (i_kt, TY_STRUCT) + i_kt = NULL +end diff --git a/pkg/images/tv/iis/ids/idsclosews.x b/pkg/images/tv/iis/ids/idsclosews.x new file mode 100644 index 00000000..40f7e40e --- /dev/null +++ b/pkg/images/tv/iis/ids/idsclosews.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_CLOSEWS -- Close the named workstation. + +procedure ids_closews (devname, n) + +short devname[n] # device name (not used) +int n # length of device name +include "../lib/ids.com" + +begin + call ids_flush(0) +end diff --git a/pkg/images/tv/iis/ids/idscround.x b/pkg/images/tv/iis/ids/idscround.x new file mode 100644 index 00000000..fc70a813 --- /dev/null +++ b/pkg/images/tv/iis/ids/idscround.x @@ -0,0 +1,61 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" +include <gki.h> + +# IDS_CROUND -- coordinate rounding. Since putcell and other similar +# calls are defined to include both the lower-left corner and the upper-right +# corners of the desired rectangle, it is necessary to "round" the +# coordinates so that adjacent rectangles do not have overlapping edges. +# This could have been done by agreeing that the top and right edges of the +# rectangle are not part of it, but this was not done in the GKI definition. +# Hence, here, we adopt the notion that if (for example) the upper y coordinate +# is in the top half of a pixel, that pixel is included and if the lower y +# coordinate is in the bottom half of a pixel, likewise, that pixel is included. +# Otherwise, the pixels are excluded from putcell. The x coordinates are +# treated similarly. +# The code depends on the fact that lower is <= upper, that upper will be +# at most GKI_MAXNDC, and that the device resolution will never be as much +# as (GKI_MAXNDC+1)/2. The last requirement stems from the fact that if +# the resolution were that high, each pixel would be 2 GKI units and +# the "rounding" based on whether or not we are in the upper or lower half +# of a pixel would probably fail due to rounding/truncation errors. + +procedure ids_cround(lower, upper, res) + +int lower, upper +real res # device resolution + +real low, up +real factor + +begin + factor = res/(GKI_MAXNDC+1) + low = real(lower) * factor + up = real(upper) * factor + + # if boundaries result in same row, return + if ( int(low) == int(up) ) + return + + # if low is in upper half of device pixel, round up + if ( (low - int(low)) >= 0.5 ) { + low = int(low) + 1 + # don't go to or beyond upper bound + if ( low < up ) { + # low already incremented; + # ... 0.2 just for "rounding protection" + lower = (low + 0.2)/factor + # if now reference same cell, return + if ( int(low) == int(up) ) + return + } + } + + # if "up" in bottom half of pixel, drop down one. Note that + # due to two "==" tests above, upper will not drop below lower. + # 0.2 means drop partway down into pixel below; calling code will + # truncate. + if ( (up - int(up)) < 0.5 ) + upper = (real(int(up)) - 0.2)/factor +end diff --git a/pkg/images/tv/iis/ids/idsdrawch.x b/pkg/images/tv/iis/ids/idsdrawch.x new file mode 100644 index 00000000..8372fac2 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsdrawch.x @@ -0,0 +1,67 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include <gki.h> +include <gset.h> +include "font.h" + +define ITALIC_TILT 0.30 # fraction of xsize to tilt italics at top + + +# IDS_DRAWCHAR -- Draw a character of the given size and orientation at the +# given position. + +procedure ids_drawchar (ch, x, y, xsize, ysize, orien, font) + +char ch # character to be drawn +int x, y # lower left GKI coords of character +int xsize, ysize # width, height of char in GKI units +int orien # orientation of character (0 degrees normal) +int font # desired character font + +real px, py, sx, sy, coso, sino, theta +int stroke, tab1, tab2, i, pen +int bitupk() +include "font.com" + +begin + if (ch < CHARACTER_START || ch > CHARACTER_END) + i = '?' - CHARACTER_START + 1 + else + i = ch - CHARACTER_START + 1 + + # Set the font. + call ids_font (font) + + tab1 = chridx[i] + tab2 = chridx[i+1] - 1 + + theta = -DEGTORAD(orien) + coso = cos(theta) + sino = sin(theta) + + do i = tab1, tab2 { + stroke = chrtab[i] + px = bitupk (stroke, COORD_X_START, COORD_X_LEN) + py = bitupk (stroke, COORD_Y_START, COORD_Y_LEN) + pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN) + + # Scale size of character. + px = px / FONT_WIDTH * xsize + py = py / FONT_HEIGHT * ysize + + # The italic font is implemented applying a tilt. + if (font == GT_ITALIC) + px = px + ((py / ysize) * xsize * ITALIC_TILT) + + # Rotate and shift. + sx = x + px * coso + py * sino + sy = y - px * sino + py * coso + + # Draw the line segment or move pen. + if (pen == 0) + call ids_point (short(sx), short(sy), false) + else + call ids_vector (short(sx), short(sy)) + } +end diff --git a/pkg/images/tv/iis/ids/idsescape.x b/pkg/images/tv/iis/ids/idsescape.x new file mode 100644 index 00000000..3c0c404f --- /dev/null +++ b/pkg/images/tv/iis/ids/idsescape.x @@ -0,0 +1,115 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "../lib/ids.h" + +# IDS_ESCAPE -- Pass a device dependent instruction on to the kernel. +# Most of the display control work is done here. + +procedure ids_escape (fn, instruction, nwords) + +int fn # function code +short instruction[ARB] # instruction data words +int nwords # length of instruction + +pointer p,q +int ids_dcopy() +short frames[IDS_MAXIMPL+2] # storage for frame data +short color[IDS_MAXGCOLOR+1] # ditto for color +short bitpl[IDS_MAXBITPL+1] # ditto for graphics bit plane +short quad[5] # 4 quadrant information +int count, count2, total +int junk + +short gki[GKI_ESCAPE_LEN] +data gki[1] /BOI/, gki[2] /GKI_ESCAPE/ + +include "../lib/ids.com" + +begin + switch(fn) { + + case IDS_RESET: + call ids_reset(instruction[1]) + + case IDS_SET_IP: + p = IDS_FRAME(i_kt) + count = ids_dcopy(instruction[1], Mems[p]) + call ids_expand(Mems[p],i_maxframes, true) + q = IDS_BITPL(i_kt) + junk = ids_dcopy ( instruction[count+1], Mems[q]) + call ids_expand(Mems[q],IDS_MAXBITPL, false) + i_image = true + call zsetup (Mems[p], Mems[q], i_image) + + case IDS_SET_GP: + p = IDS_FRAME(i_kt) + count = ids_dcopy(instruction[1], Mems[p]) + call ids_expand(Mems[p],i_maxgraph, false) + q = IDS_BITPL(i_kt) + junk = ids_dcopy ( instruction[count+1], Mems[q]) + call ids_expand(Mems[q],IDS_MAXBITPL, false) + i_image = false + call zsetup (Mems[p], Mems[q], i_image) + + case IDS_DISPLAY_I: + count = ids_dcopy(instruction[2], frames[1]) + call ids_expand(frames[1], i_maxframes, true) + count2 = ids_dcopy (instruction[2+count], color[1]) + call ids_expand(color[1], IDS_MAXGCOLOR, false) + total = count + count2 + count = ids_dcopy(instruction[total+2], quad[1]) + call ids_expand(quad[1], 4, false) + call zdisplay_i(instruction[1], frames[1], color, quad) + + case IDS_DISPLAY_G: + count = ids_dcopy(instruction[2], bitpl[1]) + call ids_expand(bitpl[1], i_maxgraph, false) + count2 = ids_dcopy (instruction[2+count], color[1]) + call ids_expand(color[1], IDS_MAXGCOLOR, false) + total = count + count2 + count = ids_dcopy(instruction[total+2], quad[1]) + call ids_expand(quad[1], 4, false) + call zdisplay_g(instruction[1], bitpl, color, quad) + + case IDS_SAVE: + call idssave(instruction[1], nwords) + + case IDS_RESTORE: + call idsrestore(instruction[1], nwords) + + case IDS_CONTROL: + count = ids_dcopy(instruction[IDS_CTRL_FRAME], frames[1]) + call ids_expand(frames[1], i_maxframes, true) + count2 = ids_dcopy (instruction[IDS_CTRL_FRAME+count], color[1]) + call ids_expand(color[1], IDS_MAXGCOLOR, false) + total = count + count2 + call zcontrol(instruction[IDS_CTRL_REG], + instruction[IDS_CTRL_RW], + frames[1], color[1], + instruction[total+IDS_CTRL_FRAME], + instruction[IDS_CTRL_N], + instruction[total+IDS_CTRL_FRAME+1] ) + # if a read, would like to return the information in gki format + # but no mechanism (yet?) for that + } +end + +# IDS_DCOPY -- copy frame and bitplane information; return the number of +# items copied, including the IDS_EOD (whose presence is required and assumed). + +int procedure ids_dcopy(from, to) + +short from[ARB] # from this storage +short to[ARB] # to this area + +int i # count + +begin + i = 0 + repeat { + i = i + 1 + to[i] = from[i] + } until ( to[i] == IDS_EOD ) + return (i) +end diff --git a/pkg/images/tv/iis/ids/idsfa.x b/pkg/images/tv/iis/ids/idsfa.x new file mode 100644 index 00000000..b2d162c8 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsfa.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_FILLAREA -- Fill a closed area. + +procedure ids_fillarea (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs +include "../lib/ids.com" + +begin + # Not implemented yet. + call ids_polyline (p, npts) +end diff --git a/pkg/images/tv/iis/ids/idsfaset.x b/pkg/images/tv/iis/ids/idsfaset.x new file mode 100644 index 00000000..a8807766 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsfaset.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "../lib/ids.h" + +# IDS_FASET -- Set the fillarea attributes. + +procedure ids_faset (gki) + +short gki[ARB] # attribute structure +pointer fa +include "../lib/ids.com" + +begin + fa = IDS_FAAP(i_kt) + FA_STYLE(fa) = gki[GKI_FASET_FS] + FA_COLOR(fa) = gki[GKI_FASET_CI] +end diff --git a/pkg/images/tv/iis/ids/idsflush.x b/pkg/images/tv/iis/ids/idsflush.x new file mode 100644 index 00000000..cd177d40 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsflush.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_FLUSH -- Flush output. + +procedure ids_flush (dummy) + +int dummy # not used at present +include "../lib/ids.com" + +begin + if (i_kt == NULL) + return + + # We flush the FIO stream. + call flush (i_out) +end diff --git a/pkg/images/tv/iis/ids/idsfont.x b/pkg/images/tv/iis/ids/idsfont.x new file mode 100644 index 00000000..b3109f83 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsfont.x @@ -0,0 +1,40 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "../lib/ids.h" + +# IDS_FONT -- Set the character font. The roman font is normal. Bold is +# implemented by increasing the vector line width; care must be taken to +# set IDS_WIDTH so that the other vector drawing procedures remember to +# change the width back. The italic font is implemented in the character +# generator by a geometric transformation. + +procedure ids_font (font) + +int font # code for font to be set +int pk1, pk2, width +include "../lib/ids.com" + +begin + pk1 = GKI_PACKREAL(1.0) + pk2 = GKI_PACKREAL(2.0) + + width = IDS_WIDTH(i_kt) + + if (font == GT_BOLD) { + if (width != pk2) { + # Name collision with ids_open !! + # call ids_optn (*"inten", *"high") + width = pk2 + } + } else { + if (GKI_UNPACKREAL(width) > 1.5) { + # Name collision with ids_open !! + # call ids_optn (*"inten", *"low") + width = pk1 + } + } + + IDS_WIDTH(i_kt) = width +end diff --git a/pkg/images/tv/iis/ids/idsgcell.x b/pkg/images/tv/iis/ids/idsgcell.x new file mode 100644 index 00000000..6ba8245f --- /dev/null +++ b/pkg/images/tv/iis/ids/idsgcell.x @@ -0,0 +1,170 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <gki.h> +include <gset.h> +include "../lib/ids.h" + +# IDS_GETCELLARRAY -- Fetch a cell array, i.e., two dimensional array of pixels +# (greylevels or colors). + +procedure ids_getcellarray (nc, nr, ax1,ay1, ax2,ay2) + +int nc, nr # number of pixels in X and Y +int ax1, ay1 # lower left corner of input window +int ax2, ay2 # upper right corner of input window + +int x1, y1, x2, y2 +int nx,ny # number of device pixels in x and y +real px1, px2, py1, py2 + +real skip_x, skip_y, sx, sy +real blockx, blocky, bcy +int i, j, startrow, element +real xres, yres +pointer sp, cell +pointer mp # final data pointer to "array" m +bool ca, use_orig, new_row + +include "../lib/ids.com" + +begin + + # determine if can do real cell array. + + ca = (IDS_CELLARRAY(i_kt) != 0) + if ( !ca ) + return + + skip_x = 1.0 + skip_y = 1.0 + blockx = 1.0 + blocky = 1.0 + + xres = real(i_xres) + yres = real(i_yres) + + # adjust pixels for edges + x1 = ax1 + x2 = ax2 + y1 = ay1 + y2 = ay2 + call ids_cround(x1,x2,xres) + call ids_cround(y1,y2,yres) + + # find out how many real pixels we have to fetch + + px1 = real(x1) * xres /(GKI_MAXNDC+1) + py1 = real(y1) * yres /(GKI_MAXNDC+1) + px2 = real(x2) * xres /(GKI_MAXNDC+1) + py2 = real(y2) * yres /(GKI_MAXNDC+1) + + nx = int( px2 ) - int( px1 ) + 1 + ny = int( py2 ) - int( py1 ) + 1 + + # if too many data points in input, set skip. If skip is close + # enough to one, set it to one. + # set block replication factors - will be > 1.0 if too few input points. + # cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have + # enough points and so *some* have to be replicated. + + if ( nx > nc ) { + skip_x = real(nx)/nc + if ( (skip_x - 1.0)*(nc-1) < 1.0 ) + skip_x = 1.0 + } else + blockx = real(nc)/nx + + if ( ny > nr ) { + skip_y = real(ny)/nr + if ( (skip_y - 1.0)*(nr-1) < 1.0 ) + skip_y = 1.0 + } else + blocky = real(nr)/ny + + # initialize counters + + call smark(sp) + + # allocate storage for output + + call salloc (mp, nc*nr, TY_SHORT) + sy = 0 + bcy = blocky + startrow = 1 + + # see if we can use original data ... no massaging + # also set the initial value of the new_row flag, which tells + # if we have to rebuild the row data + # note that if blockx > 1.0, skip_x must be 1.0, and vv + + if ( (skip_x == 1.0) && (blockx == 1.0) ) { + use_orig = true + } else { + use_orig = false + # allocate storage for a row of pixels. + call salloc ( cell, nx, TY_SHORT) + } + new_row = true + + # do it + + for ( i = 1; i <= nr ; i = i + 1) { + + # fetch the row data. The reading routine will figure out + # how to read from the various individual frames and bitplanes. + + if ( new_row) { + if (!i_snap) + call zseek (i_out, int(px1), int(py1)+int(sy+0.5)) + if ( use_orig ) + # just copy it in + if (i_snap) + call do_snap (Mems[mp+startrow-1], nx, int(px1), + int(py1)+int(sy+0.5)) + else + call read (i_out, Mems[mp+startrow-1], nx) + else + # into Mems for rework + if (i_snap) + call do_snap (Mems[cell], nx, int(px1), + int(py1)+int(sy+0.5)) + else + call read (i_out, Mems[cell], nx) + } + + # rework the row data + + if ( !use_orig && new_row ) { + if ( skip_x == 1.0) + call ids_blockit(Mems[cell], Mems[mp+startrow-1], nc, + blockx) + else { + sx = 0 + for ( j = 1; j <= nc; j = j + 1) { + element = int(sx+0.5) + Mems[mp+startrow-1+j-1] = Mems[cell + element] + sx = sx + skip_x + } + } + } + # if don't need new row of input data, duplicate the + # previous one by copying within the "m" array + if ( ! new_row ) + call amovs (Mems[mp+startrow-1-nc], Mems[mp+startrow-1], nc) + + #advance a row + + startrow = startrow + nc + if ( bcy <= real(i) ) { + sy = sy + skip_y + bcy = bcy + blocky + new_row = true + } else { + new_row = false + } + } + + call gki_retcellarray (i_in, Mems[mp], nr * nc) + call sfree(sp) +end diff --git a/pkg/images/tv/iis/ids/idsgcur.x b/pkg/images/tv/iis/ids/idsgcur.x new file mode 100644 index 00000000..d3c0a1c6 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsgcur.x @@ -0,0 +1,33 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_GETCURSOR -- Get the position of a cursor. This is the low level +# cursor read procedure. Reading the image cursor is only possible when +# the ids kernel is run interactively, i.e., when the kernel is linked +# into the CL process, which owns the terminal. A raw binary read is required. +# The cursor value is returned as a GKI structure on the stream "i_in", +# i.e., it is sent back to the process which requested it. + +procedure ids_getcursor (cursor) + +int cursor + +int cur +int x, y, key + +include "../lib/ids.com" + +begin + cur = cursor + if ( cur > IDS_CSPECIAL ) { + switch( cur ) { + case IDS_BUT_RD, IDS_BUT_WT: + call iisbutton( cur, x, y, key) + } + } else + call zcursor_read (cur, x, y, key) + + call gki_retcursorvalue (i_in, x, y, key, cur) + call flush (i_in) +end diff --git a/pkg/images/tv/iis/ids/idsinit.x b/pkg/images/tv/iis/ids/idsinit.x new file mode 100644 index 00000000..7ac925a3 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsinit.x @@ -0,0 +1,172 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <ctype.h> +include <gki.h> +include "../lib/ids.h" + +# IDS_INIT -- Initialize the ids data structures from the graphcap entry +# for the device. Called once, at OPENWS time, with the TTY pointer already +# set in the common. + +procedure ids_init (tty, devname) + +pointer tty # graphcap descriptor +char devname[ARB] # device name + +pointer nextch +int maxch, i +real char_height, char_width, char_size + +bool ttygetb() +real ttygetr() +int ttygeti(), btoi(), gstrcpy() + +include "../lib/ids.com" + +begin + # Allocate the ids descriptor and the string buffer. + if ( i_kt == NULL) { + call calloc (i_kt, LEN_IDS, TY_STRUCT) + call malloc (IDS_SBUF(i_kt), SZ_SBUF, TY_CHAR) + call malloc (IDS_BITPL(i_kt), IDS_MAXBITPL+1, TY_SHORT) + } else { + call mfree (IDS_FRAME(i_kt), TY_SHORT) + } + + + # Init string buffer parameters. The first char of the string buffer + # is reserved as a null string, used for graphcap control strings + # omitted from the graphcap entry for the device. + + IDS_SZSBUF(i_kt) = SZ_SBUF + IDS_NEXTCH(i_kt) = IDS_SBUF(i_kt) + 1 + Memc[IDS_SBUF(i_kt)] = EOS + + # get the device resolution from the graphcap entry. + + i_xres = ttygeti (tty, "xr") + if (i_xres <= 0) + i_xres = 512 + i_yres = ttygeti (tty, "yr") + if (i_yres <= 0) + i_yres = 512 + + + # Initialize the character scaling parameters, required for text + # generation. The heights are given in NDC units in the graphcap + # file, which we convert to GKI units. Estimated values are + # supplied if the parameters are missing in the graphcap entry. + + char_height = ttygetr (tty, "ch") + if (char_height < EPSILON) + char_height = 1.0 / 35.0 + char_height = char_height * GKI_MAXNDC + + char_width = ttygetr (tty, "cw") + if (char_width < EPSILON) + char_width = 1.0 / 80.0 + char_width = char_width * GKI_MAXNDC + + # If the device has a set of discreet character sizes, get the + # size of each by fetching the parameter "tN", where the N is + # a digit specifying the text size index. Compute the height and + # width of each size character from the "ch" and "cw" parameters + # and the relative scale of character size I. + + IDS_NCHARSIZES(i_kt) = min (MAX_CHARSIZES, ttygeti (tty, "th")) + nextch = IDS_NEXTCH(i_kt) + + if (IDS_NCHARSIZES(i_kt) <= 0) { + IDS_NCHARSIZES(i_kt) = 1 + IDS_CHARSIZE(i_kt,1) = 1.0 + IDS_CHARHEIGHT(i_kt,1) = char_height + IDS_CHARWIDTH(i_kt,1) = char_width + } else { + Memc[nextch+2] = EOS + for (i=1; i <= IDS_NCHARSIZES(i_kt); i=i+1) { + Memc[nextch] = 't' + Memc[nextch+1] = TO_DIGIT(i) + char_size = ttygetr (tty, Memc[nextch]) + IDS_CHARSIZE(i_kt,i) = char_size + IDS_CHARHEIGHT(i_kt,i) = char_height * char_size + IDS_CHARWIDTH(i_kt,i) = char_width * char_size + } + } + + # Initialize the output parameters. All boolean parameters are stored + # as integer flags. All string valued parameters are stored in the + # string buffer, saving a pointer to the string in the ids + # descriptor. If the capability does not exist the pointer is set to + # point to the null string at the beginning of the string buffer. + + IDS_POLYLINE(i_kt) = btoi (ttygetb (tty, "pl")) + IDS_POLYMARKER(i_kt) = btoi (ttygetb (tty, "pm")) + IDS_FILLAREA(i_kt) = btoi (ttygetb (tty, "fa")) + IDS_FILLSTYLE(i_kt) = ttygeti (tty, "fs") + IDS_ROAM(i_kt) = btoi (ttygetb (tty, "ro")) + IDS_CANZM(i_kt) = btoi (ttygetb (tty, "zo")) + IDS_ZRES(i_kt) = ttygeti (tty, "zr") + IDS_CELLARRAY(i_kt) = btoi (ttygetb (tty, "ca")) + IDS_SELERASE(i_kt) = btoi (ttygetb (tty, "se")) + + # how many image frames and graph (bit)planes do we get to play with? + + i_maxframes = ttygeti(tty, "ip") + if ( i_maxframes < 1 ) + i_maxframes = 1 + i_maxgraph = ttygeti(tty, "gp") + i_maxframes = min(int(i_maxframes), IDS_MAXIMPL) + i_maxgraph = min(int(i_maxgraph), IDS_MAXGRPL) + + # allocate space for the frame descriptors + # the "2" accounts for possible graphics channel ( see ids_expand.x) + # and the trailing IDS_EOD + + call malloc (IDS_FRAME(i_kt), max(i_maxframes,i_maxgraph)+2, TY_SHORT) + + # Initialize the input parameters: last cursor used. + + IDS_LCURSOR(i_kt) = 1 + + # Save the device string in the descriptor. + nextch = IDS_NEXTCH(i_kt) + IDS_DEVNAME(i_kt) = nextch + maxch = IDS_SBUF(i_kt) + SZ_SBUF - nextch + 1 + nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1 + IDS_NEXTCH(i_kt) = nextch + +end + + +# IDS_GSTRING -- Get a string value parameter from the graphcap table, +# placing the string at the end of the string buffer. If the device does +# not have the named capability return a pointer to the null string, +# otherwise return a pointer to the string. Since pointers are used, +# rather than indices, the string buffer is fixed in size. The additional +# degree of indirection required with an index was not considered worthwhile +# in this application since the graphcap entries are never very large. + +pointer procedure ids_gstring (cap) + +char cap[ARB] # device capability to be fetched +pointer strp, nextch +int maxch, nchars +int ttygets() + +include "../lib/ids.com" + +begin + nextch = IDS_NEXTCH(i_kt) + maxch = IDS_SBUF(i_kt) + SZ_SBUF - nextch + 1 + + nchars = ttygets (i_tty, cap, Memc[nextch], maxch) + if (nchars > 0) { + strp = nextch + nextch = nextch + nchars + 1 + } else + strp = IDS_SBUF(i_kt) + + IDS_NEXTCH(i_kt) = nextch + return (strp) +end diff --git a/pkg/images/tv/iis/ids/idsline.x b/pkg/images/tv/iis/ids/idsline.x new file mode 100644 index 00000000..ecc63d8c --- /dev/null +++ b/pkg/images/tv/iis/ids/idsline.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include "../lib/ids.h" + +# IDS_LINE set the line type option in the nspp world + +procedure ids_line(index) + +int index # index for line type switch statement + +int linetype + +include "../lib/ids.com" + +begin + switch (index) { + case GL_CLEAR: + linetype = 0 + case GL_DASHED: + linetype = 0FF00X + case GL_DOTTED: + linetype = 08888X + case GL_DOTDASH: + linetype = 0F040X + default: + linetype = 0FFFFX # GL_SOLID and default + } + i_linemask = linetype +end diff --git a/pkg/images/tv/iis/ids/idslutfill.x b/pkg/images/tv/iis/ids/idslutfill.x new file mode 100644 index 00000000..be42c774 --- /dev/null +++ b/pkg/images/tv/iis/ids/idslutfill.x @@ -0,0 +1,36 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> + +# IDSLUTFILL -- Fill a lookup table from a set of line end points + +procedure idslfill (in, icount, out, lenlut, lutmin, lutmax) + +short in[ARB] # input: line end points +int icount # number of input data items +short out[ARB] # output: the lookup table +int lenlut # lut size +int lutmin,lutmax # inclusive range for lut values + +int i,j +int xs, ys, xe, ye +real slope + +begin + # xs and xe are zero based coordinates + xs = real(in[1]) * (lenlut - 1)/GKI_MAXNDC. + 0.5 + ys = real(in[2]) * (lutmax - lutmin)/GKI_MAXNDC. + lutmin + 0.5 + do i = 3, icount, 2 { + xe = real(in[i]) * (lenlut - 1)/GKI_MAXNDC. + 0.5 + ye = real(in[i+1]) * (lutmax - lutmin)/GKI_MAXNDC. + lutmin + 0.5 + if (xe != xs) { + slope = real(ye - ys) / (xe - xs) + do j = xs, xe { + out[j+1] = ys + (j - xs) * slope + } + } + xs = xe + ys = ye + } + out[1] = 0 # keep background at zero +end diff --git a/pkg/images/tv/iis/ids/idsopen.x b/pkg/images/tv/iis/ids/idsopen.x new file mode 100644 index 00000000..cee1aebe --- /dev/null +++ b/pkg/images/tv/iis/ids/idsopen.x @@ -0,0 +1,58 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "../lib/ids.h" + +# IDS_OPEN -- Install the image kernel as a kernel device driver. +# The device table DD consists of an array of the entry point addresses for +# the driver procedures. If a driver does not implement a particular +# instruction the table entry for that procedure may be set to zero, causing +# the interpreter to ignore the instruction. + +procedure ids_open (devname, dd) + +char devname[ARB] # nonnull for forced output to device +int dd[ARB] # device table to be initialized + +int locpr() +extern ids_openws(), ids_closews(), ids_clear(), ids_cancel() +extern ids_flush(), ids_polyline(), ids_polymarker(), ids_text() +extern ids_fillarea(), ids_putcellarray(), ids_plset() +extern ids_pmset(), ids_txset(), ids_faset() +extern ids_escape() +extern ids_setcursor(), ids_getcursor(), ids_getcellarray() + +include "../lib/ids.com" + +begin + # Flag first pass. Save forced device name in common for OPENWS. + + i_kt = NULL + call strcpy (devname, i_device, SZ_IDEVICE) + + # Install the device driver. + dd[GKI_OPENWS] = locpr (ids_openws) + dd[GKI_CLOSEWS] = locpr (ids_closews) + dd[GKI_DEACTIVATEWS] = 0 + dd[GKI_REACTIVATEWS] = 0 + dd[GKI_MFTITLE] = 0 + dd[GKI_CLEAR] = locpr (ids_clear) + dd[GKI_CANCEL] = locpr (ids_cancel) + dd[GKI_FLUSH] = locpr (ids_flush) + dd[GKI_POLYLINE] = locpr (ids_polyline) + dd[GKI_POLYMARKER] = locpr (ids_polymarker) + dd[GKI_TEXT] = locpr (ids_text) + dd[GKI_FILLAREA] = locpr (ids_fillarea) + dd[GKI_PUTCELLARRAY] = locpr (ids_putcellarray) + dd[GKI_SETCURSOR] = locpr (ids_setcursor) + dd[GKI_PLSET] = locpr (ids_plset) + dd[GKI_PMSET] = locpr (ids_pmset) + dd[GKI_TXSET] = locpr (ids_txset) + dd[GKI_FASET] = locpr (ids_faset) + dd[GKI_GETCURSOR] = locpr (ids_getcursor) + dd[GKI_GETCELLARRAY] = locpr (ids_getcellarray) + dd[GKI_ESCAPE] = locpr (ids_escape) + dd[GKI_SETWCS] = 0 + dd[GKI_GETWCS] = 0 + dd[GKI_UNKNOWN] = 0 +end diff --git a/pkg/images/tv/iis/ids/idsopenws.x b/pkg/images/tv/iis/ids/idsopenws.x new file mode 100644 index 00000000..bd25b260 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsopenws.x @@ -0,0 +1,120 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <fset.h> +include <gki.h> +include <error.h> +include "../lib/ids.h" + +# IDS_OPENWS -- Open the named workstation. Once a workstation has been +# opened we leave it open until some other workstation is opened or the +# kernel is closed. Opening a workstation involves initialization of the +# kernel data structures. Initialization of the device itself is left to +# an explicit reset command. + +procedure ids_openws (devname, n, mode) + +short devname[ARB] # device name +int n # length of device name +int mode # access mode + +long filesize +bool need_open, same_dev +pointer sp, buf, devinfo + +long fstatl() +pointer ttygdes() +bool streq(), ttygetb() +int fopnbf(), ttygets() +extern zopnim(), zardim(), zawrim(), zawtim(), zsttim(), zclsim() +errchk ttygdes +int oldmode +data oldmode /-1/ + +include "../lib/ids.com" + +begin + call smark (sp) + call salloc (buf, max (SZ_FNAME, n), TY_CHAR) + call salloc (devinfo, SZ_LINE, TY_CHAR) + + # If a device was named when the kernel was opened then output will + # always be to that device (i_device) regardless of the device named + # in the OPENWS instruction. If no device was named (null string) + # then unpack the device name, passed as a short integer array. + + if (i_device[1] == EOS) { + call achtsc (devname, Memc[buf], n) + Memc[buf+n] = EOS + } else + call strcpy (i_device, Memc[buf], SZ_FNAME) + + # find out if first time, and if not, if same device as before + # note that if (i_kt == NULL), then same_dev is false. + + same_dev = false + need_open = true + if ( i_kt != NULL ) { + same_dev = (streq(Memc[IDS_DEVNAME(i_kt)], Memc[buf])) + if ( !same_dev || ( oldmode != mode)) + call close(i_out) + else + need_open = false + } + oldmode = mode + + # Initialize the kernel data structures. Open graphcap descriptor + # for the named device, allocate and initialize descriptor and common. + # graphcap entry for device must exist. + + if (need_open) { + if ((i_kt != NULL) && !same_dev) + call ttycdes (i_tty) + if (!same_dev) { + i_tty = ttygdes (Memc[buf]) + if (ttygetb (i_tty, "LC")) + call error (1, "operation not supported on device") + } + + if (ttygets (i_tty, "DD", Memc[devinfo], SZ_LINE) <= 0) + call strcpy (Memc[buf], Memc[devinfo], SZ_LINE) + + # Open the output file. The device is connected to FIO as a + # binary file. mode must be READ_WRITE or WRITE_ONLY + # for image display! + + iferr (i_out = fopnbf (Memc[devinfo], mode, zopnim, zardim, + zawrim, zawtim, zsttim, zclsim)) { + + call ttycdes (i_tty) + call erract (EA_ERROR) + } + call fseti (i_out, F_ADVICE, SEQUENTIAL) + + } + + # Initialize data structures. + # Device specific initialization will be done in the zinit call + # from ids_init(). + + if (!same_dev) { + call ids_init (i_tty, Memc[buf]) + + # Now set the file size to allow mapping of all control registers + # as well as all image and graphics planes. The call to fstatl + # returns the size of an image plane (!!). zinit does whatever + # device work it needs to do, and uses its arguments to determine + # the total file size, which it returns. + # This feature need not be used (and is not for the IIS display). + # + # We also set the F_ASYNC parameter to YES. + + i_frsize = fstatl(i_out, F_FILESIZE) + filesize = i_frsize + call zinit(i_maxframes, i_maxgraph, filesize) + call fseti(i_out, F_ASYNC, YES) + + } + + call sfree (sp) +end diff --git a/pkg/images/tv/iis/ids/idspcell.x b/pkg/images/tv/iis/ids/idspcell.x new file mode 100644 index 00000000..d678b286 --- /dev/null +++ b/pkg/images/tv/iis/ids/idspcell.x @@ -0,0 +1,178 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "../lib/ids.h" + +# number of grey scale symbols +define NSYMBOL 11 +define TSIZE (1.0/2.0) + +# IDS_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels +# (greylevels or colors). + +procedure ids_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2) + +short m[ARB] # cell array +int nc, nr # number of pixels in X and Y + # (number of columns[x], rows[y] +int ax1, ay1 # lower left corner of output window +int ax2, ay2 # upper right corner of output window + +int x1,y1,x2,y2 +real px1, py1, px2, py2 +int nx, ny +real skip_x, skip_y, sx, sy +real blockx, blocky, bcy +int i, j, startrow, element +real xres, yres +pointer sp, cell +bool ca, use_orig, new_row + +include "../lib/ids.com" + +begin + # determine if can do real cell array. + + ca = (IDS_CELLARRAY(i_kt) != 0) + if ( !ca ) + return + + skip_x = 1.0 + skip_y = 1.0 + blockx = 1.0 + blocky = 1.0 + + xres = real(i_xres) + yres = real(i_yres) + + # adjust pixels for edges + x1 = ax1 + x2 = ax2 + y1 = ay1 + y2 = ay2 + call ids_cround(x1,x2,xres) + call ids_cround(y1,y2,yres) + + # find out how many real pixels we have to fill + + px1 = real(x1) * xres /(GKI_MAXNDC+1) + py1 = real(y1) * yres /(GKI_MAXNDC+1) + px2 = real(x2) * xres /(GKI_MAXNDC+1) + py2 = real(y2) * yres /(GKI_MAXNDC+1) + + nx = int( px2 ) - int( px1 ) + 1 + ny = int( py2 ) - int( py1 ) + 1 + + # if too many data points in input, set skip. If skip is close + # enough to one, set it to one. + # set block replication factors - will be > 1.0 if too few input points. + # cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have + # enough points and so *some* have to be replicated. + + if ( nc > nx ) { + skip_x = real(nc)/nx + if ( (skip_x - 1.0)*(nx-1) < 1.0 ) + skip_x = 1.0 + } else + blockx = real(nx)/nc + + if ( nr > ny ) { + skip_y = real(nr)/ny + if ( (skip_y - 1.0)*(ny-1) < 1.0 ) + skip_y = 1.0 + } else + blocky = real(ny)/nr + + # initialize counters + + call smark(sp) + sy = skip_y + bcy = blocky + startrow = 1 + element = startrow + + # see if we can use original data ... no massaging + # also set the initial value of the new_row flag, which tells + # if we have to rebuild the row data + # note that if blockx > 1.0, skip_x must be 1.0, and vv + + if ( (skip_x == 1.0) && (blockx == 1.0) ) { + use_orig = true + new_row = false + } else { + use_orig = false + new_row = true + # allocate storage for a row of pixels. + call salloc ( cell, nx, TY_SHORT) + } + + # do it + + for ( i = 1; i <= ny ; i = i + 1) { + + # Build the row data. + + if (!use_orig && new_row) { + if ( skip_x == 1.0) + call ids_blockit(m[element], Mems[cell], nx, blockx) + else { + sx = skip_x + for ( j = 1; j <= nx; j = j + 1) { + Mems[cell+j-1] = m[element] + element = startrow + int(sx+0.5) + sx = sx + skip_x + } + } + } + + # Send the row data. The writing routine will figure out + # how to send to the various individual frames and bitplanes. + + call zseek (i_out, int(px1), int(py1)+i-1) + if (use_orig) + call write (i_out, m[element], nx) + else + call write (i_out, Mems[cell], nx) + + # Advance a row. + + element = startrow + if ( bcy <= real(i) ) { + startrow = 1 + nc * int(sy+0.5) + element = startrow + sy = sy + skip_y + bcy = bcy + blocky + new_row = true + } else { + new_row = false + } + } + + call sfree(sp) +end + + +# IDS_BLOCKIT -- block replication of data + +procedure ids_blockit( from, to, count, factor) + +short from[ARB] # input data +short to[ARB] # output data +int count # number of output pixels +real factor # blocking factor + +int i, j +real bc + +begin + bc = factor + j = 1 + for ( i = 1; i <= count ; i = i + 1 ) { + to[i] = from[j] + if ( bc <= real(i) ) { + j = j + 1 + bc = bc + factor + } + } +end diff --git a/pkg/images/tv/iis/ids/idspl.x b/pkg/images/tv/iis/ids/idspl.x new file mode 100644 index 00000000..77ac3bc3 --- /dev/null +++ b/pkg/images/tv/iis/ids/idspl.x @@ -0,0 +1,61 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "../lib/ids.h" + +# nspp particulars +# base width of line +define BASELW 8 + +# IDS_POLYLINE -- Draw a polyline. The polyline is defined by the array of +# points P, consisting of successive (x,y) coordinate pairs. The first point +# is not plotted but rather defines the start of the polyline. The remaining +# points define line segments to be drawn. + +procedure ids_polyline (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs + +pointer pl +int i, len_p +int linewidth + +include "../lib/ids.com" + +begin + if ( npts <= 0) + return + + len_p = npts * 2 + + # Update polyline attributes if necessary. + + pl = IDS_PLAP(i_kt) + + if (IDS_TYPE(i_kt) != PL_LTYPE(pl)) { + call ids_line(PL_LTYPE(pl)) + IDS_TYPE(i_kt) = PL_LTYPE(pl) + } + if (IDS_WIDTH(i_kt) != PL_WIDTH(pl)) { + linewidth = int(real(BASELW) * GKI_UNPACKREAL(PL_WIDTH(pl))) + i_linewidth = max(1,linewidth) + IDS_WIDTH(i_kt) = PL_WIDTH(pl) + } + if (IDS_COLOR(i_kt) != PL_COLOR(pl)) { + i_linecolor = PL_COLOR(pl) + IDS_COLOR(i_kt) = PL_COLOR(pl) + } + + # Move to the first point. point() will plot it, which is + # ok here, and vector may well plot it again. + + call ids_point(p[1], p[2], true) + + # Draw the polyline. + + for (i=3; i <= len_p; i=i+2) { + call ids_vector ( p[i], p[i+1]) + + } +end diff --git a/pkg/images/tv/iis/ids/idsplset.x b/pkg/images/tv/iis/ids/idsplset.x new file mode 100644 index 00000000..cf49ea1f --- /dev/null +++ b/pkg/images/tv/iis/ids/idsplset.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "../lib/ids.h" + +# IDS_PLSET -- Set the polyline attributes. The polyline width parameter is +# passed to the encoder as a packed floating point number, i.e., int(LWx100). + +procedure ids_plset (gki) + +short gki[ARB] # attribute structure +pointer pl + +include "../lib/ids.com" + +begin + pl = IDS_PLAP(i_kt) + PL_LTYPE(pl) = gki[GKI_PLSET_LT] + PL_WIDTH(pl) = gki[GKI_PLSET_LW] + PL_COLOR(pl) = gki[GKI_PLSET_CI] +end diff --git a/pkg/images/tv/iis/ids/idspm.x b/pkg/images/tv/iis/ids/idspm.x new file mode 100644 index 00000000..b165b7cc --- /dev/null +++ b/pkg/images/tv/iis/ids/idspm.x @@ -0,0 +1,56 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "../lib/ids.h" + +# nspp particulars +# base width of line +define BASELW 8 + +# IDS_POLYMARKER -- Draw a polymarker. The polymarker is defined by the array +# of points P, consisting of successive (x,y) coordinate pairs. The first point +# is not plotted but rather defines the start of the polyline. The remaining +# points define line segments to be drawn. + +procedure ids_polymarker (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs + +pointer pm +int i, len_p +int linewidth +short x,y + +include "../lib/ids.com" + +begin + if ( npts <= 0) + return + + len_p = npts * 2 + + # Update polymarker attributes if necessary. + + pm = IDS_PMAP(i_kt) + + if (IDS_TYPE(i_kt) != PM_LTYPE(pm)) { + call ids_line(PM_LTYPE(pm)) + IDS_TYPE(i_kt) = PM_LTYPE(pm) + } + if (IDS_WIDTH(i_kt) != PM_WIDTH(pm)) { + linewidth = int(real(BASELW) * GKI_UNPACKREAL(PM_WIDTH(pm))) + i_linewidth = max(1,linewidth) + IDS_WIDTH(i_kt) = PM_WIDTH(pm) + } + if (IDS_COLOR(i_kt) != PM_COLOR(pm)) { + i_linecolor = PM_COLOR(pm) + IDS_COLOR(i_kt) = PM_COLOR(pm) + } + + for (i=1; i <= len_p; i=i+2) { + x = p[i] + y = p[i+1] + call ids_point (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC, true) + } +end diff --git a/pkg/images/tv/iis/ids/idspmset.x b/pkg/images/tv/iis/ids/idspmset.x new file mode 100644 index 00000000..be46ede8 --- /dev/null +++ b/pkg/images/tv/iis/ids/idspmset.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "../lib/ids.h" + +# IDS_PMSET -- Set the polymarker attributes. + +procedure ids_pmset (gki) + +short gki[ARB] # attribute structure +pointer pm +include "../lib/ids.com" + +begin + pm = IDS_PMAP(i_kt) + PM_LTYPE(pm) = gki[GKI_PMSET_MT] + PM_WIDTH(pm) = gki[GKI_PMSET_MW] + PM_COLOR(pm) = gki[GKI_PMSET_CI] +end diff --git a/pkg/images/tv/iis/ids/idspoint.x b/pkg/images/tv/iis/ids/idspoint.x new file mode 100644 index 00000000..2addb635 --- /dev/null +++ b/pkg/images/tv/iis/ids/idspoint.x @@ -0,0 +1,65 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <fset.h> +include "../lib/ids.h" + +# IDS_POINT -- Plot a point in the current plane at given (GKI) coordinates. + +procedure ids_point (ax,ay,flag) + +short ax,ay # point coordinates, GKI +bool flag # true if should plot point, false if just a + # pen move +int xp, yp +int bufsize +int fstati() + +include "../lib/ids.com" + +begin + # convert to device coords, plot max value, then record in i_pt + xp = real(ax) * i_xres /(GKI_MAXNDC+1) + yp = real(ay) * i_yres /(GKI_MAXNDC+1) + + # if flag is true, we plot the point. If false, we just want + # to record the points (a pen move), so skip the plot commands + + if (flag) { + # set buffer to size one + bufsize = fstati (i_out, F_BUFSIZE) + call fseti (i_out, F_BUFSIZE, 1) + + # plot it + call zseek (i_out, xp, yp) + call write(i_out, short(IDS_ZRES(i_kt)-1), 1) + + # restore buffer + call fseti (i_out, F_BUFSIZE, bufsize) + } + i_pt_x = xp + i_pt_y = yp +end + + +# IDS_RPOINT - Plot a point in the current plane at given (device coord) offsets +# from current point. + +procedure ids_rpoint (dx,dy) + +short dx,dy # DEVICE coordinate increments from cur. pos. + +int xp, yp + +include "../lib/ids.com" + +begin + xp = i_pt_x + dx + yp = i_pt_y + dy + + call zseek (i_out, xp, yp) + call write(i_out, short(IDS_ZRES(i_kt)-1), 1) + + i_pt_x = xp + i_pt_y = yp +end diff --git a/pkg/images/tv/iis/ids/idsreset.x b/pkg/images/tv/iis/ids/idsreset.x new file mode 100644 index 00000000..627b3d4e --- /dev/null +++ b/pkg/images/tv/iis/ids/idsreset.x @@ -0,0 +1,56 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "../lib/ids.h" + +# IDS_RESET -- Reset the state of the transform common, i.e., in response to +# a clear or a cancel. Initialize all attribute packets to their default +# values and set the current state of the device to undefined, forcing the +# device state to be reset when the next output instruction is executed. +# Clear the image, graphics, and luts only if reset is "hard" enough. + +procedure ids_reset(hardness) + +short hardness + +pointer pl, pm, fa, tx + +include "../lib/ids.com" + +begin + # Set pointers to attribute substructures. + pl = IDS_PLAP(i_kt) + pm = IDS_PMAP(i_kt) + fa = IDS_FAAP(i_kt) + tx = IDS_TXAP(i_kt) + + # Initialize the attribute packets. + PL_LTYPE(pl) = 1 + PL_WIDTH(pl) = GKI_PACKREAL(1.) + PL_COLOR(pl) = 1 + PM_LTYPE(pm) = 1 + PM_WIDTH(pm) = GKI_PACKREAL(1.) + PM_COLOR(pm) = 1 + FA_STYLE(fa) = 1 + FA_COLOR(fa) = 1 + TX_UP(tx) = 90 + TX_SIZE(tx) = GKI_PACKREAL(1.) + TX_PATH(tx) = GT_RIGHT + TX_HJUSTIFY(tx) = GT_LEFT + TX_VJUSTIFY(tx) = GT_BOTTOM + TX_FONT(tx) = GT_ROMAN + TX_COLOR(tx) = 1 + TX_SPACING(tx) = 0.0 + + # Set the device attributes to undefined, forcing them to be reset + # when the next output instruction is executed. + + IDS_TYPE(i_kt) = -1 + IDS_WIDTH(i_kt) = -1 + IDS_COLOR(i_kt) = -1 + IDS_TXSIZE(i_kt) = -1 + IDS_TXFONT(i_kt) = -1 + + call zreset(hardness) +end diff --git a/pkg/images/tv/iis/ids/idsrestore.x b/pkg/images/tv/iis/ids/idsrestore.x new file mode 100644 index 00000000..246631c0 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsrestore.x @@ -0,0 +1,84 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_RESTORE -- Restore the control state of the display, together with +# zero to all of the image and graphics planes. + +procedure ids_restore (data, n) + +short data[ARB] # instruction data words +short n # number of data words + +int fd # binary file output descriptor +short i, j +short frame[IDS_MAXIMPL+1] # frames to save +short graph[IDS_MAXGRPL+1] # graph planes to save +short buffer[IDS_MAXDATA] # for data storage + +include "../lib/ids.com" + +begin + # determine file descriptor to read (opened by upper end) + # ( assume upper end has retrieved whatever data it stored and + # leaves fd pointing at control information offset) + # then retrieve the frame data + + fd = data[1] + + # image data + + call read(fd, i, SZ_SHORT) + call read(fd, buffer, i) + j = 0 + i = 0 + repeat { + i = i + 1 + j = j + 1 + frame[j] = buffer[i] + } until ( (buffer[i] == IDS_EOD) || ( j == i_maxframes) ) + frame[i+1] = IDS_EOD + + # graph data + + call read(fd, i, SZ_SHORT) + call read(fd, buffer, i) + i = 0 + j = 0 + repeat { + i = i + 1 + j = j + 1 + graph[j] = buffer[i] + } until ( (buffer[i] == IDS_EOD) || ( j == i_maxgraph) ) + graph[i+1] = IDS_EOD + + # get all control information + + call zdev_restore(fd) + + # get image data + + if ( frame[1] == IDS_EOD) { + for ( i = 1 ; i <= i_maxframes ; i = i + 1) + frame[i] = i + frame[i+1] = IDS_EOD + } + if ( frame[1] != 0 ) { + for ( i = 1 ; frame[i] != IDS_EOD ; i = i + 1) + call zim_restore (fd, frame[i]) + } + + # get graphics data + + if ( graph[1] == IDS_EOD) { + for ( i = 1 ; i <= i_maxgraph ; i = i + 1) + graph[i] = i + graph[i+1] = IDS_EOD + } + if ( graph[1] != 0 ) { + for ( i = 1 ; graph[i] != IDS_EOD ; i = i + 1) + call zgr_restore (fd, graph[i]) + } + + # upper end to close file +end diff --git a/pkg/images/tv/iis/ids/idssave.x b/pkg/images/tv/iis/ids/idssave.x new file mode 100644 index 00000000..a66ebc00 --- /dev/null +++ b/pkg/images/tv/iis/ids/idssave.x @@ -0,0 +1,82 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_SAVE -- Save the control state of the display, together with +# zero to all of the image and graphics planes. + +procedure ids_save (data, n) + +short data[ARB] # instruction data words +short n # count of data words + +int fd # binary file output descriptor +short i, j +short frame[IDS_MAXIMPL+1] # frames to save +short graph[IDS_MAXGRPL+1] # graph planes to save + +include "../lib/ids.com" + +begin + # do we need to check n ?? + + # determine file descriptor to write (opened by upper end) + # ( assume upper end has saved whatever data it wanted and + # leaves fd pointing at control information offset) + # then squirrel away the frame data + + fd = data[1] + + # image data + + i = 1 + j = 0 + repeat { + i = i + 1 + j = j + 1 + frame[j] = data[i] + } until ( data[i] == IDS_EOD ) + call write(fd, j, SZ_SHORT) + call write(fd, frame[1], j*SZ_SHORT) + + # graph data + + j = 0 + repeat { + i = i + 1 + j = j + 1 + graph[j] = data[i] + } until ( data[i] == IDS_EOD ) + call write(fd, j, SZ_SHORT) + call write(fd, graph[1], j*SZ_SHORT) + + # get all control information + + call zdev_save(fd) + + # get image data + + if ( frame[1] == IDS_EOD) { + for ( i = 1 ; i <= i_maxframes ; i = i + 1) + frame[i] = i + frame[i+1] = IDS_EOD + } + if ( frame[1] != 0 ) { + for ( i = 1 ; frame[i] != IDS_EOD ; i = i + 1) + call zim_save (fd, frame[i]) + } + + # get graphics data + + if ( graph[1] == IDS_EOD) { + for ( i = 1 ; i <= i_maxgraph ; i = i + 1) + graph[i] = i + graph[i+1] = IDS_EOD + } + if ( graph[1] != 0 ) { + for ( i = 1 ; graph[i] != IDS_EOD ; i = i + 1) + call zgr_save (fd, graph[i]) + } + + # upper end to close file +end diff --git a/pkg/images/tv/iis/ids/idsscur.x b/pkg/images/tv/iis/ids/idsscur.x new file mode 100644 index 00000000..7ec48c32 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsscur.x @@ -0,0 +1,12 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IDS_SETCURSOR -- Set the position of a cursor. + +procedure ids_setcursor (x, y, cursor) + +int x, y # new position of cursor +int cursor # cursor to be set + +begin + call zcursor_set(cursor, x, y) +end diff --git a/pkg/images/tv/iis/ids/idsstream.x b/pkg/images/tv/iis/ids/idsstream.x new file mode 100644 index 00000000..bb7360b4 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsstream.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IDS_GRSTREAM -- Set the FD of the graphics/image stream, to which +# we return cell arrays and cursor values. + +procedure ids_grstream (stream) + +int stream + +include "../lib/ids.com" + +begin + i_in = stream +end diff --git a/pkg/images/tv/iis/ids/idstx.x b/pkg/images/tv/iis/ids/idstx.x new file mode 100644 index 00000000..7209d00b --- /dev/null +++ b/pkg/images/tv/iis/ids/idstx.x @@ -0,0 +1,428 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include <gset.h> +include <gki.h> +include "../lib/ids.h" + +define BASECS_X 12 # Base (size 1.0) char width in GKI coords. +define BASECS_Y 12 # Base (size 1.0) char height in GKI coords. + + +# IDS_TEXT -- Draw a text string. The string is drawn at the position (X,Y) +# using the text attributes set by the last GKI_TXSET instruction. The text +# string to be drawn may contain embedded set font escape sequences of the +# form \fR (roman), \fG (greek), etc. We break the input text sequence up +# into segments at font boundaries and draw these on the output device, +# setting the text size, color, font, and position at the beginning of each +# segment. + +procedure ids_text (xc, yc, text, n) + +int xc, yc # where to draw text string +short text[ARB] # text string +int n # number of characters + +real x, y, dx, dy, tsz +int x1, x2, y1, y2, orien +int x0, y0, ids_dx, ids_dy, ch, cw +int xstart, ystart, newx, newy +int totlen, polytext, font, seglen +pointer sp, seg, ip, op, tx, first +int stx_segment() + +include "../lib/ids.com" + +real i_dx, i_dy # scale GKI to window coords +int i_x1, i_y1 # origin of device window +int i_x2, i_y2 # upper right corner of device window +data i_dx /1.0/, i_dy /1.0/ +data i_x1 /0/, i_y1 /0/, i_x2 /GKI_MAXNDC/, i_y2 / GKI_MAXNDC/ + +begin + call smark (sp) + call salloc (seg, n + 2, TY_CHAR) + + # Set pointer to the text attribute structure. + tx = IDS_TXAP(i_kt) + + # Set the text size and color if not already set. Both should be + # invalidated when the screen is cleared. Text color should be + # invalidated whenever another color is set. The text size was + # set by ids_txset, and is just a scaling factor. + + IDS_TXSIZE(i_kt) = TX_SIZE(tx) + # For display, have 32767 sizes, so just scale the the base sizes. + tsz = GKI_UNPACKREAL(TX_SIZE(tx)) # scale factor + ch = IDS_CHARHEIGHT(i_kt,1) * tsz + cw = IDS_CHARWIDTH(i_kt,1) * tsz + + if (TX_COLOR(tx) != IDS_COLOR(i_kt)) { + # Should do something like call ids_color (TX_COLOR(tx)) + # But that requires some association of color with hardware + # and what that should be is not clear. + IDS_COLOR(i_kt) = TX_COLOR(tx) + } + + # Set the linetype to a solid line, and invalidate last setting. + call ids_linetype (GL_SOLID) + IDS_TYPE(i_kt) = -1 + + # Break the text string into segments at font boundaries and count + # the total number of printable characters. + + totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx)) + + # Compute the text drawing parameters, i.e., the coordinates of the + # first character to be drawn, the step between successive characters, + # and the polytext flag (GKI coords). + + call stx_parameters (xc,yc, totlen, x0,y0, ids_dx,ids_dy, polytext, + orien) + + # Draw the segments, setting the font at the beginning of each segment. + # The first segment is drawn at (X0,Y0). The separation between + # characters is DX,DY. A segment is drawn as a block if the polytext + # flag is set, otherwise each character is drawn individually. + + x = x0 * i_dx + i_x1 + y = y0 * i_dy + i_y1 + dx = ids_dx * i_dx + dy = ids_dy * i_dy + + for (ip=seg; Memc[ip] != EOS; ip=ip+1) { + # Process the font control character heading the next segment. + font = Memc[ip] + ip = ip + 1 + + # Draw the segment. + while (Memc[ip] != EOS) { + # Clip leading out of bounds characters. + for (; Memc[ip] != EOS; ip=ip+1) { + x1 = x; x2 = x1 + cw + y1 = y; y2 = y1 + ch + + if (x1 >= i_x1 && x2 <= i_x2 && y1 >= i_y1 && y2 <= i_y2) + break + else { + x = x + dx + y = y + dy + } + + if (polytext == NO) { + ip = ip + 1 + break + } + } + + # Coords of first char to be drawn. + xstart = x + ystart = y + + # Move OP to first out of bounds char. + for (op=ip; Memc[op] != EOS; op=op+1) { + x1 = x; x2 = x1 + cw + y1 = y; y2 = y1 + ch + + if (x1 <= i_x1 || x2 >= i_x2 || y1 <= i_y1 || y2 >= i_y2) + break + else { + x = x + dx + y = y + dy + } + + if (polytext == NO) { + op = op + 1 + break + } + } + + # Count number of inbounds chars. + seglen = op - ip + + # Leave OP pointing to the end of this segment. + if (polytext == NO) + op = ip + 1 + else { + while (Memc[op] != EOS) + op = op + 1 + } + + # Compute X,Y of next segment. + newx = xstart + (dx * (op - ip)) + newy = ystart + dy + + # Quit if no inbounds chars. + if (seglen == 0) { + x = newx + y = newy + ip = op + next + } + + # Output the inbounds chars. + + first = ip + x = xstart + y = ystart + + while (seglen > 0 && (polytext == YES || ip == first)) { + call ids_drawchar (Memc[ip], nint(x), nint(y), cw, ch, + orien, font) + ip = ip + 1 + seglen = seglen - 1 + x = x + dx + y = y + dy + } + + x = newx + y = newy + ip = op + } + } + + call sfree (sp) +end + + +# STX_SEGMENT -- Process the text string into segments, in the process +# converting from type short to char. The only text attribute that can +# change within a string is the font, so segments are broken by \fI, \fG, +# etc. font select sequences embedded in the text. The segments are encoded +# sequentially in the output string. The first character of each segment is +# the font number. A segment is delimited by EOS. A font number of EOS +# marks the end of the segment list. The output string is assumed to be +# large enough to hold the segmented text string. + +int procedure stx_segment (text, n, out, start_font) + +short text[ARB] # input text +int n # number of characters in text +char out[ARB] # output string +int start_font # initial font code + +int ip, op +int totlen, font + +begin + out[1] = start_font + totlen = 0 + op = 2 + + for (ip=1; ip <= n; ip=ip+1) { + if (text[ip] == '\\' && text[ip+1] == 'f') { + # Select font. + out[op] = EOS + op = op + 1 + ip = ip + 2 + + switch (text[ip]) { + case 'B': + font = GT_BOLD + case 'I': + font = GT_ITALIC + case 'G': + font = GT_GREEK + default: + font = GT_ROMAN + } + + out[op] = font + op = op + 1 + + } else { + # Deposit character in segment. + out[op] = text[ip] + op = op + 1 + totlen = totlen + 1 + } + } + + # Terminate last segment and add null segment. + + out[op] = EOS + out[op+1] = EOS + + return (totlen) +end + + +# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates +# of the lower left corner of the first character to be drawn, the spacing +# between characters, and the polytext flag. Input consists of the coords +# of the text string, the length of the string, and the text attributes +# defining the character size, justification in X and Y of the coordinates, +# and orientation of the string. All coordinates are in GKI units. + +procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien) + +int xc, yc # coordinates at which string is to be drawn +int totlen # number of characters to be drawn +int x0, y0 # lower left corner of first char to be drawn +int dx, dy # step in X and Y between characters +int polytext # OK to output text segment all at once +int orien # rotation angle of characters + +pointer tx +int up, path +real dir, ch, cw, cosv, sinv, space, sz +real xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q + +include "../lib/ids.com" + +begin + tx = IDS_TXAP(i_kt) + + # Get character sizes in GKI coords. + sz = GKI_UNPACKREAL (TX_SIZE(tx)) + ch = IDS_CHARHEIGHT(i_kt,1) * sz + cw = IDS_CHARWIDTH(i_kt,1) * sz + + # Compute the character rotation angle. This is independent of the + # direction in which characters are drawn. A character up vector of + # 90 degrees (normal) corresponds to a rotation angle of zero. + + up = TX_UP(tx) + orien = up - 90 + + # Determine the direction in which characters are to be plotted. + # This depends on both the character up vector and the path, which + # is defined relative to the up vector. + + path = TX_PATH(tx) + switch (path) { + case GT_UP: + dir = up + case GT_DOWN: + dir = up - 180 + case GT_LEFT: + dir = up + 90 + default: # GT_NORMAL, GT_RIGHT + dir = up - 90 + } + + # ------- DX, DY --------- + # Convert the direction vector into the step size between characters. + # Note CW and CH are in GKI coordinates, hence DX and DY are too. + # Additional spacing of some fraction of the character size is used + # if TX_SPACING is nonzero. + + dir = -DEGTORAD(dir) + cosv = cos (dir) + sinv = sin (dir) + + # Correct for spacing (unrotated). + space = (1.0 + TX_SPACING(tx)) + if (path == GT_UP || path == GT_DOWN) + p = ch * space + else + p = cw * space + q = 0 + + # Correct for rotation. + dx = p * cosv + q * sinv + dy = -p * sinv + q * cosv + + # ------- XU, YU --------- + # Determine the coordinates of the center of the first character req'd + # to justify the string, assuming dimensionless characters spaced on + # centers DX,DY apart. + + xvlen = dx * (totlen - 1) + yvlen = dy * (totlen - 1) + + switch (TX_HJUSTIFY(tx)) { + case GT_CENTER: + xu = - (xvlen / 2.0) + case GT_RIGHT: + # If right justify and drawing to the left, no offset req'd. + if (xvlen < 0) + xu = 0 + else + xu = -xvlen + default: # GT_LEFT, GT_NORMAL + # If left justify and drawing to the left, full offset right req'd. + if (xvlen < 0) + xu = -xvlen + else + xu = 0 + } + + switch (TX_VJUSTIFY(tx)) { + case GT_CENTER: + yu = - (yvlen / 2.0) + case GT_TOP: + # If top justify and drawing downward, no offset req'd. + if (yvlen < 0) + yu = 0 + else + yu = -yvlen + default: # GT_BOTTOM, GT_NORMAL + # If bottom justify and drawing downward, full offset up req'd. + if (yvlen < 0) + yu = -yvlen + else + yu = 0 + } + + # ------- XV, YV --------- + # Compute the offset from the center of a single character required + # to justify that character, given a particular character up vector. + # (This could be combined with the above case but is clearer if + # treated separately.) + + p = -DEGTORAD(orien) + cosv = cos(p) + sinv = sin(p) + + # Compute the rotated character in size X and Y. + xsize = abs ( cw * cosv + ch * sinv) + ysize = abs (-cw * sinv + ch * cosv) + + switch (TX_HJUSTIFY(tx)) { + case GT_CENTER: + xv = 0 + case GT_RIGHT: + xv = - (xsize / 2.0) + default: # GT_LEFT, GT_NORMAL + xv = xsize / 2 + } + + switch (TX_VJUSTIFY(tx)) { + case GT_CENTER: + yv = 0 + case GT_TOP: + yv = - (ysize / 2.0) + default: # GT_BOTTOM, GT_NORMAL + yv = ysize / 2 + } + + # ------- X0, Y0 --------- + # The center coordinates of the first character to be drawn are given + # by the reference position plus the string justification vector plus + # the character justification vector. + + x0 = xc + xu + xv + y0 = yc + yu + yv + + # The character drawing primitive requires the coordinates of the + # lower left corner of the character (irrespective of orientation). + # Compute the vector from the center of a character to the lower left + # corner of a character, rotate to the given orientation, and correct + # the starting coordinates by addition of this vector. + + p = - (cw / 2.0) + q = - (ch / 2.0) + + x0 = x0 + ( p * cosv + q * sinv) + y0 = y0 + (-p * sinv + q * cosv) + + # ------- POLYTEXT --------- + # Set the polytext flag. Polytext output is possible only if chars + # are to be drawn to the right with no extra spacing between chars. + + if (abs(dy) == 0 && dx == cw) + polytext = YES + else + polytext = NO +end diff --git a/pkg/images/tv/iis/ids/idstxset.x b/pkg/images/tv/iis/ids/idstxset.x new file mode 100644 index 00000000..3c9529da --- /dev/null +++ b/pkg/images/tv/iis/ids/idstxset.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <gki.h> +include "../lib/ids.h" + +# IDS_TXSET -- Set the text drawing attributes. + +procedure ids_txset (gki) + +short gki[ARB] # attribute structure + +pointer tx + +include "../lib/ids.com" + +begin + tx = IDS_TXAP(i_kt) + TX_UP(tx) = gki[GKI_TXSET_UP] + TX_PATH(tx) = gki[GKI_TXSET_P ] + TX_HJUSTIFY(tx) = gki[GKI_TXSET_HJ] + TX_VJUSTIFY(tx) = gki[GKI_TXSET_VJ] + TX_FONT(tx) = gki[GKI_TXSET_F ] + TX_QUALITY(tx) = gki[GKI_TXSET_Q ] + TX_COLOR(tx) = gki[GKI_TXSET_CI] + + TX_SPACING(tx) = GKI_UNPACKREAL (gki[GKI_TXSET_SP]) + TX_SIZE(tx) = gki[GKI_TXSET_SZ] + +end diff --git a/pkg/images/tv/iis/ids/idsvector.x b/pkg/images/tv/iis/ids/idsvector.x new file mode 100644 index 00000000..6d1ec502 --- /dev/null +++ b/pkg/images/tv/iis/ids/idsvector.x @@ -0,0 +1,122 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <fset.h> +include "../lib/ids.h" + +define MAXC 10000 # just a largish int here + +# IDS_VECTOR -- Plot a line in the current plane; the starting coordinates +# are in ids.com: i_pt_x, i_pt_y. The end points are the arguments +# to vector. +# the code is Bresenham's algorithm, as taken from the line drawing +# routine in Forth-11 image display code. + +procedure ids_vector (ax,ay) + +short ax,ay # vector end coordinates, GKI + +short x,y +short xe ,ye # end coordinates, device +short dx,dy,dd +short xi,yi, xid,yid # increments +short total, e # total change and error +int bufsize # file i/o buffersize +int fstati() +int count, cmax + +include "../lib/ids.com" + +begin + x = ax + y = ay + + bufsize = fstati(i_out, F_BUFSIZE) + + # convert x,y to device coords. + xe = real(x) * i_xres /(GKI_MAXNDC+1) + ye = real(y) * i_yres /(GKI_MAXNDC+1) + + # determine delta x and y, and x/y increments + + dx = xe - i_pt_x + dy = ye - i_pt_y + + # set movement increments, take absolute value of dx, dy + if ( dy >= 0 ) + yi = 1 + else { + yi = -1 + dy = -dy + } + if ( dx >= 0 ) + xi = 1 + else { + xi = -1 + dx = -dx + } + + # set diagonal movement increments + xid = xi + yid = yi + + # if, for instance, pos. slope less than 45 degrees, most movement + # is in x, so then set (the ususal) y increment to zero + if ( dy >= dx ) + xi = 0 + else + yi = 0 + + # Set up for buffer of one, and let code find best buffering + cmax = 0 + call fseti(i_out, F_BUFSIZE, 1) + count = 0 + + # Plot the first point + call ids_rpoint (0, 0) + + # Is there anything to do? determine total increments to plot; if + # zero, quit + total = dx + dy + if ( total == 0 ) { + call fseti (i_out, F_BUFSIZE, bufsize) + return + } + + # set error to zero, determine difference in x,y change. + e = 0 + dd = dy - dx + if ( dd >= 0 ) { + dd = -dd + dy = dx + } + + # plot the line + repeat { + dx = dd + e + if ( (dy + e + dx) >= 0 ) { + # diagonal plot, accounts for two units of increment + if ( count > cmax ) { + # leaving current (x) line, so determine how many points + # have plotted on line and use this (maximum) as line + # buffering size + call fseti(i_out, F_BUFSIZE, count) + cmax = count + count = 0 + } + call ids_rpoint ( xid, yid ) + total = total - 2 + e = dx + } else { + # move in x (or y) only; for the small positive slope line, + # real line will move up and finally over line being plotted, + # hence e increases. + call ids_rpoint ( xi, yi ) + total = total - 1 + e = e + dy + count = count + 1 + } + } until ( total <= 0 ) + # restore original buffer size + call fseti(i_out, F_BUFSIZE, bufsize) +end diff --git a/pkg/images/tv/iis/ids/mkpkg b/pkg/images/tv/iis/ids/mkpkg new file mode 100644 index 00000000..79778100 --- /dev/null +++ b/pkg/images/tv/iis/ids/mkpkg @@ -0,0 +1,43 @@ +# Make the CV package library. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + idscancel.x ../lib/ids.com ../lib/ids.h <fset.h> + idschars.x ../lib/ids.com ../lib/ids.h + idsclear.x ../lib/ids.com ../lib/ids.h + idsclose.x ../lib/ids.com ../lib/ids.h + idsclosews.x ../lib/ids.h ../lib/ids.com + idscround.x ../lib/ids.h <gki.h> + idsdrawch.x font.com font.h <gki.h> <gset.h> <math.h> + idsescape.x ../lib/ids.com ../lib/ids.h <gki.h> + idsfa.x ../lib/ids.com ../lib/ids.h + idsfaset.x ../lib/ids.com ../lib/ids.h <gki.h> + idsflush.x ../lib/ids.com ../lib/ids.h + idsfont.x ../lib/ids.com ../lib/ids.h <gki.h> <gset.h> + idsgcell.x <mach.h> ../lib/ids.com ../lib/ids.h <gki.h> <gset.h> + idsgcur.x ../lib/ids.com ../lib/ids.h + idsinit.x ../lib/ids.com ../lib/ids.h <ctype.h> <gki.h> <mach.h> + idsline.x ../lib/ids.com ../lib/ids.h <gset.h> + idslutfill.x <gki.h> + idsopen.x ../lib/ids.com ../lib/ids.h <gki.h> + idsopenws.x ../lib/ids.com ../lib/ids.h <error.h> <gki.h>\ + <fset.h> <mach.h> + idspcell.x ../lib/ids.com ../lib/ids.h <gki.h> <gset.h> + idspl.x ../lib/ids.com ../lib/ids.h <gki.h> + idsplset.x ../lib/ids.com ../lib/ids.h <gki.h> + idspm.x ../lib/ids.com ../lib/ids.h <gki.h> + idspmset.x ../lib/ids.com ../lib/ids.h <gki.h> + idspoint.x ../lib/ids.com ../lib/ids.h <fset.h> <gki.h> + idsreset.x ../lib/ids.com ../lib/ids.h <gset.h> <gki.h> + idsrestore.x ../lib/ids.com ../lib/ids.h + idssave.x ../lib/ids.com ../lib/ids.h + idsscur.x + idsstream.x ../lib/ids.com ../lib/ids.h + idstx.x ../lib/ids.com ../lib/ids.h <gki.h> <gset.h> <math.h> + idstxset.x ../lib/ids.com ../lib/ids.h <gki.h> <gset.h> + idsvector.x ../lib/ids.com ../lib/ids.h <fset.h> <gki.h> + ; diff --git a/pkg/images/tv/iis/ids/testcode/README b/pkg/images/tv/iis/ids/testcode/README new file mode 100644 index 00000000..31198b43 --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/README @@ -0,0 +1,2 @@ +This is junk code which I think should be thrown away. I will leave it here +for the time just in case. (LED 22/4/91) diff --git a/pkg/images/tv/iis/ids/testcode/box.x b/pkg/images/tv/iis/ids/testcode/box.x new file mode 100644 index 00000000..e3c1d22b --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/box.x @@ -0,0 +1,83 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "imd.h" +include <gki.h> + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# create a box test image + +procedure t_im() + +pointer gp +char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME] +int fd + +pointer gopen() +bool streq() +int open() + +short i,data[DIM+1] +short set_image[6] +int key +real x[30],y[30] +real lb,ub,mid +int mod() + +begin + call clgstr("output", output, SZ_FNAME) + if (!streq (output, "") ) { + call strcpy (output, output_file, SZ_FNAME) + fd = open (output_file, NEW_FILE, BINARY_FILE) + } else + fd = open ("dev$stdimage", NEW_FILE, BINARY_FILE) + + call clgstr("device", device, SZ_FNAME) + gp = gopen ( device, NEW_FILE, fd) + + # now set up boxes + set_image[1] = 1 + set_image[2] = IMD_EOD + set_image[3] = IMD_BLUE + set_image[4] = IMD_EOD + call gescape ( gp, IMD_SET_GP, set_image, 4) + lb = 0.0 + ub = 1.0 + mid = (lb + ub)/2. + for ( i = 1; i <= 5 ; i = i + 1 ) { + if ( mod(i-1,2) == 0 ) { + x[1] = lb + y[1] = mid + x[2] = mid + y[2] = ub + x[3] = ub + y[3] = mid + x[4] = mid + y[4] = lb + x[5] = lb + y[5] = mid + } else { + x[1] = (mid-lb)/2 + lb + y[1] = x[1] + x[2] = x[1] + # x[2] = x[1] - .05 + y[2] = y[1] + mid - lb + x[3] = y[2] + y[3] = y[2] + # y[3] = y[2] - .05 + x[4] = y[2] + y[4] = x[1] + x[5] = x[1] + y[5] = y[1] + lb = x[1] + ub = y[2] + } + call gpline ( gp, x, y, 5) + } + + # all done + call gclose ( gp ) + call close ( fd ) +end diff --git a/pkg/images/tv/iis/ids/testcode/boxin.x b/pkg/images/tv/iis/ids/testcode/boxin.x new file mode 100644 index 00000000..e854935f --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/boxin.x @@ -0,0 +1,98 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <fio.h> +include <fset.h> +include "ids.h" +include <gki.h> + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# create a box test image + +procedure t_im() + +pointer gp +char device[SZ_FNAME] + +pointer gopen() +int dd[LEN_GKIDD] + +short i,data[DIM+1] +short set_image[6] +int key, j +real x[30],y[30] +real lb,ub,mid +int mod() + +begin + call clgstr("device", device, SZ_FNAME) + call ids_open (device, dd) + call gki_inline_kernel (STDIMAGE, dd) + gp = gopen ( device, NEW_FILE, STDIMAGE) + + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + + # enable the blue plane + set_image[1] = IDS_ON + set_image[2] = IDS_EOD # all graphics frames + set_image[3] = IDS_BLUE # color + set_image[4] = IDS_EOD + set_image[5] = IDS_EOD # all quadrants + call gescape ( gp, IDS_DISPLAY_G, set_image, 5) + + # set which plane to write into + set_image[1] = 1 + set_image[2] = IDS_EOD # first graphics frame + set_image[3] = IDS_BLUE # color + set_image[4] = IDS_EOD + call gescape ( gp, IDS_SET_GP, set_image, 4) + + # now set up boxes + lb = 0.0 + ub = 1.0 + mid = (lb + ub)/2. + for ( i = 1; i <= 5 ; i = i + 1 ) { + if ( mod(i-1,2) == 0 ) { + x[1] = lb + y[1] = mid + x[2] = mid + y[2] = ub + x[3] = ub + y[3] = mid + x[4] = mid + y[4] = lb + x[5] = lb + y[5] = mid + } else { + x[1] = (mid-lb)/2 + lb + y[1] = x[1] + x[2] = x[1] + y[2] = y[1] + mid - lb + x[3] = y[2] + y[3] = y[2] + x[4] = y[2] + y[4] = x[1] + x[5] = x[1] + y[5] = y[1] + lb = x[1] + ub = y[2] + } + do j = 1,5 { + x[j] = x[j] * 32768. / 32767. + if (x[j] > 1.0) + x[j] = 1.0 + y[j] = y[j] * 32768. / 32767. + if (y[j] > 1.0) + y[j] = 1.0 + } + call gpline ( gp, x, y, 5) + } + + # all done + call gclose ( gp ) + call ids_close +end diff --git a/pkg/images/tv/iis/ids/testcode/crin.x b/pkg/images/tv/iis/ids/testcode/crin.x new file mode 100644 index 00000000..c9d27279 --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/crin.x @@ -0,0 +1,130 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <fio.h> +include <fset.h> +include "ids.h" +include <gki.h> +include <gset.h> + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# zoom + +procedure t_im() + +pointer gp +char device[SZ_FNAME] + +pointer gopen() +int dd[LEN_GKIDD] + +short i, data[DIM+1] +int key, but, fnum +real x, y +real xjunk, yjunk + +begin + call clgstr("device", device, SZ_FNAME) + call ids_open (device, dd) + call gki_inline_kernel (STDIMAGE, dd) + gp = gopen ( device, NEW_FILE, STDIMAGE) + + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + call ids_grstream (STDIMAGE) + + # read first to clear box + call gseti(gp, G_CURSOR, IDS_BUT_RD) + call ggcur(gp, xjunk, yjunk, key) + + i = 1 + repeat { + call eprintf("set zoom and zoom center\n") + call gseti (gp, G_CURSOR, IDS_BUT_WT) + call ggcur(gp, x, y, but) + call gseti (gp, G_CURSOR, 1) + call ggcur(gp, x, y, key) + call zm(gp, but, x, y) + call eprintf("set frame, 4 to exit\n") + call gseti (gp, G_CURSOR, IDS_BUT_WT) + call ggcur(gp, xjunk, yjunk, fnum) + if ( fnum == 4) + break + call iset(gp, fnum) + repeat { + call gseti (gp, G_CURSOR, IDS_BUT_WT) + call ggcur(gp, xjunk, yjunk, but) + call gseti (gp, G_CURSOR, fnum) + call rpc(gp, x, y, key) + call ggcell (gp, data, 1, 1, x, y, x, y) + call eprintf("frame %d, datum: %d\n") + call pargi (fnum) + call pargs (data[1]) + } until ( but == 4) + } until ( i == 0 ) + + + # all done + call gclose ( gp ) + call ids_close +end + +# rpcursor --- read and print cursor + +procedure rpc(gp, sx, sy, key) + +pointer gp +real sx,sy +int key + +begin + call ggcur (gp, sx, sy, key) + call eprintf("cursor: (%f,%f) (%d,%d) key %d\n") + call pargr (sx) + call pargr (sy) + call pargi ( int(sx*32767)/64) + call pargi ( int(sy*32767)/64) + call pargi (key) +end + +# zoom + +procedure zm(gp, pow, x, y) + +int pow +pointer gp +real x, y + +short data[9] + +begin + data[1] = IDS_ZOOM + data[2] = IDS_WRITE + data[3] = 3 + data[4] = IDS_EOD + data[5] = IDS_EOD + data[6] = 0 + data[7] = 2**(pow-1) + data[8] = x * GKI_MAXNDC + data[9] = y * GKI_MAXNDC + call gescape ( gp, IDS_CONTROL, data[1], 9) +end + +# set image plane for operation + +procedure iset (gp, frame) + +int frame +pointer gp + +short data[10] + +begin + data[1] = frame + data[2] = IDS_EOD + data[3] = IDS_EOD # all bitplanes + call gescape (gp, IDS_SET_IP, data, 3) +end diff --git a/pkg/images/tv/iis/ids/testcode/grey.x b/pkg/images/tv/iis/ids/testcode/grey.x new file mode 100644 index 00000000..a7e16b83 --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/grey.x @@ -0,0 +1,90 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "imd.h" + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# create a grey scale test image, using frames 1 and 2, and +# position the cursor in the upper right quadrant. + +procedure t_im() + +pointer gp +char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME] +int fd + +pointer gopen() +bool streq() +int open() + +short i,data[DIM+1] +short display[6] +short set_image[3] +real y, sx, sy +int key + +begin + call clgstr("output", output, SZ_FNAME) + if (!streq (output, "") ) { + call strcpy (output, output_file, SZ_FNAME) + fd = open (output_file, NEW_FILE, BINARY_FILE) + } else + fd = open ("dev$stdimage", NEW_FILE, BINARY_FILE) + + call clgstr("device", device, SZ_FNAME) + gp = gopen ( device, NEW_FILE, fd) + + data[1] = IMD_R_HARD + call gescape ( gp, IMD_RESET, data, 1) + # display all frames off + display[1] = IMD_OFF + display[2] = IMD_EOD # all frames + display[3] = IMD_EOD # all colors + display[4] = IMD_EOD # all quads + call gescape ( gp, IMD_DISPLAY_I, display, 6) + # display frames 1, 2 on -- 1 red, 2 green + display[1] = IMD_ON + display[2] = 1 + display[3] = IMD_EOD + display[4] = IMD_RED + display[5] = IMD_EOD + display[6] = IMD_EOD # all quads + call gescape ( gp, IMD_DISPLAY_I, display, 6) + display[1] = IMD_ON + display[2] = 2 + display[3] = IMD_EOD + display[4] = IMD_GREEN + display[5] = IMD_EOD + display[6] = IMD_EOD # all quads + call gescape ( gp, IMD_DISPLAY_I, display, 6) + + # now set up grey scale changing upward in frame 1 + set_image[1] = 1 + set_image[2] = IMD_EOD + set_image[3] = IMD_EOD # all planes + call gescape ( gp, IMD_SET_IP, set_image, 3) + for ( i = 1; i <= DIM ; i = i + 1 ) { + call amovks ( i-1, data, DIM) + y = real(i-1)/(DIM-1) + call gpcell ( gp, data, DIM, 1, 0., y, 1., y) + } + + # grey scale changing horizontally in frame 2 + set_image[1] = 2 + call gescape ( gp, IMD_SET_IP, set_image, 3) + do i = 1, DIM + data[i] = i + call gpcell ( gp, data, DIM, 1, 0., 0., 1., 1.) + + # set the cursor + call gscur ( gp, 0.0, 1.0) + + # read cursor + # call ggcur( gp, sx, sy, key) + + # all done + call gclose ( gp ) + call close ( fd ) +end diff --git a/pkg/images/tv/iis/ids/testcode/grin.x b/pkg/images/tv/iis/ids/testcode/grin.x new file mode 100644 index 00000000..b76e58b2 --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/grin.x @@ -0,0 +1,98 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <fio.h> +include <fset.h> +include <gki.h> +include "ids.h" + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# create a grey scale test image, using frames 1 and 2, and +# position the cursor in the upper right quadrant. + +procedure t_im() + +pointer gp +char device[SZ_FNAME] + +pointer gopen() +int open() +int dd[LEN_GKIDD] + +short i,data[DIM+1] +short display[6] +short set_image[3] +real y, sx, sy +int key + +begin + call clgstr("device", device, SZ_FNAME) + call ids_open (device, dd) + call gki_inline_kernel (STDIMAGE, dd) + gp = gopen ( device, NEW_FILE, STDIMAGE) + + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + call ids_grstream(STDIMAGE) + + data[1] = IDS_R_HARD + call gescape ( gp, IDS_RESET, data, 1) + # display all frames off + display[1] = IDS_OFF + display[2] = IDS_EOD # all frames + display[3] = IDS_EOD # all colors + display[4] = IDS_EOD # all quads + call gescape ( gp, IDS_DISPLAY_I, display, 6) + # display frames 1, 2 on -- 1 red, 2 green + display[1] = IDS_ON + display[2] = 1 + display[3] = IDS_EOD + display[4] = IDS_RED + display[5] = IDS_EOD + display[6] = IDS_EOD # all quads + call gescape ( gp, IDS_DISPLAY_I, display, 6) + display[1] = IDS_ON + display[2] = 2 + display[3] = IDS_EOD + display[4] = IDS_GREEN + display[5] = IDS_EOD + display[6] = IDS_EOD # all quads + call gescape ( gp, IDS_DISPLAY_I, display, 6) + + # now set up grey scale changing upward in frame 1 + set_image[1] = 1 + set_image[2] = IDS_EOD + set_image[3] = IDS_EOD # all planes + call gescape ( gp, IDS_SET_IP, set_image, 3) + for ( i = 1; i <= DIM ; i = i + 1 ) { + call amovks ( i-1, data, DIM) + y = real(i-1)/(DIM-1) + call gpcell ( gp, data, DIM, 1, 0., y, 1., y) + } + + # grey scale changing horizontally in frame 2 + set_image[1] = 2 + call gescape ( gp, IDS_SET_IP, set_image, 3) + do i = 1, DIM + data[i] = i-1 + call gpcell ( gp, data, DIM, 1, 0., 0., 1., 1.) + + # set the cursor + call gscur ( gp, 0.0, 1.0) + + # read cursor + call ggcur (gp, sx, sy, key) + call eprintf("cursor read as : (%f,%f) (%d,%d), key %d\n") + call pargr (sx) + call pargr (sy) + call pargi ( int(sx*32767)/64) + call pargi ( int(sy*32767)/64) + call pargi (key) + + # all done + call gclose (gp) + call ids_close +end diff --git a/pkg/images/tv/iis/ids/testcode/scr.x b/pkg/images/tv/iis/ids/testcode/scr.x new file mode 100644 index 00000000..ec4821cf --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/scr.x @@ -0,0 +1,130 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "imd.h" +include <gset.h> +include <gki.h> + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# scroll + +procedure t_im() + +pointer gp +char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME] +int fd + +pointer gopen() +bool streq() +int open() +common /local/gp + +begin + call clgstr("output", output, SZ_FNAME) + if (!streq (output, "") ) { + call strcpy (output, output_file, SZ_FNAME) + fd = open (output_file, NEW_FILE, BINARY_FILE) + } else + fd = open ("dev$stdimage", NEW_FILE, BINARY_FILE) + + call clgstr("device", device, SZ_FNAME) + gp = gopen ( device, NEW_FILE, fd) + + call cl_button + call scroll(0,0) + call cursor(128,128) + call wt_button + call scroll(128,195) + call cursor(128,128) + call wt_button + call zm(4,128,128) + call wt_button + call cursor(128,128) + call wt_button + call zm(1,205,205) + + # all done + call gclose ( gp ) + call close ( fd ) +end + +procedure scroll(x,y) + +int x,y + +pointer gp +common /local/gp +short data[8] + +begin + data[1] = IMD_SCROLL + data[2] = IMD_WRITE + data[3] = 2 + data[4] = IMD_EOD + data[5] = IMD_EOD + data[6] = 0 + data[7] = (x-1) * MCXSCALE + data[8] = (y-1) * MCYSCALE + call gescape(gp, IMD_CONTROL, data, 8) +end + +procedure cursor(x,y) + +int x,y +pointer gp +real xr, yr +common /local/gp + +begin + xr = real((x-1)*MCXSCALE)/GKI_MAXNDC + yr = real((y-1)*MCXSCALE)/GKI_MAXNDC + call gseti(gp, G_CURSOR, 1) + call gscur(gp, xr, yr) +end + +procedure wt_button + +real x,y +int key +pointer gp +common /local/gp +begin + call gseti(gp, G_CURSOR, IMD_BUT_WT) + call ggcur(gp, x, y, key) +end + +procedure cl_button + +real x,y +int key +pointer gp +common /local/gp + +begin + call gseti(gp, G_CURSOR, IMD_BUT_RD) + call ggcur(gp, x, y, key) +end + +procedure zm(power, x,y) + +int power +int x,y + +short data[9] +pointer gp +common /local/gp + +begin + data[1] = IMD_ZOOM + data[2] = IMD_WRITE + data[3] = 3 + data[4] = IMD_EOD + data[5] = IMD_EOD + data[6] = 0 + data[7] = power + data[8] = (x-1) * MCXSCALE + data[9] = (y-1) * MCYSCALE + call gescape(gp, IMD_CONTROL, data, 9) +end diff --git a/pkg/images/tv/iis/ids/testcode/scrin.x b/pkg/images/tv/iis/ids/testcode/scrin.x new file mode 100644 index 00000000..7a704fe4 --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/scrin.x @@ -0,0 +1,130 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <fio.h> +include <fset.h> +include "ids.h" +include <gset.h> +include <gki.h> + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# scroll + +procedure t_im() + +pointer gp +char device[SZ_FNAME] + +pointer gopen() +int dd[LEN_GKIDD] +common /local/gp + +begin + call clgstr("device", device, SZ_FNAME) + call ids_open (device, dd) + call gki_inline_kernel (STDIMAGE, dd) + gp = gopen ( device, NEW_FILE, STDIMAGE) + + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + call ids_grstream (STDIMAGE) + + call cl_button + call scroll(1,1) + call cursor(129,129) + call wt_button + call scroll(129,195) + call cursor(129,129) + call wt_button + call zm(4,129,129) + call wt_button + call cursor(129,129) + call wt_button + call zm(1,205,205) + + # all done + call gclose ( gp ) + call ids_close +end + +procedure scroll(x,y) + +int x,y + +pointer gp +common /local/gp +short data[8] + +begin + data[1] = IDS_SCROLL + data[2] = IDS_WRITE + data[3] = 2 + data[4] = IDS_EOD + data[5] = IDS_EOD + data[6] = 0 + data[7] = (x-1) * MCXSCALE + data[8] = (y-1) * MCYSCALE + call gescape(gp, IDS_CONTROL, data, 8) +end + +procedure cursor(x,y) + +int x,y +pointer gp +real xr, yr +common /local/gp + +begin + xr = real((x-1)*MCXSCALE)/GKI_MAXNDC + yr = real((y-1)*MCXSCALE)/GKI_MAXNDC + call gseti(gp, G_CURSOR, 1) + call gscur(gp, xr, yr) +end + +procedure wt_button + +real x,y +int key +pointer gp +common /local/gp +begin + call gseti(gp, G_CURSOR, IDS_BUT_WT) + call ggcur(gp, x, y, key) +end + +procedure cl_button + +real x,y +int key +pointer gp +common /local/gp + +begin + call gseti(gp, G_CURSOR, IDS_BUT_RD) + call ggcur(gp, x, y, key) +end + +procedure zm(power, x,y) + +int power +int x,y + +short data[9] +pointer gp +common /local/gp + +begin + data[1] = IDS_ZOOM + data[2] = IDS_WRITE + data[3] = 3 + data[4] = IDS_EOD + data[5] = IDS_EOD + data[6] = 0 + data[7] = power + data[8] = (x-1) * MCXSCALE + data[9] = (y-1) * MCYSCALE + call gescape(gp, IDS_CONTROL, data, 9) +end diff --git a/pkg/images/tv/iis/ids/testcode/sn.x b/pkg/images/tv/iis/ids/testcode/sn.x new file mode 100644 index 00000000..ebce47c0 --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/sn.x @@ -0,0 +1,192 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <fio.h> +include <fset.h> +include "ids.h" +include <gki.h> +include <gset.h> +include <imhdr.h> + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# snap + +procedure t_im() + +pointer gp +char device[SZ_FNAME] +char cjunk[SZ_FNAME] + +pointer gopen() +int dd[LEN_GKIDD] + +int key, fnum, zfac +int ps, pe +real x, y +real xjunk, yjunk +int clgeti +bool image, clgetb + +begin + call clgstr("device", device, SZ_FNAME) + call ids_open (device, dd) + call gki_inline_kernel (STDIMAGE, dd) + gp = gopen ( device, NEW_FILE, STDIMAGE) + + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + call ids_grstream (STDIMAGE) + + # read first to clear box + call gseti(gp, G_CURSOR, IDS_BUT_RD) + call ggcur(gp, xjunk, yjunk, key) + + repeat { + if (clgetb ("done?")) + break + + zfac = clgeti ("zoom factor") + + call clgstr ("Set zoom center, press <cr>", cjunk, SZ_FNAME) + call gseti (gp, G_CURSOR, 1) + call ggcur(gp, x, y, key) + call zm(gp, zfac, x, y) + + image = clgetb("Do you want a picture?") + if (image) + call snapi (gp) + else { + repeat { + ps = clgeti ("starting line") + if ( ps == -1) + break + pe = clgeti ("ending line") + call snap (gp, ps, pe) + } + } + } + + + # all done + call gclose ( gp ) + call ids_close +end + +# zoom + +procedure zm(gp, pow, x, y) + +int pow +pointer gp +real x, y + +short data[9] + +begin + data[1] = IDS_ZOOM + data[2] = IDS_WRITE + data[3] = 3 + data[4] = IDS_EOD + data[5] = IDS_EOD + data[6] = 0 + data[7] = 2**(pow-1) + data[8] = x * GKI_MAXNDC + data[9] = y * GKI_MAXNDC + call gescape ( gp, IDS_CONTROL, data[1], 9) +end + +procedure snap (gp, ps, pe) + +pointer gp +int ps, pe + +real y +short data[7] +pointer sp +pointer sndata +int i,j + +begin + call smark (sp) + data[1] = IDS_SNAP + data[2] = IDS_WRITE + data[3] = 1 + data[4] = IDS_EOD + data[5] = IDS_EOD + data[6] = 0 + data[7] = IDS_SNAP_RGB + call gescape (gp, IDS_CONTROL, data, 7) + + if (pe < ps) { + call eprintf("Can't handle ending position < start \n") + return + } + + call salloc ( sndata, DIM, TY_SHORT) + call eprintf ("snapping from %d through %d\n") + call pargi (ps) + call pargi (pe) + call eprintf ("data values 0-5 255 256 511\n") + do i = ps, pe { + y = real(i)*MCYSCALE / GKI_MAXNDC. + call ggcell (gp, Mems[sndata], DIM, 1, 0.0, y, 1.0, y) + call eprintf ("r%3d data:") + call pargi (i) + call eprintf (" %5d %5d %5d %5d %5d %5d %5d %5d %5d\n") + do j = 0, 5 + call pargs (Mems[sndata+j]) + call pargs (Mems[sndata+255]) + call pargs (Mems[sndata+256]) + call pargs (Mems[sndata+511]) + } + + data[1] = IDS_R_SNAPDONE + call gescape (gp, IDS_RESET, data, 1) + + call sfree (sp) +end + +procedure snapi (gp) + +pointer gp + +real y +short data[7] +pointer im, immap(), impl2s() +char fname[SZ_FNAME] +int i + +begin + call clgstr ("file", fname, SZ_FNAME) + im = immap(fname, NEW_FILE, 0) + IM_PIXTYPE(im) = TY_SHORT + IM_LEN(im,1) = DIM + IM_LEN(im,2) = DIM + + data[1] = IDS_SNAP + data[2] = IDS_WRITE + data[3] = 1 + data[4] = IDS_EOD + data[5] = IDS_EOD + data[6] = 0 + data[7] = IDS_SNAP_RGB + call gescape (gp, IDS_CONTROL, data, 7) + + do i = 0, 511 { + if ( mod(i,52) == 0) { + call eprintf ("%d ") + call pargi (100*i/DIM) + call flush (STDERR) + } + y = real(i)*MCYSCALE / GKI_MAXNDC. + call ggcell (gp, Mems[impl2s(im,i+1)], 512, 1, 0.0, y, 1.0, y) + } + call eprintf ("\n") + + call imunmap(im) + data[1] = IDS_R_SNAPDONE + call gescape (gp, IDS_RESET, data, 1) +end diff --git a/pkg/images/tv/iis/ids/testcode/t_giis.x b/pkg/images/tv/iis/ids/testcode/t_giis.x new file mode 100644 index 00000000..601bc17b --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/t_giis.x @@ -0,0 +1,67 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <gki.h> + +# GIIS -- Graphics kernel for image output to the IIS. +# The whole package is copied as much as possible from the stdgraph package. + +procedure t_giis() + +int fd, list +pointer gki, sp, fname, devname +int dev[LEN_GKIDD], deb[LEN_GKIDD] +int debug, verbose, gkiunits +bool clgetb() +int clpopni(), clgfil(), open(), btoi() +int gki_fetch_next_instruction() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (devname, SZ_FNAME, TY_CHAR) + + # Open list of metafiles to be decoded. + list = clpopni ("input") + + # Get parameters. + call clgstr ("device", Memc[devname], SZ_FNAME) + if (clgetb ("generic")) { + debug = NO + verbose = NO + gkiunits = NO + } else { + debug = btoi (clgetb ("debug")) + verbose = btoi (clgetb ("verbose")) + gkiunits = btoi (clgetb ("gkiunits")) + } + + # Open the graphics kernel. + call ids_open (Memc[devname], dev) + call gkp_install (deb, STDERR, verbose, gkiunits) + + # Process a list of metacode files, writing the decoded metacode + # instructions on the standard output. + + while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) { + # Open input file. + iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) { + call erract (EA_WARN) + next + } + + # Process the metacode instruction stream. + while (gki_fetch_next_instruction (fd, gki) != EOF) { + if (debug == YES) + call gki_execute (Mems[gki], deb) + call gki_execute (Mems[gki], dev) + } + + call close (fd) + } + + call gkp_close() + call ids_close() + call clpcls (list) + call sfree (sp) +end diff --git a/pkg/images/tv/iis/ids/testcode/zm.x b/pkg/images/tv/iis/ids/testcode/zm.x new file mode 100644 index 00000000..dff01cbe --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/zm.x @@ -0,0 +1,64 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "imd.h" +include <gki.h> +include <gset.h> + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# zoom + +procedure t_im() + +pointer gp +char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME] +int fd + +pointer gopen() +bool streq() +int open() + +short i,data[DIM+1] +short set_image[6] +int key +real x[30],y[30] +int xjunk, yjunk + +begin + call clgstr("output", output, SZ_FNAME) + if (!streq (output, "") ) { + call strcpy (output, output_file, SZ_FNAME) + fd = open (output_file, NEW_FILE, BINARY_FILE) + } else + fd = open ("dev$stdimage", NEW_FILE, BINARY_FILE) + + call clgstr("device", device, SZ_FNAME) + gp = gopen ( device, NEW_FILE, fd) + + # now zoom after reading button presses + # read first to clear box + call gseti(gp, G_CURSOR, IMD_BUT_RD) + call ggcur(gp, xjunk, yjunk, key) + + for ( i = 1 ; i < 5 ; i = i + 1) { + call gseti(gp, G_CURSOR, IMD_BUT_WT) + call ggcur(gp, xjunk, yjunk, key) + + data[11] = IMD_ZOOM + data[12] = IMD_WRITE + data[13] = 3 + data[14] = IMD_EOD + data[15] = IMD_EOD + data[16] = 0 + data[17] = 4 + data[18] = (((i-1)* 128)-1) * MCXSCALE + data[19] = (((i-1)* 128)-1) * MCYSCALE + call gescape ( gp, IMD_CONTROL, data[11], 9) + } + + # all done + call gclose ( gp ) + call close ( fd ) +end diff --git a/pkg/images/tv/iis/ids/testcode/zmin.x b/pkg/images/tv/iis/ids/testcode/zmin.x new file mode 100644 index 00000000..676a72f0 --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/zmin.x @@ -0,0 +1,84 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <fio.h> +include <fset.h> +include "ids.h" +include <gki.h> +include <gset.h> + +define DIM 512 +define MCXSCALE 64 +define MCYSCALE 64 + +# zoom + +procedure t_im() + +pointer gp +char device[SZ_FNAME] + +pointer gopen() +int dd[LEN_GKIDD] + +short i,data[DIM+1] +short set_image[6] +int key +real x[30],y[30] +real xjunk, yjunk + +begin + call clgstr("device", device, SZ_FNAME) + call ids_open (device, dd) + call gki_inline_kernel (STDIMAGE, dd) + gp = gopen ( device, NEW_FILE, STDIMAGE) + + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + call ids_grstream (STDIMAGE) + + # now zoom after reading button presses + # read first to clear box + call gseti(gp, G_CURSOR, IDS_BUT_RD) + call ggcur(gp, xjunk, yjunk, key) + + for ( i = 1 ; i < 5 ; i = i + 1) { + call gseti (gp, G_CURSOR, IDS_BUT_WT) + call ggcur(gp, xjunk, yjunk, key) + call gseti (gp, G_CURSOR, 1) + call rpc(gp, xjunk, yjunk, key) + + data[11] = IDS_ZOOM + data[12] = IDS_WRITE + data[13] = 3 + data[14] = IDS_EOD + data[15] = IDS_EOD + data[16] = 0 + data[17] = 4 + data[18] = min(((i-1)* 128) * MCXSCALE, GKI_MAXNDC) + data[19] = min(((i-1)* 128) * MCYSCALE, GKI_MAXNDC) + call gescape ( gp, IDS_CONTROL, data[11], 9) + } + + # all done + call gclose ( gp ) + call ids_close +end + +# rpcursor --- read and print cursor + +procedure rpc(gp, sx, sy, key) + +pointer gp +real sx,sy +int key + +begin + call ggcur (gp, sx, sy, key) + call eprintf("cursor: (%f,%f) (%d,%d) key %d\n") + call pargr (sx) + call pargr (sy) + call pargi ( int(sx*32767)/64) + call pargi ( int(sy*32767)/64) + call pargi (key) +end diff --git a/pkg/images/tv/iis/ids/testcode/zztest.x b/pkg/images/tv/iis/ids/testcode/zztest.x new file mode 100644 index 00000000..599b7103 --- /dev/null +++ b/pkg/images/tv/iis/ids/testcode/zztest.x @@ -0,0 +1,81 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <fset.h> +include <gset.h> + +define XS 0.216 +define XE 0.719 +define YS 0.214 +define YE 0.929 + +task test = t_test + +# T_TEST -- Test program for graphics plotting. A labelled grid is output. + +procedure t_test () + +bool redir +pointer sp, gp +char command[SZ_LINE], image[SZ_FNAME], word[SZ_LINE] +char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME] +int cmd, input_fd, stat, fd + +pointer gopen() +bool streq() +int fstati(), open(), getline() + +begin + # If the input has been redirected, input is read from the named + # command file. If not, each image name in the input template is + # plotted. + + if (fstati (STDIN, F_REDIR) == YES) { +call eprintf ("Input has been redirected\n") + redir = true + cmd = open (STDIN, READ_ONLY, TEXT_FILE) + } + + # Loop over commands until EOF + repeat { + if (redir) { + if (getline (STDIN, command, SZ_LINE) == EOF) + break + call sscan (command) + call gargwrd (word, SZ_LINE) + if (!streq (word, "plot")) { + # Pixel window has been stored as WCS 2 + call gseti (gp, G_WCS, 2) + call gscan (command) + next + } else + call gargwrd (image) + } + + call clgstr ("output", output, SZ_FNAME) + if (!streq (output, "")) { + call strcpy (output, output_file, SZ_FNAME) + fd = open (output_file, NEW_FILE, BINARY_FILE) + } else + fd = open ("dev$crt", NEW_FILE, BINARY_FILE) + + call clgstr ("device", device, SZ_FNAME) + gp = gopen (device, NEW_FILE, fd) + + call gseti (gp, G_XDRAWGRID, 1) + call gseti (gp, G_YDRAWGRID, 1) + call gseti (gp, G_NMAJOR, 21) + call glabax (gp, "TEST", "NDC_X", "NDC_Y") + call gline (gp, XS, YS, XE, YS) + call gline (gp, XE, YS, XE, YE) + call gline (gp, XE, YE, XS, YE) + call gline (gp, XS, YE, XS, YS) + call gmark (gp, 0.5, 0.5, GM_CROSS, 3.0, 3.0) + call gtext (gp, XS, YS-0.1, "DICOMED crtpict film area") + call gclose (gp) + call close (fd) + } + + call clpcls (input_fd) + call sfree (sp) +end diff --git a/pkg/images/tv/iis/iis.cl b/pkg/images/tv/iis/iis.cl new file mode 100644 index 00000000..becb72c4 --- /dev/null +++ b/pkg/images/tv/iis/iis.cl @@ -0,0 +1,22 @@ +plot + +#{ IIS -- The IIS Image Display Control package. + +package iis + +set iis = "images$tv/iis/" + +task cv, + cvl = "iis$x_iis.e" + +task blink = "iis$blink.cl" +task erase = "iis$erase.cl" +task $frame = "iis$frame.cl" +task lumatch = "iis$lumatch.cl" +task $monochrome = "iis$monochrome.cl" +task pseudocolor = "iis$pseudocolor.cl" +task rgb = "iis$rgb.cl" +task $window = "iis$window.cl" +task zoom = "iis$zoom.cl" + +clbye() diff --git a/pkg/images/tv/iis/iis.hd b/pkg/images/tv/iis/iis.hd new file mode 100644 index 00000000..a0be19f2 --- /dev/null +++ b/pkg/images/tv/iis/iis.hd @@ -0,0 +1,16 @@ +# Help directory for the IIS package + +$doc = "images$tv/iis/doc/" +$iis = "images$tv/iis/" + +blink hlp=doc$blink.hlp, src=iis$blink.cl +cv hlp=doc$cv.hlp src=iis$src/cv.x +cvl hlp=doc$cvl.hlp +erase hlp=doc$erase.hlp, src=iis$erase.cl +frame hlp=doc$frame.hlp, src=iis$frame.cl +lumatch hlp=doc$lumatch.hlp, src=iis$lumatch.cl +monochrome hlp=doc$monochrome.hlp, src=iis$monochrome.cl +pseudocolor hlp=doc$pseudocolor.hlp, src=iis$pseudocolor.cl +rgb hlp=doc$rgb.hlp, src=iis$rgb.cl +window hlp=doc$window.hlp, src=iis$window.cl +zoom hlp=doc$zoom.hlp, src=iis$zoom.cl diff --git a/pkg/images/tv/iis/iis.men b/pkg/images/tv/iis/iis.men new file mode 100644 index 00000000..08123e61 --- /dev/null +++ b/pkg/images/tv/iis/iis.men @@ -0,0 +1,11 @@ + blink - Blink two frames + cv - Control image device, display "snapshot" + cvl - Load image display (newer version of 'display') + erase - Erase an image frame + frame - Select the frame to be displayed + lumatch - Match the lookup tables of two frames + monochrome - Select monochrome enhancement + pseudocolor - Select pseudocolor enhancement + rgb - Select true color mode (red, green, and blue frames) + window - Adjust the contrast and dc offset of the current frame + zoom - Zoom in on the image (change magnification) diff --git a/pkg/images/tv/iis/iis.par b/pkg/images/tv/iis/iis.par new file mode 100644 index 00000000..db706f09 --- /dev/null +++ b/pkg/images/tv/iis/iis.par @@ -0,0 +1 @@ +version,s,h,"Apr91" diff --git a/pkg/images/tv/iis/iism70/README b/pkg/images/tv/iis/iism70/README new file mode 100644 index 00000000..05f01307 --- /dev/null +++ b/pkg/images/tv/iis/iism70/README @@ -0,0 +1,5 @@ +IISM70 -- Device dependent interface subroutines for the IIS Model 70 image +display device. This package uses the ZFIOGD device driver, which is +responsible for physical i/o to the device. The source for the ZFIOGD driver +is in host$gdev; this driver must be compiled and installed in a system library +(libsys.a) before i/o to the IIS will work correctly. diff --git a/pkg/images/tv/iis/iism70/idsexpand.x b/pkg/images/tv/iis/iism70/idsexpand.x new file mode 100644 index 00000000..da2a172d --- /dev/null +++ b/pkg/images/tv/iis/iism70/idsexpand.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "../lib/ids.h" +include "iis.h" + +# IDS_EXPAND -- expand FRAME/BITPL if first element is IDS_EOD +# if the frames are not counted in order, as on the Model 75, +# that should be dealt with here (use the "flag" boolean). + +procedure ids_expand(data, max, flag) + +short data[ARB] # data +short max # max number of frames/bitplanes +bool flag # true if frames ... e.g. for Model 75 + +int i + +begin + if ( data[1] != IDS_EOD ) + return + do i = 1, max { + data[i] = i + } + if ( flag) { + data[1+max] = GRCHNUM + data[2+max] = IDS_EOD + } else + data[1+max] = IDS_EOD +end diff --git a/pkg/images/tv/iis/iism70/iis.com b/pkg/images/tv/iis/iism70/iis.com new file mode 100644 index 00000000..25a69d38 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iis.com @@ -0,0 +1,12 @@ +# Common for IIS display + +int iischan # The device channel used by FIO +int iisnopen # Number of times the display has been opened +int iframe, iplane # frame, bitplanes to read/write +int i_frame_on # Which frame is on...cursor readback +short hdr[LEN_IISHDR] # Header +short zoom[16] # zoom for each plane +short xscroll[16] # scroll position for each plane +short yscroll[16] +common /iiscom/iischan, iisnopen, iframe, iplane, i_frame_on, + hdr, zoom, xscroll, yscroll diff --git a/pkg/images/tv/iis/iism70/iis.h b/pkg/images/tv/iis/iism70/iis.h new file mode 100644 index 00000000..96bb8b39 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iis.h @@ -0,0 +1,120 @@ +# This file contains the hardware definitions for the iis model 70/f +# at Kitt Peak. + +# Define header +define LEN_IISHDR 8 # Length of IIS header + +define XFERID $1[1] # transfer id +define THINGCT $1[2] # thing count +define SUBUNIT $1[3] # subuint select +define CHECKSUM $1[4] # check sum +define XREG $1[5] # x register +define YREG $1[6] # y register +define ZREG $1[7] # z register +define TREG $1[8] # t register + +# Transfer ID definitions +define IREAD 100000B +define IWRITE 0B +define PACKED 40000B +define BYPASSIFM 20000B +define BYTE 10000B +define ADDWRITE 4000B +define ACCUM 2000B +define BLOCKXFER 1000B +define VRETRACE 400B +define MUX32 200B + +# Subunits +define REFRESH 1 +define LUT 2 +define OFM 3 +define IFM 4 +define FEEDBACK 5 +define SCROLL 6 +define VIDEOM 7 +define SUMPROC 8 +define GRAPHICS 9 +define CURSOR 10 +define ALU 11 +define ZOOM 12 +define IPB 15 + +# Command definitions +define COMMAND 100000B +define ADVXONTC 100000B # Advance x on thing count +define ADVXONYOV 40000B # Advance x on y overflow +define ADVYONXOV 100000B # Advance y on x overflow +define ADVYONTC 40000B # Advance y on thing count +define ERASE 100000B # Erase + +# 4 - Button Trackball +define PUSH 40000B +define BUTTONA 400B +define BUTTONB 1000B +define BUTTONC 2000B +define BUTTOND 4000B + +# Display channels +define CHAN1 1B +define CHAN2 2B +define CHAN3 4B +define CHAN4 10B +define ALLCHAN 17B +define GRCHAN 100000B +define GRCHNUM 16 + +define LEN_IISFRAMES 4 +define IISFRAMES CHAN1, CHAN2, CHAN3, CHAN4 + +# Center coordinates for zoom/scroll +define IIS_XCEN 256 +define IIS_YCEN 255 +# Inverted Y center is just IIS_YDIM - IIS_YCEN +define IIS_YCEN_INV 256 + +# Colors + +# these are bit plane mappings +define BLUE 1B +define GREEN 2B +define RED 4B +define MONO 7B +# next colors used by snap code ... used as array indexes. +define BLU 1 +define GR 2 +define RD 3 + + +# Bit plane selections +define BITPL0 1B +define BITPL1 2B +define BITPL2 4B +define BITPL3 10B +define BITPL4 20B +define BITPL5 40B +define BITPL6 100B +define BITPL7 200B +define ALLBITPL 377B + +# IIS Sizes +define IIS_XDIM 512 +define IIS_YDIM 512 +define MCXSCALE 64 # Metacode x scale +define MCYSCALE 64 # Metacode y scale +define SZB_IISHDR 16 # Size of IIS header in bytes +define LEN_ZOOM 3 # Zoom parameters +define LEN_CURSOR 3 # Cursor parameters +define LEN_SELECT 12 # frame select +define LEN_LUT 256 # Look up table +define LEN_OFM 1024 # Output function look up table +define LEN_IFM 8192 # Input function look up table +define LEN_VIDEOM 2048 # videometer output memory +define LEN_GRAM 256 # graphics ram +define MAXX 512 # maximum x register + 1 + +# IIS Status Words +define IIS_FILSIZE (IIS_XDIM * IIS_YDIM * SZB_CHAR) +define IIS_BLKSIZE 1 +define IIS_OPTBUFSIZE 32768 +define IIS_MAXBUFSIZE 32768 diff --git a/pkg/images/tv/iis/iism70/iisbutton.x b/pkg/images/tv/iis/iism70/iisbutton.x new file mode 100644 index 00000000..50dfff7b --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisbutton.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +# IISBUTTON -- Read, button status + +procedure iisbutton (cnum, x, y, key) + +int cnum # cursor number +int x,y # coordinates +int key # key pressed + +short status +int and() + +include "iis.com" + +begin + call iishdr (IREAD, 1, CURSOR+COMMAND, 0, 0, 0, 0) + call iisio (status, 1 * SZB_CHAR) + + if ( cnum == IDS_BUT_WT ) { + while ( and (int(status), PUSH) == 0 ) { + call tsleep(1) + call iisio (status, 1 * SZB_CHAR) + } + } + + if ( and ( int(status), PUSH) == 0 ) + key = 0 + else { + status = and ( int(status), 7400B) / 256 + switch(status) { + case 4: + status = 3 + + case 8: + status = 4 + } + key = status + } +end diff --git a/pkg/images/tv/iis/iism70/iiscls.x b/pkg/images/tv/iis/iism70/iiscls.x new file mode 100644 index 00000000..c717f636 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iiscls.x @@ -0,0 +1,27 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "iis.h" + +define LEN_HID 5 + +# IISCLS -- Close IIS display. + +procedure iiscls (chan, status) + +int chan[ARB] +int status + +include "iis.com" + +begin + # first we need to tuck away the constants for zoom and scroll + # as we cannot read them on the model 70. Would that there were + # somewhere to put them. Alas not. So just drop them on the floor. + + if (iisnopen == 1) { + call zclsgd (iischan, status) + iisnopen = 0 + } +end diff --git a/pkg/images/tv/iis/iism70/iiscursor.x b/pkg/images/tv/iis/iism70/iiscursor.x new file mode 100644 index 00000000..5ffc9131 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iiscursor.x @@ -0,0 +1,108 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +# cscale makes 0-32767 range from 0-62. The 62 results from the need +# to describe a cursor with a center, and hence an ODD number of points. +# Thus, we pretend the cursor ranges from 0-62 rather than 0-63, and +# the center is at (31,31). +# cwidth describes the (cursor) ram width, which is 64 ( by 64). + +define CSCALE 528 +define CWIDTH 64 +define CSIZE 4096 + +# IISCURSOR -- Read, Write cursor shape, turn cursor on/off + +procedure iiscursor (rw, cur, n, data) + +short rw # read or write +short cur # cursor number ... ignored for IIS M70 +short n # number of data values +short data[ARB] # the data + +short command, len +short shape[CSIZE] +short status +int rate +int i,j,index +int mod(), and(), or(), andi() + +include "iis.com" + +begin + len = 1 + if (data[1] != IDS_CSHAPE) { + call iishdr (IREAD, len, CURSOR+COMMAND, 0, 0, 0, 0) + call iisio (status, len * SZB_CHAR) + } + + if (rw == IDS_WRITE) + command = andi (IWRITE+VRETRACE, 177777B) + else + command = andi (IREAD+VRETRACE, 177777B) + + if (data[1] != IDS_CSHAPE){ + if (rw == IDS_WRITE) { + switch (data[1]) { + case IDS_OFF: + status = and(int(status), 177776B) + + case IDS_ON: + status = or (int(status), 1) + + case IDS_CBLINK: + rate = mod (int(data[2])-1, 4) * 8 + status = or (rate, and (int(status),177747B)) + } + call iishdr (command, len, CURSOR+COMMAND, 0, 0, 0, 0) + call iisio (status, len * SZB_CHAR) + } else { + if ( data[1] == IDS_CBLINK ) + data[2] = ( and (int(status), 30B) / 8 ) + 1 + else if ( and ( int(status), 1) == 0 ) + data[1] = IDS_OFF + else + data[1] = IDS_ON + } + + } else { + # deal with cursor shape. + + len = CSIZE + if ( rw == IDS_WRITE) { + call aclrs (shape, CSIZE) + for ( i = 2 ; i <= n-1 ; i = i + 2 ) { + # given GKI data pairs for x,y cursor_on bits, set shape datum + # the first value is x, then y + if (data[i] == IDS_EOD) + break + j = data[i]/CSCALE + index = (data[i+1]/CSCALE) * CWIDTH + j + 1 + shape[index] = 1 + } + } + + call iishdr (command, len, CURSOR, ADVXONTC, ADVYONXOV, 0, 0) + call iisio (shape, len * SZB_CHAR) + + # if read command, return all set bits as GKI x,y pairs + if ( rw != IDS_WRITE) { + i = 2 + for ( j = 1 ; j <= CSIZE ; j = j + 1 ) { + if ( shape[j] != 0 ) { + data[i] = mod(j,CWIDTH) * CSCALE + data[i+1] = (j/CWIDTH) * CSCALE + i = i + 2 + if ( i > n-1 ) + break + } + } + if ( i <= n ) + data[i] = IDS_EOD + n = i + } + } +end diff --git a/pkg/images/tv/iis/iism70/iishdr.x b/pkg/images/tv/iis/iism70/iishdr.x new file mode 100644 index 00000000..bf22d493 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iishdr.x @@ -0,0 +1,31 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" + +# IISHDR -- Form IIS header. + +procedure iishdr (id, count, subunit, x, y, z, t) + +int id, count, subunit, x, y, z, t +int i, sum +include "iis.com" + +begin + XFERID(hdr) = id + THINGCT(hdr) = count + SUBUNIT(hdr) = subunit + XREG(hdr) = x + YREG(hdr) = y + ZREG(hdr) = z + TREG(hdr) = t + CHECKSUM(hdr) = 1 + + if (THINGCT(hdr) > 0) + THINGCT(hdr) = -THINGCT(hdr) + + sum = 0 + for (i = 1; i <= LEN_IISHDR; i = i + 1) + sum = sum + hdr[i] + CHECKSUM(hdr) = -sum +end diff --git a/pkg/images/tv/iis/iism70/iishisto.x b/pkg/images/tv/iis/iism70/iishisto.x new file mode 100644 index 00000000..374342a0 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iishisto.x @@ -0,0 +1,53 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +# IISHISTO -- Activate, Read histogram. + +procedure iishisto (rw, color, offset, a_n, data) + +short rw # read or write +short color[ARB] # color(s) to write +short offset # offset into histogram table +short a_n # number of data values +short data[ARB] # the data + +int n, command, off, len, x, y, z +include "iis.com" + +begin + n = a_n + if (n < 1) + return + + # set the area to be histogrammed ... in data[1], currently + # device very specific ( 2 == whole region) . Need to fix this + # perhaps via specific graph plane filled with gkifill command to + # depict area desired. + # n must be twice the number of datum values. Upper level code + # must know this to leave enough room. Would be better if upper + # code could ignore this (fact). + + if (rw == IDS_WRITE) { + command = IWRITE+VRETRACE + x = 0 + y = 0 + z = 0 + len = 1 + data[1] = 2 + call iishdr (command, len, VIDEOM+COMMAND, x, y, z, 0) + call iisio (data[1], len * SZB_CHAR) + return + } + + off = offset + command = IREAD+VRETRACE + len = min (n, LEN_VIDEOM-off+1) + off = min (LEN_VIDEOM, off) - 1 + y = off/MAXX + ADVYONXOV + x = mod (off, MAXX) + ADVXONTC + call iishdr (command, len, VIDEOM, x, y, z, 0) + call iisio (data, len * SZB_CHAR) +end diff --git a/pkg/images/tv/iis/iism70/iisifm.x b/pkg/images/tv/iis/iism70/iisifm.x new file mode 100644 index 00000000..ef04a1be --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisifm.x @@ -0,0 +1,51 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +define LUT_IMAX 255 + +# IISIFM -- Read and Write INPUT look up table. +# Written data is from line end points, read data +# is full array. + +procedure iisifm (rw, offset, n, data) + +short rw # read or write +short offset # offset into lut +short n # number of data values +short data[ARB] # the data + +int command,len,x,y +pointer sp, idata + +include "iis.com" + +begin + if ( rw == IDS_WRITE) { + if (n < 4) + return + + call smark (sp) + call salloc (idata, LEN_IFM, TY_SHORT) + call aclrs (Mems[idata], LEN_IFM) + + command = IWRITE+VRETRACE + call idslfill (data, int(n), Mems[idata], LEN_IFM, 0, LUT_IMAX) + len = LEN_IFM + } else { + len = n + command = IREAD+VRETRACE + } + + y = ADVYONXOV + x = ADVXONTC + call iishdr (command, len, IFM, x, y, 0, 0) + + if (rw == IDS_WRITE) { + call iisio (Mems[idata], len * SZB_CHAR) + call sfree (sp) + } else + call iisio (data, len * SZB_CHAR) +end diff --git a/pkg/images/tv/iis/iism70/iisio.x b/pkg/images/tv/iis/iism70/iisio.x new file mode 100644 index 00000000..f8e005c6 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisio.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "iis.h" + +# IISIO -- Read/Write to IIS. + +procedure iisio (buf, nbytes) + +short buf[ARB] +int nbytes + +int nbites +int and() + +include "iis.com" + +begin + call iiswt (iischan, nbites) + if (nbites == ERR) + return + + call zawrgd (iischan, hdr, SZB_IISHDR, 0) + call iiswt (iischan, nbites) + if (nbites == ERR) + return + + if (and (int(XFERID(hdr)), IREAD) != 0) + call zardgd (iischan, buf, nbytes, 0) + else + call zawrgd (iischan, buf, nbytes, 0) + + call iiswt (iischan, nbites) +end diff --git a/pkg/images/tv/iis/iism70/iislut.x b/pkg/images/tv/iis/iism70/iislut.x new file mode 100644 index 00000000..07819247 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iislut.x @@ -0,0 +1,67 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +define LUT_LMAX 255 + +# IISLUT -- Read and Write look up table. +# NOTE the ASYMMETRY ... written data is derived from end +# points, but read data is the full array (see zsnapinit, +# for instance, for read usage.) + +procedure iislut (rw, frame, color, offset, n, data) + +short rw # read or write +short frame[ARB] # frame array +short color[ARB] # color array +short offset # offset into lut +short n # number of data values +short data[ARB] # the data + +int command,len,x,y,z,t +short iispack() +int mapcolor() +pointer sp, ldata + +include "iis.com" + +begin + z = mapcolor (color) + t = iispack(frame) + if (t == GRCHAN) { + return + } + + if ( rw == IDS_WRITE) { + if ( n < 4) + return + command = IWRITE+VRETRACE + + # data space for manipulating lut information + + call smark (sp) + call salloc (ldata, LEN_LUT, TY_SHORT) + call aclrs (Mems[ldata], LEN_LUT) + + # We could have negative lut values, but don't bother for now + call idslfill (data, int(n), Mems[ldata], LEN_LUT, 0, LUT_LMAX) + + len = LEN_LUT + } else { + len = n + command = IREAD+VRETRACE + } + + x = ADVXONTC + y = 0 + + call iishdr (command, len, LUT, x, y, z, t) + + if ( rw == IDS_WRITE) { + call iisio (Mems[ldata], len * SZB_CHAR) + call sfree (sp) + } else + call iisio (data, len * SZB_CHAR) +end diff --git a/pkg/images/tv/iis/iism70/iismatch.x b/pkg/images/tv/iis/iism70/iismatch.x new file mode 100644 index 00000000..a2435fdc --- /dev/null +++ b/pkg/images/tv/iis/iism70/iismatch.x @@ -0,0 +1,76 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +# IISMATCH -- copy (match) a set of look up tables to a given table; +# frames/color specify the given table, data gives frame/color for +# set to be changed. + +procedure iismatch (code, frames, color, n, data) + +short code # which table type +short frames[ARB] # reference frame +short color[ARB] # reference color +short n # count of data items +short data[ARB] # frame/color to be changed. + +pointer sp, ldata +int len, x,y,z,t +int unit, i +int mapcolor(), ids_dcopy() +short temp[IDS_MAXIMPL+1] +short iispack() + +include "../lib/ids.com" + +begin + switch (code) { + case IDS_FRAME_LUT: + len = LEN_LUT + x = ADVXONTC + y = 0 + z = mapcolor (color) + t = iispack (frames) + if (t == GRCHAN) + return + unit = LUT + + case IDS_OUTPUT_LUT: + len = LEN_OFM + x = ADVXONTC + y = ADVYONXOV + z = mapcolor (color) + t = 0 + + default: + return + } + + call smark (sp) + call salloc (ldata, len, TY_SHORT) + + call iishdr (IREAD+VRETRACE, len, unit, x, y, z, t) + call iisio (Mems[ldata], len * SZB_CHAR) + + i = ids_dcopy (data, temp) + switch (code) { + case IDS_FRAME_LUT: + call ids_expand (temp, i_maxframes, true) + t = iispack (temp) + i = ids_dcopy (data[i+1], temp) + call ids_expand (temp, 3, false) # 3...max colors + z = mapcolor (temp) + + case IDS_OUTPUT_LUT: + i = ids_dcopy (data[i+1], temp) + call ids_expand (temp, 3, false) + z = mapcolor (temp) + } + + call iishdr (IWRITE+VRETRACE, len, unit, x, y, z, t) + call iisio (Mems[ldata], len * SZB_CHAR) + + call sfree (sp) +end diff --git a/pkg/images/tv/iis/iism70/iisminmax.x b/pkg/images/tv/iis/iism70/iisminmax.x new file mode 100644 index 00000000..22a3062e --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisminmax.x @@ -0,0 +1,87 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +define LEN_MM 6 + +# IISMIN -- Read minimum registers + +procedure iismin (rw, color, n, data) + +short rw # read or write +short color[ARB] # color +short n # number of data values +short data[ARB] # the data + +int command,x +short const[LEN_MM] +int i,j + +include "iis.com" + +begin + if ( rw == IDS_WRITE) + return + command = IREAD+VRETRACE + x = ADVXONTC + call iishdr(command, LEN_MM, SUMPROC+COMMAND, x, 0, 0, 0) + call iisio (const, LEN_MM * SZB_CHAR) + j = 1 + for ( i = 1 ; i <= n ; i = i + 1 ) { + switch(color[j]) { + case IDS_RED: + data[i] = const[5] + + case IDS_GREEN: + data[i] = const[3] + + case IDS_BLUE: + data[i] = const[1] + } + j = j+1 + if ( color[j] == IDS_EOD ) + j = j - 1 + } +end + +# IISMAX -- Read maximum registers + +procedure iismax (rw, color, n, data) + +short rw # read or write +short color[ARB] # color +short n # number of data values +short data[ARB] # the data + +int command,x +short const[LEN_MM] +int i,j + +include "iis.com" + +begin + if ( rw == IDS_WRITE) + return + command = IREAD+VRETRACE + x = ADVXONTC + call iishdr(command, LEN_MM, SUMPROC+COMMAND, x, 0, 0, 0) + call iisio (const, LEN_MM * SZB_CHAR) + j = 1 + for ( i = 1 ; i <= n ; i = i + 1 ) { + switch(color[j]) { + case IDS_RED: + data[i] = const[6] + + case IDS_GREEN: + data[i] = const[4] + + case IDS_BLUE: + data[i] = const[2] + } + j = j+1 + if ( color[j] == IDS_EOD ) + j = j - 1 + } +end diff --git a/pkg/images/tv/iis/iism70/iisoffset.x b/pkg/images/tv/iis/iism70/iisoffset.x new file mode 100644 index 00000000..d7f618dc --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisoffset.x @@ -0,0 +1,67 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +define LEN_CONST 3 + +# IISOFFSET -- Read and Write output bias registers + +procedure iisoffset (rw, color, n, data) + +short rw # read or write +short color[ARB] # color +short n # number of data values +short data[ARB] # the data + +int command,len,x +short const[3] +int i,j + +include "iis.com" + +begin + command = IREAD+VRETRACE + x = 8 + ADVXONTC + len = LEN_CONST + call iishdr(command, len, SUMPROC+COMMAND, x, 0, 0, 0) + call iisio (const, len * SZB_CHAR) + if ( rw == IDS_WRITE) { + command = IWRITE+VRETRACE + j = 1 + for ( i =1 ; color[i] != IDS_EOD ; i = i + 1) { + switch(color[i]) { + case IDS_RED: + const[3] = data[j] + + case IDS_GREEN: + const[2] = data[j] + + case IDS_BLUE: + const[1] = data[j] + } + if ( j < n) + j = j + 1 + } + call iishdr (command, len, SUMPROC+COMMAND, x, 0, 0, 0) + call iisio (const, len * SZB_CHAR) + } else { + j = 1 + for ( i = 1 ; i <= n ; i = i + 1 ) { + switch(color[j]) { + case IDS_RED: + data[i] = const[3] + + case IDS_GREEN: + data[i] = const[2] + + case IDS_BLUE: + data[i] = const[1] + } + j = j+1 + if ( color[j] == IDS_EOD ) + j = j - 1 + } + } +end diff --git a/pkg/images/tv/iis/iism70/iisofm.x b/pkg/images/tv/iis/iism70/iisofm.x new file mode 100644 index 00000000..0c19c117 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisofm.x @@ -0,0 +1,53 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +define LUT_OMAX 1023 + +# IISOFM -- Read and Write OUTPUT look up table. +# Written data is from end points, read data is full +# array. + +procedure iisofm (rw, color, offset, n, data) + +short rw # read or write +short color[ARB] # color(s) to write +short offset # offset into lut +short n # number of data values +short data[ARB] # the data + +int command,len,x,y,z +int mapcolor() +pointer sp, odata + +include "iis.com" + +begin + z = mapcolor (color) + if ( rw == IDS_WRITE) { + if (n < 4) + return + + call smark (sp) + call salloc (odata, LEN_OFM, TY_SHORT) + call aclrs (Mems[odata], LEN_OFM) + + command = IWRITE+VRETRACE + call idslfill (data, int(n), Mems[odata], LEN_OFM, 0, LUT_OMAX) + len = LEN_OFM + } + else { + len = n + command = IREAD+VRETRACE + } + y = ADVYONXOV + x = ADVXONTC + call iishdr (command, len, OFM, x, y, z, 0) + if (rw == IDS_WRITE) { + call iisio (Mems[odata], len * SZB_CHAR) + call sfree (sp) + } else + call iisio (data, len * SZB_CHAR) +end diff --git a/pkg/images/tv/iis/iism70/iisopn.x b/pkg/images/tv/iis/iism70/iisopn.x new file mode 100644 index 00000000..29335c62 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisopn.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "iis.h" + +# IISOPN -- Open IIS display. + +procedure iisopn (devinfo, mode, chan) + +char devinfo[ARB] # device info for zopen +int mode # access mode +int chan[ARB] # receives IIS descriptor + +bool first_time +data first_time /true/ +include "iis.com" + +begin + if (first_time) { + iisnopen = 0 + first_time = false + } + + # We permit multiple opens but only open the physical device once. + if (iisnopen == 0) + call zopngd (devinfo, mode, iischan) + + if (iischan == ERR) + chan[1] = ERR + else { + iisnopen = iisnopen + 1 + chan[1] = iischan + } +end diff --git a/pkg/images/tv/iis/iism70/iispack.x b/pkg/images/tv/iis/iism70/iispack.x new file mode 100644 index 00000000..4c2c70f3 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iispack.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" + +# IISPACK -- Pack color or frame data into a single word. + +short procedure iispack (data) + +short data[ARB] +int value, bit, i +int or() + +begin + value = 0 + for (i=1; data[i] != IDS_EOD; i=i+1) { + bit = data[i] - 1 + value = or (value, 2 ** bit) + } + + return (value) +end diff --git a/pkg/images/tv/iis/iism70/iispio.x b/pkg/images/tv/iis/iism70/iispio.x new file mode 100644 index 00000000..f8c57138 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iispio.x @@ -0,0 +1,65 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "iis.h" + +# IISPIO -- Pixel i/o to the IIS. + +procedure iispio (buf, ny) + +short buf[IIS_XDIM,ny] # Cell array +int ny # number of image lines + +pointer iobuf +bool first_time +int xferid, status, npacked, szline, i +int and() +include "iis.com" +data first_time /true/ + +begin + if (first_time) { + call malloc (iobuf, IIS_MAXBUFSIZE, TY_CHAR) + first_time = false + } + + # Wait for the last i/o transfer. + call iiswt (iischan, status) + if (status == ERR) + return + + # Transmit the packet header. + call zawrgd (iischan, hdr, SZB_IISHDR, 0) + call iiswt (iischan, status) + if (status == ERR) + return + + # Read or write the data block. + npacked = ny * IIS_XDIM + szline = IIS_XDIM / (SZ_SHORT * SZB_CHAR) + + # Transmit the data byte-packed to increase the i/o bandwith + # when using network i/o. + + xferid = XFERID(hdr) + if (and (xferid, IREAD) != 0) { + # Read from the IIS. + + call zardgd (iischan, Memc[iobuf], npacked, 0) + call iiswt (iischan, status) + + # Unpack and line flip the packed data. + do i = 0, ny-1 + call achtbs (Memc[iobuf+i*szline], buf[1,ny-i], IIS_XDIM) + + } else { + # Write to the IIS. + + # Bytepack the image lines, doing a line flip in the process. + do i = 0, ny-1 + call achtsb (buf[1,ny-i], Memc[iobuf+i*szline], IIS_XDIM) + + call zawrgd (iischan, Memc[iobuf], npacked, 0) + } +end diff --git a/pkg/images/tv/iis/iism70/iisrange.x b/pkg/images/tv/iis/iism70/iisrange.x new file mode 100644 index 00000000..8fad856b --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisrange.x @@ -0,0 +1,97 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +define LEN_RANGE 1 + +# IISRANGE -- Read and write range scaling registers +# Input data is of form 1-->range "0", 2,3 --> "1", 4-7 --> "2" +# and anything beyond 7 --> "4". This is just like zoom. +# However, on readback, the actual range values are returned. If +# this should change, the zsnapinit code must change too (the only +# place where a range read is done). + +procedure iisrange (rw, color, n, data) + +short rw # read or write +short color[ARB] # color +short n # number of data values +short data[ARB] # the data + +short range +int i, j +int command, x, itemp, ival +int and(), or() +include "iis.com" + +begin + if (data[1] == IDS_EOD) + return + + command = IREAD + x = ADVXONTC + + call iishdr (command, LEN_RANGE, OFM+COMMAND, x, 0, 0, 0) + call iisio (range, LEN_RANGE * SZB_CHAR) + + if (rw == IDS_WRITE) { + command = IWRITE+VRETRACE + j = 1 + for (i=1; color[i] != IDS_EOD; i=i+1) { + switch (data[j]) { + case 1,2: + ival = data[j]-1 + case 3: + ival = 1 + case 4,5,6,7: + ival = 2 + + default: + if (ival < 0) + ival = 0 + else + ival = 3 + } + + itemp = range + switch(color[i]) { + case IDS_RED: + range = or (ival*16, and (itemp, 17B)) + + case IDS_GREEN: + range = or (ival*4, and (itemp, 63B)) + + case IDS_BLUE: + range = or (ival, and (itemp, 74B)) + } + + if ( j < n) + j = j + 1 + } + + call iishdr (command, LEN_RANGE, OFM+COMMAND, x, 0, 0, 0) + call iisio (range, LEN_RANGE * SZB_CHAR) + + } else { + # Return a range value + j = 1 + for (i=1; i <= n; i=i+1) { + itemp = range + switch (color[j]) { + case IDS_RED: + data[i] = and (itemp, 60B) / 16 + + case IDS_GREEN: + data[i] = and (itemp, 14B) / 4 + + case IDS_BLUE: + data[i] = and (itemp, 3B) + } + j = j+1 + if (color[j] == IDS_EOD) + j = j - 1 + } + } +end diff --git a/pkg/images/tv/iis/iism70/iisrd.x b/pkg/images/tv/iis/iism70/iisrd.x new file mode 100644 index 00000000..20e99cb2 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisrd.x @@ -0,0 +1,51 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" + +# IISRD -- Read data from IIS. Reads are packed when can. +# The data is line-flipped. + +procedure iisrd (chan, buf, nbytes, offset) + +int chan[ARB] +short buf[ARB] +int nbytes +long offset + +long off1, off2 +int nchars, thing_count, tid, y1, y2, x +int or() +include "iis.com" + +begin + # Convert to chars and clip at the top of the display. + off1 = (offset - 1) / SZB_CHAR + 1 + off2 = min (IIS_XDIM * IIS_YDIM, (offset + nbytes - 1) / SZB_CHAR) + 1 + nchars = off2 - off1 + + y1 = (off1-1 ) / IIS_XDIM + y2 = (off2-1 - IIS_XDIM) / IIS_XDIM + y2 = max (y1,y2) + + # Pack only if start at x=0 + x = (off1 - 1) - y1 * IIS_XDIM + if ( x == 0 ) + tid = IREAD+PACKED + else + tid = IREAD + + # If only a few chars, don't pack...have trouble with count of 1 + # and this maeks code same as iiswr.x + if ( nchars < 4 ) + tid = IREAD + + thing_count = nchars + + call iishdr (tid, thing_count, REFRESH, + or (x, ADVXONTC), or (IIS_YDIM-1-y2, ADVYONXOV), iframe, iplane) + if ( tid == IREAD) + call iisio (buf, nbytes) + else + call iispio (buf, y2 - y1 + 1) +end diff --git a/pkg/images/tv/iis/iism70/iisscroll.x b/pkg/images/tv/iis/iism70/iisscroll.x new file mode 100644 index 00000000..a583e4a4 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iisscroll.x @@ -0,0 +1,101 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <gki.h> +include "iis.h" +include "../lib/ids.h" + +# IISSCROLL -- Read and Write scroll registers +# We scroll multiple frames to multiple centers; if there are not +# enough data pairs to match the number of frames, use the last +# pair repeatedly. + +procedure iisscroll (rw, frame, n, data) + +short rw # read or write +short frame[ARB] # frame data +short n # number of data values +short data[ARB] # the data + +int z +short iispack() +int i,total, pl, index + +include "iis.com" + +begin + total = n/2 + if ( rw != IDS_WRITE) { + # Scroll registers are write only + do i = 1, total { + pl = frame[i] + if (pl == IDS_EOD) + break + data[2*i-1] = xscroll[pl] * MCXSCALE + data[2*i] = yscroll[pl] * MCYSCALE + } + + if (2*total < n) + data[2*total+1] = IDS_EOD + return + } + + # Set all the scroll offsets. + index = 1 + for (i=1; frame[i] != IDS_EOD; i=i+1) { + pl = frame[i] + xscroll[pl] = data[2*index-1] / MCXSCALE + yscroll[pl] = data[2*index ] / MCYSCALE + if (i < total) + index = index + 1 + } + + # Now do the scrolling. + for (i=1; frame[i] != IDS_EOD; i=i+1) { + pl = frame[i] + if (i == total) { + z = iispack (frame[i]) + call do_scroll (z, xscroll[pl], yscroll[pl]) + break + } else + call do_scroll (short(2**(pl-1)), xscroll[pl], yscroll[pl]) + } +end + + +procedure do_scroll (planes, x, y) + +short planes # bit map for planes +short x,y # where to scroll + +short command +short scr[2] +short xs,ys + +include "iis.com" + +begin + xs = x + ys = y + command = IWRITE+VRETRACE + scr[1] = xs + scr[2] = ys + + # If x/y scroll at "center", scr[1/2] are now IIS_[XY]CEN + # y = 0 is at top for device while y = 1 is bottom for user + # so for y, center now moves to IIS_YCEN_INV !! + + scr[2] = IIS_YDIM - 1 - scr[2] + + # Scroll is given for center, but hardware wants corner coords. + scr[1] = scr[1] - IIS_XCEN + scr[2] = scr[2] - IIS_YCEN_INV + + if (scr[1] < 0) + scr[1] = scr[1] + IIS_XDIM + if (scr[2] < 0) + scr[2] = scr[2] + IIS_YDIM + + call iishdr (command, 2, SCROLL, ADVXONTC, 0, int(planes), 0) + call iisio (scr, 2 * SZB_CHAR) +end diff --git a/pkg/images/tv/iis/iism70/iissplit.x b/pkg/images/tv/iis/iism70/iissplit.x new file mode 100644 index 00000000..2badb7cb --- /dev/null +++ b/pkg/images/tv/iis/iism70/iissplit.x @@ -0,0 +1,68 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +define X_SPLIT 12 + +# IISSPLIT -- Read and Write split screen coordinates + +procedure iissplit (rw, n, data) + +short rw # read or write +short n # number of data values +short data[ARB] # the data + +int command,len,x +short coord[2] + +include "iis.com" + +begin + len = min (int(n), 2) + if ( len < 1) { + data[1] = IDS_EOD + return + } + + if (rw == IDS_WRITE) { + if (data[1] == IDS_EOD) + return + command = IWRITE+VRETRACE + coord[1] = data[1] / MCXSCALE + + + # Split screen will display the full screen from one lut ONLY + # if the split coordinate is zero. Setting the split to 511 + # means that all the screen BUT the last pixel is from one lut. + # Hence the y coordinate for full screen in one quad is + # (device) 0 , (user) 511. If the user requests split at (0,0), + # we honor this as a (device) (0,0). This will remove the + # ability to split the screen with just the bottom line + # in the "other" lut, which shouldn't bother anyone. + + if (len == 2) + coord[2] = (IIS_YDIM - 1) - data[2]/MCYSCALE + + if (coord[2] == IIS_YDIM - 1) + coord[2] = 0 + + } else + command = IREAD+VRETRACE + + # at most, read/write the x,y registers + x = X_SPLIT + ADVXONTC + + call iishdr (command, len, LUT+COMMAND, x, 0, 0, 0) + call iisio (coord, len * SZB_CHAR) + + if ( rw != IDS_WRITE ) { + data[1] = coord[1] * MCXSCALE + if ( len == 2 ) { + if ( coord[2] == 0) + coord[2] = IIS_YDIM - 1 + data[2] = (IIS_YDIM - 1 - coord[2] ) * MCYSCALE + } + } +end diff --git a/pkg/images/tv/iis/iism70/iistball.x b/pkg/images/tv/iis/iism70/iistball.x new file mode 100644 index 00000000..ebcc6566 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iistball.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +# IISTBALL -- Read, Write tball status to turn tball on/off + +procedure iistball (rw, data) + +short rw # read or write +short data[ARB] # the data + +int command,len +short status +int and(), or() + +include "iis.com" + +begin + len = 1 + call iishdr (IREAD, len, CURSOR+COMMAND, 0, 0, 0, 0) + call iisio (status, len * SZB_CHAR) + if ( rw == IDS_WRITE) { + command = IWRITE+VRETRACE + switch (data[1]) { + case IDS_OFF: + status = and (int(status), 177771B) + + case IDS_ON: + status = or ( int(status), 6) + } + call iishdr (command, 1, CURSOR+COMMAND, 0, 0, 0, 0) + call iisio (status, 1 * SZB_CHAR) + } else { + if ( and ( int(status), 6) == 0 ) + data[2] = IDS_OFF + else + data[2] = IDS_ON + } +end diff --git a/pkg/images/tv/iis/iism70/iiswr.x b/pkg/images/tv/iis/iism70/iiswr.x new file mode 100644 index 00000000..11bb2803 --- /dev/null +++ b/pkg/images/tv/iis/iism70/iiswr.x @@ -0,0 +1,51 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" + +# IISWR -- Write pixel data to IIS. Writes are packed with full lines only. +# The data is line-flipped, causing the first line to be displayed at the bottom +# of the screen. + +procedure iiswr (chan, buf, nbytes, offset) + +int chan[ARB] +short buf[ARB] +int nbytes +long offset + +long off1, off2 +int nchars, thing_count, tid, y1, y2, x +int or() +include "iis.com" + +begin + # Convert to chars and clip at the top of the display. + off1 = (offset - 1) / SZB_CHAR + 1 + off2 = min (IIS_XDIM * IIS_YDIM, (offset + nbytes - 1) / SZB_CHAR) + 1 + nchars = off2 - off1 + + y1 = (off1-1 ) / IIS_XDIM + y2 = (off2-1 - IIS_XDIM) / IIS_XDIM + y2 = max (y1,y2) + + # Pack only if full lines + x = (off1 - 1) - y1 * IIS_XDIM + if ( x == 0 ) + tid = IWRITE+BYPASSIFM+PACKED+BLOCKXFER+BYTE + else + tid = IWRITE+BYPASSIFM + + # If only a few chars, don't pack (BLOCKXFER needs nchar>=4) + if ( nchars < 4 ) + tid = IWRITE+BYPASSIFM + + thing_count = nchars + + call iishdr (tid, thing_count, REFRESH, + or (x, ADVXONTC), or (IIS_YDIM-1-y2, ADVYONXOV), iframe, iplane) + if ( tid == IWRITE+BYPASSIFM) + call iisio (buf, nbytes) + else + call iispio (buf, y2 - y1 + 1) +end diff --git a/pkg/images/tv/iis/iism70/iiswt.x b/pkg/images/tv/iis/iism70/iiswt.x new file mode 100644 index 00000000..93f1e04a --- /dev/null +++ b/pkg/images/tv/iis/iism70/iiswt.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <knet.h> +include "iis.h" + +# IISWT -- Wait for IIS display. + +procedure iiswt (chan, nbytes) + +int chan[ARB] +int nbytes +include "iis.com" + +begin + call zawtgd (iischan, nbytes) + nbytes = nbytes * SZB_CHAR +end diff --git a/pkg/images/tv/iis/iism70/iiszoom.x b/pkg/images/tv/iis/iism70/iiszoom.x new file mode 100644 index 00000000..d703beec --- /dev/null +++ b/pkg/images/tv/iis/iism70/iiszoom.x @@ -0,0 +1,98 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" +include "../lib/ids.h" + +# IISZOOM -- Read and Write zoom magnification and coordinates. +# the zoom coordinates give the point that should appear in the +# center of the screen. For the I2S model 70, this requires a +# scroll. In order for the scroll to be "determinable", we always +# set the I2S "zoom center" to (IIS_XCEN,IIS_YCEN_INV). The IIS_YCEN_INV +# results from specifying IIS_YCEN for y center and then having to "invert" y +# to put GKI(y) = 0 at bottom. +# This routine implements a command of the form "zoom these frames +# to the coordinates given, with each triple of data setting a +# zoom factor and a zoom center for the corresponding frame". +# If there are excess frames (rel. to "n"), use the last triple. + +procedure iiszoom (rw, frames, n, data) + +short rw # read or write +short frames[ARB] # which frames to zoom +short n # number of data values +short data[ARB] # the data + +int command,x +int i, total,pl,index +short zm,temp[4] +short scroll[2*IDS_MAXIMPL + 1] +short center[3] +# magnification, and "zoom center" +data temp /0,IIS_XCEN,IIS_YCEN_INV, 0/ +# center in GKI x=256 y=255 +data center/ 16384, 16320, 0/ + +include "iis.com" + +begin + total = n/3 + + if ( rw != IDS_WRITE) { + # hardware is write only + do i = 1, total { + index = (i-1) * 3 + 1 + pl = frames[i] + if ( pl == IDS_EOD) + break + data[index] = zoom[pl] + data[index+1] = xscroll[pl] * MCXSCALE + data[index+2] = yscroll[pl] * MCYSCALE + } + if ( 3*total < n) + data[index+3] = IDS_EOD + return + } + + # can't have in data statements as IDS_EOD == (-2) and + # fortran won't allow () in data statements!!! + + temp[4] = IDS_EOD + center[3] = IDS_EOD + command = IWRITE+VRETRACE + x = ADVXONTC + + # the model 70 zooms all frames together. So ignore "frames" + # argument here, though needed for subsequent scroll. + + zm = data[1] + if ( zm <= 1 ) + zm = 0 + else if (zm >= 8) + zm = 3 + else + switch(zm) { + case 2,3: + zm = 1 + + case 4,5,6,7: + zm = 2 + } + call amovks(short(2**zm), zoom, 16) + temp[1] = zm + call iishdr (command, 3, ZOOM, x, 0, 0, 0) + call iisio (temp, 3 * SZB_CHAR) + + # now we have to scroll to the desired location (in GKI). + # If zoom is zero, don't do anything: this will leave the + # various images panned to some previously set place, but + # that is what is wanted when doing split screen and we pan + # some of the images. + + if (zm != 0) { + do i = 1, total + call amovs (data[i * 3 - 1 ], scroll[i*2-1], 2) + scroll[total*2+1] = IDS_EOD + call iisscroll(short(IDS_WRITE), frames, short(total*2+1), scroll) + } +end diff --git a/pkg/images/tv/iis/iism70/mkpkg b/pkg/images/tv/iis/iism70/mkpkg new file mode 100644 index 00000000..9944d732 --- /dev/null +++ b/pkg/images/tv/iis/iism70/mkpkg @@ -0,0 +1,58 @@ +# Makelib file for the image display interface. An image display device is +# accessed by high level code via the GKI interface. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + idsexpand.x <gki.h> ../lib/ids.h iis.h + iisbutton.x <mach.h> iis.h ../lib/ids.h iis.com + iiscls.x <mach.h> iis.h iis.com <knet.h> + iiscursor.x <mach.h> iis.h ../lib/ids.h iis.com + iishdr.x <mach.h> iis.h iis.com + iishisto.x <mach.h> iis.h ../lib/ids.h iis.com + iisifm.x <mach.h> iis.h ../lib/ids.h iis.com + iisio.x <mach.h> iis.h iis.com <knet.h> + iislut.x <mach.h> iis.h ../lib/ids.h iis.com + iismatch.x <mach.h> iis.h ../lib/ids.h ../lib/ids.com + iisminmax.x <mach.h> iis.h ../lib/ids.h iis.com + iisoffset.x <mach.h> iis.h ../lib/ids.h iis.com + iisofm.x <mach.h> iis.h ../lib/ids.h iis.com + iisopn.x <mach.h> iis.h iis.com <knet.h> + iispack.x ../lib/ids.h + iispio.x <mach.h> iis.h <knet.h> iis.com + iisrange.x <mach.h> iis.h ../lib/ids.h iis.com + iisrd.x <mach.h> iis.h iis.com + iisscroll.x <gki.h> <mach.h> iis.h ../lib/ids.h iis.com + iissplit.x <mach.h> iis.h ../lib/ids.h iis.com + iistball.x <mach.h> iis.h ../lib/ids.h iis.com + iiswr.x <mach.h> iis.h iis.com + iiswt.x <mach.h> iis.h iis.com <knet.h> + iiszoom.x <mach.h> iis.h ../lib/ids.h iis.com + zardim.x iis.h + zawrim.x + zawtim.x <mach.h> iis.h iis.com + zclear.x <mach.h> ../lib/ids.h iis.h + zclsim.x + zcontrol.x ../lib/ids.h iis.h + zcursor_read.x <gki.h> <mach.h> iis.h ../lib/ids.h iis.com + zcursor_set.x <gki.h> <mach.h> iis.h ../lib/ids.h iis.com + zdisplay_g.x <mach.h> iis.h ../lib/ids.h + zdisplay_i.x <mach.h> iis.h ../lib/ids.h ../lib/ids.com iis.com + zinit.x <mach.h> iis.h ../lib/ids.h ../lib/ids.com iis.com + zopnim.x + zreset.x <gki.h> <mach.h> ../lib/ids.h iis.h iis.com + zrestore.x <mach.h> ../lib/ids.h iis.h + zsave.x <mach.h> ../lib/ids.h iis.h + zseek.x <fset.h> <mach.h> ../lib/ids.h iis.h + + zsetup.x <fset.h> <mach.h> ../lib/ids.h iis.h ../lib/ids.com\ + iis.com + zsnap.x <fset.h> <mach.h> iis.h ../lib/ids.h zsnap.com iis.com\ + ../lib/ids.com + zsnapinit.x <fset.h> <mach.h> iis.h ../lib/ids.h zsnap.com iis.com\ + ../lib/ids.com + zsttim.x <knet.h> + ; diff --git a/pkg/images/tv/iis/iism70/zardim.x b/pkg/images/tv/iis/iism70/zardim.x new file mode 100644 index 00000000..e6811840 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zardim.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "iis.h" + +# ZARDIM -- Read data from a binary file display device. + +procedure zardim (chan, buf, nbytes, offset) + +int chan[ARB] +short buf[ARB] +int nbytes +long offset + +begin + call iisrd (chan, buf, nbytes, offset) +end diff --git a/pkg/images/tv/iis/iism70/zawrim.x b/pkg/images/tv/iis/iism70/zawrim.x new file mode 100644 index 00000000..7e5fa266 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zawrim.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ZAWRIM -- Write data to a binary file display device. + +procedure zawrim (chan, buf, nbytes, offset) + +int chan[ARB] +short buf[ARB] +int nbytes +long offset + +begin + call iiswr (chan, buf, nbytes, offset) +end diff --git a/pkg/images/tv/iis/iism70/zawtim.x b/pkg/images/tv/iis/iism70/zawtim.x new file mode 100644 index 00000000..ef857bdd --- /dev/null +++ b/pkg/images/tv/iis/iism70/zawtim.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "iis.h" + +# ZAWTIM -- Wait for an image display frame which is addressable as +# a binary file. + +procedure zawtim (chan, nbytes) + +int chan[ARB], nbytes +include "iis.com" + +begin + call iiswt (chan, nbytes) +end diff --git a/pkg/images/tv/iis/iism70/zclear.x b/pkg/images/tv/iis/iism70/zclear.x new file mode 100644 index 00000000..a03d429c --- /dev/null +++ b/pkg/images/tv/iis/iism70/zclear.x @@ -0,0 +1,33 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "../lib/ids.h" +include "iis.h" + +# ZCLEAR -- Erase IIS frame. + +procedure zclear (frame, bitplane, flag) + +short frame[ARB] # frame array +short bitplane[ARB] # bitplane array +bool flag # true if image plane + +int z, t +short erase +int and(), andi() +short iispack() + +begin + if (flag) { + z = iispack (frame) + z = and (z, ALLCHAN) + } else + z = GRCHAN + + t = iispack (bitplane) + erase = andi (ERASE, 177777B) + + call iishdr (IWRITE+BYPASSIFM+BLOCKXFER, 1, FEEDBACK, + ADVXONTC, ADVYONXOV, z, t) + call iisio (erase, SZB_CHAR) +end diff --git a/pkg/images/tv/iis/iism70/zclsim.x b/pkg/images/tv/iis/iism70/zclsim.x new file mode 100644 index 00000000..a2bd2029 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zclsim.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ZCLSIM -- Close an image display frame which is addressable as +# a binary file. + +procedure zclsim (chan, status) + +int chan[ARB] +int status + +begin + call iiscls (chan, status) +end diff --git a/pkg/images/tv/iis/iism70/zcontrol.x b/pkg/images/tv/iis/iism70/zcontrol.x new file mode 100644 index 00000000..56d8caeb --- /dev/null +++ b/pkg/images/tv/iis/iism70/zcontrol.x @@ -0,0 +1,116 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" +include "iis.h" + +# ZCONTROL -- call the device dependent control routines + +procedure zcontrol(device, rw, frame, color, offset, n, data) + +short device # which device/register to control +short rw # write/read/wait,read +short frame[ARB] # array of image frames +short color[ARB] # array of color +short offset # generalized offset or datum +short n # count of items in data array +short data[ARB] # data array + +begin + switch(device) { + case IDS_FRAME_LUT: + call iislut(rw, frame, color, offset, n, data) + + case IDS_GR_MAP: + # for now, nothing + + case IDS_INPUT_LUT: + call iisifm(rw, offset, n, data) + + case IDS_OUTPUT_LUT: + call iisofm(rw, color, offset, n, data) + + case IDS_SPLIT: + call iissplit(rw, n, data) + + case IDS_SCROLL: + call iisscroll(rw, frame, n, data) + + case IDS_ZOOM: + call iiszoom(rw, frame, n, data) + + case IDS_OUT_OFFSET: + call iisoffset(rw, color, n, data) + + case IDS_MIN: + call iismin(rw, color, n, data) + + case IDS_MAX: + call iismax(rw, color, n, data) + + case IDS_RANGE: + call iisrange(rw, color, n, data) + + case IDS_HISTOGRAM: + call iishisto(rw, color, offset, n, data) + + case IDS_ALU_FCN: + # for now, nothing + + case IDS_FEEDBACK: + # for now, nothing + + case IDS_SLAVE: + # for now, nothing + + case IDS_CURSOR: + call iiscursor(rw, offset, n, data) + + case IDS_TBALL: + call iistball(rw, data) + + case IDS_DIGITIZER: + # for now, nothing + + case IDS_BLINK: + # for now, nothing + + case IDS_SNAP: + call zsnap_init(data[1]) + + case IDS_MATCH: + call iismatch (rw, frame, color, n, data) + } +end + + +# MAPCOLOR - modify the color array to map rgb for iis + +int procedure mapcolor(color) + +short color[ARB] # input data + +int i +int val, result +int or() + +begin + result = 0 + for ( i = 1; color[i] != IDS_EOD ; i = i + 1 ) { + val = color[i] + switch (val) { + case IDS_RED: + val = RED + + case IDS_GREEN: + val = GREEN + + case IDS_BLUE: + val = BLUE + + default: + val = 2**(val-1) + } + result = or (result, val) + } + return (result) +end diff --git a/pkg/images/tv/iis/iism70/zcursor_read.x b/pkg/images/tv/iis/iism70/zcursor_read.x new file mode 100644 index 00000000..6de5bc8e --- /dev/null +++ b/pkg/images/tv/iis/iism70/zcursor_read.x @@ -0,0 +1,96 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <gki.h> +include "iis.h" +include "../lib/ids.h" + +# ZCURSOR_READ -- Read cursor from display. This assumes that the cursor +# is centered at (31,31) + +procedure zcursor_read (cnum, xcur, ycur, key) + +int cnum # cursor number +int xcur, ycur # cursor position...GKI coordinates +int key # key pressed + +short cursor[2] # local storage +real x,y +int frame +real zm +int mod(), and() +define exit_ 10 + +include "iis.com" + +begin + # Computations must be done in floating point when zoomed + # or values are off by a pixel. Also, want fractional + # pixel returned values in the zoomed case. + + call iishdr(IREAD, 2, COMMAND+CURSOR, 1+ADVXONTC, 0,0,0) + call iisio (cursor, 2 * SZB_CHAR) + + # which frame is the cursor relative to? We assume that cnum + # mod IDS_CSET refers to the image plane (graphics fits in + # here as an image plane for iism70), and cnum / IDS_CSET + # sets which cursor. + # If cursor is #0, then take lowest numbered frame that is + # being displayed. + # Return frame number as the "key". + + if (cnum == 0) { + frame = i_frame_on + if ((frame == ERR) || (frame < 1) ) { + key = ERR + return + } + } else if (cnum != IDS_CRAW) { + frame = mod(cnum-1, IDS_CSET) + 1 + } else { + zm = 1. + frame = 0 # return unusual frame num. if raw read + } + + # deal with cursor offset--hardware fault sometimes adds extra + # bit, so chop it off with and(). + x = mod (and (int(cursor[1]), 777B)+ 31, 512) + y = mod (and (int(cursor[2]), 777B)+ 31, 512) + + if (cnum == IDS_CRAW) + goto exit_ + + # x,y now in device coordinates for screen but not world. + # next, we determine number of pixels from screen center. + + zm = zoom[frame] + x = x/zm - IIS_XCEN./zm + y = y/zm - IIS_YCEN_INV./zm + + # Now add in scroll offsets, which are to screen center. + x = x + xscroll[frame] + + # Note that the Y one is inverted + y = y + (IIS_YDIM-1) - yscroll[frame] + + if (x < 0) + x = x + IIS_XDIM + else if (x > IIS_XDIM) + x = x - IIS_XDIM + + if (y < 0) + y = y + IIS_YDIM + else if (y > IIS_YDIM) + y = y - IIS_YDIM +exit_ + # invert y for user + y = (IIS_YDIM -1) - y + + # The Y inversion really complicates things... + y = y + 1.0 - (1.0/zm) + + # convert to GKI + xcur = x * MCXSCALE + ycur = y * MCYSCALE + key = frame +end diff --git a/pkg/images/tv/iis/iism70/zcursor_set.x b/pkg/images/tv/iis/iism70/zcursor_set.x new file mode 100644 index 00000000..50b1d446 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zcursor_set.x @@ -0,0 +1,100 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <gki.h> +include "../lib/ids.h" +include "iis.h" + +# ZCURSOR_SET -- Write cursor to display. This code assumes the standard +# cursor which is centered on (31,31). + +procedure zcursor_set (cnum, xcur, ycur) + +int cnum # cursor number +int xcur, ycur # GKI x,y cursor position + +short cursor[2] # local storage +real x,y,zm +int xedge +int yedge, frame +int mod() +define output 10 + +include "iis.com" + +begin + # which frame does cursor refer to? ( see zcursor_read() for + # more information. ) + + if (cnum == IDS_CRAW) { + x = real(xcur)/MCXSCALE + y = real(ycur)/MCYSCALE + zm = 1 + xedge = 0 + yedge = 0 + goto output + } + + if (cnum == 0) { + frame = i_frame_on + if ((frame == ERR) || (frame < 1)) + return # WHAT SHOULD WE DO? + } else + frame = mod( cnum-1, IDS_CSET) + 1 + zm = zoom[frame] + + # Find the left/upper edge of the display + # xedge is real as we can't drop the fraction of IIS_XCEN/zm + # (This was true when XCEN was 255; now is 256 so can use int + # since 256 is a multiple of all possible values of zm.) + + xedge = xscroll[frame] - IIS_XCEN/zm + if (xedge < 0) + xedge = xedge + IIS_XDIM + yedge = ( (IIS_YDIM-1) - yscroll[frame]) - int(IIS_YCEN_INV/zm) + if (yedge < 0) + yedge = yedge + IIS_YDIM + + # xcur, ycur are in gki. Check if value too big...this will + # happen if NDC = 1.0, for instance which should be acceptable + # but will be "out of range". + + x = real(xcur)/MCXSCALE + if ( x > (IIS_XDIM - 1.0/zm) ) + x = IIS_XDIM - 1.0/zm + y = real(ycur)/MCYSCALE + if ( y > (IIS_YDIM - 1.0/zm) ) + y = IIS_YDIM - 1.0/zm + + # Invert y value to get device orientation; account for + # fractional pixels + +output + y = (IIS_YDIM - 1.0/zm) - y + + # Account for the mod 512 nature of the display + + if (x < xedge) + x = x + IIS_XDIM + if (y < yedge) + y = y + IIS_YDIM + + # Are we still on screen ? + + if ((x >= (xedge + IIS_XDIM/zm)) || (y >= (yedge + IIS_YDIM/zm)) ) { + call eprintf("cursor set off screen -- ignored\n") + return + } + + # Calculate cursor positioning coordinates. + + cursor[1] = int ((x-real(xedge)) * zm ) - 31 + if ( cursor[1] < 0 ) + cursor[1] = cursor[1] + IIS_XDIM + cursor[2] = int ((y-real(yedge)) * zm ) - 31 + if ( cursor[2] < 0 ) + cursor[2] = cursor[2] + IIS_YDIM + + call iishdr (IWRITE+VRETRACE, 2, COMMAND+CURSOR, 1+ADVXONTC, 0,0,0) + call iisio (cursor, 2 * SZB_CHAR) +end diff --git a/pkg/images/tv/iis/iism70/zdisplay_g.x b/pkg/images/tv/iis/iism70/zdisplay_g.x new file mode 100644 index 00000000..21cf9e09 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zdisplay_g.x @@ -0,0 +1,91 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "../lib/ids.h" +include "iis.h" + +define INSERT 100000B + +# ZDISPLAY_G -- Display the referenced graphics bitplanes in the given color(s) + +procedure zdisplay_g (sw, bitpl, color, quad ) + +short sw # on or off +short bitpl[ARB] # bitpl list +short color[ARB] # color list +short quad[ARB] # quadrants to activate + +short gram[LEN_GRAM] +bool off +int i, lbound, val +short mask[7] +short fill +# red a bit weak so have contrast with cursor +#colors of graph: blue grn red yellow rd-bl gn-bl white +data mask /37B, 1740B, 74000B, 77740B, 74037B, 1777B, 77777B/ + +begin + if ( sw == IDS_OFF ) + off = true + else { + off = false + } + + # ignore bitpl argument since only one set of them and "color" + # fully specifies them. + # ignore quad for now + # much manipulation of color graphics ram table required!! + # strictly speaking, when we turn a plane off, we ought to be + # sure that any plane which is on, and "beneath", is turned on; + # this is a lot of trouble, so for starters, we don't. + # first find out what is on + + call iishdr(IREAD+VRETRACE, LEN_GRAM, GRAPHICS, ADVXONTC, 0, 0, 0) + call iisio (gram, LEN_GRAM * SZB_CHAR) + + # Check for red graphics plane for cursor + + if ( gram[LEN_GRAM/2+1] != 176000B ) + call amovks ( short(176000B), gram[LEN_GRAM/2+1], LEN_GRAM/2) + + for ( i = 1 ; color[i] != IDS_EOD ; i = i + 1 ) { + # Bit plane 8 reserved for cursor + if ( color[i] > 7 ) + next + # map IDS colors to IIS bit planes -- one-based. + switch (color[i]) { + case IDS_RED: + val = RD + case IDS_GREEN: + val = GR + case IDS_BLUE: + val = BLU + default: + val = color[i] + } + lbound = 2 ** (val - 1) + if ( off ) + call aclrs ( gram[lbound+1], lbound) + else + call amovks ( short(INSERT+mask[val]), gram[lbound+1], lbound) + } + gram[1] = 0 + + # If a bit plane is off, reset it with next "lower" one, thus + # uncovering any planes masked by the one turned off. + + if (off) { + fill = 0 + do i = 2, LEN_GRAM/2 { + if (gram[i] == 0 ) + gram[i] = fill + else + fill = gram[i] + } + } + + # Write out the data + + call iishdr(IWRITE+VRETRACE, LEN_GRAM, GRAPHICS, ADVXONTC, 0, 0, 0) + call iisio (gram, LEN_GRAM * SZB_CHAR) +end diff --git a/pkg/images/tv/iis/iism70/zdisplay_i.x b/pkg/images/tv/iis/iism70/zdisplay_i.x new file mode 100644 index 00000000..e08db8c3 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zdisplay_i.x @@ -0,0 +1,124 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "../lib/ids.h" +include "iis.h" + +# ZDISPLAY_I -- Display the referenced image planes in the given color(s) +# and in the given quadrants of the screen. + +procedure zdisplay_i (sw, frames, color, quad) + +short sw # on or off +short frames[ARB] # frame list +short color[ARB] # color list +short quad[ARB] # quadrant list + + +bool off +short channels +short select[LEN_SELECT] +int q,c,index, temp +int mq # mapped quadrant +int mapquad() +short iispack() +int and(), or(), xor() + +include "iis.com" +include "../lib/ids.com" # for i_maxframes! only + +begin + if ( sw == IDS_ON ) { + off = false + } else + off = true + + # first find out what is on + call iishdr(IREAD+VRETRACE, LEN_SELECT, COMMAND+LUT, ADVXONTC, 0,0,0) + call iisio (select, LEN_SELECT * SZB_CHAR) + + # then add in/remove frames + channels = iispack(frames) + + for ( q = 1 ; quad[q] != IDS_EOD ; q = q + 1 ) { + mq = mapquad(quad[q]) + if ( ! off ) { + for ( c =1 ; color[c] != IDS_EOD ; c = c + 1 ) { + switch ( color[c] ) { + case IDS_RED: + index = mq + 8 + + case IDS_GREEN: + index = mq + 4 + + case IDS_BLUE: + index = mq + } + select[index] = or ( int(channels), int(select[index]) ) + } + } else { + for ( c =1 ; color[c] != IDS_EOD ; c = c + 1 ) { + switch ( color[c] ) { + case IDS_RED: + index = mq + 8 + + case IDS_GREEN: + index = mq + 4 + + case IDS_BLUE: + index = mq + } + select[index] = and ( xor ( 177777B, int(channels)), + int(select[index])) + } + } + } + + # Record which frame is being displayed for cursor readback. + temp = 0 + do q = 1, LEN_SELECT + temp = or (temp, int(select[q])) + + if ( temp == 0) + i_frame_on = ERR + else { + do q = 1, i_maxframes { + if (and (temp, 2**(q-1)) != 0) { + i_frame_on = q + break + } + } + } + call iishdr(IWRITE+VRETRACE, LEN_SELECT, COMMAND+LUT, ADVXONTC, 0,0,0) + call iisio (select, LEN_SELECT * SZB_CHAR) +end + + +# MAPQUAD -- map user quadrant to device ... returns ONE-based quadrant +# if prefer ZERO-based, add one to "index" computation above. + +int procedure mapquad (quadrant) + +short quadrant + +int mq + +begin + switch ( quadrant ) { + case 1: + mq = 2 + + case 2: + mq = 1 + + case 3: + mq = 3 + + case 4: + mq = 4 + + default: + mq = 1 # should never happen + } + return (mq) +end diff --git a/pkg/images/tv/iis/iism70/zinit.x b/pkg/images/tv/iis/iism70/zinit.x new file mode 100644 index 00000000..e03fd57c --- /dev/null +++ b/pkg/images/tv/iis/iism70/zinit.x @@ -0,0 +1,45 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "../lib/ids.h" +include "iis.h" + +# ZINIT -- initialize for IIS operation +# in general case, would use nfr and ngr to determine maximum file size +# which would encompass all the images and graphics planes and all the +# devices too. Then, file mapped i/o could move most of the device indep. +# code to the reading and writing routines. +# not done for IIS + +procedure zinit (nfr, ngr, filesize) + +short nfr # maximum number of image frames +short ngr # maximum number of graphics bit planes +long filesize # returned value + +short pl[IDS_MAXIMPL+2] +short zm[4] + +include "../lib/ids.com" +include "iis.com" + +begin + i_snap = false + # we have no place to store all the zoom and scroll information. + # so we initialize to zoom = 1 and scroll = center for all planes + pl[1] = IDS_EOD + call ids_expand(pl, i_maxframes, true) + zm[1] = 1 + zm[2] = IIS_XCEN * MCXSCALE + zm[3] = IIS_YCEN * MCYSCALE + zm[4] = IDS_EOD + call iiszoom(short(IDS_WRITE), pl, short(4), zm) + call iisscroll(short(IDS_WRITE), pl, short(3), zm[2]) + + # We also need to set the i_frame_on variable (iis.com), which + # we do with a "trick": We call zdisplay_i with quad == EOD; + # this is a "nop" for the display code, but will set the variable. + + call zdisplay_i (short(IDS_ON), short(IDS_EOD), short(IDS_EOD), + short(IDS_EOD)) +end diff --git a/pkg/images/tv/iis/iism70/zopnim.x b/pkg/images/tv/iis/iism70/zopnim.x new file mode 100644 index 00000000..25df2f21 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zopnim.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ZOPNIM -- Open an image display frame which is addressable as +# a binary file. + +procedure zopnim (devinfo, mode, chan) + +char devinfo[ARB] # packed devinfo string +int mode # access mode +int chan + +int iischan[2] # Kludge + +begin + call iisopn (devinfo, mode, iischan) + chan = iischan[1] +end diff --git a/pkg/images/tv/iis/iism70/zreset.x b/pkg/images/tv/iis/iism70/zreset.x new file mode 100644 index 00000000..3d067d04 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zreset.x @@ -0,0 +1,164 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <gki.h> +include "../lib/ids.h" +include "iis.h" + +# cfactor is conversion from integer to NDC coordinates (max 32767) for cursor +# see iiscursor.x +# The "hardness" notion is now somewhat obsolete...a range of reset values +# would be better, especially if better named. + +define CFACTOR 528 + +# ZRESET -- reset IIS + +procedure zreset (hardness) + +short hardness # soft, medium, hard + +short data[LEN_IFM] +short frames[IDS_MAXIMPL+1] +short colors[IDS_MAXGCOLOR+1] +short quad[5] +int i,j + +include "iis.com" + +begin + if ( hardness == IDS_R_SNAPDONE ) { + call zsnap_done + return + } + + # mark all frames + do i = 1,IDS_MAXIMPL + frames[i] = i + frames[IDS_MAXIMPL+1] = IDS_EOD + # mark all colors + do i = 1, IDS_MAXGCOLOR + colors[i] = i + colors[IDS_MAXGCOLOR+1] = IDS_EOD + # all quadrants + do i = 1,4 + quad[i] = i + quad[5] = IDS_EOD + + if ( hardness == IDS_R_SOFT) { + # all coordinates are NDC ( 0 - 32767 ) + # Reseting the "soft" parameters: scroll, constant offsets, + # split point, alu, zoom; turn cursor and tball on. + + # constants + call aclrs (data,3) + call iisoffset(short(IDS_WRITE), colors, short(3), data) + + # range + data[1] = 1 + call iisrange (short(IDS_WRITE), colors, short(1), data) + + # split point + call aclrs ( data, 2) + call iissplit(short(IDS_WRITE), short(2), data) + + # alu + data[1] = 0 + call iishdr(IWRITE, 1, ALU+COMMAND, 0, 0, 0, 0) + call iisio (data, 1 * SZB_CHAR) + + # graphics status register + data[1] = 0 + call iishdr(IWRITE, 1, GRAPHICS+COMMAND, 0, 0, 0, 0) + call iisio (data, 1 * SZB_CHAR) + + # zoom + data[1] = 1 + data[2] = IIS_XCEN * MCXSCALE # gki mid point + data[3] = IIS_YCEN * MCYSCALE + data[4] = IDS_EOD + call iiszoom(short(IDS_WRITE), frames, short(4), data) + + # scroll -- screen center to be centered + # zoom does affect scroll if zoom not power==1 + # so to be safe, do scroll after zoom. + data[1] = IIS_XCEN * MCXSCALE + data[2] = IIS_YCEN * MCYSCALE + data[3] = IDS_EOD + call iisscroll(short(IDS_WRITE), frames, short(3), data) + + # cursor and tball; no blink for cursor + data[1] = IDS_ON + call iiscursor(short(IDS_WRITE), short(1), short(1), data) + call iistball (short(IDS_WRITE), data) + data[1] = IDS_CBLINK + data[2] = IDS_CSTEADY + call iiscursor(short(IDS_WRITE), short(1), short(1), data) + + # standard cursor shape + data[1] = IDS_CSHAPE + j = 2 + # don't use last line/column so have a real center + for ( i = 0 ; i <= 62 ; i = i + 1 ) { + # make the puka in the middle + if ( (i == 30) || (i == 31) || (i == 32) ) + next + # fill in the lines + data[j] = 31 * CFACTOR + data[j+1] = i * CFACTOR + j = j + 2 + data[j] = i * CFACTOR + data[j+1] = 31 * CFACTOR + j = j + 2 + } + data[j] = IDS_EOD + call iiscursor ( short(IDS_WRITE), short(1), short(j), data) + + return + } + + if ( hardness == IDS_R_MEDIUM) { + # reset all tables to linear--ofm, luts, ifm + # ofm (0,0) to (0.25,1.0) to (1.0,1.0) + data[1] = 0 + data[2] = 0 + data[3] = 0.25 * GKI_MAXNDC + data[4] = GKI_MAXNDC + data[5] = GKI_MAXNDC + data[6] = GKI_MAXNDC + call iisofm(short(IDS_WRITE), colors, short(1), short(6), data) + + # luts + data[1] = 0 + data[2] = 0 + data[3] = GKI_MAXNDC + data[4] = GKI_MAXNDC + call iislut(short(IDS_WRITE), frames, colors, short(1), + short(4), data) + + # ifm (0,0) to (1/32, 1.0) to (1.,1.) + # ifm is length 8192, but output is only 255. So map linearly for + # first 256, then flat. Other possibility is ifm[i] = i-1 ( for + # i = 1,8192) which relies on hardware dropping high bits. + + data[1] = 0 + data[2] = 0 + data[3] = (1./32.) * GKI_MAXNDC + data[4] = GKI_MAXNDC + data[5] = GKI_MAXNDC + data[6] = GKI_MAXNDC + call iisifm(short(IDS_WRITE), short(1), short(6), data) + + return + } + + if (hardness == IDS_R_HARD) { + # clear all image/graph planes, and set channel selects to + # mono + call zclear(frames, frames, true) + call zclear(frames, frames, false) + # reset all to no display + call zdisplay_i(short(IDS_OFF), frames, colors, quad) + call zdisplay_g(short(IDS_OFF), frames, colors, quad) + } +end diff --git a/pkg/images/tv/iis/iism70/zrestore.x b/pkg/images/tv/iis/iism70/zrestore.x new file mode 100644 index 00000000..ed478a20 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zrestore.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "../lib/ids.h" +include "iis.h" + +# restore device, image, graphics data + +procedure zdev_restore(fd) + +int fd # file descriptor to read from + +begin +end + +procedure zim_restore(fd, frame) + +int fd +short frame[ARB] # frame numbers to restore + +begin +end + +procedure zgr_restore(fd, plane) + +int fd +short plane[ARB] + +begin +end diff --git a/pkg/images/tv/iis/iism70/zsave.x b/pkg/images/tv/iis/iism70/zsave.x new file mode 100644 index 00000000..666f1b1f --- /dev/null +++ b/pkg/images/tv/iis/iism70/zsave.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "../lib/ids.h" +include "iis.h" + +# save device, image, graphics data + +procedure zdev_save(fd) + +int fd # file descriptor to write to + +begin +end + +procedure zim_save(fd, frame) + +int fd +short frame[ARB] # frame numbers to save + +begin +end + +procedure zgr_save(fd, plane) + +int fd +short plane[ARB] + +begin +end diff --git a/pkg/images/tv/iis/iism70/zseek.x b/pkg/images/tv/iis/iism70/zseek.x new file mode 100644 index 00000000..6f3fed25 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zseek.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <fset.h> +include "../lib/ids.h" +include "iis.h" + +# ZSEEK -- Seek for an image frame + +procedure zseek (fd, x, y) + +int fd # file to write +int x, y # device coordinates + +long offset + +begin + offset = max (1, 1 + (x + y * IIS_XDIM) * SZ_SHORT) + + call seek (fd, offset) +end diff --git a/pkg/images/tv/iis/iism70/zsetup.x b/pkg/images/tv/iis/iism70/zsetup.x new file mode 100644 index 00000000..0803ac3a --- /dev/null +++ b/pkg/images/tv/iis/iism70/zsetup.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <fset.h> +include "../lib/ids.h" +include "iis.h" + +# ZSETUP -- Setup up common block information for read/write + +procedure zsetup (frame, bitpl, flag) + +short frame[ARB] # frame information +short bitpl[ARB] # bitplane information +bool flag # true if image, false if graphics + +short iispack() +int mapcolor() + +include "iis.com" +include "../lib/ids.com" + +begin + # If don't flush, then last line of "previous" frame + # may get steered to wrong image plane + call flush (i_out) + call fseti (i_out, F_CANCEL, OK) + if ( flag ) { + iframe = iispack ( frame ) + iplane = iispack ( bitpl ) + } else { + iframe = GRCHAN + iplane = mapcolor( bitpl ) + } +end diff --git a/pkg/images/tv/iis/iism70/zsnap.com b/pkg/images/tv/iis/iism70/zsnap.com new file mode 100644 index 00000000..8dd6796c --- /dev/null +++ b/pkg/images/tv/iis/iism70/zsnap.com @@ -0,0 +1,26 @@ +# snap common block +int sn_fd # device file descriptor +int sn_frame, sn_bitpl # save current iframe, iplane +int zbufsize # fio buffer size--save here +pointer lutp[3,LEN_IISFRAMES] # look up table storage +pointer ofmp[3] # rgb ofm tables +pointer grp[3] # graphics tables +pointer result[3] # rgb results +pointer answer # final answer +pointer input # input data +pointer zs # zoom/scrolled data; scratch +pointer grbit_on # graphics bit on +bool gr_in_use # graphics RAM not all zeroes +bool on[LEN_IISFRAMES] # if frames on at all +bool multi_frame # snap using >1 frame +short range[3] # range and offset for rgb +short offset[3] +short left[3,2,LEN_IISFRAMES] # left boundary of line +short right[3,2,LEN_IISFRAMES] # right boundary of line +short ysplit # split point for y +short prev_y # previous line read +short sn_start, sn_end # color range to snap + +common / zsnap / sn_fd, sn_frame, sn_bitpl, zbufsize, lutp, ofmp, grp, + result, answer, input, zs, grbit_on, gr_in_use, on, multi_frame, + range, offset, left, right, ysplit, prev_y, sn_start, sn_end diff --git a/pkg/images/tv/iis/iism70/zsnap.x b/pkg/images/tv/iis/iism70/zsnap.x new file mode 100644 index 00000000..c0f9b230 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zsnap.x @@ -0,0 +1,239 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <fset.h> +include "iis.h" +include "../lib/ids.h" + +# DO_SNAP -- Return a line of the active image display, as seen +# by the viewer. + +procedure do_snap (buf, nchar, xpos, ypos) + +short buf[ARB] # buffer to read into +int nchar # how many to read +int xpos, ypos # and from where + +int y, yindex, xs, xe +int line, previous +int i,j +int yedge +int zm, count +bool first + +include "../lib/ids.com" +include "iis.com" +include "zsnap.com" + +begin + # Check if read is for one line only + + if (nchar > IIS_XDIM) { + call eprintf("ZSNAP -- too many pixels (%d) requested.\n") + call pargi (nchar) + call aclrs (buf, nchar) + return + } + + # Determine x and y coordinates on screen. + + y = IIS_YDIM - 1 - ypos + xs = xpos + xe = xs + nchar - 1 + count = nchar + + # See if we are dealing with (a part of only) one line + + if (xe >= IIS_XDIM) { + call eprintf("ZSNAP -- line overlap error (xend is %d).\n") + call pargi (xe) + call aclrs (buf, nchar) + return + } + + # Determine whether above or below split point. + + if (y < ysplit) + yindex = 1 + else + yindex = 2 + + # Clear accumulators + + do j = sn_start, sn_end + call aclrs (Mems[result[j]], IIS_XDIM) + + # Fetch and massage data for each active frame + + first = true + previous = -1 # a bit of safety if no frames on + do i = 1, i_maxframes { + if (on[i]) { + # If frame not active in any color for this half of screen, + # ignore it + if (sn_start != sn_end) { + if ((left[BLU, yindex, i] == -1) && + (left[GR , yindex, i] == -1) && + (left[RD , yindex, i] == -1) ) + next + } else if (left[sn_start, yindex, i] == -1) + next + + zm = zoom[i] + iplane = 377B # all bit planes + iframe = 2**(i-1) + + # y edge of frame (top) [ see zcursor_set for more information] + yedge = IIS_YCEN - yscroll[i] + IIS_YCEN_INV - IIS_YCEN_INV/zm + if (yedge < 0) + yedge = yedge + IIS_YDIM + + # Desired y (screen) coordinate + line = yedge + y/zm + if (line >= IIS_YDIM) + line = line - IIS_YDIM + # If have done this line before, just return the same answer + + if (first) { + if (line == prev_y) { + call amovs (Mems[answer], buf, nchar) + return + } + previous = line + first = false + } + + # Turn line into file position. + line = IIS_YDIM - 1 - line + if (multi_frame) + call fseti (sn_fd, F_CANCEL, OK) + call zseek (sn_fd, xs, line) + call read (sn_fd, Mems[input], count) + call zmassage (zm, xscroll[i], yindex, i, xs, xe) + } + } + + # Apply scaling + + do j = sn_start, sn_end { + # Note...xs, xe are zero-based indices + if ( offset[j] != 0) + call aaddks (Mems[result[j]+xs], offset[j], + Mems[result[j]+xs], count) + if ( range[j] != 1) + call adivks (Mems[result[j]+xs], range[j], + Mems[result[j]+xs], count) + call aluts (Mems[result[j]+xs], Mems[result[j]+xs], count, + Mems[ofmp[j]]) + } + + # Or in the graphics ... use of "select" (asel) depends on design + # decision in zdisplay_g.x + + if (gr_in_use) { + iframe = GRCHAN + iplane = 177B # ignore cursor plane + zm = zoom[GRCHNUM] + + yedge = IIS_YCEN - yscroll[GRCHNUM] + IIS_YCEN_INV - IIS_YCEN_INV/zm + if (yedge < 0) + yedge = yedge + IIS_YDIM + + line = yedge + y/zm + if (line >= IIS_YDIM) + line = line - IIS_YDIM + line = IIS_YDIM - 1 - line + + if (multi_frame) + call fseti (sn_fd, F_CANCEL, OK) + + call zseek (sn_fd, xs, line) + call read (sn_fd, Mems[input], count) + call zmassage (zm, xscroll[GRCHNUM], yindex, GRCHNUM, xs, xe) + + do j = sn_start, sn_end { + call aluts (Mems[input+xs], Mems[zs], count, Mems[grp[j]]) + + # Build boolean which says if have graphics on + call abneks (Mems[zs], short(0), Memi[grbit_on], count) + + # With INSERT on: replace data with graphics. + call asels (Mems[zs], Mems[result[j]+xs], Mems[result[j]+xs], + Memi[grbit_on], count) + } + } + + # The answer is: + + if (sn_start != sn_end) { + call aadds (Mems[result[BLU]], Mems[result[GR]], + Mems[answer], IIS_XDIM) + call aadds (Mems[answer], Mems[result[RD]], Mems[answer], IIS_XDIM) + call adivks (Mems[answer], short(3), Mems[answer], IIS_XDIM) + } else { + # Put in "answer" so repeated lines are in known location + call amovs (Mems[result[sn_start]], Mems[answer], nchar) + } + + # Set the previous line and return the answer + + prev_y = previous + call amovs (Mems[answer], buf, nchar) +end + + +# ZMASSAGE --- do all the boring massaging of the data: zoom, scroll, look +# up tables. + +procedure zmassage (zm, xscr, yi, i, xstart, xend) + +int zm # zoom factor +short xscr # x scroll +int yi # y-index +int i # frame index +int xstart, xend # indices for line start and end + +int lb, count # left bound, count of number of items +int j, x1, x2, itemp +include "zsnap.com" + +begin + if ( (xscr != IIS_XCEN) || (zm != 1)) { + if (xscr == IIS_XCEN) + # Scrolling not needed + call amovs (Mems[input], Mems[zs], IIS_XDIM) + else { + # Scroll the data + lb = xscr - IIS_XCEN + if ( lb < 0 ) + lb = lb + IIS_XDIM + count = IIS_XDIM - lb + call amovs (Mems[input+lb], Mems[zs], count) + call amovs (Mems[input], Mems[zs+count], lb) + } + # Now zoom it + if (zm == 1) + call amovs (Mems[zs], Mems[input], IIS_XDIM) + else + call ids_blockit (Mems[zs+IIS_XCEN-IIS_XCEN/zm], Mems[input], + IIS_XDIM, real(zm)) + } + + if (i == GRCHNUM) + return + + # With the aligned data, perform the lookup. Note that left is + # 0 based, right is (0-based) first excluded value. + + do j = sn_start, sn_end { + if (left[j, yi, i] == -1) + next + itemp = left[j,yi,i] + x1 = max (itemp, xstart) + itemp = right[j,yi,i] + x2 = min (itemp - 1, xend) + call aluts (Mems[input+x1], Mems[zs], x2-x1+1, Mems[lutp[j,i]]) + call aadds (Mems[zs], Mems[result[j]+x1], Mems[result[j]+x1], + x2-x1+1) + } +end diff --git a/pkg/images/tv/iis/iism70/zsnapinit.x b/pkg/images/tv/iis/iism70/zsnapinit.x new file mode 100644 index 00000000..48ed083c --- /dev/null +++ b/pkg/images/tv/iis/iism70/zsnapinit.x @@ -0,0 +1,314 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <fset.h> +include "iis.h" +include "../lib/ids.h" + +define XSPLIT LEN_SELECT+1 +define YSPLIT LEN_SELECT+2 + +# ZSNAP_INIT -- initialize snap data structures. + +procedure zsnap_init(kind) + +short kind + +pointer ptr +short gram[LEN_GRAM] +short select[LEN_SELECT+2] # include split points +short color[4] +short frame[2] +short cds, off, num +short xsplit, x_right + +int i, j, k, temp +int khp, val, frame_count +bool used, mono +int and(), or(), fstati() + +include "zsnap.com" +include "iis.com" +include "../lib/ids.com" + +begin + i_snap = true + sn_frame = iframe + sn_bitpl = iplane + sn_fd = i_out + call flush(sn_fd) + call fseti(sn_fd, F_CANCEL, OK) + prev_y = -1 + + # Determine what snap range to do + if (kind == IDS_SNAP_MONO) + mono= true + else + mono = false + + switch (kind) { + case IDS_SNAP_RGB: + # Note: BLU < RD and covers full color range + sn_start = BLU + sn_end = RD + + case IDS_SNAP_MONO, IDS_SNAP_BLUE: + sn_start = BLU + sn_end = BLU + + case IDS_SNAP_GREEN: + sn_start = GR + sn_end = GR + + case IDS_SNAP_RED: + sn_start = RD + sn_end = RD + } + + # Find out which planes are active -- any quadrant + + call iishdr (IREAD, LEN_SELECT+2, COMMAND+LUT, ADVXONTC, 0, 0, 0) + call iisio (select, (LEN_SELECT+2)*SZB_CHAR) + + # record split point. Adjust x_split so 511 becomes + # 512. This is so the "right" side of a quadrant is given by one + # plus the last used point. + + ysplit = select[YSPLIT] + xsplit = select[XSPLIT] + x_right = xsplit + if (x_right == IIS_XDIM-1) + x_right = IIS_XDIM + + + # For certain split positions, some quadrants don't appear at all. + + if (xsplit == 0) + call nullquad (0, 2, select) + else if (xsplit == IIS_XDIM-1) + call nullquad (1, 3, select) + if (ysplit == 0) + call nullquad (0, 1, select) + else if (ysplit == IIS_YDIM-1) + call nullquad (2, 3, select) + + # Which frames are active, in any quadrant? + + temp = 0 + do i = 1, LEN_SELECT + temp = or (temp, int(select[i])) + do i = 1, i_maxframes { + if ( and (temp, 2**(i-1)) != 0) + on[i] = true + else + on[i] = false + } + + # Find out where each active plane starts and stops. Split points + # are screen coordinates, not picture coordinates. Graphics does + # not split (!). left coord is inclusive, right is one beyond end. + # left/right dimensions: color, above/below_ysplit, image_plane. + # Frame_count counts frames in use. Could be clever and only count + # active frames whose pixels are on the screen (pan/zoom effects). + + frame_count = 0 + do i = 1, i_maxframes { + if ( !on[i] ) + next + else + frame_count = frame_count + 1 + do j = sn_start, sn_end { # implicit BLUE (GREEN RED) + # quadrants for IIS are UL:0, UR:1, LL:2, LR:3 + do k = 0, 3 { + temp = select[(j-1)*4 + k + 1] + used = (and(temp, 2**(i-1)) != 0) + khp = k/2 + 1 + switch (k) { + case 0, 2: + if (used) { + left[j,khp,i] = 0 + right[j,khp,i] = x_right + } else { + left[j,khp,i] = -1 + } + + case 1, 3: + if (used) { + if ( left[j,khp,i] == -1) + left[j,khp,i] = xsplit + right[j,khp,i] = IIS_XDIM + } + } # end switch + } # end k ( quad loop) + } # end j ( color loop) + } # end i ( frame loop) + + # now do range and offset + + cds = IDS_READ + num = 3 + color[1] = IDS_BLUE + color[2] = IDS_GREEN + color[3] = IDS_RED + color[4] = IDS_EOD + call iisrange(cds, color, num, range) + call iisoffset(cds, color, num, offset) + do i = sn_start, sn_end + range[i] = 2**range[i] + + # now allocate memory for all the various tables + + call malloc (input, IIS_XDIM, TY_SHORT) + call malloc (answer, IIS_XDIM, TY_SHORT) + call malloc (zs, IIS_XDIM, TY_SHORT) + # for each color: + do j = sn_start, sn_end { + call malloc (result[j], IIS_XDIM, TY_SHORT) + call malloc (ofmp[j], LEN_OFM, TY_SHORT) + call malloc (grp[j], LEN_GRAM/2, TY_SHORT) + do i = 1, i_maxframes { + if ( on[i] ) + call malloc (lutp[j,i], LEN_LUT, TY_SHORT) + } + } + call malloc (grbit_on, IIS_XDIM, TY_INT) + + # fill these up + + cds = IDS_READ + off = 1 + frame[2] = IDS_EOD + color[2] = IDS_EOD + do j = sn_start, sn_end { + if (j == BLU) + color[1] = IDS_BLUE + else if ( j == GR) + color[1] = IDS_GREEN + else + color[1] = IDS_RED + num = LEN_OFM + call iisofm (cds, color, off, num, Mems[ofmp[j]]) + do i = 1, i_maxframes { + if (on[i]) { + frame[1] = i + num = LEN_LUT + call iislut (cds, frame, color, off, num, Mems[lutp[j,i]]) + } + } + } + + # the graphics planes ... assume insert mode!! + # Note if any graphics mapping ram is in use...if no graphics on, + # snap can run faster. + + call iishdr (IREAD, LEN_GRAM, GRAPHICS, ADVXONTC, 0, 0, 0) + call iisio (gram, LEN_GRAM * SZB_CHAR) + + gr_in_use = false + do j = sn_start, sn_end + call aclrs(Mems[grp[j]], LEN_GRAM/2) + # Leave first one 0; don't mess with cursor plane + do i = 2, LEN_GRAM/2 { + temp = and (77777B, int(gram[i])) + if (temp != 0) + gr_in_use = true + if (! mono) { + do j = sn_start, sn_end + switch (j) { + case RD: + Mems[grp[RD]+i-1] = and (temp,76000B)/32 + case GR: + Mems[grp[GR]+i-1] = and (temp, 1740B) + case BLU: + Mems[grp[BLU]+i-1] = and (temp, 37B)*32 + } + } else { + # All graphics planes + val = or ( and (temp, 76000B)/32, and (temp, 1740B)) + val = or ( and (temp, 37B)*32, val) + Mems[grp[sn_start]+i-1] = val + } + } + + if (gr_in_use) + frame_count = frame_count + 1 + if (frame_count > 1) { + multi_frame = true + # set buffer to size of one line + zbufsize = fstati (sn_fd, F_BUFSIZE) + call fseti (sn_fd, F_BUFSIZE, IIS_XDIM) + } else + multi_frame = false + + # Now adjust look up tables for fact that they do 9 bit 2's complement + # arithmetic! + do j = sn_start, sn_end { + do i = 1, i_maxframes { + if (on[i]) { + ptr = lutp[j,i] + do k = 1, LEN_LUT { + if (Mems[ptr+k-1] > 255 ) + Mems[ptr+k-1] = Mems[ptr+k-1] - 512 + } + } + } + } +end + + +# NULLQUAD -- zero out lut mapping for quadrants that cannot appear on +# screen + +procedure nullquad (q, p, sel) + +int q, p # two quadrants to eliminate, zero based +short sel[ARB] # the mapping array + +int i + +begin + do i = 0,2 { + sel[i*4 + q + 1] = 0 + sel[i*4 + p + 1] = 0 + } +end + + +# ZSNAP_DONE -- reset paramters + +procedure zsnap_done() + +int i,j + +include "iis.com" +include "zsnap.com" +include "../lib/ids.com" + +begin + if ( ! i_snap ) + return + i_snap = false + call fseti(sn_fd, F_CANCEL, OK) + if (multi_frame) { + # restore buffering + call fseti (sn_fd, F_BUFSIZE, zbufsize) + } + iframe = sn_frame + iplane = sn_bitpl + + # release storage + call mfree (grbit_on, TY_INT) + do j = sn_start, sn_end { + call mfree (result[j], TY_SHORT) + call mfree (ofmp[j], TY_SHORT) + call mfree (grp[j], TY_SHORT) + do i = 1, i_maxframes { + if ( on[i] ) + call mfree (lutp[j,i], TY_SHORT) + } + } + + call mfree (zs, TY_SHORT) + call mfree (answer, TY_SHORT) + call mfree (input, TY_SHORT) +end diff --git a/pkg/images/tv/iis/iism70/zsttim.x b/pkg/images/tv/iis/iism70/zsttim.x new file mode 100644 index 00000000..2f441ed7 --- /dev/null +++ b/pkg/images/tv/iis/iism70/zsttim.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <knet.h> + +# ZSTTIM -- Return status on binary file display device. + +procedure zsttim (chan, what, lvalue) + +int chan[ARB], what +long lvalue + +begin + call zsttgd (chan, what, lvalue) +end diff --git a/pkg/images/tv/iis/lib/ids.com b/pkg/images/tv/iis/lib/ids.com new file mode 100644 index 00000000..cd6bc086 --- /dev/null +++ b/pkg/images/tv/iis/lib/ids.com @@ -0,0 +1,25 @@ +# IDS common. A common is necessary since there is no graphics descriptor +# in the argument list of the kernel procedures. The data structures +# are designed along the lines of FIO: a small common is used to hold the time +# critical data elements, and an auxiliary dynamically allocated descriptor is +# used for everything else. + +pointer i_kt # kernel image display descriptor +pointer i_tty # graphcap descriptor +int i_in, i_out # input file, output file +int i_xres, i_yres # desired device resolution +long i_frsize # frame size in chars +short i_maxframes, i_maxgraph # max num. of image frames, gr. planes +int i_linemask # current linemask +int i_linewidth # current line width +int i_linecolor # current line color +short i_pt_x, i_pt_y # current plot point, device coords +int i_csize # text character size +int i_font # text font +bool i_snap # true if a snap in progress +bool i_image # frame/bitplane data is for image +char i_device[SZ_IDEVICE] # force output to named device + +common /idscom/ i_kt, i_tty, i_in, i_out, i_xres, i_yres, i_frsize, + i_maxframes, i_maxgraph, i_linemask, i_linewidth, i_linecolor, + i_pt_x, i_pt_y, i_csize, i_font, i_snap, i_image, i_device diff --git a/pkg/images/tv/iis/lib/ids.h b/pkg/images/tv/iis/lib/ids.h new file mode 100644 index 00000000..bbf36392 --- /dev/null +++ b/pkg/images/tv/iis/lib/ids.h @@ -0,0 +1,175 @@ +# IDS definitions. + +define MAX_CHARSIZES 10 # max discreet device char sizes +define SZ_SBUF 1024 # initial string buffer size +define SZ_IDEVICE 31 # maxsize forced device name + +# The IDS state/device descriptor. + +define LEN_IDS 81 + +define IDS_SBUF Memi[$1] # string buffer +define IDS_SZSBUF Memi[$1+1] # size of string buffer +define IDS_NEXTCH Memi[$1+2] # next char pos in string buf +define IDS_NCHARSIZES Memi[$1+3] # number of character sizes +define IDS_POLYLINE Memi[$1+4] # device supports polyline +define IDS_POLYMARKER Memi[$1+5] # device supports polymarker +define IDS_FILLAREA Memi[$1+6] # device supports fillarea +define IDS_CELLARRAY Memi[$1+7] # device supports cell array +define IDS_ZRES Memi[$1+8] # device resolution in Z +define IDS_FILLSTYLE Memi[$1+9] # number of fill styles +define IDS_ROAM Memi[$1+10] # device supports roam +define IDS_CANZM Memi[$1+11] # device supports zoom +define IDS_SELERASE Memi[$1+12] # device has selective erase +define IDS_FRAME Memi[$1+13] # pointer to frames area +define IDS_BITPL Memi[$1+14] # pointer to bitplane area + # extra space +define IDS_FRCOLOR Memi[$1+18] # frame color +define IDS_GRCOLOR Memi[$1+19] # graphics color +define IDS_LCURSOR Memi[$1+20] # last cursor accessed +define IDS_COLOR Memi[$1+21] # last color set +define IDS_TXSIZE Memi[$1+22] # last text size set +define IDS_TXFONT Memi[$1+23] # last text font set +define IDS_TYPE Memi[$1+24] # last line type set +define IDS_WIDTH Memi[$1+25] # last line width set +define IDS_DEVNAME Memi[$1+26] # name of open device +define IDS_CHARHEIGHT Memi[$1+30+$2-1] # character height +define IDS_CHARWIDTH Memi[$1+40+$2-1] # character width +define IDS_CHARSIZE Memr[P2R($1+50+$2-1)] # text sizes permitted +define IDS_PLAP ($1+60) # polyline attributes +define IDS_PMAP ($1+64) # polymarker attributes +define IDS_FAAP ($1+68) # fill area attributes +define IDS_TXAP ($1+71) # default text attributes + +# Substructure definitions. + +define LEN_PL 4 +define PL_STATE Memi[$1] # polyline attributes +define PL_LTYPE Memi[$1+1] +define PL_WIDTH Memi[$1+2] +define PL_COLOR Memi[$1+3] + +define LEN_PM 4 +define PM_STATE Memi[$1] # polymarker attributes +define PM_LTYPE Memi[$1+1] +define PM_WIDTH Memi[$1+2] +define PM_COLOR Memi[$1+3] + +define LEN_FA 3 # fill area attributes +define FA_STATE Memi[$1] +define FA_STYLE Memi[$1+1] +define FA_COLOR Memi[$1+2] + +define LEN_TX 10 # text attributes +define TX_STATE Memi[$1] +define TX_UP Memi[$1+1] +define TX_SIZE Memi[$1+2] +define TX_PATH Memi[$1+3] +define TX_SPACING Memr[P2R($1+4)] +define TX_HJUSTIFY Memi[$1+5] +define TX_VJUSTIFY Memi[$1+6] +define TX_FONT Memi[$1+7] +define TX_QUALITY Memi[$1+8] +define TX_COLOR Memi[$1+9] + +define IDS_EOD (-2) # flag for end of data + +define IDS_RESET 10 # escape 10 +define IDS_R_HARD 0 # hard reset +define IDS_R_MEDIUM 1 # medium +define IDS_R_SOFT 2 +define IDS_R_SNAPDONE 3 # end snap + +define IDS_SET_IP 11 # escape 11 +define IDS_SET_GP 12 # escape 12 +define IDS_DISPLAY_I 13 # escape 13 +define IDS_DISPLAY_G 14 # escape 14 +define IDS_SAVE 15 # escape 15 +define IDS_RESTORE 16 # escape 16 + +# max sizes + +define IDS_MAXIMPL 16 # maximum number of image planes +define IDS_MAXGRPL 16 # maximum number of graphics planes +define IDS_MAXBITPL 16 # maximum bit planes per frame +define IDS_MAXGCOLOR 8 # maximum number of colors (graphics) +define IDS_MAXDATA 8192 # maximum data structure in display + +define IDS_RED 1 +define IDS_GREEN 2 +define IDS_BLUE 3 +define IDS_YELLOW 4 +define IDS_RDBL 5 +define IDS_GRBL 6 +define IDS_WHITE 7 +define IDS_BLACK 8 + +define IDS_QUAD_UR 1 # upper right quad.: split screen mode +define IDS_QUAD_UL 2 +define IDS_QUAD_LL 3 +define IDS_QUAD_LR 4 + +define IDS_CONTROL 17 # escape 17 +define IDS_CTRL_LEN 6 +define IDS_CTRL_REG 1 # what to control +define IDS_CTRL_RW 2 # read/write field in control instr. +define IDS_CTRL_N 3 # count of DATA items +define IDS_CTRL_FRAME 4 # pertinent frame(s) +define IDS_CTRL_COLOR 5 # and color +define IDS_CTRL_OFFSET 6 # generalized "register" +define IDS_CTRL_DATA 7 # data array + +define IDS_WRITE 0 # write command +define IDS_READ 1 # read command +define IDS_READ_WT 2 # wait for action, then read +define IDS_OFF 1 # turn whatever off +define IDS_ON 2 +define IDS_CBLINK 3 # cursor blink +define IDS_CSHAPE 4 # cursor shape + +define IDS_CSTEADY 1 # cursor blink - steady (no blink) +define IDS_CFAST 2 # cursor blink - fast +define IDS_CMEDIUM 3 # cursor blink - medium +define IDS_CSLOW 4 # cursor blink - slow + +define IDS_FRAME_LUT 1 # look-up table for image frame +define IDS_GR_MAP 2 # graphics color map...lookup table per + # se makes little sense for bit plane +define IDS_INPUT_LUT 3 # global input lut +define IDS_OUTPUT_LUT 4 # final lut +define IDS_SPLIT 5 # split screen coordinates +define IDS_SCROLL 6 # scroll coordinates +define IDS_ZOOM 7 # zoom magnification +define IDS_OUT_OFFSET 8 # output bias +define IDS_MIN 9 # data minimum +define IDS_MAX 10 # data maximum +define IDS_RANGE 11 # output range select +define IDS_HISTOGRAM 12 # output data histogram +define IDS_ALU_FCN 13 # arithmetic feedback function +define IDS_FEEDBACK 14 # feedback control +define IDS_SLAVE 15 # auxillary host or slave processor + +define IDS_CURSOR 20 # cursor control - on/off/blink/shape +define IDS_TBALL 21 # trackball control - on/off +define IDS_DIGITIZER 22 # digitizer control - on/off +define IDS_BLINK 23 # for blink request +define IDS_SNAP 24 # snap function +define IDS_MATCH 25 # match lookup tables + +# snap codes ... just reuse color codes from above. +define IDS_SNAP_RED IDS_RED # snap the blue image +define IDS_SNAP_GREEN IDS_GREEN # green +define IDS_SNAP_BLUE IDS_BLUE # blue +define IDS_SNAP_RGB IDS_BLACK # rgb image --- do all three +define IDS_SNAP_MONO IDS_WHITE # do just one + +# cursor parameters + +define IDS_CSET 128 # number of cursors per "group" + +define IDS_CSPECIAL 4097 # special "cursors" + # must be > (IDS_CSET * number of cursor groups) +define IDS_CRAW IDS_CSPECIAL # raw cursor read +define IDS_BUT_RD 4098 # "cursor number" for read buttons cmd +define IDS_BUT_WT 4099 # wait for button press, then read +define IDS_CRAW2 4100 # A second "raw" cursor diff --git a/pkg/images/tv/iis/lumatch.cl b/pkg/images/tv/iis/lumatch.cl new file mode 100644 index 00000000..1890152b --- /dev/null +++ b/pkg/images/tv/iis/lumatch.cl @@ -0,0 +1,8 @@ +#{ LUMATCH -- Match the lookup tables for two frames. + +# frame,i,a,,1,4,frame to be adjusted +# ref_frame,i,a,,1,4,reference frame + +{ + _dcontrol (frame=frame, alternate=ref_frame, match=yes) +} diff --git a/pkg/images/tv/iis/lumatch.par b/pkg/images/tv/iis/lumatch.par new file mode 100644 index 00000000..60e3b7b3 --- /dev/null +++ b/pkg/images/tv/iis/lumatch.par @@ -0,0 +1,2 @@ +frame,i,a,,1,4,frame to be adjusted +ref_frame,i,a,,1,4,frame to be matched diff --git a/pkg/images/tv/iis/mkpkg b/pkg/images/tv/iis/mkpkg new file mode 100644 index 00000000..7b45b437 --- /dev/null +++ b/pkg/images/tv/iis/mkpkg @@ -0,0 +1,25 @@ +# Make the CV (Control Video) display load and control package. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $update libpkg.a + $omake x_iis.x + $link x_iis.o libpkg.a -o xx_iis.e + ; + +install: + $move xx_iis.e bin$x_iis.e + ; + +libpkg.a: + @ids + @iism70 + @src + ; diff --git a/pkg/images/tv/iis/monochrome.cl b/pkg/images/tv/iis/monochrome.cl new file mode 100644 index 00000000..91de948f --- /dev/null +++ b/pkg/images/tv/iis/monochrome.cl @@ -0,0 +1,5 @@ +#{ MONOCHROME -- Set monochrome enhancement on display. + +{ + _dcontrol (map="mono") +} diff --git a/pkg/images/tv/iis/pseudocolor.cl b/pkg/images/tv/iis/pseudocolor.cl new file mode 100644 index 00000000..74d66a82 --- /dev/null +++ b/pkg/images/tv/iis/pseudocolor.cl @@ -0,0 +1,24 @@ +#{ PSEUDOCOLOR -- Select pseudocolor enhancement. + +# enhancement,s,a,linear,,,"type of pseudocolor enhancement:\n\ +# linear - map greyscale into a spectrum\n\ +# random - one randomly chosen color is assigned each greylevel\n\ +# 8color - eight random colors\n\ +# enter selection" +# window,b,h,yes,,,window display after enabling pseudocolor +# enhance,s,h + +{ + # Query for enchancement and copy into local param, otherwise each + # reference will cause a query. + enhance = enhancement + + if (enhance == "linear") + _dcontrol (map = "linear", window=window) + else if (enhance == "random") + _dcontrol (map = "random", window=window) + else if (enhance == "8color") + _dcontrol (map = "8color", window=window) + else + error (0, "unknown enhancement") +} diff --git a/pkg/images/tv/iis/pseudocolor.par b/pkg/images/tv/iis/pseudocolor.par new file mode 100644 index 00000000..e99d8d80 --- /dev/null +++ b/pkg/images/tv/iis/pseudocolor.par @@ -0,0 +1,7 @@ +enhancement,s,a,random,,,"type of pseudocolor enhancement:\n\ + linear - map greyscale into a spectrum\n\ + random - a randomly chosen color is assigned to each greylevel\n\ + 8color - use eight colors chosen at random\n\ +enter selection" +window,b,h,yes,,,window display after enabling pseudocolor +enhance,s,h diff --git a/pkg/images/tv/iis/rgb.cl b/pkg/images/tv/iis/rgb.cl new file mode 100644 index 00000000..4fada018 --- /dev/null +++ b/pkg/images/tv/iis/rgb.cl @@ -0,0 +1,11 @@ +#{ RGB -- Select rgb display mode. + +# red_frame,i,a,1,1,4,red frame +# green_frame,i,a,2,1,4,green frame +# blue_frame,i,a,3,1,4,blue frame +# window,b,h,no,,,window RGB frames + +{ + _dcontrol (type="rgb", red_frame=red_frame, green_frame=green_frame, + blue_frame=blue_frame, rgb_window=window) +} diff --git a/pkg/images/tv/iis/rgb.par b/pkg/images/tv/iis/rgb.par new file mode 100644 index 00000000..86d11871 --- /dev/null +++ b/pkg/images/tv/iis/rgb.par @@ -0,0 +1,4 @@ +red_frame,i,a,1,1,4,red frame +green_frame,i,a,2,1,4,green frame +blue_frame,i,a,3,1,4,blue frame +window,b,h,no,,,window RGB frames diff --git a/pkg/images/tv/iis/src/blink.x b/pkg/images/tv/iis/src/blink.x new file mode 100644 index 00000000..fc176f7a --- /dev/null +++ b/pkg/images/tv/iis/src/blink.x @@ -0,0 +1,132 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include <gki.h> +include "../lib/ids.h" + +# BLINK -- blink the display. + +procedure blink() + +char token[SZ_LINE] +int tok, count, rate +int sets, button, i +int ctoi(), ip +pointer sp, setp, ptr +int cv_rdbut() +int val, nchar + +define errmsg 10 + +include "cv.com" + +begin + # get rate for blink + + call gargtok (tok, token, SZ_LINE) + if (tok != TOK_NUMBER) { + call eprintf ("Bad blink rate: %s\n") + call pargstr (token) + return + } + ip = 1 + count = ctoi(token, ip, rate) + if (rate < 0) { + call eprintf ("negative rate not legal\n") + return + } + + call smark (sp) + # The "3" is to hold frame/color/quad for one frame; + # the "2" is to allow duplication of each frame so that + # some frames can stay "on" longer. The extra "1" is for graphics. + call salloc (setp, 2 * 3 * (cv_maxframes+1), TY_POINTER) + sets = 0 + + # which frames to blink + + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + while ( (sets <= cv_maxframes+1) && (tok != TOK_NEWLINE) ) { + sets = sets + 1 + ptr = setp + (3 * (sets-1)) + call salloc (Memi[ptr], IDS_MAXIMPL+1, TY_SHORT) + if (tok == TOK_IDENTIFIER) { + if (token[1] == 'f') { + call cv_frame (token[2], Mems[Memi[ptr]]) + if (Mems[Memi[ptr]] == ERR) { + call sfree (sp) + return + } + } + } else if (tok == TOK_NUMBER) { + ip = 1 + nchar = ctoi (token[1], ip, val) + if ( (val < 0) || (val > cv_maxframes)) { + call eprintf ("illegal frame value: %s\n") + call pargstr (token) + call sfree (sp) + return + } + Mems[Memi[ptr]] = val + Mems[Memi[ptr]+1] = IDS_EOD + } else { +errmsg + call eprintf ("Unexpected input: %s\n") + call pargstr (token) + call sfree (sp) + return + } + ptr = ptr + 1 + call salloc (Memi[ptr], IDS_MAXGCOLOR+1, TY_SHORT) + call salloc (Memi[ptr+1], 5, TY_SHORT) + Mems[Memi[ptr]] = IDS_EOD # default all colors + Mems[Memi[ptr+1]] = IDS_EOD # default all quads + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if ( (tok != TOK_IDENTIFIER) && (tok != TOK_NEWLINE)) + goto errmsg + if ((tok == TOK_IDENTIFIER) && (token[1] == 'c')) { + call cv_color (token[2], Mems[Memi[ptr]]) + if (Mems[Memi[ptr]] == ERR) { + call sfree (sp) + return + } + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + } + if ( (tok != TOK_IDENTIFIER) && (tok != TOK_NEWLINE)) + goto errmsg + if ((tok == TOK_IDENTIFIER) && (token[1] == 'q')) { + call cv_quad (token[2], Mems[Memi[ptr+1]]) + if (Mems[Memi[ptr+1]] == ERR) { + call sfree (sp) + return + } + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + } + } # end while + + button = cv_rdbut() # clear any buttons pressed + call eprintf ("Press any button to terminate blink\n") + repeat { + do i = 1, sets { + ptr = setp + 3 * (i-1) + call cvdisplay (IDS_ON, IDS_DISPLAY_I, Mems[Memi[ptr]], + Mems[Memi[ptr+1]], Mems[Memi[ptr+2]]) + # Delay for "rate*100" milliseconds + call zwmsec (rate * 100) + + # Leave something on screen when button pushed + button = cv_rdbut() + if (button > 0) + break + call cvdisplay (IDS_OFF, IDS_DISPLAY_I, Mems[Memi[ptr]], + Mems[Memi[ptr+1]], Mems[Memi[ptr+2]]) + } + } until (button > 0) + + call sfree (sp) +end diff --git a/pkg/images/tv/iis/src/clear.x b/pkg/images/tv/iis/src/clear.x new file mode 100644 index 00000000..60cf69eb --- /dev/null +++ b/pkg/images/tv/iis/src/clear.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include "../lib/ids.h" + +# CLEAR -- clear certain frames in the display + +procedure clear() + +char token[SZ_LINE] +int tok +short frames[IDS_MAXIMPL+1] + +define nexttok 10 + +include "cv.com" + +begin + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + + while ( (tok == TOK_IDENTIFIER) || (tok == TOK_NUMBER) ) { + if (tok == TOK_IDENTIFIER) { + switch (token[1]) { + case 'a', 'g': + # all colors + call cvclearg (short(IDS_EOD), short (IDS_EOD)) + if (token[1] == 'g') + goto nexttok + frames[1] = IDS_EOD + + case 'f': + call cv_frame (token[2], frames) + } + } else + call cv_frame (token[1], frames) + + call cvcleari (frames) + if (token[1] == 'a') + return + + # get next token +nexttok + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + } +end diff --git a/pkg/images/tv/iis/src/cv.com b/pkg/images/tv/iis/src/cv.com new file mode 100644 index 00000000..ec9c70e7 --- /dev/null +++ b/pkg/images/tv/iis/src/cv.com @@ -0,0 +1,16 @@ +# common block for cv + +pointer cv_gp # file descriptor to write +pointer cv_stack # working space for escape sequences +int cv_maxframes # device max frames +int cv_maxgraph # device max graph planes +int cv_xcen, cv_ycen # user pixel coords of center of dev. +int cv_xres, cv_yres # device resolution +int cv_zres # device z resolution +real cv_xcon, cv_ycon # conversion from NDC to GKI +int cv_grch # graphics channel +real cv_xwinc, cv_ywinc # cursor position for window command + +common /cvcom/ cv_gp, cv_stack, cv_maxframes, cv_maxgraph, cv_xcen, cv_ycen, + cv_xres, cv_yres, cv_zres, cv_xcon, cv_ycon, cv_grch, + cv_xwinc, cv_ywinc diff --git a/pkg/images/tv/iis/src/cv.h b/pkg/images/tv/iis/src/cv.h new file mode 100644 index 00000000..80f3016b --- /dev/null +++ b/pkg/images/tv/iis/src/cv.h @@ -0,0 +1,51 @@ +# constants for cv package...should come from a graphcap entry + +# These are one based. +define CV_XCEN 257 +define CV_YCEN 256 + +define CV_XRES 512 +define CV_YRES 512 +define CV_ZRES 256 + +define CV_MAXF 4 +define CV_MAXG 7 + +define CV_GRCHNUM 16 + +# CVLEN is just the *estimated* never to be exceeded amount of storage needed +# to set up the escape sequence. It could be determined dynamically by +# changing cv_move to count elements instead of moving them. Then the known +# counts would be used with amovs to hustle the elements into the "salloc'ed" +# space. Instead, with a static count, we can salloc once upon entering +# the cv program and free up at exit. + +define CVLEN 128 + +# Following are from "display.h"... only SAMPLE_SIZE and MAXLOG needed +# as of May, 1985. But we might incorporate other programs from "tv", +# so leave them. + +# Size limiting parameters. + +define MAXCHAN 2 +define SAMPLE_SIZE 600 + +# If a logarithmic greyscale transformation is desired, the input range Z1:Z2 +# will be mapped into the range 1.0 to 10.0 ** MAXLOG before taking the log +# to the base 10. + +define MAXLOG 3 + +# The following parameter is used to compare display pixel coordinates for +# equality. It determines the maximum permissible magnification. The machine +# epsilon is not used because the computations are nontrivial and accumulation +# of error is a problem. + +define DS_TOL (1E-4) + +# These parameters are needed for user defined transfer functions. + +define SZ_BUF 4096 +define STARTPT 0.0E0 +define ENDPT 4095.0E0 diff --git a/pkg/images/tv/iis/src/cv.x b/pkg/images/tv/iis/src/cv.x new file mode 100644 index 00000000..a169a402 --- /dev/null +++ b/pkg/images/tv/iis/src/cv.x @@ -0,0 +1,175 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <fio.h> +include <fset.h> +include "../lib/ids.h" +include <gki.h> +include <ctotok.h> +include <error.h> +include "cv.h" + +# Captain Video + +procedure t_cv() + +pointer gp +char device[SZ_FNAME] +char command[SZ_LINE] + +pointer gopen(), sp +int dd[LEN_GKIDD] + +int scan, tok, envgets() + +include "cv.com" + +begin + call smark (sp) + call salloc (cv_stack, CVLEN, TY_SHORT) + + if (envgets ("stdimage", device, SZ_FNAME) == 0) + call error (EA_FATAL, + "variable 'stdimage' not defined in environment") + + call ids_open (device, dd) + call gki_inline_kernel (STDIMAGE, dd) + gp = gopen ( device, READ_WRITE, STDIMAGE) + + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + call ids_grstream (STDIMAGE) + + # to do: + # initialize local variables: image display size, etc + # instead of defines such as MCXSCALE, etc + cv_maxframes = CV_MAXF + cv_maxgraph = CV_MAXG + cv_xcen = CV_XCEN + cv_ycen = CV_YCEN + cv_xres = CV_XRES + cv_yres = CV_YRES + cv_zres = CV_ZRES + cv_gp = gp + cv_xcon = real(GKI_MAXNDC+1)/CV_XRES + cv_ycon = real(GKI_MAXNDC+1)/CV_YRES + cv_grch = CV_GRCHNUM + cv_xwinc = -1. # Flag: Don't know what lut is + + repeat { + call printf (":-) ") + call flush (STDOUT) + if (scan() == EOF) + break + call gargtok(tok, command, SZ_LINE) + if ((tok == TOK_EOS) || (tok == TOK_NEWLINE)) + next + # decode next command + call strlwr(command) + switch (command[1]) { + case 'x', 'q': + break + + + case 'b': + call blink + + case 'c': + if (command[2] == 'l') + call clear + else + call rdcur + + case 'd': + call display(command[2]) + + case 'e': # erase means clear + call clear + + case 'h', '?': + call help + + # case 'l': + # call load + + case 'm': + call match + + case 'o': + call offset + + case 'p': + if ( command[2] == 's') + call map(command[2]) # pseudo color + else + call pan + + case 'r': + if (command[2] == 'e') + call reset + else + call range + + case 's': + if (command[2] == 'n') + call snap + else + call split + + case 't': + call tell + + case 'w': + if (command[2] == 'r') + call text + else + call window + + case 'z': + call zoom + + default: + call eprintf("unknown command: %s\n") + call pargstr(command[1]) + + } # end switch statement + + } # end repeat statment + + # all done + + call gclose ( gp ) + call ids_close + call sfree (sp) +end + + +# HELP -- print informative message + +procedure help() + +begin + call eprintf ("--- () : optional; [] : select one; N : number; C/F/Q : see below\n") + call eprintf ("b(link) N F (C Q) (F (C Q)..) blink N = 10 is one second\n") + call eprintf ("c(ursor) [on off F] cursor\n") + call eprintf ("di F (C Q) [on off] display image\n") + call eprintf ("dg C (F Q) [on off] display graphics\n") + call eprintf ("e(rase) [N a(ll) g(raphics) F] erase (clear)\n") + #call eprintf ("l(oad) load a frame\n") + call eprintf ("m(atch) (o) F (C) (to) (F) (C) match (output) lookup table\n") + call eprintf ("o(ffset) C N offset color N: 0 to +- 4095\n") + call eprintf ("p(an) (F) pan images\n") + call eprintf ("ps(eudo) (o) (F C) (rn sn) pseudo color mapping rn/sn: random n/seed n\n") + call eprintf ("r(ange) N (C) (N C ...) scale image N: 1-8\n") + call eprintf ("re(set) [r i t a] reset display registers/image/tables/all\n") + call eprintf ("sn(ap) (C) snap a picture\n") + call eprintf ("s(plit) [c o px,y nx,y] split picture\n") + call eprintf ("t(ell) tell display state\n") + call eprintf ("w(indow) (o) (F C) window (output) frames\n") + call eprintf ("wr(ite) [F C] text write text to frame/graphics\n") + call eprintf ("z(oom) N (F) zoom frames N: 1-8\n") + call eprintf ("x or q exit/quit\n") + call eprintf ("--- C: letter c followed by r/g/b/a or, for snap r,g,b,m,bw,rgb,\n") + call eprintf ("--- or for dg r/g/b/y/p/m/w, as 'cr', 'ca', or 'cgb'\n") + call eprintf ("--- F: f followed by a frame number or 'a' for all\n") + call eprintf ("--- Q: q followed by quadrant number or t,b,l,r for top, bottom,...\n") +end diff --git a/pkg/images/tv/iis/src/cvparse.x b/pkg/images/tv/iis/src/cvparse.x new file mode 100644 index 00000000..46aba66b --- /dev/null +++ b/pkg/images/tv/iis/src/cvparse.x @@ -0,0 +1,196 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../lib/ids.h" +include <ctype.h> + +# CVPARSE -- parsing routines for the cv package + +# CV_FRAME -- parse a frame specification + +procedure cv_frame(str, result) + +char str[ARB] # input string +short result[ARB] # result string + +int ip +int op +int i +int used[IDS_MAXIMPL] +int gused + +include "cv.com" + +begin + if (str[1] == 'a') { + result[1] = IDS_EOD + return + } + call aclrs(used,IDS_MAXIMPL) + gused = 0 + op = 1 + for (ip = 1; str[ip] != EOS; ip = ip + 1) { + if (!IS_DIGIT(str[ip])) { + if (str[ip] == 'g') + gused = 1 + else { + call eprintf("unknown frame specifier: %c\n") + call pargc(str[ip]) + } + next + } + i = TO_INTEG (str[ip]) # fail if > than 9 planes! use ctoi() + if ((i < 1) || (i > cv_maxframes) ) { + call eprintf ("out of bounds frame: %d\n") + call pargi(i) + next + } else + used[i] = 1 + } + do i= 1,IDS_MAXIMPL + if (used[i] != 0) { + result[op] = i + op = op + 1 + } + if (gused != 0) { + result[op] = cv_grch + op = op + 1 + } + if (op > 1) + result[op] = IDS_EOD + else + result[op] = ERR +end + + +# CV_COLOR -- parse a color specification + +procedure cv_color(str, result) + +char str[ARB] # input string +short result[ARB] # result string + +int ip +int op +int i +short val +short used[IDS_MAXGCOLOR+1] + +include "cv.com" + +begin + if (str[1] == 'a') { + result[1] = IDS_EOD + return + } + call aclrs (used, IDS_MAXGCOLOR+1) + op = 1 + for (ip = 1; str[ip] != EOS; ip = ip + 1) { + switch (str[ip]) { + case 'r': + val = IDS_RED + + case 'g': + val = IDS_GREEN + + case 'b': + val = IDS_BLUE + + case 'y': + val = IDS_YELLOW + + case 'w': + val = IDS_WHITE + + case 'p': + val = IDS_RDBL + + case 'm': + val = IDS_GRBL + + default: + call eprintf("unknown color: %c\n") + call pargc(str[ip]) + next + } + used[val] = 1 + } + do i = 1, IDS_MAXGCOLOR+1 + if (used[i] != 0) { + result[op] = i + op = op + 1 + } + if (op > 1) + result[op] = IDS_EOD + else + result[op] = ERR +end + + +# CV_QUAD -- parse a quad specification + +procedure cv_quad(str, result) + +char str[ARB] # input string +short result[ARB] # result string + +int ip +int op +int i +short used[4] + +include "cv.com" + +begin + if (str[1] == 'a') { + result[1] = IDS_EOD + return + } + call aclrs(used, 4) + op = 1 + for (ip = 1; str[ip] != EOS; ip = ip + 1) { + if (!IS_DIGIT(str[ip])) { + switch(str[ip]) { + case 'a': + call amovks (1, used, 4) + + case 't': + used[1] = 1 + used[2] = 1 + + case 'b': + used[3] = 1 + used[4] = 1 + + case 'l': + used[2] = 1 + used[3] = 1 + + case 'r': + used[1] = 1 + used[4] = 1 + + default: + call eprintf("unknown quad specifier: %c\n") + call pargc(str[ip]) + } + } else { + i = TO_INTEG (str[ip]) + if ((i < 1) || (i > 4)) { + call eprintf ("out of bounds quad: %d\n") + call pargi(i) + next + } else + used[i] = 1 + } + } + do i = 1,4 { + if (used[i] != 0) { + result[op] = i + op = op + 1 + } + } + if (op > 1) + result[op] = IDS_EOD + else + result[op] = ERR +end diff --git a/pkg/images/tv/iis/src/cvulut.x b/pkg/images/tv/iis/src/cvulut.x new file mode 100644 index 00000000..683c9500 --- /dev/null +++ b/pkg/images/tv/iis/src/cvulut.x @@ -0,0 +1,130 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <ctype.h> +include "cv.h" + +# CV_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-4096]. 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 cv_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 cv_rlut, cv_sort, malloc + +begin + call smark (sp) + call salloc (x, SZ_BUF, TY_REAL) + call salloc (y, SZ_BUF, 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 cv_rlut (fname, Memr[x], Memr[y], nvalues) + call alimr (Memr[x], nvalues, z1, z2) + call amapr (Memr[x], Memr[x], nvalues, z1, z2, STARTPT, ENDPT) + call cv_sort (Memr[x], Memr[y], nvalues) + + # Fill lut in straight line segments - piecewise linear + call malloc (lut, SZ_BUF, 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-1 + Mems[lut+j-1] = y1 + slope * (j-x1) + } + + call sfree (sp) +end + + +# CV_RLUT -- Read text file of x, y, values. + +procedure cv_rlut (utab, x, y, nvalues) + +char utab[SZ_FNAME] # Name of list file +real x[SZ_BUF] # Array of x values, filled on return +real y[SZ_BUF] # 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, malloc + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + iferr (fd = open (utab, READ_ONLY, TEXT_FILE)) + call error (0, "Error opening user 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 > SZ_BUF) + call error (0, + "Intensity transformation table cannot exceed 4096 values") + + x[n] = xval + y[n] = yval + } + + nvalues = n + call close (fd) + call sfree (sp) +end + + +# CV_SORT -- Bubble sort of paired arrays. + +procedure cv_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/images/tv/iis/src/cvutil.x b/pkg/images/tv/iis/src/cvutil.x new file mode 100644 index 00000000..81721081 --- /dev/null +++ b/pkg/images/tv/iis/src/cvutil.x @@ -0,0 +1,538 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <gki.h> +include <imhdr.h> +include "cv.h" +include "../lib/ids.h" + +# CVUTIL -- utility control routines for cv package + +############ CLEAR display ############ +# CVCLEARG -- clear all of graphics (bit) planes + +procedure cvclearg (frame, color) + +short frame[ARB] +short color[ARB] + +int count +int cv_move() + +include "cv.com" + +begin + count = cv_move (frame, Mems[cv_stack]) + count = count + cv_move (color, Mems[cv_stack+count]) + call gescape (cv_gp, IDS_SET_GP, Mems[cv_stack], count) + call gclear (cv_gp) +end + +# CVCLEARI -- clear specified image frames + +procedure cvcleari (frames) + +short frames[ARB] + +include "cv.com" + +begin + call cv_iset (frames) + call gclear (cv_gp) +end + +############ CURSOR and BUTTON ############ +# CV_RDBUT -- read button on trackball (or whatever) +# if none pressed, will get zero back + +int procedure cv_rdbut() + +int oldcnum +real x, y +int button +int gstati + +include "cv.com" + +begin + oldcnum = gstati (cv_gp, G_CURSOR) + call gseti (cv_gp, G_CURSOR, IDS_BUT_RD) + call ggcur (cv_gp, x, y, button) + call gseti (cv_gp, G_CURSOR, oldcnum) + return(button) +end + +# CV_WTBUT -- wait for button to be pressed, then read it + +int procedure cv_wtbut() + +int oldcnum +real x, y +int button +int gstati + +include "cv.com" + +begin + oldcnum = gstati (cv_gp, G_CURSOR) + call gseti (cv_gp, G_CURSOR, IDS_BUT_WT) + call ggcur (cv_gp, x, y, button) + call gseti (cv_gp, G_CURSOR, oldcnum) + return(button) +end + +# CV_RCUR -- read cursor. The cursor read/set routines do not restore +# the cursor number...this to avoid numerous stati/seti calls that +# usually are not needed. + +procedure cv_rcur (cnum, x, y) + +int cnum +real x,y +int junk + +include "cv.com" + +begin + call gseti (cv_gp, G_CURSOR, cnum) + call ggcur (cv_gp, x, y, junk) +end + +# CV_SCUR -- set cursor + +procedure cv_scur (cnum, x, y) + +int cnum +real x,y + +include "cv.com" + +begin + call gseti (cv_gp, G_CURSOR, cnum) + call gscur (cv_gp, x, y) +end + + +# CV_RCRAW -- read the raw cursor (return actual screen coordinates). + +procedure cv_rcraw (x, y) + +real x,y + +include "cv.com" + +begin + call cv_rcur (IDS_CRAW, x, y) +end + +# CV_SCRAW -- set raw cursor + +procedure cv_scraw (x, y) + +real x,y + +include "cv.com" + +begin + call cv_scur (IDS_CRAW, x, y) +end + + +# cvcur -- turn cursor on or off + +procedure cvcur (instruction) + +int instruction + +include "cv.com" + +begin + Mems[cv_stack] = IDS_CURSOR + Mems[cv_stack+1] = IDS_WRITE + Mems[cv_stack+2] = 1 + Mems[cv_stack+3] = IDS_EOD + Mems[cv_stack+4] = IDS_EOD + Mems[cv_stack+5] = 1 + Mems[cv_stack+6] = instruction + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], 7) +end + +############ DISPLAY ############ +# cvdisplay + +procedure cvdisplay (instruction, device, frame, color, quad) + +int instruction +int device +short frame, color, quad + +int i +int cv_move() + +include "cv.com" + +begin + Mems[cv_stack] = instruction + i = cv_move (frame, Mems[cv_stack+1]) + i = i + cv_move (color, Mems[cv_stack+1+i]) + i = i + cv_move (quad, Mems[cv_stack+1+i]) + call gescape (cv_gp, device, Mems[cv_stack], 1+i) +end + +############ MATCH ############ +# cvmatch -- build match escape sequence + +procedure cvmatch (lt, fr, cr, frames, color) + +int lt # type +short fr[ARB] # reference frame and color +short cr[ARB] +short frames[ARB] # frames to be changed +short color[ARB] # and colors + +int count, n +int cv_move() + +include "cv.com" + +begin + Mems[cv_stack] = IDS_MATCH + Mems[cv_stack+1] = lt + count = cv_move (fr, Mems[cv_stack+3]) + count = count + cv_move (cr, Mems[cv_stack+3+count]) + n = count + Mems[cv_stack+count+3] = 0 # unused offset + count = count + cv_move (frames, Mems[cv_stack+4+count]) + count = count + cv_move (color, Mems[cv_stack+4+count]) + Mems[cv_stack+2] = count - n + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], count+4) +end + +############ OFFSET ############ +# cvoffset -- set offset registers + +procedure cvoffset( color, data) + +short color[ARB] +short data[ARB] + +int count, cv_move() +int i + +include "cv.com" + +begin + Mems[cv_stack] = IDS_OUT_OFFSET + Mems[cv_stack+1] = IDS_WRITE + Mems[cv_stack+3] = IDS_EOD # no-op the frames slot + count = cv_move (color, Mems[cv_stack+4]) + Mems[cv_stack+4+count] = 1 # (unused) offset + i = cv_move (data, Mems[cv_stack+5+count]) + i = i - 1 # don't include EOD of "data" + Mems[cv_stack+2] = i + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], i+count+5) +end + +############ PAN ############ +# cvpan -- move the image(s) around +# The x,y coordinates are NDC that, it is assumed, came from a cursor +# read, and therefore are of the form +# ((one_based_pixel-1)/(resolution)) *(GKI_MAXNDC+1) / GKI_MAXNDC +# The division by GKI_MAXNDC turns into NDC what was GKI ranging from +# 0 through 511*64 (for IIS) which conforms to the notion of specifying +# each pixel by its left/bottom GKI boundary. + +procedure cvpan (frames, x, y) + +short frames[ARB] +real x,y # position in NDC + +int count, cv_move() + +include "cv.com" + +begin + Mems[cv_stack] = IDS_SCROLL + Mems[cv_stack+1] = IDS_WRITE + Mems[cv_stack+2] = 3 + count = cv_move (frames, Mems[cv_stack+3]) + Mems[cv_stack+3+count] = IDS_EOD # all colors + Mems[cv_stack+4+count] = 1 # (unused) offset + Mems[cv_stack+5+count] = x * GKI_MAXNDC + Mems[cv_stack+6+count] = y * GKI_MAXNDC + Mems[cv_stack+7+count] = IDS_EOD # for all frames + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], count+8) +end + +############ RANGE ############ +# cvrange -- scale ouput before final look up table + +procedure cvrange ( color, range) + +short color[ARB] +short range[ARB] + +int cv_move(), count, i + +include "cv.com" + +begin + Mems[cv_stack] = IDS_RANGE + Mems[cv_stack+1] = IDS_WRITE + Mems[cv_stack+3] = IDS_EOD # all frames + count = cv_move (color, Mems[cv_stack+4]) + Mems[cv_stack+4+count] = 1 # (unused) offset + i = cv_move (range, Mems[cv_stack+5+count]) + i = i - 1 # don't include EOD of "range" + Mems[cv_stack+2] = i + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], i+count+5) +end + +############ RESET display ############ +# cvreset -- reset display +# SOFT -- everything but lookup tables and image/graphics planes +# MEDIUM -- everything but image/graphics planes +# HARD -- everything...planes are cleared, all images OFF + +procedure cvreset (hardness) + +int hardness + +include "cv.com" + +begin + Mems[cv_stack] = hardness + call gescape (cv_gp, IDS_RESET, Mems[cv_stack], 1) +end + + +############ SNAP a picture ############ +# cvsnap -- takes a full picture of image display + +procedure cvsnap (fname, snap_color) + +char fname[ARB] # image file name +int snap_color + +pointer im, immap(), impl2s() +int i, factor +real y + +include "cv.com" + +begin + im = immap(fname, NEW_FILE, 0) + IM_PIXTYPE(im) = TY_SHORT + IM_LEN(im,1) = cv_xres + IM_LEN(im,2) = cv_yres + + Mems[cv_stack] = IDS_SNAP + Mems[cv_stack+1] = IDS_WRITE + Mems[cv_stack+2] = 1 # frame, color are not relevant + Mems[cv_stack+3] = IDS_EOD + Mems[cv_stack+4] = IDS_EOD + Mems[cv_stack+5] = 0 + Mems[cv_stack+6] = snap_color + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], 7) + + factor = cv_yres/10 + 1 + call eprintf (" (%% done: ") + call flush (STDERR) + do i = 0, cv_yres-1 { + if ( mod(i,factor) == 0) { + call eprintf ("%d ") + call pargi (int(10*i/cv_yres)*10) + call flush (STDERR) + } + y = real(i)*cv_ycon / GKI_MAXNDC. + call ggcell (cv_gp, Mems[impl2s(im,i+1)], cv_xres, 1, 0.0, + y, 1.0, y) + } + call eprintf ("100)\n") + + call imunmap(im) + Mems[cv_stack] = IDS_R_SNAPDONE + call gescape (cv_gp, IDS_RESET, Mems[cv_stack], 1) +end + +############ SPLIT ############ +# cvsplit -- set split screen position + +procedure cvsplit (x, y) + +real x,y # NDC coordinates + +include "cv.com" + +begin + Mems[cv_stack] = IDS_SPLIT + Mems[cv_stack+1] = IDS_WRITE + Mems[cv_stack+2] = 2 + Mems[cv_stack+3] = IDS_EOD # no-op frame and color + Mems[cv_stack+4] = IDS_EOD + Mems[cv_stack+5] = 1 # (unused) offset + # NOTE multiplacation by MAXNDC+1 ... x, and y, are never == 1.0 + # ( see split.x) + # and truncation effects will work out just right, given what the + # image display kernel does with these numbers + Mems[cv_stack+6] = x * (GKI_MAXNDC+1) + Mems[cv_stack+7] = y * (GKI_MAXNDC+1) + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], 8) +end + +############ TEXT ############ +# Write text + +procedure cvtext (x, y, text, size) + +real x, y, size +char text[ARB] + +char format[SZ_LINE] + +include "cv.com" + +begin + call sprintf (format, SZ_LINE, "s=%f") + call pargr (size) + call gtext (cv_gp, x, y, text, format) +end + +############ WHICH ############ +# Tell which frames are one. The best we can do now is +# tell if any, and if so, which is the "first" + +procedure cvwhich (fr) + +short fr[ARB] + +real x,y +int cnum, oldcnum +int gstati + +include "cv.com" + +begin + # Use here the fact that if cursor number is zero, the + # kernel will return the number of the first displayed + # frame, or "ERR" if none. + oldcnum = gstati (cv_gp, G_CURSOR) + cnum = 0 + call gseti (cv_gp, G_CURSOR, cnum) + call ggcur (cv_gp, x, y, cnum) + call gseti (cv_gp, G_CURSOR, oldcnum) + fr[1] = cnum + fr[2] = IDS_EOD +end + +############ WLUT ############ +# cvwlut ... change lookup tables +# the data is in form of line endpoints. + +procedure cvwlut (device, frames, color, data, n) + +int device +short frames[ARB] +short color[ARB] +short data[ARB] +int n + +int count, cv_move() + +include "cv.com" + +begin + # Device had better refer to a look-up table, or who knows + # what will happen! + Mems[cv_stack] = device + Mems[cv_stack+1] = IDS_WRITE + Mems[cv_stack+2] = n + count = cv_move (frames, Mems[cv_stack+3]) + count = count + cv_move (color, Mems[cv_stack+3+count]) + Mems[cv_stack+3+count] = 1 # (unused) offset + call amovs (data, Mems[cv_stack+count+4],n) + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], n+count+4) +end + +############ ZOOM ############ +# cvzoom -- zoom the image +# See comment under PAN about x and y. + +procedure cvzoom (frames, power, x, y) + +short frames[ARB] +int power +real x,y + +int count, cv_move() + +include "cv.com" + +begin + Mems[cv_stack] = IDS_ZOOM + Mems[cv_stack+1] = IDS_WRITE + Mems[cv_stack+2] = 3 + count = cv_move (frames, Mems[cv_stack+3]) + Mems[cv_stack+3+count] = IDS_EOD # (unused) color + Mems[cv_stack+4+count] = IDS_EOD # (unused) offset + Mems[cv_stack+5+count] = power + Mems[cv_stack+6+count] = x * GKI_MAXNDC + Mems[cv_stack+7+count] = y * GKI_MAXNDC + call gescape (cv_gp, IDS_CONTROL, Mems[cv_stack], count+8) +end + +############ SUBROUTINES ############## +# CV_MOVE -- transfer an array into the escape data array; returns number +# of items transfered. + +int procedure cv_move (in, out) + +short in[ARB] +short out[ARB] + +int count + +begin + count = 0 + repeat { + count = count + 1 + out[count] = in[count] + } until (in[count] == IDS_EOD) + return (count) +end + +# CV_ISET -- Tell the image kernel that i/o is to be done for the +# specified frame/frames. + +procedure cv_iset (frames) + +short frames[ARB] + +short idata[30] +int i, cv_move() + +include "cv.com" + +begin + i = cv_move (frames, idata) + idata[i+1] = IDS_EOD # all bit planes + call gescape (cv_gp, IDS_SET_IP, idata, i+1) +end + +# CV_GSET -- Tell the image kernel that i/o is to be done for the +# specified colors. + +procedure cv_gset (colors) + +short colors[ARB] + +short idata[30] +int i, cv_move() + +include "cv.com" + +begin + idata[1] = IDS_EOD # all "frames" + i = cv_move (colors, idata[2]) + call gescape (cv_gp, IDS_SET_GP, idata, i+1) +end diff --git a/pkg/images/tv/iis/src/display.x b/pkg/images/tv/iis/src/display.x new file mode 100644 index 00000000..d04b1365 --- /dev/null +++ b/pkg/images/tv/iis/src/display.x @@ -0,0 +1,104 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include "../lib/ids.h" + +# DISPLAY -- Turn frames on or off + +procedure display(command) + +char command[ARB] + +int tok +char token[SZ_LINE] +short color[IDS_MAXGCOLOR+1] +short frames[IDS_MAXIMPL+1] +short quad[5] +short instruction +int escape +include "cv.com" + +begin + if (command[1] == 'i') + escape = IDS_DISPLAY_I + else if (command[1] == 'g') + escape = IDS_DISPLAY_G + else { + call eprintf ("Only 'di' or 'dg' are understood\n") + return + } + + instruction = ERR + frames[1] = ERR + color[1] = ERR + quad[1] = IDS_EOD + + repeat { + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if ( tok == TOK_IDENTIFIER) { + switch (token[1]) { + case 'c': + call cv_color (token[2], color) + if (color[1] == ERR) + return + + case 'f': + call cv_frame (token[2], frames) + if (frames[1] == ERR) + return + + + case 'o': + if (token[2] == 'n') + instruction = IDS_ON + else if (token[2] == 'f') + instruction = IDS_OFF + + case 'q': + call cv_quad (token[2], quad) + if (quad[1] == ERR) + return + } + } else if (tok == TOK_NUMBER) { + call cv_frame (token[1], frames) + if (frames[1] == ERR) + return + } + } until ( tok == TOK_NEWLINE ) + + + # Require a frame number, but allow default of color and quad to "all". + # But, for graphics, default the frame and require a color. + # In either case, for OFF, allow all defaults. + if (escape == IDS_DISPLAY_I) { + if ((instruction == IDS_OFF) && (frames[1] == ERR)) + frames[1] = IDS_EOD + if ( color[1] == ERR) + color[1] = IDS_EOD + } else { + if ((instruction == IDS_OFF) && ( color[1] == ERR) ) + color[1] = IDS_EOD + if ( frames[1] == ERR) + frames[1] = IDS_EOD + } + + if (frames[1] == ERR) { + call eprintf ("Frame specification required\n") + return + } + if (color[1] == ERR) { + call eprintf ("Color specification required\n") + return + } + + # if neither "on" nor "off", then turn off all, and turn + # on the specified frames + if (instruction == ERR) { + call cvdisplay (IDS_OFF , escape, short(IDS_EOD), + short(IDS_EOD), short(IDS_EOD)) + instruction = IDS_ON + } + call cvdisplay (instruction, escape, frames, color, quad) +end diff --git a/pkg/images/tv/iis/src/gwindow.h b/pkg/images/tv/iis/src/gwindow.h new file mode 100644 index 00000000..5050b304 --- /dev/null +++ b/pkg/images/tv/iis/src/gwindow.h @@ -0,0 +1,34 @@ +# Window descriptor structure. + +define LEN_WDES (5+(W_MAXWC+1)*LEN_WC+80) +define LEN_WC 10 # 4=[XbXeYbYe]+2=tr_type[xy] +define W_MAXWC 5 # max world coord systems +define W_SZIMSECT 79 # image section string + +define W_DEVICE Memi[$1] +define W_FRAME Memi[$1+1] # device frame number +define W_XRES Memi[$1+2] # device resolution, x +define W_YRES Memi[$1+3] # device resolution, y +define W_WC ($1+$2*LEN_WC+5) # ptr to coord descriptor +define W_IMSECT Memc[($1+65-1)*SZ_STRUCT+1] + +# Fields of the WC coordinate descriptor, a substructure of the window +# descriptor. "W_XB(W_WC(w,0))" is the XB field of wc 0 of window W. + +define W_XS Memr[P2R($1)] # starting X value +define W_XE Memr[P2R($1+1)] # ending X value +define W_XT Memi[$1+2] # X transformation type +define W_YS Memr[P2R($1+3)] # starting Y value +define W_YE Memr[P2R($1+4)] # ending Y value +define W_YT Memi[$1+5] # Y transformation type +define W_ZS Memr[P2R($1+6)] # starting Z value (greyscale) +define W_ZE Memr[P2R($1+7)] # ending Z value +define W_ZT Memi[$1+8] # Z transformation type +define W_UPTR Memi[$1+9] # LUT when ZT=USER + +# Types of coordinate and greyscale transformations. + +define W_UNITARY 0 # values map without change +define W_LINEAR 1 # linear mapping +define W_LOG 2 # logarithmic mapping +define W_USER 3 # user specifies transformation diff --git a/pkg/images/tv/iis/src/load1.x b/pkg/images/tv/iis/src/load1.x new file mode 100644 index 00000000..c33cc1dd --- /dev/null +++ b/pkg/images/tv/iis/src/load1.x @@ -0,0 +1,324 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +#### load1.x (from load.x) #### + +include <mach.h> +include <imset.h> +include <imhdr.h> +include <error.h> +include <gki.h> +include <fio.h> +include <fset.h> +include "gwindow.h" +include "../lib/ids.h" +include "cv.h" + +# LOAD - Load an image. The specified image section is mapped into +# the specified section of an image display frame. The mapping involves +# a linear transformation in X and Y and a linear or logarithmic transformation +# in Z (greyscale). Images of all pixel datatypes are supported, and there +# no upper limit on the size of an image. The display device is interfaced +# via GIO metacode. + +procedure t_load() + +char image[SZ_FNAME] +short frame[IDS_MAXIMPL+1] +bool frame_erase, border_erase +pointer im, wdes, sp + +pointer gp +char device[SZ_FNAME] +int dd[LEN_GKIDD] + +int envgets() +short clgets() +bool clgetb() +pointer immap(), gopen() + +include "cv.com" +errchk immap, imunmap, ds_getparams + +begin + call smark (sp) + call salloc (cv_stack, CVLEN, TY_SHORT) + call salloc (wdes, LEN_WDES, TY_STRUCT) + + if (envgets ("stdimage", device, SZ_FNAME) == 0) + call error (EA_FATAL, + "variable 'stdimage' not defined in environment") + + call ids_open (device, dd) + call gki_inline_kernel (STDIMAGE, dd) + # Need READ_WRITE so can call cvdisplay + gp = gopen ( device, READ_WRITE, STDIMAGE) + + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + call ids_grstream (STDIMAGE) + + # to do: + # initialize local variables: image display size, etc + # instead of defines such as MCXSCALE, etc + + cv_maxframes = CV_MAXF + cv_maxgraph = CV_MAXG + cv_xcen = CV_XCEN + cv_ycen = CV_YCEN + cv_xres = CV_XRES + cv_yres = CV_YRES + cv_zres = CV_ZRES + cv_gp = gp + cv_xcon = real(GKI_MAXNDC+1)/CV_XRES + cv_ycon = real(GKI_MAXNDC+1)/CV_YRES + cv_grch = CV_GRCHNUM + cv_xwinc = -1. # Flag: Don't know what lut is + + # Open input imagefile. + call clgstr ("image", image, SZ_FNAME) + im = immap (image, READ_ONLY, 0) + + # Ultimately, we should get a sequence of frames, all of which get + # loaded with the same image. + + frame[1] = clgets ("frame") + frame[2] = IDS_EOD + frame_erase = clgetb ("erase") + + # Optimize for sequential i/o. + call imseti (im, IM_ADVICE, SEQUENTIAL) + + # The frame being displayed does not necessarily change when a new + # frame is loaded. (We might consider letting user select via the + # cv package) + + if (clgetb ("select_frame")) { + call cvdisplay (IDS_OFF, IDS_DISPLAY_I, short(IDS_EOD), + short(IDS_EOD), short(IDS_EOD)) + call cvdisplay (IDS_ON, IDS_DISPLAY_I, frame, short(IDS_EOD), + short(IDS_EOD)) + } + + if (frame_erase) + call cvcleari (frame) + + # Tell GIO what frame(s) to write + call cv_iset (frame) + + # Done with all possible read/write calls to cv package. Fix up so + # don't read device if we erase the frame, so need WRITE_ONLY mode. + # fseti on STDIMAGE didn't work. + + if (frame_erase) { + call gclose (gp) + call gki_inline_kernel (STDIMAGE, dd) + gp = gopen ( device, WRITE_ONLY, STDIMAGE) + cv_gp = gp + call fseti (STDIMAGE, F_TYPE, SPOOL_FILE) + call fseti (STDIMAGE, F_CANCEL, OK) + } + + # Get display parameters and set up transformation. + call ds_getparams (im, wdes, image, frame) + + # Erase the border (space between displayed image section and edge of + # window) only if screen was not erased and border erasing is enabled. + + if (frame_erase) + border_erase = false + else + border_erase = clgetb ("border_erase") + + # Display the image. + call ds_load_display (im, wdes, border_erase) + + call imunmap (im) + + # All done. + call gclose (gp) + call ids_close() + call sfree (sp) +end + + +# DS_GETPARAMS -- Get the parameters controlling how the image is mapped +# into the display frame. Set up the transformations and save in the graphics +# descriptor file. + +procedure ds_getparams (im, wdes, image, frame) + +pointer im, wdes # Image and graphics descriptors +char image[SZ_FNAME] # Should be determined from im +short frame[ARB] + +bool fill, zscale_flag, zrange_flag, zmap_flag +real xcenter, ycenter +real xsize, ysize, pxsize, pysize +real xmag, ymag, xscale, yscale +real z1, z2, contrast +int nsample_lines, ncols, nlines, len_stdline +pointer sp, w, ztrans, lut, lutfile + +bool clgetb() +int clgeti() +real clgetr() +bool streq() + +include "cv.com" + +begin + call smark (sp) + call salloc (ztrans, SZ_FNAME, TY_CHAR) + + # Set up a new graphics descriptor structure defining the coordinate + # transformation used to map the image into the display frame. + + call strcpy (image, W_IMSECT(wdes), W_SZIMSECT) + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # The fill, zscale, and zrange parameters determine the algorithms to + # be used to scale the image in the spatial and greyscale dimensions. + # If greyscale mapping is disabled the zscale and zrange options are + # disabled. Greyscale mapping can also be disabled by turning off + # zscale and zrange and setting Z1 and Z2 to the device greyscale min + # and max values, producing a unitary transformation. + + fill = clgetb ("fill") + call clgstr ("ztrans", Memc[ztrans], SZ_FNAME) + if (streq (Memc[ztrans], "none") || streq (Memc[ztrans], "user")) { + zscale_flag = false + zrange_flag = false + zmap_flag = false + } else { + zmap_flag = true + zscale_flag = clgetb ("zscale") + if (!zscale_flag) + zrange_flag = clgetb ("zrange") + } + + # Determine Z1 and Z2, the range of input greylevels to be mapped into + # the fixed range of display greylevels. + + if (zscale_flag) { + # Autoscaling is desired. Compute Z1 and Z2 which straddle the + # median computed by sampling a portion of the image. + + contrast = clgetr ("contrast") + nsample_lines = clgeti ("nsample_lines") + len_stdline = SAMPLE_SIZE / nsample_lines + call zscale (im, z1, z2, contrast, SAMPLE_SIZE, len_stdline) + + } else if (zrange_flag) { + nsample_lines = clgeti ("nsample_lines") + call maxmin (im, z1, z2, nsample_lines) + + } else if (zmap_flag) { + z1 = clgetr ("z1") + z2 = clgetr ("z2") + } + + # Determine the display window into which the image is to be mapped + # in normalized device coordinates. + + xcenter = max(0.0, min(1.0, clgetr ("xcenter"))) + ycenter = max(0.0, min(1.0, clgetr ("ycenter"))) + xsize = max(0.0, min(1.0, clgetr ("xsize"))) + ysize = max(0.0, min(1.0, clgetr ("ysize"))) + + # Determine X and Y scaling ratios required to map the image into the + # normalized display window. If spatial scaling is not desired filling + # must be disabled and XMAG and YMAG must be set to 1.0 in the + # parameter file. Fill mode will always produce an aspect ratio of 1; + # if nonequal scaling is required then the magnification ratios must + # be set explicitly by the user. + + if (fill) { + # Compute scale in units of window coords per data pixel required + # to scale image to fit window. + + xscale = xsize / max (1, (ncols - 1)) + yscale = ysize / max (1, (nlines - 1)) + + if (xscale < yscale) + yscale = xscale + else + xscale = yscale + + } else { + # Compute scale required to provide image magnification ratios + # specified by the user. Magnification is specified in units of + # display pixels, i.e, a magnification ratio of 1.0 means that + # image pixels will map to display pixels without scaling. + + xmag = clgetr ("xmag") + ymag = clgetr ("ymag") + xscale = 1.0 / ((cv_xres - 1) / xmag) + yscale = 1.0 / ((cv_yres - 1) / ymag) + } + + # Set device window limits in normalized device coordinates. + # World coord system 0 is used for the device window. + + w = W_WC(wdes,0) + W_XS(w) = xcenter - xsize / 2.0 + W_XE(w) = xcenter + xsize / 2.0 + W_YS(w) = ycenter - ysize / 2.0 + W_YE(w) = ycenter + ysize / 2.0 + + # Set pixel coordinates of window, world coordinate system #1. + + w = W_WC(wdes,1) + pxsize = xsize / xscale + pysize = ysize / yscale + + # If the image is too large to fit in the window given the scaling + # factors XSCALE and YSCALE, the following will set starting and ending + # pixel coordinates in the interior of the image. If the image is too + # small to fill the window then the pixel coords will reference beyond + # the bounds of the image. + + W_XS(w) = (ncols - 1) / 2.0 + 1 - (pxsize / 2.0) + W_XE(w) = W_XS(w) + pxsize + W_YS(w) = (nlines - 1) / 2.0 + 1 - (pysize / 2.0) + W_YE(w) = W_YS(w) + pysize + + # All spatial transformations are linear. + W_XT(w) = W_LINEAR + W_YT(w) = W_LINEAR + + # Determine whether a log or linear greyscale transformation is + # desired. + if (streq (Memc[ztrans], "log")) + W_ZT(w) = W_LOG + else if (streq (Memc[ztrans], "linear")) + W_ZT(w) = W_LINEAR + else if (streq (Memc[ztrans], "none")) + W_ZT(w) = W_UNITARY + else if (streq (Memc[ztrans], "user")) { + W_ZT(w) = W_USER + call salloc (lutfile, SZ_FNAME, TY_CHAR) + call clgstr ("lutfile", Memc[lutfile], SZ_FNAME) + call cv_ulut (Memc[lutfile], z1, z2, lut) + W_UPTR(w) = lut + } else { + call eprintf ("Bad greylevel transformation '%s'\n") + call pargstr (Memc[ztrans]) + W_ZT(w) = W_LINEAR + } + + # Set up the greyscale transformation. + W_ZS(w) = z1 + W_ZE(w) = z2 + + # Tell the user what values were used. + call printf ("cvl: z1 %6.1f, z2 %6.1f\n") + call pargr (z1) + call pargr (z2) + + # The user world coordinate system should be set from the CTRAN + # structure in the image header, but for now we just make it equal + # to the pixel coordinate system. + + call amovi (Memi[w], Memi[W_WC(wdes,2)], LEN_WC) +end diff --git a/pkg/images/tv/iis/src/load2.x b/pkg/images/tv/iis/src/load2.x new file mode 100644 index 00000000..5372907f --- /dev/null +++ b/pkg/images/tv/iis/src/load2.x @@ -0,0 +1,335 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +#### load2.x (from load.x) #### + +include <mach.h> +include <imset.h> +include <imhdr.h> +include <error.h> +include <gki.h> +include <fio.h> +include <fset.h> +include "gwindow.h" +include "../lib/ids.h" +include "cv.h" + +# DS_LOAD_DISPLAY -- Map an image into the display window. In general this +# involves independent linear transformations in the X, Y, and Z (greyscale) +# dimensions. If a spatial dimension is larger than the display window then +# the image is block averaged. If a spatial dimension or a block averaged +# dimension is smaller than the display window then linear interpolation is +# used to expand the image. Both the input image and the output device appear +# to us as images, accessed via IMIO. +# +# World coordinate system 0 (WCS 0) defines the position and size of the device +# window in NDC coordinates (0-1 in either axis). WCS 1 assigns a pixel +# coordinate system to the same window. If we convert the NDC coordinates of +# the window into device coordinates in pixels, then the ratios of the window +# coordinates in pixels to the image coordinates in pixels defines the real +# magnification factors for the two spatial axes. If the pixel coordinates +# are out of bounds then the image will be displayed centered in the window +# with zero fill at the edges. If the frame has not been erased then the fill +# areas must be explicitly zeroed. + +procedure ds_load_display (im, wdes, border_erase) + +pointer im # input image +pointer wdes # graphics window descriptor +bool border_erase + +int wx1, wx2, wy1, wy2 # device window to be filled with image data +real px1, px2, py1, py2 # image coords in fractional image pixels +real pxsize, pysize # size of image section in fractional pixels +real wxcenter, wycenter # center of device window in frac device pixels +real xmag, ymag # x,y magnification ratios +pointer w0, w1 # world coord systems 0 (NDC) and 1 (pixel) + +include "cv.com" + +begin + # Compute pointers to WCS 0 and 1. + w0 = W_WC(wdes,0) + w1 = W_WC(wdes,1) + + # Compute X and Y magnification ratios required to map image into + # the device window in device pixel units. + + xmag = (W_XE(w0) - W_XS(w0)) * cv_xres / (W_XE(w1) - W_XS(w1)) + ymag = (W_YE(w0) - W_YS(w0)) * cv_yres / (W_YE(w1) - W_YS(w1)) + + # Compute the coordinates of the image section to be displayed. + # This is not necessarily the same as WCS 1 since the WCS coords + # need not be inbounds. + + px1 = max (1.0, W_XS(w1)) + px2 = min (real (IM_LEN(im,1)), W_XE(w1)) + py1 = max (1.0, W_YS(w1)) + py2 = min (real (IM_LEN(im,2)), W_YE(w1)) + + # Now compute the coordinates of the image section to be written in + # device pixel units. This section must lie within or on the device + # window. + # This computation for I2S will give 257, which does differ by one + # for the Y center (due to inversion in I2S). This should not matter, + # but if it does, this comment will change! + + pxsize = px2 - px1 + pysize = py2 - py1 + wxcenter = (W_XE(w0) + W_XS(w0)) / 2.0 * cv_xres + 1 + wycenter = (W_YE(w0) + W_YS(w0)) / 2.0 * cv_yres + 1 + + wx1 = max (1, int (wxcenter - (pxsize / 2.0 * xmag))) + wx2 = max (wx1, min (cv_xres, int (wx1 + (pxsize * xmag)))) + wy1 = max (1, int (wycenter - (pysize / 2.0 * ymag))) + wy2 = max (wy1, min (cv_yres, int (wy1 + (pysize * ymag)))) + + # Display the image data, ignoring zero filling at the boundaries. + + call ds_map_image (im, px1,px2,py1,py2, wx1,wx2,wy1,wy2, + W_ZS(w1), W_ZE(w1), W_ZT(w1), W_UPTR(w1)) + + # Zero the border of the window if the frame has not been erased, + # and if the displayed section does not occupy the full window. + + if (border_erase) + call ds_erase_border (im, wdes, wx1,wx2,wy1,wy2) +end + + +# DS_MAP_IMAGE -- Map an image section from the input image to a section +# (window) of the output image (the display device). All spatial scaling is +# handled by the "scaled input" package, i.e., SIGL2[SR]. Our task is to +# get lines from the scaled input image, transform the greyscale if necessary, +# and write the lines to the output device. + +procedure ds_map_image (im, px1,px2,py1,py2, wx1,wx2,wy1,wy2, z1,z2,zt, uptr) + +pointer im # input image +real px1,px2,py1,py2 # input section +int wx1,wx2,wy1,wy2 # output section +real z1,z2 # range of input greylevels to be mapped. +int zt # log or linear greylevel transformation +pointer uptr # pointer to user transformation table + +bool unitary_greyscale_transformation +short lut1, lut2, z1_s, z2_s, dz1_s, dz2_s +real dz1, dz2 +int wy, nx, ny, xblk, yblk +pointer in, out, si +pointer sigl2s(), sigl2r(), sigl2_setup() +errchk sigl2s, sigl2r, sigl2_setup +real xs, xe, y +pointer sp, outr +bool fp_equalr() +real if_elogr() +extern if_elogr + +include "cv.com" + +begin + call smark (sp) + + # Set up for scaled image input. + + nx = wx2 - wx1 + 1 + ny = wy2 - wy1 + 1 + xblk = INDEFI + yblk = INDEFI + si = sigl2_setup (im, px1,px2,nx,xblk, py1,py2,ny,yblk) + + # Output array, and limiting x values in NDC + + call salloc (out, nx, TY_SHORT) + xs = real(wx1 - 1) * cv_xcon / GKI_MAXNDC + # Don't subtract 1 from wx2 as we want it to be first one not filled + xe = real(wx2) * cv_xcon / GKI_MAXNDC + if ( xe > 1.0) + xe = 1.0 + + # The device ZMIN and ZMAX parameters define the acceptable range + # of greyscale values for the output device (e.g., 0-255 for most 8-bit + # display devices). For the general display, we use 0 and the + # device "z" resolution. Values Z1 and Z2 are mapped linearly or + # logarithmically into these. + + dz1 = 0 + dz2 = cv_zres-1 + + # If the user specified the transfer function, see that the + # intensity and greyscale values are in range. + + if (zt == W_USER) { + call alims (Mems[uptr], SZ_BUF, lut1, lut2) + dz1_s = short (dz1) + dz2_s = short (dz2) + if (lut2 < dz1_s || lut1 > dz2_s) + call eprintf ("User specified greyscales out of range\n") + if (z2 < IM_MIN(im) || z1 > IM_MAX(im)) + call eprintf ("User specified intensities out of range\n") + } + + # Type short pixels are treated as a special case to minimize vector + # operations for such images (which are common). If the image pixels + # are either short or real then only the ALTR (greyscale transformation) + # vector operation is required. The ALTR operator linearly maps + # greylevels in the range Z1:Z2 to DZ1:DZ2, and does a floor ceiling + # of DZ1:DZ2 on all pixels outside the range. 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. + + if (zt == W_UNITARY) + unitary_greyscale_transformation = true + else + unitary_greyscale_transformation = + (fp_equalr (dz1,z1) && fp_equalr (dz2,z2)) || fp_equalr (z1,z2) + + if (IM_PIXTYPE(im) == TY_SHORT && zt != W_LOG) { + + # Set dz1_s and dz2_s depending on transformation + if (zt != W_USER) { + dz1_s = short (dz1) + dz2_s = short (dz2) + } else { + dz1_s = short (STARTPT) + dz2_s = short (ENDPT) + } + z1_s = short (z1) + z2_s = short (z2) + + for (wy=wy1; wy <= wy2; wy=wy+1) { + in = sigl2s (si, wy - wy1 + 1) + y = real(wy-1) * cv_ycon / GKI_MAXNDC + if (unitary_greyscale_transformation) + call gpcell (cv_gp, Mems[in], nx, 1, xs, y, xe, y) + else if (zt == W_USER) { + call amaps (Mems[in], Mems[out], nx, z1_s,z2_s, dz1_s,dz2_s) + call aluts (Mems[out], Mems[out], nx, Mems[uptr]) + call gpcell (cv_gp, Mems[out], nx, 1, xs, y, xe, y) + } else { + call amaps (Mems[in], Mems[out], nx, z1_s,z2_s, dz1_s,dz2_s) + call gpcell (cv_gp, Mems[out], nx, 1, xs, y, xe, y) + } + } + } else { + call salloc (outr, nx, TY_REAL) + for (wy=wy1; wy <= wy2; wy=wy+1) { + in = sigl2r (si, wy - wy1 + 1) + y = real(wy - 1) * cv_ycon / GKI_MAXNDC + + if (zt == W_LOG) { + call amapr (Memr[in], Memr[outr], nx, + z1, z2, 1.0, 10.0 ** MAXLOG) + call alogr (Memr[outr], Memr[outr], nx, if_elogr) + call amapr (Memr[outr], Memr[outr], nx, + 1.0, real(MAXLOG), dz1, dz2) + call achtrs (Memr[outr], Mems[out], nx) + } else if (unitary_greyscale_transformation) { + call achtrs (Memr[in], Mems[out], nx) + } else if (zt == W_USER) { + call amapr (Memr[in], Memr[outr], nx, z1,z2, STARTPT,ENDPT) + call achtrs (Memr[outr], Mems[out], nx) + call aluts (Mems[out], Mems[out], nx, Mems[uptr]) + } else { + call amapr (Memr[in], Memr[outr], nx, z1, z2, dz1, dz2) + call achtrs (Memr[outr], Mems[out], nx) + } + call gpcell (cv_gp, Mems[out], nx, 1, xs, y, xe, y) + } + } + + call sfree (sp) + call sigl2_free (si) +end + + +# DS_ERASE_BORDER -- Zero the border of the window if the frame has not been +# erased, and if the displayed section does not occupy the full window. +# It would be more efficient to do this while writing the greyscale data to +# the output image, but that would complicate the display procedures and frames +# are commonly erased before displaying an image. + +procedure ds_erase_border (im, wdes, wx1,wx2,wy1,wy2) + +pointer im # input image +pointer wdes # window descriptor +int wx1,wx2,wy1,wy2 # section of display window filled by image data + +int dx1,dx2,dy1,dy2 # coords of full display window in device pixels +int j, n, n1 +pointer w0 +pointer sp, zero +real xls, xle, xrs, xre, y + +include "cv.com" + +begin + call smark (sp) + call salloc (zero, cv_xres, TY_SHORT) + call aclrs (Mems[zero], cv_xres) + + # Compute device pixel coordinates of the full display window. + w0 = W_WC(wdes,0) + dx1 = W_XS(w0) * (cv_xres - 1) + 1 + dx2 = W_XE(w0) * (cv_xres - 1) + 1 + dy1 = W_YS(w0) * (cv_yres - 1) + 1 + dy2 = W_YE(w0) * (cv_yres - 1) + 1 + + # Determine left and right (exclusive), start and end, x values in NDC + # for pixels not already filled. + # If, say, dx1 < wx1, we want to clear dx1 through wx1-1, which means + # that for gpcell, we want the (right) end points to be the first + # pixel not cleared. + xls = real(dx1 - 1) * cv_xcon / GKI_MAXNDC + xle = real(wx1) * cv_xcon / GKI_MAXNDC + if (xle > 1.0) + xle = 1.0 + xre = real(dx2 - 1) * cv_xcon / GKI_MAXNDC + xrs = real(wx2) * cv_xcon / GKI_MAXNDC + if (xre > 1.0) + xre = 1.0 + + # Erase lower margin. + n = dx2 - dx1 + 1 + for (j=dy1; j < wy1; j=j+1) { + y = real(j-1) * cv_ycon / GKI_MAXNDC + call gpcell (cv_gp, Mems[zero], n, 1, xls, y, xre, y) + } + + # Erase left and right margins. By doing the right margin of a line + # immediately after the left margin we have a high liklihood that the + # display line will still be in the FIO buffer. + + n = wx1 - dx1 + n1 = dx2 - wx2 + for (j=wy1; j <= wy2; j=j+1) { + y = real(j-1) * cv_ycon / GKI_MAXNDC + if (dx1 < wx1) + call gpcell (cv_gp, Mems[zero], n, 1, xls, y, xle, y) + if (wx2 < dx2) + call gpcell (cv_gp, Mems[zero], n1, 1, xrs, y, xre, y) + } + + # Erase upper margin. + n = dx2 - dx1 + 1 + for (j=wy2+1; j <= dy2; j=j+1) { + y = real(j-1) * cv_ycon / GKI_MAXNDC + call gpcell (cv_gp, Mems[zero], n, 1, xls, y, xre, y) + } + + call sfree (sp) +end + + +# IF_ELOG -- The error function for log10. Note that MAX_EXPONENT is +# currently an integer so it is converted to the appropriate data type +# before being returned. + +real procedure if_elogr (x) + +real x # the input pixel value + +begin + return (real(-MAX_EXPONENT)) +end + diff --git a/pkg/images/tv/iis/src/map.x b/pkg/images/tv/iis/src/map.x new file mode 100644 index 00000000..5ea7c230 --- /dev/null +++ b/pkg/images/tv/iis/src/map.x @@ -0,0 +1,320 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include <gki.h> +include "../lib/ids.h" + +# MAP -- set fixed or variable LUT mapping + +procedure map(command) + +char command[ARB] + +char token[SZ_LINE] +int tok +short frames[IDS_MAXIMPL+2] # frames, graphics, EOD +short colors[IDS_MAXGCOLOR] +int device +short pcolor[2] +real limit +long seed +real urand(), xfactor +int ctoi() +int i, ip, iseed, level, nchar +bool triangle +pointer sp, rdata, gdata, bdata, rp, gp, bp + +include "cv.com" + +begin + # Find out if want to change output tables + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (( tok == TOK_IDENTIFIER) && (token[1] == 'o' )) { + device = IDS_OUTPUT_LUT + } else { + device = IDS_FRAME_LUT + # reset input pointers; same as having pushed back token + call reset_scan + call gargtok (tok, token, SZ_LINE) + } + + # Default to all frames, all colors + frames[1] = IDS_EOD + colors[1] = IDS_EOD + triangle = true # default to simple three function type + seed = -1 + level = 8 + + # which frames to change, colors, etc + + repeat { + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (tok == TOK_IDENTIFIER) { + if (token[1] == 'f') { + call cv_frame (token[2], frames) + if (frames[1] == ERR) + return + } else if (token[1] == 'c') { + call cv_color (token[2], colors) + if (colors[1] == ERR) + return + } else if (token[1] == 'r') { # (random) level count + ip = 2 + nchar = ctoi (token, ip, level) + if (nchar <= 0) { + call eprintf ("Incorrect random count: %s\n") + call pargstr (token[2]) + return + } + if (level < 4) + level = 4 + else if (level > 128) + level = 128 + triangle = false + } else if (token[1] == 's') { # seed + ip = 2 + nchar = ctoi (token, ip, iseed) + if (nchar <= 0) { + call eprintf ("Incorrect seed: %s\n") + call pargstr (token[2]) + return + } + seed = iseed + triangle = false + } else { + call eprintf ("Unknown map argument: %s\n") + call pargstr (token) + return + } + } else if (tok != TOK_NEWLINE) { + call eprintf ("Unexpected map input: %s\n") + call pargstr (token) + return + } + } until ( tok == TOK_NEWLINE) + + pcolor[2] = IDS_EOD + # Sorry, but we "know" that ofm shouldn't go beyond first + # 256 for common NOAO use. + if ( device == IDS_FRAME_LUT) + limit = 1.0 + else + limit = 0.25 + + # Build the three functions and load them. + # First, expand colors if using all + + if (colors[1] == IDS_EOD) { + colors[1] = IDS_RED + colors[2] = IDS_GREEN + colors[3] = IDS_BLUE + colors[4] = IDS_EOD + } + + # if standard pseudocolor, let kodak do it + + if (triangle) { + call kodak (device, frames, colors, limit) + return + } + + # Not standard pseudo color -- do random one + # First, set up arrays + + call smark (sp) + call salloc (rdata, level*4, TY_SHORT) + call salloc (gdata, level*4, TY_SHORT) + call salloc (bdata, level*4, TY_SHORT) + + if (seed == -1) + seed = level + + call aclrs (Mems[rdata], level*4) + call aclrs (Mems[gdata], level*4) + call aclrs (Mems[bdata], level*4) + + xfactor = real(GKI_MAXNDC)/level * limit + + # set first data points to zero (0,0) to (1/level,0) + Mems[rdata+2] = xfactor + Mems[gdata+2] = xfactor + Mems[bdata+2] = xfactor + # Set last segment to white ((level-1)/level,1.0) to (1.0,1.0) + Mems[rdata+level*4-4] = real(level-1) * xfactor + Mems[gdata+level*4-4] = real(level-1) * xfactor + Mems[bdata+level*4-4] = real(level-1) * xfactor + Mems[rdata+level*4-3] = GKI_MAXNDC + Mems[gdata+level*4-3] = GKI_MAXNDC + Mems[bdata+level*4-3] = GKI_MAXNDC + Mems[rdata+level*4-2] = GKI_MAXNDC + Mems[gdata+level*4-2] = GKI_MAXNDC + Mems[bdata+level*4-2] = GKI_MAXNDC + Mems[rdata+level*4-1] = GKI_MAXNDC + Mems[gdata+level*4-1] = GKI_MAXNDC + Mems[bdata+level*4-1] = GKI_MAXNDC + + # Do the intermediate ones + do i=2, level-1 { + rp = rdata + (i-1)*4 + gp = gdata + (i-1)*4 + bp = bdata + (i-1)*4 + Mems[rp] = real(i-1) * xfactor + Mems[gp] = real(i-1) * xfactor + Mems[bp] = real(i-1) * xfactor + Mems[rp+1] = urand(seed) * GKI_MAXNDC + Mems[gp+1] = urand(seed) * GKI_MAXNDC + Mems[bp+1] = urand(seed) * GKI_MAXNDC + Mems[rp+2] = real(i) * xfactor + Mems[gp+2] = real(i) * xfactor + Mems[bp+2] = real(i) * xfactor + Mems[rp+3] = Mems[rp+1] + Mems[gp+3] = Mems[gp+1] + Mems[bp+3] = Mems[bp+1] + } + + # If color requested, do it + for ( i = 1; colors[i] != IDS_EOD; i = i + 1 ) { + pcolor[1] = colors[i] + switch (colors[i]) { + case IDS_RED: + call cvwlut (device, frames, pcolor, Mems[rdata], level*4) + + case IDS_GREEN: + call cvwlut (device, frames, pcolor, Mems[gdata], level*4) + + case IDS_BLUE: + call cvwlut (device, frames, pcolor, Mems[bdata], level*4) + } + } + + call sfree (sp) +end + +# KODAK -- provides three variable width and variable center triangular +# color mapping functions. + +procedure kodak (device, frames, colors, limit) + +int device # IDS_FRAME_LUT or IDS_OUTPUT_LUT +short frames[ARB] # frames to change +short colors[ARB] # colors to affect +real limit # factor to apply to limit x range + +short wdata[20], pcolor[2] +real center, width +int n, ksub(), button, i +int cv_rdbut(), cv_wtbut() + +begin + pcolor[2] = IDS_EOD + for (i = 1; colors[i] != IDS_EOD; i = i + 1) { + pcolor[1] = colors[i] + switch (colors[i]) { + case IDS_RED: + n = ksub (1.0, 0.5, wdata, limit) + + case IDS_GREEN: + n = ksub (0.5, 0.5, wdata, limit) + + case IDS_BLUE: + n = ksub (0.0, 0.5, wdata, limit) + } + + call cvwlut (device, frames, pcolor, wdata, n) + } + + button = cv_rdbut() # clear buttons + repeat { + call eprintf ("Press A, B, C for red, green, blue; D to exit\n") + button = cv_wtbut() + if (button == 4) + break + switch (button) { + case 1: + pcolor[1] = IDS_RED + + case 2: + pcolor[1] = IDS_GREEN + + case 3: + pcolor[1] = IDS_BLUE + } + + # Loop, reading cursor and modifying the display for the + # selected color. + + repeat { + call cv_rcraw(center, width) + width = width * 2. # flatten it + n = ksub (center, width, wdata, limit) + call cvwlut (device, frames, pcolor, wdata, n) + button = cv_rdbut() + } until (button != 0) + } +end + +# KSUB -- determines data points for a triangular mapping function +# Returns number of points in data array. + +int procedure ksub (center, width, data, limit) + +real center, width, limit +short data[ARB] + +int n +real xs, xe, ys, ye, xscale + +include "cv.com" + +begin + n = 0 + xscale = GKI_MAXNDC * limit + if (width < (1.0/cv_yres)) + width = 1.0/cv_yres + + if (center > 0.) { + xs = center - width + if (xs < 0.) + xs = 0. + else if (xs > 0.) { + data[1] = 0. + data[2] = 0. + n = n + 2 + } + ys = (xs - center)/width + 1.0 + data[n+1] = xs * xscale + data[n+2] = ys * GKI_MAXNDC + data[n+3] = center * xscale + data[n+4] = GKI_MAXNDC + n = n + 4 + } + + if (center < 1.0) { + xe = width + center + if (xe > 1.0) + xe = 1.0 + ye = (center - xe)/width + 1.0 + data[n+1] = center * xscale + data[n+2] = GKI_MAXNDC + data[n+3] = xe * xscale + data[n+4] = ye * GKI_MAXNDC + n = n + 4 + if (xe < 1.0) { + data[n+1] = xscale + data[n+2] = 0 + n = n + 2 + } + } + + # Extend last value to end + if (limit != 1.0) { + data[n+1] = GKI_MAXNDC + data[n+2] = data[n] + n = n + 2 + } + + return (n) +end diff --git a/pkg/images/tv/iis/src/match.x b/pkg/images/tv/iis/src/match.x new file mode 100644 index 00000000..ebbe523d --- /dev/null +++ b/pkg/images/tv/iis/src/match.x @@ -0,0 +1,172 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include "../lib/ids.h" + +# MATCH -- Match look up tables. The command reads +# match this_one (to) that one + +procedure match + +char token[SZ_LINE] +int tok +short f_ref[2] +short c_ref[IDS_MAXGCOLOR+1] +short frames[IDS_MAXIMPL+1] +short colors[IDS_MAXGCOLOR+1] +short nextcolor +int nchar, i, val, ctoi() +int ltype + +include "cv.com" + +begin + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if ( (tok == TOK_IDENTIFIER) && (token[1] == 'o') ) { + ltype = IDS_OUTPUT_LUT + } else { + ltype = IDS_FRAME_LUT + # "Push back" the token + call reset_scan + call gargtok (tok, token, SZ_LINE) + } + + # All this parsing tells us why YACC and LEX were invented + # Use "i" to tell if have parsed something useful + + i = -1 + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if ((tok == TOK_IDENTIFIER) && (token[1] == 'f')) { + i = 1 + call cv_frame (token[2], frames) + if (frames[1] == ERR) + return + } else if (tok == TOK_NUMBER) { + i = 1 + nchar = ctoi (token, i, val) + if ((val < 1) || (val > cv_maxframes)) { + call eprintf ("Invalid frame specification: %d\n") + call pargi (val) + return + } else { + frames[1] = val + frames[2] = IDS_EOD + } + } else if (ltype == IDS_FRAME_LUT) { + call eprintf ("missing frame arguement\n") + return + } else + frames[1] = IDS_EOD + + # default first color argument to all colors for both FRAME and OUTPUT + # tables...means make all colors the same. + + colors[1] = IDS_EOD # default all colors + + # Advance if previous token was useful + + if ( i != -1 ) { + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + } + + # Look for a color + + if ((tok == TOK_IDENTIFIER) && (token[1] == 'c')) { + call cv_color (token[2], colors) + if (colors[1] == ERR) + return + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + } + + # look for fill word "to" + + if ((tok == TOK_IDENTIFIER) && (token[1] == 't')) { + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + } + + # if FRAME LUT, we default frame to first frame to be changed. + # if OUTPUT LUT, frame is irrelevant + + i = -1 + if (tok == TOK_IDENTIFIER) { + if (token[1] == 'f') + i = 2 + else if (token[1] != 'c') { + call eprintf ("Unexpected argument: %s\n") + call pargstr (token) + return + } + } else if (tok == TOK_NUMBER) + i = 1 + + # if ltype is OUTPUT lut, don't care about frame type, but can't + # omit it...so default to EOD + + f_ref[1] = IDS_EOD + f_ref[2] = IDS_EOD + if (ltype == IDS_FRAME_LUT) { + if (i == -1) { + f_ref[1] = frames[1] + } else { + nchar = ctoi (token, i, val) + if ((val < 1) || (val > cv_maxframes)) { + call eprintf ("Invalid frame specification: %d\n") + call pargi (val) + return + } + f_ref[1] = val + } + } + + # Only thing left should be the reference color. + # If found a frame before, advance the token. + + if (i != -1) { + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + } + if ((tok != TOK_NEWLINE) && (tok != TOK_IDENTIFIER)) { + call eprintf ("Unexpected input: %s\n") + call pargstr (token) + return + } + c_ref[1] = IDS_EOD + if (tok == TOK_IDENTIFIER) { + if (token[1] != 'c') { + call eprintf ("Unexpected input (color required): %s\n") + call pargstr (token) + return + } else { + call cv_color (token[2], c_ref) + if (c_ref[1] == ERR) + return + } + } + + if (c_ref[1] != IDS_EOD) + call cvmatch (ltype, f_ref, c_ref, frames, colors) + else { + # No specific color for reference. If no color specified + # to copy into, do all. + c_ref[2] = IDS_EOD + if ( colors[1] == IDS_EOD ) { + colors[1] = IDS_RED + colors[2] = IDS_GREEN + colors[3] = IDS_BLUE + colors[4] = IDS_EOD + } + # Match for each color given in "colors" + for ( i = 1 ; colors[i] != IDS_EOD; i = i + 1) { + nextcolor = colors[i+1] + colors[i+1] = IDS_EOD + c_ref[1] = colors[i] + call cvmatch (ltype, f_ref, c_ref, frames, colors[i]) + colors[i+1] = nextcolor + } + } +end diff --git a/pkg/images/tv/iis/src/maxmin.x b/pkg/images/tv/iis/src/maxmin.x new file mode 100644 index 00000000..d16874e9 --- /dev/null +++ b/pkg/images/tv/iis/src/maxmin.x @@ -0,0 +1,52 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imhdr.h> + +# MAXMIN -- Get the minimum and maximum pixel values of an image. If valid +# header values are available they are used, otherwise the image is sampled +# on an even grid and the min and max values of this sample are returned. + +procedure maxmin (im, zmin, zmax, nsample_lines) + +pointer im +real zmin, zmax # min and max intensity values +int nsample_lines # amount of image to sample + +int step, ncols, nlines, sample_size, imlines, i +real minval, maxval +pointer imgl2r() + +begin + # Only calculate minimum, maximum pixel values if the current + # values are unknown, or if the image was modified since the + # old values were computed. + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + if (IM_LIMTIME(im) >= IM_MTIME(im)) { + # Use min and max values in image header if they are up to date. + zmin = IM_MIN(im) + zmax = IM_MAX(im) + + } else { + zmin = MAX_REAL + zmax = -MAX_REAL + + # Try to include a constant number of pixels in the sample + # regardless of the image size. The entire image is used if we + # have a small image, and at least sample_lines lines are read + # if we have a large image. + + sample_size = 512 * nsample_lines + imlines = min(nlines, max(nsample_lines, sample_size / ncols)) + step = nlines / (imlines + 1) + + do i = 1 + step, nlines, max (1, step) { + call alimr (Memr[imgl2r(im,i)], ncols, minval, maxval) + zmin = min (zmin, minval) + zmax = max (zmax, maxval) + } + } +end diff --git a/pkg/images/tv/iis/src/mkpkg b/pkg/images/tv/iis/src/mkpkg new file mode 100644 index 00000000..34ee515c --- /dev/null +++ b/pkg/images/tv/iis/src/mkpkg @@ -0,0 +1,39 @@ +# Make the CV display load and control package. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + blink.x ../lib/ids.h <ctotok.h> <ctype.h> <gki.h> cv.com + clear.x ../lib/ids.h <ctotok.h> <ctype.h> cv.com + cv.x cv.com cv.h ../lib/ids.h <ctotok.h> <error.h> <fio.h>\ + <fset.h> <gki.h> + cvparse.x cv.com ../lib/ids.h <ctype.h> + cvulut.x cv.h <ctype.h> <error.h> + cvutil.x cv.com cv.h ../lib/ids.h <gki.h> <gset.h> <imhdr.h>\ + cv.com + display.x ../lib/ids.h <ctotok.h> <ctype.h> cv.com + load1.x cv.com cv.h ../lib/ids.h <error.h> <gki.h> gwindow.h\ + <fio.h> <fset.h> <imhdr.h> <imset.h> <mach.h> + load2.x cv.com cv.h ../lib/ids.h <error.h> <gki.h> gwindow.h\ + cv.com <fio.h> <fset.h> <imhdr.h> <imset.h> <mach.h> + map.x ../lib/ids.h <ctotok.h> <ctype.h> <gki.h> cv.com + match.x ../lib/ids.h <ctotok.h> cv.com + maxmin.x <imhdr.h> <mach.h> + offset.x ../lib/ids.h <ctotok.h> <ctype.h> cv.com + pan.x cv.com ../lib/ids.h <ctotok.h> <ctype.h> <gki.h> + range.x ../lib/ids.h <ctotok.h> <ctype.h> cv.com + rdcur.x ../lib/ids.h <ctotok.h> <ctype.h> cv.com <gki.h> + reset.x ../lib/ids.h <ctotok.h> <ctype.h> cv.com + sigl2.x <error.h> <imhdr.h> + snap.x ../lib/ids.h <ctotok.h> <ctype.h> cv.com <gki.h>\ + <imhdr.h> + split.x ../lib/ids.h <ctotok.h> <ctype.h> cv.com + tell.x ../lib/ids.h cv.com + text.x ../lib/ids.h <ctotok.h> <ctype.h> + window.x ../lib/ids.h <ctotok.h> <ctype.h> <gki.h> cv.com + zoom.x ../lib/ids.h <ctotok.h> <ctype.h> <gki.h> cv.com + zscale.x <imhdr.h> + ; diff --git a/pkg/images/tv/iis/src/offset.x b/pkg/images/tv/iis/src/offset.x new file mode 100644 index 00000000..356ae55f --- /dev/null +++ b/pkg/images/tv/iis/src/offset.x @@ -0,0 +1,53 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include "../lib/ids.h" + +# OFFSET -- Change the bias (offset) for certain colors + +procedure offset() + +int tok, i, nchar, ip +char token[SZ_LINE] +short color[IDS_MAXGCOLOR+1] +short offsetdata[4] # extra space for cvmove EOD +int count, ctoi() + +include "cv.com" + +begin + # In principle, we should be able to accept input for color group + # followed by offset value(s) or "vice versa" or for a series of + # color/offset pairs. We try for most of that. + color[1] = ERR + offsetdata[1] = ERR + count = 1 + # anything but TOK_NEWLINE + tok = TOK_NUMBER + repeat { + if (tok == TOK_NEWLINE) { + call eprintf ("Insufficient offset specification\n") + return + } + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (token[1] == 'c') { + call cv_color (token[2], color) + if (color[1] == ERR) + return + } else if (tok == TOK_NUMBER) { + ip = 1 + nchar = ctoi (token, ip, i) + if ( count <= 3) { + offsetdata[count] = i + count = count + 1 + } + } + } until ( (color[1] != ERR) && (offsetdata[1] != ERR) && + (tok == TOK_NEWLINE) ) + + offsetdata[count] = IDS_EOD # mark end + + call cvoffset (color, offsetdata) +end diff --git a/pkg/images/tv/iis/src/pan.x b/pkg/images/tv/iis/src/pan.x new file mode 100644 index 00000000..b8929510 --- /dev/null +++ b/pkg/images/tv/iis/src/pan.x @@ -0,0 +1,99 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include <gki.h> +include "../lib/ids.h" + +# PAN -- pan some or all of the frames + +procedure pan() + +char token[SZ_LINE] +int tok +short frames[IDS_MAXIMPL+2] # frames, graphics, EOD + +include "cv.com" + +begin + frames[1] = IDS_EOD # default all frames + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (token[1] == 'f') { + call cv_frame (token[2], frames) + if (frames[1] == ERR) + return + } else if (tok == TOK_NUMBER) { + call cv_frame (token[1], frames) + if (frames[1] == ERR) + return + } else { + call eprintf ("Unexpected input: %s\n") + call pargstr (token) + return + } + + call pansub (frames) +end + + +# PANSUB -- Pan subroutine, handles code common to pan and zoom + +procedure pansub (frames) + +short frames[ARB] # frames to pan + +int button +int cnum, cv_rdbut() +real x,y, xc, yc +real oldx, oldy + +include "cv.com" + +begin + button = cv_rdbut() # clear buttons by reading them + call eprintf ("Press any button when done\n") + + # Where is cursor now? + + call cv_rcraw (xc,yc) + + # Calculate NDC screen center and cursor number. + # x,y are NDC, but always < 1.0 The transformation applied here + # insures that the correct pixel is calculated by the kernel + # after passing x,y through the gio cursor routines. + x = real(cv_xcen - 1) * cv_xcon / GKI_MAXNDC + y = real(cv_ycen - 1) * cv_ycon / GKI_MAXNDC + cnum = frames[1] + if (cnum == IDS_EOD) + cnum = 0 + call cv_scraw (x, y) # put cursor at screen center + + # Determine NDC there for frame of interest + call cv_rcur (cnum, x, y) + + # Restore cursor + call cv_scraw (xc, yc) + + repeat { + oldx = xc + oldy = yc + repeat { + call cv_rcraw (xc, yc) + button = cv_rdbut() + } until ( (xc != oldx) || (yc != oldy) || (button > 0)) + # Determine change and reflect it about current screen + # center so image moves in direction cursor moves. + x = x - (xc - oldx) + y = y - (yc - oldy) + if (x > 1.0) + x = x - 1.0 + else if (x < 0) + x = x + 1.0 + if (y > 1.0) + y = y - 1.0 + else if (y < 0) + y = y + 1.0 + call cvpan (frames, x, y) + } until (button > 0) +end diff --git a/pkg/images/tv/iis/src/range.x b/pkg/images/tv/iis/src/range.x new file mode 100644 index 00000000..664e3ab8 --- /dev/null +++ b/pkg/images/tv/iis/src/range.x @@ -0,0 +1,57 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include "../lib/ids.h" + +# RANGE -- set the scaling (range) registers + +procedure range() + +char token[SZ_LINE] +int tok, i, nchar, ip +short color[IDS_MAXGCOLOR+1] +short rdata[4] # extra space for cvmove EOD +int count, ctoi() + +include "cv.com" + +begin + # In principle, we should be able to accept input for color group + # followed by range value(s) or "vice versa" or for a series of + # color/range pairs. We try for most of that. + color[1] = IDS_EOD + rdata[1] = ERR + count = 1 + # anything but TOK_NEWLINE + tok = TOK_NUMBER + repeat { + if (tok == TOK_NEWLINE) { + call eprintf ("Insufficient range specification\n") + return + } + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (token[1] == 'c') { + call cv_color (token[2], color) + if (color[1] == ERR) + return + } else if (tok == TOK_NUMBER) { + ip = 1 + nchar = ctoi (token, ip, i) + if (i < 1) { + call eprintf ("bad range specification: %d\n") + call pargi (i) + return + } + if ( count <= 3) { + rdata[count] = i + count = count + 1 + } + } + } until ( (rdata[1] != ERR) && (tok == TOK_NEWLINE )) + + rdata[count] = IDS_EOD # mark end + + call cvrange ( color, rdata) +end diff --git a/pkg/images/tv/iis/src/rdcur.x b/pkg/images/tv/iis/src/rdcur.x new file mode 100644 index 00000000..5d27097e --- /dev/null +++ b/pkg/images/tv/iis/src/rdcur.x @@ -0,0 +1,111 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include <gki.h> +include "../lib/ids.h" + +# RDCUR -- read cursor and datum + +procedure rdcur() + +char token[SZ_LINE], ch +int tok, cnum, px, py +int junk, ip, fx, fy +real x,y +short datum +short frames[IDS_MAXIMPL+2] # frames, one graphics, EOD +int scan(), ctoi(), mod(), and() + +include "cv.com" + +begin + cnum = ERR + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (tok == TOK_NUMBER) { + ip = 1 + junk = ctoi (token, ip, cnum) + frames[1] = cnum + frames[2] = IDS_EOD + } + else if (tok == TOK_IDENTIFIER) { + if (token[1] == 'o') { + if (token[2] == 'n') + call cvcur(IDS_ON) + else if (token[2] == 'f') + call cvcur(IDS_OFF) + else { + call eprintf ("Unrecognized cursor command: %s\n") + call pargstr (token) + } + return + } + call cv_frame (token[2], frames) + cnum = frames[1] + if ( cnum == IDS_EOD) { + call eprintf ("Please specify a particular frame\n") + return + } + } + if ( (cnum == ERR) || (cnum < 1) ) { + call eprintf ("bad cursor number: %d\n") + call pargi (cnum) + return + } + + # set kernel to do i/o on specified frames (for ggcell routine) + call cv_iset (frames) + + call eprintf ("Press <cr> for each read; any key but <sp>, and then <cr>, to exit\n") + repeat { + if (scan() != EOS) + break + repeat { + call scanc (ch) + } until (ch != ' ') + if (ch != '\n') + break + call cv_rcur (cnum, x, y) + call ggcell (cv_gp, datum, 1, 1, x, y, x, y) + x = x * GKI_MAXNDC / cv_xcon + 1. + y = y * GKI_MAXNDC / cv_ycon + 1. + px = int(x) + py = int(y) + # Only allow fractions to 1/8 as that is max zoom for IIS + x = real (int((x - px)*8))/8. + y = real (int((y - py)*8))/8. + # Print minimum number of decimal places, but do x and y the same + call eprintf ("frame %d, pixel (") + call pargi (cnum) + fx = x * 8 + fy = y * 8 + if ((fx == 0) && (fy == 0)) { + call eprintf ("%d,%d") + call pargi (px) + call pargi (py) + junk = 0 + } else { + call eprintf ("%.*f,%.*f") + + if ( (mod(fx,4) == 0) && (mod(fy,4) == 0) ) + junk = 1 + else if ( (and(fx,1) != 0) || (and(fy,1) != 0) ) + junk = 3 + else + junk = 2 + + call pargi (junk) + call pargr (px+x) + call pargi (junk) + call pargr (py+y) + } + if (junk == 0) + junk = 8 + else + junk = 6 - 2 * junk + call eprintf ("): %*w%4d\n") + call pargi (junk) + call pargs (datum) + } +end diff --git a/pkg/images/tv/iis/src/reset.x b/pkg/images/tv/iis/src/reset.x new file mode 100644 index 00000000..3a2e60e9 --- /dev/null +++ b/pkg/images/tv/iis/src/reset.x @@ -0,0 +1,37 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include "../lib/ids.h" + +# RESET -- reset the display + +procedure reset() + +char token[SZ_LINE] +int tok + +include "cv.com" + +begin + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (tok == TOK_IDENTIFIER) { + switch(token[1]) { + case 'r': + call cvreset( IDS_R_SOFT) + + case 't': + call cvreset( IDS_R_MEDIUM) + + case 'i': + call cvreset( IDS_R_HARD) + + case 'a': + call cvreset( IDS_R_SOFT) + call cvreset( IDS_R_MEDIUM) + call cvreset( IDS_R_HARD) + + } + } +end diff --git a/pkg/images/tv/iis/src/sigl2.x b/pkg/images/tv/iis/src/sigl2.x new file mode 100644 index 00000000..226d4f5b --- /dev/null +++ b/pkg/images/tv/iis/src/sigl2.x @@ -0,0 +1,677 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> + +.help sigl2, sigl2_setup +.nf ___________________________________________________________________________ +SIGL2 -- Get a line from a spatially scaled 2-dimensional image. This procedure +works like the regular IMIO get line procedure, but rescales the input +2-dimensional image in either or both axes upon input. 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 = sigl2_setup (im, x1,x2,nx, y1,y2,ny) + sigl2_free (si) + ptr = sigl2[sr] (si, linenumber) + +SIGL2_SETUP must be called to set up the transformations after mapping the +image and before performing any scaled i/o to the image. SIGL2_FREE must be +called when finished to return buffer space. +.endhelp ______________________________________________________________________ + +# Scaled image descriptor for 2-dim images + +define SI_LEN 15 +define SI_MAXDIM 2 # images of 2 dimensions supported +define SI_NBUFS 3 # nbuffers used by SIGL2 + +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_TYBUF Memi[$1+12] # buffer type +define SI_XOFF Memi[$1+13] # offset in input image to first X +define SI_INIT Memi[$1+14] # 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) + +# SIGL2_SETUP -- Set up the spatial transformation for SIGL2[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. +# +# Valdes - Jan 9, 1985: +# Nx or ny can be 1 and blocking factors can be specified. + +pointer procedure sigl2_setup (im, px1, px2, nx, xblk, py1, py2, ny, yblk) + +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 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_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) && !IS_INDEFI (blksize[i])) { + 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 + do j = 0, npts[i]-1 + Memr[gp+j] = start + (j * tau[i]) + } + + return (si) +end + + +# SIGL2_FREE -- Free storage associated with an image opened for scaled +# input. This does not close and unmap the image. + +procedure sigl2_free (si) + +pointer si +int i + +begin + # Free SIGL2 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 + + +# SIGL2S -- 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 sigl2s (si, lineno) + +pointer si # pointer to SI descriptor +int lineno + +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))) + + # 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)) + + if (SI_INTERP(si,1) == NO) + call amovs (Mems[rawline], Mems[SI_BUF(si,i)], 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_2 < SI_TOL) + return (SI_BUF(si,1)) + else if (weight_1 < SI_TOL) + return (SI_BUF(si,2)) + 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) + +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 + +short temp_s +int nblks_x, nblks_y, ncols, nlines, xoff, i, j +int first_line, nlines_in_sum, npix, nfull_blks, count +real sum +pointer sp, a, b +pointer imgs2s() +errchk imgs2s + +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)) + return (imgs2s (im, xoff, xoff + npix - 1, y, y)) + + 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. + a = imgs2s (im, xoff, xoff + npix - 1, i, i) + + # 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 + + +# SIGL2R -- 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 sigl2r (si, lineno) + +pointer si # pointer to SI descriptor +int lineno + +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))) + + # 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)) + + if (SI_INTERP(si,1) == NO) + call amovr (Memr[rawline], Memr[SI_BUF(si,i)], 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_2 < SI_TOL) + return (SI_BUF(si,1)) + else if (weight_1 < SI_TOL) + return (SI_BUF(si,2)) + 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) + +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 nblks_x, nblks_y, ncols, nlines, xoff, i, j +int first_line, nlines_in_sum, npix, nfull_blks, count +real sum +pointer sp, a, b +pointer imgs2r() +errchk imgs2r + +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)) + return (imgs2r (im, xoff, xoff + npix - 1, y, y)) + + 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. + a = imgs2r (im, xoff, xoff + npix - 1, i, i) + + # 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 diff --git a/pkg/images/tv/iis/src/snap.x b/pkg/images/tv/iis/src/snap.x new file mode 100644 index 00000000..12694568 --- /dev/null +++ b/pkg/images/tv/iis/src/snap.x @@ -0,0 +1,64 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include <imhdr.h> +include <gki.h> +include "../lib/ids.h" + +# SNAP -- Take a picture!! + +procedure snap() + +char token[SZ_LINE] +int tok +char fname[SZ_FNAME] +int snap_color + +include "cv.com" + +begin + snap_color = IDS_SNAP_MONO # default color for snap + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (tok == TOK_IDENTIFIER) { + if (token[1] != 'c') { + call eprintf ("unknown snap argument: %s\n") + call pargstr (token) + return + } else { + # snap colors: r, g, b, rgb, m (monochrome) == bw (black/white) + switch (token[2]) { + case 'm': + snap_color = IDS_SNAP_MONO + + case 'r': + if ((token[3] == 'g') && (token[4] == 'b') ) + snap_color = IDS_SNAP_RGB + else + snap_color = IDS_SNAP_RED + + case 'g': + snap_color = IDS_SNAP_GREEN + + case 'b': + if (token[3] == 'w') + snap_color = IDS_SNAP_MONO + else + snap_color = IDS_SNAP_BLUE + + default: + call eprintf ("Unknown snap color: %c\n") + call pargc (token[2]) + return + } + } + } else if (tok != TOK_NEWLINE) { + call eprintf ("unexpected argument to snap: %s\n") + call pargstr (token) + return + } + + call clgstr("snap_file", fname, SZ_FNAME) + call cvsnap (fname, snap_color) +end diff --git a/pkg/images/tv/iis/src/split.x b/pkg/images/tv/iis/src/split.x new file mode 100644 index 00000000..393fc218 --- /dev/null +++ b/pkg/images/tv/iis/src/split.x @@ -0,0 +1,95 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include "../lib/ids.h" + +# SPLIT -- set the split screen point + +procedure split() + +char token[SZ_LINE] +int tok +int nchar, ctoi() +int i, x, y +real xr, yr +int ctor() +bool a_real + +define errmsg 10 + +include "cv.com" + +begin + a_real = false + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (tok == TOK_IDENTIFIER) { + switch(token[1]) { + case 'c': + x = cv_xcen + y = cv_ycen + + case 'o': + x = 1 + y = 1 + + case 'n', 'p': # n: ndc, p: pixel + if (token[1] == 'n') + a_real = true + if (IS_DIGIT(token[2])) + i = 2 + else { + call gargtok (tok, token, SZ_LINE) + if (tok != TOK_NUMBER) { +errmsg + call eprintf ("bad split pixel: %s\n") + call pargstr (token) + return + } else + i = 1 + } + if (a_real) + nchar = ctor (token, i, xr) + else + nchar = ctoi (token, i, x) + if (nchar == 0) { + call eprintf ("No conversion, ") + goto errmsg + } + call gargtok (tok, token, SZ_LINE) + if (tok == TOK_PUNCTUATION) + call gargtok (tok, token, SZ_LINE) + i = 1 + if (a_real) + nchar = ctor (token, i, yr) + else + nchar = ctoi (token, i, y) + if (nchar == 0) { + call eprintf ("No conversion, ") + goto errmsg + } + + default: + call eprintf ("unknown split code: %c\n") + call pargc (token[1]) + return + } + } + # Convert to NDC, BUT note, that as x and y range from 1 through + # cv_[xy]res, xr and yr will never be 1.0---and they must not be + # (see cvsplit()) + if (!a_real ) { + xr = real(x-1) / cv_xres + yr = real(y-1) / cv_xres + } + if ( xr < 0 ) + xr = 0 + if ( yr < 0 ) + yr = 0 + if ( xr >= 1.0 ) + xr = real(cv_xres-1)/cv_xres + if ( yr >= 1.0 ) + yr = real(cv_yres-1)/cv_yres + call cvsplit (xr, yr) +end diff --git a/pkg/images/tv/iis/src/tell.x b/pkg/images/tv/iis/src/tell.x new file mode 100644 index 00000000..cce4987e --- /dev/null +++ b/pkg/images/tv/iis/src/tell.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + + +include "../lib/ids.h" + +# TELL -- Tell user about display state + +procedure tell() + +short f[IDS_MAXIMPL+2] # Ultimately, want an array terminated + # with IDS_EOD as usual + +include "cv.com" + +begin + # We don't know much, do we? + + call cvwhich(f) + if ( f[1] > 0) { + call eprintf ("Frame %d, at least, is on.\n") + call pargs (f[1]) + } else + call eprintf ("No frames are on.\n") +end diff --git a/pkg/images/tv/iis/src/text.x b/pkg/images/tv/iis/src/text.x new file mode 100644 index 00000000..32623786 --- /dev/null +++ b/pkg/images/tv/iis/src/text.x @@ -0,0 +1,71 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include "../lib/ids.h" + +# TEXT -- put text into image planes or graphics bit planes + +procedure text() + +char token[SZ_LINE] +int tok, ip, cnum +short frames[IDS_MAXIMPL+2] # frames, graphics, EOD +short colors[IDS_MAXGCOLOR] +real x, y +int button, cv_wtbut() +char line[SZ_LINE] +real size, clgetr() + +begin + frames[1] = ERR + colors[1] = ERR + + # which frames for text + + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (tok == TOK_IDENTIFIER) { + if (token[1] == 'f') { + call cv_frame (token[2], frames) + if (frames[1] == ERR) + return + } else if (token[1] == 'c') { + call cv_color (token[2], colors) + if (colors[1] == ERR) + return + } + } else if (tok == TOK_NUMBER) { + call cv_frame (token[1], frames) + if (frames[1] == ERR) + return + } + if ( (frames[1] == ERR) && (colors[1] == ERR)) { + call eprintf ("Inadequate text specification: %s\n") + call pargstr (token) + return + } + + call gargstr (line, SZ_LINE) + + # Prompt user to set cursor + + call eprintf ("Set cursor to desired location, then press any button\n") + button = cv_wtbut() + + # Set up kernel for write + if (frames[1] != ERR) { + cnum = frames[1] + call cv_iset (frames) + } else { + cnum = 16 # SORRY, is IIS specific - we should do better + call cv_gset (colors) + } + call cv_rcur (cnum, x, y) + + size = clgetr("textsize") + ip = 1 + while (IS_WHITE(line[ip])) + ip = ip + 1 + call cvtext (x, y, line[ip], size) +end diff --git a/pkg/images/tv/iis/src/window.x b/pkg/images/tv/iis/src/window.x new file mode 100644 index 00000000..e3523a90 --- /dev/null +++ b/pkg/images/tv/iis/src/window.x @@ -0,0 +1,181 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include <gki.h> +include "../lib/ids.h" + +# WINDOW -- window the display. + +procedure window() + +char token[SZ_LINE] +int tok, cnum +short frames[IDS_MAXIMPL+2] # frames, graphics, EOD +short colors[IDS_MAXGCOLOR] +real x, y +real xold, yold +int device, button, cv_rdbut() +short wdata[16] +int n, first, last +real istart, iend, slope + +include "cv.com" + +begin + # Find out if want to change output tables + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (( tok == TOK_IDENTIFIER) && (token[1] == 'o')) { + device = IDS_OUTPUT_LUT + slope = 4.0 # Device dependent !! + } else { + device = IDS_FRAME_LUT + slope = 1.0 + # reset input pointers; same as having pushed back token + call reset_scan + call gargtok (tok, token, SZ_LINE) + } + + # Default to all frames, all colors + frames[1] = IDS_EOD + colors[1] = IDS_EOD + + # which frames to window + + repeat { + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (tok == TOK_IDENTIFIER) { + if (token[1] == 'f') { + call cv_frame (token[2], frames) + if (frames[1] == ERR) + return + } else if (token[1] == 'c') { + call cv_color (token[2], colors) + if (colors[1] == ERR) + return + } else { + call eprintf ("Unknown window argument: %s\n") + call pargstr (token) + return + } + } else if (tok == TOK_NUMBER) { + call cv_frame (token[1], frames) + if (frames[1] == ERR) + return + } else if (tok != TOK_NEWLINE) { + call eprintf ("Unexpected window input: %s\n") + call pargstr (token) + return + } + } until ( tok == TOK_NEWLINE) + + # rememeber current cursor postion + + cnum = 0 + call cv_rcur (cnum, xold, yold) + + # Now set up loop to window display; we need to read back + # display but cannot, so for now, use "common" variables + # If first time, use defaults. + + if (cv_xwinc == -1) { + if (slope == 1.0) { + cv_xwinc = 0.25 + cv_ywinc = .75 + } else { + cv_xwinc = .0625 + cv_ywinc = .9375 + } + } + call cv_scraw (cv_xwinc, cv_ywinc) + + button = cv_rdbut() # clear buttons by reading them + call eprintf ("Press any button when done\n") + + # The mapping equation is table value = 0.25 + y * (i-x) + # where i runs from 0 to 1.0, x ranges from 0. to 1.0 and y + # from 0 to large. + + repeat { + call cv_rcraw (cv_xwinc, cv_ywinc) + x = cv_xwinc + y = (cv_ywinc - 0.5) * 4 + # Keep y from equalling 2 or -2 : + if (y >= 2.) + y = 1.99 + else if ( y <= -2.0) + y = -1.99 + if (y > 1.) + y = 1. / (2. - y) + else if (y < -1.) + y = -1. / (2. + y) + + if ( y == 0.0) { + iend = 1.0 + istart = 0.0 + first = 0 + last = GKI_MAXNDC + } else if ( y > 0.) { + istart = x - 0.25/y + iend = 1.0/y + istart + first = 0 + last = GKI_MAXNDC + } else { + iend = x - 0.25/y + istart = 1.0/y + iend + first = GKI_MAXNDC + last = 0 + } + if (istart < 0.) + istart = 0. + if (iend > 1.0) + iend = 1.0 + if (istart > 1.0) + istart = 1.0 + if (iend < istart) + iend = istart + wdata[1] = 0 + if ( istart > 0.) { + wdata[2] = first + wdata[3] = istart * GKI_MAXNDC + wdata[4] = first + n = 5 + } else { + wdata[2] = (0.25 -x*y) * GKI_MAXNDC + n = 3 + } + wdata[n] = iend * GKI_MAXNDC + if ( iend < 1.0) { + # In this case, we reach max/min y value before end of table, so + # extend it horizontally to end + wdata[n+1] = last + wdata[n+2] = GKI_MAXNDC + wdata[n+3] = last + n = n + 3 + } else { + wdata[n+1] = (0.25 + y * (1.0 - x)) * GKI_MAXNDC + n = n + 1 + } + call cvwlut (device, frames, colors, wdata, n) + button = cv_rdbut() + } until (button > 0) + + # Restore old cursor position + call cv_rcur (cnum, xold, yold) + + # Tell the user what final mapping was + call printf ("window: from (%5.3f,%5.3f) to (%5.3f,%5.3f)\n") + call pargr (istart) + if (istart > 0.) + call pargr (real(first)/GKI_MAXNDC) + else + call pargr (real(wdata[2])/GKI_MAXNDC) + call pargr (iend) + if (iend < 1.0) + call pargr (real(last)/GKI_MAXNDC) + else + call pargr (real(wdata[n])/GKI_MAXNDC) + +end diff --git a/pkg/images/tv/iis/src/zoom.x b/pkg/images/tv/iis/src/zoom.x new file mode 100644 index 00000000..c7e7bff7 --- /dev/null +++ b/pkg/images/tv/iis/src/zoom.x @@ -0,0 +1,60 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> +include <ctype.h> +include <gki.h> +include "../lib/ids.h" + +# ZOOM -- zoom, then pan, the display. If zoom power == 1, then +# don't bother panning. + +procedure zoom() + +char token[SZ_LINE] +int tok, count, power, cnum +short frames[IDS_MAXIMPL+2] # frames, graphics, EOD +real x, y +int ctoi, ip + +include "cv.com" + +begin + # get power for zoom + + call gargtok (tok, token, SZ_LINE) + if (tok != TOK_NUMBER) { + call eprintf ("Bad zoom power: %s\n") + call pargstr (token) + return + } + ip = 1 + count = ctoi(token, ip, power) + + # which frames to zoom + + frames[1] = IDS_EOD # default all frames + call gargtok (tok, token, SZ_LINE) + call strlwr (token) + if (token[1] == 'f') { + call cv_frame (token[2], frames) + if (frames[1] == ERR) + return + } else if (tok == TOK_NUMBER) { + call cv_frame (token[1], frames) + if (frames[1] == ERR) + return + } else { + call eprintf ("Unexpected input: %s\n") + call pargstr (token) + return + } + + # where to zoom ... find which frame to read cursor position from + + cnum = frames[1] + if (cnum == IDS_EOD) + cnum = 0 + call cv_rcur (cnum, x, y) + call cvzoom (frames, power, x, y) + call pansub (frames) +end diff --git a/pkg/images/tv/iis/src/zscale.x b/pkg/images/tv/iis/src/zscale.x new file mode 100644 index 00000000..bfb0b116 --- /dev/null +++ b/pkg/images/tv/iis/src/zscale.x @@ -0,0 +1,457 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +.help zscale +.nf ___________________________________________________________________________ +ZSCALE -- Compute the optimal Z1, Z2 (range of greyscale values to be +displayed) of an image. For efficiency a statistical subsample of an image +is used. The pixel sample evenly subsamples the image in x and y. The entire +image is used if the number of pixels in the image is smaller than the desired +sample. + +The sample is accumulated in a buffer and sorted by greyscale value. +The median value is the central value of the sorted array. The slope of a +straight line fitted to the sorted sample is a measure of the standard +deviation of the sample about the median value. Our algorithm is to sort +the sample and perform an iterative fit of a straight line to the sample, +using pixel rejection to omit gross deviants near the endpoints. The fitted +straight line is the transfer function used to map image Z into display Z. +If more than half the pixels are rejected the full range is used. The slope +of the fitted line is divided by the user-supplied contrast factor and the +final Z1 and Z2 are computed, taking the origin of the fitted line at the +median value. +.endhelp ______________________________________________________________________ + +define MIN_NPIXELS 5 # smallest permissible sample +define MAX_REJECT 0.5 # max frac. of pixels to be rejected +define GOOD_PIXEL 0 # use pixel in fit +define BAD_PIXEL 1 # ignore pixel in all computations +define REJECT_PIXEL 2 # reject pixel after a bit +define KREJ 2.5 # k-sigma pixel rejection factor +define MAX_ITERATIONS 5 # maximum number of fitline iterations + + +# ZSCALE -- Sample the image and compute Z1 and Z2. + +procedure zscale (im, z1, z2, contrast, optimal_sample_size, len_stdline) + +pointer im # image to be sampled +real z1, z2 # output min and max greyscale values +real contrast # adj. to slope of transfer function +int optimal_sample_size # desired number of pixels in sample +int len_stdline # optimal number of pixels per line + +int npix, minpix, ngoodpix, center_pixel, ngrow +real zmin, zmax, median +real zstart, zslope +pointer sample, left +int zsc_sample_image(), zsc_fit_line() + +begin + # Subsample the image. + npix = zsc_sample_image (im, sample, optimal_sample_size, len_stdline) + center_pixel = max (1, (npix + 1) / 2) + + # Sort the sample, compute the minimum, maximum, and median pixel + # values. + + call asrtr (Memr[sample], Memr[sample], npix) + zmin = Memr[sample] + zmax = Memr[sample+npix-1] + + # The median value is the average of the two central values if there + # are an even number of pixels in the sample. + + left = sample + center_pixel - 1 + if (mod (npix, 2) == 1 || center_pixel >= npix) + median = Memr[left] + else + median = (Memr[left] + Memr[left+1]) / 2 + + # Fit a line to the sorted sample vector. If more than half of the + # pixels in the sample are rejected give up and return the full range. + # If the user-supplied contrast factor is not 1.0 adjust the scale + # accordingly and compute Z1 and Z2, the y intercepts at indices 1 and + # npix. + + minpix = max (MIN_NPIXELS, int (npix * MAX_REJECT)) + ngrow = max (1, nint (npix * .01)) + ngoodpix = zsc_fit_line (Memr[sample], npix, zstart, zslope, + KREJ, ngrow, MAX_ITERATIONS) + + if (ngoodpix < minpix) { + z1 = zmin + z2 = zmax + } else { + if (contrast > 0) + zslope = zslope / contrast + z1 = max (zmin, median - (center_pixel - 1) * zslope) + z2 = min (zmax, median + (npix - center_pixel) * zslope) + } + + call mfree (sample, TY_REAL) +end + + +# ZSC_SAMPLE_IMAGE -- Extract an evenly gridded subsample of the pixels from +# a two-dimensional image into a one-dimensional vector. + +int procedure zsc_sample_image (im, sample, optimal_sample_size, len_stdline) + +pointer im # image to be sampled +pointer sample # output vector containing the sample +int optimal_sample_size # desired number of pixels in sample +int len_stdline # optimal number of pixels per line + +int ncols, nlines, col_step, line_step, maxpix, line +int opt_npix_per_line, npix_per_line +int opt_nlines_in_sample, min_nlines_in_sample, max_nlines_in_sample +pointer op +pointer imgl2r() + +begin + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Compute the number of pixels each line will contribute to the sample, + # and the subsampling step size for a line. The sampling grid must + # span the whole line on a uniform grid. + + opt_npix_per_line = min (ncols, len_stdline) + col_step = (ncols + opt_npix_per_line-1) / opt_npix_per_line + npix_per_line = (ncols + col_step-1) / col_step + + # Compute the number of lines to sample and the spacing between lines. + # We must ensure that the image is adequately sampled despite its + # size, hence there is a lower limit on the number of lines in the + # sample. We also want to minimize the number of lines accessed when + # accessing a large image, because each disk seek and read is expensive. + # The number of lines extracted will be roughly the sample size divided + # by len_stdline, possibly more if the lines are very short. + + min_nlines_in_sample = max (1, optimal_sample_size / len_stdline) + opt_nlines_in_sample = max(min_nlines_in_sample, min(nlines, + (optimal_sample_size + npix_per_line-1) / npix_per_line)) + line_step = max (1, nlines / (opt_nlines_in_sample)) + max_nlines_in_sample = (nlines + line_step-1) / line_step + + # Allocate space for the output vector. Buffer must be freed by our + # caller. + + maxpix = npix_per_line * max_nlines_in_sample + call malloc (sample, maxpix, TY_REAL) + +# call eprintf ("sample: x[%d:%d:%d] y[%d:%d:%d]\n") +# call pargi(1);call pargi(ncols); call pargi(col_step) +# call pargi((line_step+1)/2); call pargi(nlines); call pargi(line_step) + + # Extract the vector. + op = sample + do line = (line_step + 1) / 2, nlines, line_step { + call zsc_subsample (Memr[imgl2r(im,line)], Memr[op], + npix_per_line, col_step) + op = op + npix_per_line + if (op - sample + npix_per_line > maxpix) + break + } + + return (op - sample) +end + + +# ZSC_SUBSAMPLE -- Subsample an image line. Extract the first pixel and +# every "step"th pixel thereafter for a total of npix pixels. + +procedure zsc_subsample (a, b, npix, step) + +real a[ARB] +real b[npix] +int npix, step +int ip, i + +begin + if (step <= 1) + call amovr (a, b, npix) + else { + ip = 1 + do i = 1, npix { + b[i] = a[ip] + ip = ip + step + } + } +end + + +# ZSC_FIT_LINE -- Fit a straight line to a data array of type real. This is +# an iterative fitting algorithm, wherein points further than ksigma from the +# current fit are excluded from the next fit. Convergence occurs when the +# next iteration does not decrease the number of pixels in the fit, or when +# there are no pixels left. The number of pixels left after pixel rejection +# is returned as the function value. + +int procedure zsc_fit_line (data, npix, zstart, zslope, krej, ngrow, maxiter) + +real data[npix] # data to be fitted +int npix # number of pixels before rejection +real zstart # Z-value of pixel data[1] (output) +real zslope # dz/pixel (output) +real krej # k-sigma pixel rejection factor +int ngrow # number of pixels of growing +int maxiter # max iterations + +int i, ngoodpix, last_ngoodpix, minpix, niter +real xscale, z0, dz, x, z, mean, sigma, threshold +double sumxsqr, sumxz, sumz, sumx, rowrat +pointer sp, flat, badpix, normx +int zsc_reject_pixels(), zsc_compute_sigma() + +begin + call smark (sp) + + if (npix <= 0) + return (0) + else if (npix == 1) { + zstart = data[1] + zslope = 0.0 + return (1) + } else + xscale = 2.0 / (npix - 1) + + # Allocate a buffer for data minus fitted curve, another for the + # normalized X values, and another to flag rejected pixels. + + call salloc (flat, npix, TY_REAL) + call salloc (normx, npix, TY_REAL) + call salloc (badpix, npix, TY_SHORT) + call aclrs (Mems[badpix], npix) + + # Compute normalized X vector. The data X values [1:npix] are + # normalized to the range [-1:1]. This diagonalizes the lsq matrix + # and reduces its condition number. + + do i = 0, npix - 1 + Memr[normx+i] = i * xscale - 1.0 + + # Fit a line with no pixel rejection. Accumulate the elements of the + # matrix and data vector. The matrix M is diagonal with + # M[1,1] = sum x**2 and M[2,2] = ngoodpix. The data vector is + # DV[1] = sum (data[i] * x[i]) and DV[2] = sum (data[i]). + + sumxsqr = 0 + sumxz = 0 + sumx = 0 + sumz = 0 + + do i = 1, npix { + x = Memr[normx+i-1] + z = data[i] + sumxsqr = sumxsqr + (x ** 2) + sumxz = sumxz + z * x + sumz = sumz + z + } +# call eprintf ("\t%10g %10g %10g\n") +# call pargd(sumxsqr); call pargd(sumxz); call pargd(sumz) + + # Solve for the coefficients of the fitted line. + z0 = sumz / npix + dz = sumxz / sumxsqr + +# call eprintf ("fit: z0=%g, dz=%g\n") +# call pargr(z0); call pargr(dz) + + # Iterate, fitting a new line in each iteration. Compute the flattened + # data vector and the sigma of the flat vector. Compute the lower and + # upper k-sigma pixel rejection thresholds. Run down the flat array + # and detect pixels to be rejected from the fit. Reject pixels from + # the fit by subtracting their contributions from the matrix sums and + # marking the pixel as rejected. + + ngoodpix = npix + minpix = max (MIN_NPIXELS, int (npix * MAX_REJECT)) + + for (niter=1; niter <= maxiter; niter=niter+1) { + last_ngoodpix = ngoodpix + + # Subtract the fitted line from the data array. + call zsc_flatten_data (data, Memr[flat], Memr[normx], npix, z0, dz) + + # Compute the k-sigma rejection threshold. In principle this + # could be more efficiently computed using the matrix sums + # accumulated when the line was fitted, but there are problems with + # numerical stability with that approach. + + ngoodpix = zsc_compute_sigma (Memr[flat], Mems[badpix], npix, + mean, sigma) + threshold = sigma * krej + + # Detect and reject pixels further than ksigma from the fitted + # line. + ngoodpix = zsc_reject_pixels (data, Memr[flat], Memr[normx], + Mems[badpix], npix, sumxsqr, sumxz, sumx, sumz, threshold, + ngrow) + + # Solve for the coefficients of the fitted line. Note that after + # pixel rejection the sum of the X values need no longer be zero. + + if (ngoodpix > 0) { + rowrat = sumx / sumxsqr + z0 = (sumz - rowrat * sumxz) / (ngoodpix - rowrat * sumx) + dz = (sumxz - z0 * sumx) / sumxsqr + } + +# call eprintf ("fit: z0=%g, dz=%g, threshold=%g, npix=%d\n") +# call pargr(z0); call pargr(dz); call pargr(threshold); call pargi(ngoodpix) + + if (ngoodpix >= last_ngoodpix || ngoodpix < minpix) + break + } + + # Transform the line coefficients back to the X range [1:npix]. + zstart = z0 - dz + zslope = dz * xscale + + call sfree (sp) + return (ngoodpix) +end + + +# ZSC_FLATTEN_DATA -- Compute and subtract the fitted line from the data array, +# returned the flattened data in FLAT. + +procedure zsc_flatten_data (data, flat, x, npix, z0, dz) + +real data[npix] # raw data array +real flat[npix] # flattened data (output) +real x[npix] # x value of each pixel +int npix # number of pixels +real z0, dz # z-intercept, dz/dx of fitted line +int i + +begin + do i = 1, npix + flat[i] = data[i] - (x[i] * dz + z0) +end + + +# ZSC_COMPUTE_SIGMA -- Compute the root mean square deviation from the +# mean of a flattened array. Ignore rejected pixels. + +int procedure zsc_compute_sigma (a, badpix, npix, mean, sigma) + +real a[npix] # flattened data array +short badpix[npix] # bad pixel flags (!= 0 if bad pixel) +int npix +real mean, sigma # (output) + +real pixval +int i, ngoodpix +double sum, sumsq, temp + +begin + sum = 0 + sumsq = 0 + ngoodpix = 0 + + # Accumulate sum and sum of squares. + do i = 1, npix + if (badpix[i] == GOOD_PIXEL) { + pixval = a[i] + ngoodpix = ngoodpix + 1 + sum = sum + pixval + sumsq = sumsq + pixval ** 2 + } + + # Compute mean and sigma. + switch (ngoodpix) { + case 0: + mean = INDEF + sigma = INDEF + case 1: + mean = sum + sigma = INDEF + default: + mean = sum / ngoodpix + temp = sumsq / (ngoodpix - 1) - sum**2 / (ngoodpix * (ngoodpix - 1)) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngoodpix) +end + + +# ZSC_REJECT_PIXELS -- Detect and reject pixels more than "threshold" greyscale +# units from the fitted line. The residuals about the fitted line are given +# by the "flat" array, while the raw data is in "data". Each time a pixel +# is rejected subtract its contributions from the matrix sums and flag the +# pixel as rejected. When a pixel is rejected reject its neighbors out to +# a specified radius as well. This speeds up convergence considerably and +# produces a more stringent rejection criteria which takes advantage of the +# fact that bad pixels tend to be clumped. The number of pixels left in the +# fit is returned as the function value. + +int procedure zsc_reject_pixels (data, flat, normx, badpix, npix, + sumxsqr, sumxz, sumx, sumz, threshold, ngrow) + +real data[npix] # raw data array +real flat[npix] # flattened data array +real normx[npix] # normalized x values of pixels +short badpix[npix] # bad pixel flags (!= 0 if bad pixel) +int npix +double sumxsqr,sumxz,sumx,sumz # matrix sums +real threshold # threshold for pixel rejection +int ngrow # number of pixels of growing + +int ngoodpix, i, j +real residual, lcut, hcut +double x, z + +begin + ngoodpix = npix + lcut = -threshold + hcut = threshold + + do i = 1, npix + if (badpix[i] == BAD_PIXEL) + ngoodpix = ngoodpix - 1 + else { + residual = flat[i] + if (residual < lcut || residual > hcut) { + # Reject the pixel and its neighbors out to the growing + # radius. We must be careful how we do this to avoid + # directional effects. Do not turn off thresholding on + # pixels in the forward direction; mark them for rejection + # but do not reject until they have been thresholded. + # If this is not done growing will not be symmetric. + + do j = max(1,i-ngrow), min(npix,i+ngrow) { +#call eprintf ("\t\t%d->%d\tcheck\n");call pargi(j); call pargs(badpix[j]) + if (badpix[j] != BAD_PIXEL) { + if (j <= i) { + x = normx[j] + z = data[j] +#call eprintf ("\treject [%d:%6g]=%6g sum[xsqr,xz,z]\n") +#call pargi(j); call pargd(x); call pargd(z) +#call eprintf ("\t%10g %10g %10g\n") +#call pargd(sumxsqr); call pargd(sumxz); call pargd(sumz) + sumxsqr = sumxsqr - (x ** 2) + sumxz = sumxz - z * x + sumx = sumx - x + sumz = sumz - z +#call eprintf ("\t%10g %10g %10g\n") +#call pargd(sumxsqr); call pargd(sumxz); call pargd(sumz) + badpix[j] = BAD_PIXEL + ngoodpix = ngoodpix - 1 + } else + badpix[j] = REJECT_PIXEL +#call eprintf ("\t\t%d->%d\tset\n");call pargi(j); call pargs(badpix[j]) + } + } + } + } + + return (ngoodpix) +end diff --git a/pkg/images/tv/iis/window.cl b/pkg/images/tv/iis/window.cl new file mode 100644 index 00000000..25f00c65 --- /dev/null +++ b/pkg/images/tv/iis/window.cl @@ -0,0 +1,5 @@ +#{ WINDOW -- Adjust the lookup tables for the current frame. + +{ + _dcontrol (type="frame", window+) +} diff --git a/pkg/images/tv/iis/x_iis.x b/pkg/images/tv/iis/x_iis.x new file mode 100644 index 00000000..06813f75 --- /dev/null +++ b/pkg/images/tv/iis/x_iis.x @@ -0,0 +1,7 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# Driver for image control + +task cv = t_cv, + cvl = t_load + #giis = t_giis diff --git a/pkg/images/tv/iis/zoom.cl b/pkg/images/tv/iis/zoom.cl new file mode 100644 index 00000000..9aa48959 --- /dev/null +++ b/pkg/images/tv/iis/zoom.cl @@ -0,0 +1,11 @@ +#{ ZOOM -- Zoom in on a portion of the display. + +# zoom_factor,i,a,2,1,4,factor by which image scale is to be expanded +# window,b,h,no,,,window enlarged image + +{ + if (window) + _dcontrol (zoom=zoom_factor, roam=yes, window=yes) + else + _dcontrol (zoom=zoom_factor, roam=yes) +} diff --git a/pkg/images/tv/iis/zoom.par b/pkg/images/tv/iis/zoom.par new file mode 100644 index 00000000..849c3439 --- /dev/null +++ b/pkg/images/tv/iis/zoom.par @@ -0,0 +1,2 @@ +zoom_factor,i,a,2,1,4,factor by which image scale is to be expanded +window,b,h,no,,,window enlarged image diff --git a/pkg/images/tv/imedit.par b/pkg/images/tv/imedit.par new file mode 100644 index 00000000..f23ea1c6 --- /dev/null +++ b/pkg/images/tv/imedit.par @@ -0,0 +1,24 @@ +input,s,a,,,,Images to be edited +output,s,a,,,,Output images +cursor,*imcur,h,"",,,Cursor input +logfile,s,h,"",,,Logfile for record of cursor commands +display,b,h,yes,,,Display images? +autodisplay,b,h,yes,,,Automatic image display? +autosurface,b,h,no,,,Automatic surface plots? +aperture,s,h,"circular","|circular|square|",,Aperture type +radius,r,h,2.,,,Substitution radius +search,r,h,2.,,,Search radius +minvalue,r,h,INDEF,,,Minimum value to modify +maxvalue,r,h,INDEF,,,Maximum value to modify +buffer,r,h,1.,0.,,Background buffer width +width,r,h,2.,1.,,Background width +xorder,i,h,2,0,,Background x order +yorder,i,h,2,0,,Background y order +value,r,h,0.,,,Constant value substitution +sigma,r,h,INDEF,,,Added noise sigma +angh,r,h, -33.,,,Horizontal viewing angle (degrees) +angv,r,h,25.,,,Vertical viewing angle (degrees) +command,s,h,"display $image 1 erase=$erase fill=yes order=0 >& dev$null",,,Display command +graphics,s,h,"stdgraph",,,Graphics device +default,s,h,"b",,,Default option for x-y input +fixpix,b,h,no,,,Fixpix style input? diff --git a/pkg/images/tv/imedit/bpmedit.cl b/pkg/images/tv/imedit/bpmedit.cl new file mode 100644 index 00000000..01d5f7aa --- /dev/null +++ b/pkg/images/tv/imedit/bpmedit.cl @@ -0,0 +1,69 @@ +# BPMEDIT -- Edit BPM masks. + +procedure bpmedit (images) + +string images {prompt="List of images"} +string bpmkey = "BPM" {prompt="Keyword with mask name"} +int frame = 1 {prompt="Display frame with mask overlay"} +int refframe = 2 {prompt="Display frame without mask overlay"} +string command = "display $image $frame over=$mask erase=$erase ocol='1-10=red,green' fill-" {prompt="Display command"} +bool display = yes {prompt="Interactive display?"} +string cursor = "" {prompt="Cursor input"} + +struct *fd + +begin + int i1 + file im, bpm, temp + struct dispcmd + + set imedit_help = "tv$imedit/bpmedit.key" + + temp = mktemp ("tmp$iraf") + + sections (images, option="fullname", > temp) + + fd = temp + while (fscan (fd, im) != EOF) { + bpm = ""; hselect (im, bpmkey, yes) | scan (bpm) + if (bpm == "") { + printf ("WARNING: No %s keyword (%s)\n", bpmkey, im) + next + } + if (imaccess(bpm)==NO) { + printf ("WARNING: Can't access mask (%s)\n", bpm) + next + } + + if (display) { + # Override certain display parameters. + display.bpdisplay="none" + display.fill = no + + # Set display command. + dispcmd = command + i1 = strstr ("$image", dispcmd) + if (i1 > 0) + dispcmd = substr (dispcmd, 1, i1-1) // im // + substr (dispcmd, i1+6, 1000) + i1 = strstr ("$frame", dispcmd) + if (i1 > 0) + dispcmd = substr (dispcmd, 1, i1-1) // frame // + substr (dispcmd, i1+6, 1000) + i1 = strstr ("$mask", dispcmd) + if (i1 > 0) + dispcmd = substr (dispcmd, 1, i1-1) // "$image" // + substr (dispcmd, i1+5, 1000) + i1 = strstr (">", dispcmd) + if (i1 == 0) + dispcmd += " >& dev$null" + + display (im, refframe, over="", >& "dev$null") + imedit (bpm, "", command=dispcmd, display=display, + cursor=cursor, search=0) + } else + imedit (bpm, "", command=dispcmd, display=display, + cursor=cursor, search=0) + } + fd = ""; delete (temp, verify-) +end diff --git a/pkg/images/tv/imedit/bpmedit.key b/pkg/images/tv/imedit/bpmedit.key new file mode 100644 index 00000000..0d660732 --- /dev/null +++ b/pkg/images/tv/imedit/bpmedit.key @@ -0,0 +1,51 @@ + BPMEDIT CURSOR KEYSTROKE COMMANDS + +The following are the useful commands for BPMEDIT. Note all +the commands for IMEDIT are available but only those shown +here should be used for editing pixel masks. + + ? Print help + : Colon commands (see below) + i Initialize (start over without saving changes) + q Quit and save changes + r Redraw image display + + Increase radius by one + - Decrease radius by one + I Interrupt task immediately + Q Quit without saving changes + +The following editing options are available. Rectangular +and vector regions are specified with two positions and +aperture regions are specified by one position. The current +aperture type (circular or square) is used in the latter +case. All the following substitute the new value set for +the "value" parameter (see :value). Some replace all pixels +within the mask that have the same pixel value as the value +at the cursor position. + + d Set rectangle to "value" + e Set aperture to "value" + u Undo last change (see also 'i', 'j', and 'k') + v Set vector to "value" + = Replace pixels = to "cursor value" to "value" + < Replace pixels < or = to "cursor value" to "value" + > Replace pixels > than or = to "cursor value" to "value" + + + BPMEDIT COLON COMMANDS + +The colon either print the current value of a parameter when +there is no value or set the parameter to the specified +value. + +aperture [type] Aperture type (circular|square) +autodisplay [yes|no] Automatic image display? +command [string] Display command +display [yes|no] Display image? +eparam Edit parameters +radius [value] Aperture radius +value [value] Constant substitution value +minvalue [value] Minimum value for modification (INDEF=minimum) +maxvalue [value] Maximum value for modification (INDEF=maximum) +write [name] Write changes to name + diff --git a/pkg/images/tv/imedit/epbackground.x b/pkg/images/tv/imedit/epbackground.x new file mode 100644 index 00000000..339de946 --- /dev/null +++ b/pkg/images/tv/imedit/epbackground.x @@ -0,0 +1,71 @@ +include "epix.h" + +# EP_BACKGROUND -- Replace aperture by background values. +# The aperture is first centered. The background is determined from a +# annulus buffered from the aperture and of a specified width. The +# background is obtained by fitting a surface. Noise may be added +# using a gaussian or by histogram sampling. + +procedure ep_background (ep, ap, xa, ya, xb, yb) + +pointer ep # EPIX structure +int ap # Aperture type +int xa, ya, xb, yb # Aperture coordinates + +int i, x1, x2, y1, y2 +pointer mask, x, y, w, gs + +begin + i = max (5., + abs (EP_SEARCH(ep)) + EP_BUFFER(ep) + EP_WIDTH(ep) + 1) + x1 = min (xa, xb) - i + x2 = max (xa, xb) + i + y1 = min (ya, yb) - i + y2 = max (ya, yb) + i + call ep_gdata (ep, x1, x2, y1, y2) + if (EP_OUTDATA(ep) != NULL) { + call malloc (mask, EP_NPTS(ep), TY_INT) + call malloc (x, EP_NPTS(ep), TY_REAL) + call malloc (y, EP_NPTS(ep), TY_REAL) + call malloc (w, EP_NPTS(ep), TY_REAL) + + call ep_search (ep, Memr[EP_OUTDATA(ep)], EP_NX(ep), EP_NY(ep), + ap, xa, ya, xb, yb) + call ep_mask (ep, mask, ap, xa, ya, xb, yb) + call ep_gsfit (ep, Memr[EP_OUTDATA(ep)], Memi[mask], Memr[x], + Memr[y], Memr[w], EP_NX(ep), EP_NY(ep), gs) + call ep_bg (Memr[EP_OUTDATA(ep)], Memi[mask], + Memr[x], Memr[y], EP_NPTS(ep), gs) + call ep_noise (EP_SIGMA(ep), Memr[EP_OUTDATA(ep)], + Memi[mask], Memr[x], Memr[y], EP_NPTS(ep), gs) + + call mfree (mask, TY_INT) + call mfree (x, TY_REAL) + call mfree (y, TY_REAL) + call mfree (w, TY_REAL) + call gsfree (gs) + } +end + + +# EP_BG -- Replace aperture pixels by the background surface fit values. + +procedure ep_bg (data, mask, x, y, npts, gs) + +real data[npts] # Data subraster +int mask[npts] # Mask subraster +real x[npts], y[npts] # Coordinates +int npts # Number of points +pointer gs # Surface pointer + +int i +real gseval() + +begin + if (gs == NULL) + return + + do i = 1, npts + if (mask[i] == 1) + data[i] = gseval (gs, x[i], y[i]) +end diff --git a/pkg/images/tv/imedit/epcol.x b/pkg/images/tv/imedit/epcol.x new file mode 100644 index 00000000..e71d5e47 --- /dev/null +++ b/pkg/images/tv/imedit/epcol.x @@ -0,0 +1,80 @@ +include "epix.h" + +# EP_COL -- Replace aperture by column interpolation from background annulus. +# The aperture is first centered. The interpolation is across columns +# from the nearest pixel in the background annulus. Gaussian Noise may +# be added. + +procedure ep_col (ep, ap, xa, ya, xb, yb) + +pointer ep # EPIX pointer +int ap # Aperture type +int xa, ya, xb, yb # Aperture coordinates + +int i, x1, x2, y1, y2 +pointer mask, gs + +begin + i = abs (EP_SEARCH(ep)) + EP_BUFFER(ep) + 1 + x1 = min (xa, xb) - i + x2 = max (xa, xb) + i + y1 = min (ya, yb) + y2 = max (ya, yb) + call ep_gdata (ep, x1, x2, y1, y2) + if (EP_OUTDATA(ep) != NULL) { + call malloc (mask, EP_NPTS(ep), TY_INT) + + call ep_search (ep, Memr[EP_OUTDATA(ep)], EP_NX(ep), + EP_NY(ep), ap, xa, ya, xb, yb) + call ep_mask (ep, mask, ap, xa, ya, xb, yb) + call ep_col1 (Memr[EP_OUTDATA(ep)], Memi[mask], EP_NX(ep), + EP_NY(ep)) + if (!IS_INDEF (EP_SIGMA(ep))) + call ep_noise (EP_SIGMA(ep), Memr[EP_OUTDATA(ep)], + Memi[mask], Memr[EP_OUTDATA(ep)], Memr[EP_OUTDATA(ep)], + EP_NPTS(ep), gs) + + call mfree (mask, TY_INT) + } +end + + +# EP_COL1 -- Do column interpolation. + +procedure ep_col1 (data, mask, nx, ny) + +real data[nx,ny] # Data subraster +int mask[nx,ny] # Mask subraster +int nx, ny # Number of points + +int i, j, xa, xb, xc, xd +real a, b + +begin + do i = 1, ny { + for (xa=1; xa<=nx && mask[xa,i]!=1; xa=xa+1) + ; + if (xa > nx) + next + for (xb=nx; xb>xa && mask[xb,i]!=1; xb=xb-1) + ; + for (xc=xa; xc>=1 && mask[xc,i]!=2; xc=xc-1) + ; + for (xd=xb; xd<=nx && mask[xd,i]!=2; xd=xd+1) + ; + if (xc < 1 && xd > nx) + next + else if (xc < 1) + do j = xa, xb + data[j,i] = data[xd,i] + else if (xd > nx) + do j = xa, xb + data[j,i] = data[xc,i] + else { + a = data[xc,i] + b = (data[xd,i] - a) / (xd - xc) + do j = xa, xb + data[j,i] = a + b * (j - xc) + } + } +end diff --git a/pkg/images/tv/imedit/epcolon.x b/pkg/images/tv/imedit/epcolon.x new file mode 100644 index 00000000..51765889 --- /dev/null +++ b/pkg/images/tv/imedit/epcolon.x @@ -0,0 +1,335 @@ +include "epix.h" + +# List of colon commands. +define CMDS "|angh|angv|aperture|autodisplay|autosurface|buffer|command|\ + |display|eparam|graphics|input|output|radius|search|sigma|\ + |value|minvalue|maxvalue|width|write|xorder|yorder|" + +define ANGH 1 # Horizontal viewing angle +define ANGV 2 # Vertical viewing angle +define APERTURE 3 # Aperture type +define AUTODISPLAY 4 # Automatic display? +define AUTOSURFACE 5 # Automatic surface graph? +define BUFFER 6 # Background buffer width +define COMMAND 7 # Display command +define DISPLAY 9 # Display image? +define EPARAM 10 # Eparam +define GRAPHICS 11 # Graphics device +define INPUT 12 # Input image +define OUTPUT 13 # Output image +define RADIUS 14 # Aperture radius +define SEARCH 15 # Search radius +define SIGMA 16 # Noise sigma +define VALUE 18 # Constant substitution value +define MINVALUE 19 # Minimum value for replacement +define MAXVALUE 20 # Maximum value for replacement +define WIDTH 21 # Background width +define WRITE 22 # Write output +define XORDER 23 # X order +define YORDER 24 # Y order + +# EP_COLON -- Respond to colon commands. +# The changed parameters are written to the parameter file and +# to the optional log file. + +procedure ep_colon (ep, cmdstr, newimage) + +pointer ep # EPIX structure +char cmdstr[ARB] # Colon command +int newimage # New image? + +int ival, ncmd +real rval +bool bval +pointer sp, cmd + +bool strne() +int nscan(), strdic(), btoi(), imaccess() +pointer immap() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Scan the command string and get the first word. + call sscan (cmdstr) + call gargwrd (Memc[cmd], SZ_LINE) + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS) + + switch (ncmd) { + case ANGH: + call gargr (rval) + if (nscan() == 1) { + call printf ("angh %g\n") + call pargr (EP_ANGH(ep)) + } else { + EP_ANGH(ep) = rval + call clputr ("angh", EP_ANGH(ep)) + } + case ANGV: + call gargr (rval) + if (nscan() == 1) { + call printf ("angv %g\n") + call pargr (EP_ANGV(ep)) + } else { + EP_ANGV(ep) = rval + call clputr ("angv", EP_ANGV(ep)) + } + case APERTURE: + call gargwrd (Memc[cmd], SZ_FNAME) + if (nscan() == 1) { + call printf ("aperture %s\n") + switch (EP_APERTURE(ep)) { + case APCIRCULAR: + call pargstr ("circular") + case APSQUARE: + call pargstr ("square") + } + } else { + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, APTYPES) + if (ncmd > 0) { + EP_APERTURE(ep) = ncmd + call clpstr ("aperture", Memc[cmd]) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":aperture %s\n") + call pargstr (Memc[cmd]) + } + } else + call printf ("Unknown aperture type\n") + } + case AUTODISPLAY: + call gargb (bval) + if (nscan() == 1) { + if (EP_AUTODISPLAY(ep) == YES) + call printf ("autodisplay yes\n") + else + call printf ("autodisplay no\n") + } else { + EP_AUTODISPLAY(ep) = btoi (bval) + call clputb ("autodisplay", bval) + } + case AUTOSURFACE: + call gargb (bval) + if (nscan() == 1) { + if (EP_AUTOSURFACE(ep) == YES) + call printf ("autosurface yes\n") + else + call printf ("autosurface no\n") + } else { + EP_AUTOSURFACE(ep) = btoi (bval) + call clputb ("autosurface", bval) + } + case BUFFER: + call gargr (rval) + if (nscan() == 1) { + call printf ("buffer %g\n") + call pargr (EP_BUFFER(ep)) + } else { + EP_BUFFER(ep) = rval + call clputr ("buffer", EP_BUFFER(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":buffer %g\n") + call pargr (EP_BUFFER(ep)) + } + } + case COMMAND: + call gargwrd (Memc[cmd], SZ_FNAME) + if (nscan() == 1) { + call printf ("command %s\n") + call pargstr (EP_COMMAND(ep)) + } else { + call strcpy (Memc[cmd], EP_COMMAND(ep), EP_SZLINE) + call gargstr (Memc[cmd], SZ_FNAME) + call strcat (Memc[cmd], EP_COMMAND(ep), EP_SZFNAME) + call clpstr ("command", EP_COMMAND(ep)) + } + case DISPLAY: + call gargb (bval) + if (nscan() == 1) { + if (EP_DISPLAY(ep) == YES) + call printf ("display yes\n") + else + call printf ("display no\n") + } else { + EP_DISPLAY(ep) = btoi (bval) + call clputb ("display", bval) + } + case EPARAM: + call clcmdw ("eparam imedit") + call ep_setpars (ep) + case GRAPHICS: + call gargwrd (Memc[cmd], SZ_FNAME) + if (nscan() == 1) { + call printf ("graphics %s\n") + call pargstr (EP_GRAPHICS(ep)) + } else { + call strcpy (Memc[cmd], EP_GRAPHICS(ep), EP_SZFNAME) + call clpstr ("graphics", EP_GRAPHICS(ep)) + } + case INPUT: + call gargwrd (Memc[cmd], SZ_FNAME) + if (nscan() == 1) { + call printf ("input %s\n") + call pargstr (EP_INPUT(ep)) + } else if (strne (Memc[cmd], EP_INPUT(ep))) { + call strcpy (Memc[cmd], EP_INPUT(ep), SZ_LINE) + newimage = YES + } + case OUTPUT: + call gargwrd (Memc[cmd], SZ_FNAME) + if (nscan() == 1) { + call printf ("output %s\n") + call pargstr (EP_OUTPUT(ep)) + } else if (strne (Memc[cmd], EP_INPUT(ep))) { + if (imaccess (Memc[cmd], READ_ONLY) == YES) { + call eprintf ("%s: Output image %s exists\n") + call pargstr (EP_INPUT(ep)) + call pargstr (Memc[cmd]) + } else + call strcpy (Memc[cmd], EP_OUTPUT(ep), EP_SZFNAME) + } + case RADIUS: + call gargr (rval) + if (nscan() == 1) { + call printf ("radius %g\n") + call pargr (EP_RADIUS(ep)) + } else { + EP_RADIUS(ep) = rval + call clputr ("radius", EP_RADIUS(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":radius %g\n") + call pargr (EP_RADIUS(ep)) + } + } + case SEARCH: + call gargr (rval) + if (nscan() == 1) { + call printf ("search %g\n") + call pargr (EP_SEARCH(ep)) + } else { + EP_SEARCH(ep) = rval + call clputr ("search", EP_SEARCH(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":search %g\n") + call pargr (EP_SEARCH(ep)) + } + } + case SIGMA: + call gargr (rval) + if (nscan() == 1) { + call printf ("sigma %g\n") + call pargr (EP_SIGMA(ep)) + } else { + EP_SIGMA(ep) = rval + call clputr ("sigma", EP_SIGMA(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":sigma %g\n") + call pargr (EP_SIGMA(ep)) + } + } + case VALUE: + call gargr (rval) + if (nscan() == 1) { + call printf ("value %g\n") + call pargr (EP_VALUE(ep)) + } else { + EP_VALUE(ep) = rval + call clputr ("value", EP_VALUE(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":value %g\n") + call pargr (EP_VALUE(ep)) + } + } + case MINVALUE: + call gargr (rval) + if (nscan() == 1) { + call printf ("minvalue %g\n") + call pargr (EP_MINVALUE(ep)) + } else { + EP_MINVALUE(ep) = rval + call clputr ("minvalue", EP_MINVALUE(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":minvalue %g\n") + call pargr (EP_MINVALUE(ep)) + } + } + case MAXVALUE: + call gargr (rval) + if (nscan() == 1) { + call printf ("maxvalue %g\n") + call pargr (EP_MAXVALUE(ep)) + } else { + EP_MAXVALUE(ep) = rval + call clputr ("maxvalue", EP_MAXVALUE(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":maxvalue %g\n") + call pargr (EP_MAXVALUE(ep)) + } + } + case WIDTH: + call gargr (rval) + if (nscan() == 1 || rval < 1.) { + call printf ("width %g\n") + call pargr (EP_WIDTH(ep)) + } else { + EP_WIDTH(ep) = max (1., rval) + call clputr ("width", EP_WIDTH(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":width %g\n") + call pargr (EP_WIDTH(ep)) + } + } + case WRITE: + call gargwrd (Memc[cmd], SZ_FNAME) + ival = YES + if (nscan() == 1) + call strcpy (EP_OUTPUT(ep), Memc[cmd], SZ_FNAME) + else if (strne (Memc[cmd], EP_INPUT(ep))) { + if (imaccess (Memc[cmd], READ_ONLY) == YES) { + call eprintf ("Image %s exists\n") + call pargstr (Memc[cmd]) + ival = NO + } + } + + if (ival == YES) { + call printf ("output %s\n") + call pargstr (Memc[cmd]) + if (imaccess (Memc[cmd], READ_ONLY) == YES) + call imdelete (Memc[cmd]) + call imunmap (EP_IM(ep)) + call ep_imcopy (EP_WORK(ep), Memc[cmd]) + EP_IM(ep) = immap (EP_WORK(ep), READ_WRITE, 0) + } + case XORDER: + call gargi (ival) + if (nscan() == 1) { + call printf ("xorder %d\n") + call pargi (EP_XORDER(ep)) + } else { + EP_XORDER(ep) = max (0, ival) + call clputi ("xorder", EP_XORDER(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":xorder %d\n") + call pargi (EP_XORDER(ep)) + } + } + case YORDER: + call gargi (ival) + if (nscan() == 1) { + call printf ("yorder %d\n") + call pargi (EP_YORDER(ep)) + } else { + EP_YORDER(ep) = max (0, ival) + call clputi ("yorder", EP_YORDER(ep)) + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), ":yorder %d\n") + call pargi (EP_YORDER(ep)) + } + } + default: + call printf ("Unrecognized or ambiguous command\007") + } + + call sfree (sp) +end diff --git a/pkg/images/tv/imedit/epconstant.x b/pkg/images/tv/imedit/epconstant.x new file mode 100644 index 00000000..0a168a19 --- /dev/null +++ b/pkg/images/tv/imedit/epconstant.x @@ -0,0 +1,51 @@ +include "epix.h" + +# EP_CONSTANT -- Replace aperture by constant value. +# The aperture is first centered. + +procedure ep_constant (ep, ap, xa, ya, xb, yb) + +pointer ep # EPIX pointer +int ap # Aperture type +int xa, ya, xb, yb # Aperture coordinates + +int i, x1, x2, y1, y2 +pointer mask + +begin + i = max (5., abs (EP_SEARCH(ep)) + 1) + x1 = min (xa, xb) - i + x2 = max (xa, xb) + i + y1 = min (ya, yb) - i + y2 = max (ya, yb) + i + call ep_gdata (ep, x1, x2, y1, y2) + if (EP_OUTDATA(ep) != NULL) { + call malloc (mask, EP_NPTS(ep), TY_INT) + + call ep_search (ep, Memr[EP_OUTDATA(ep)], EP_NX(ep), + EP_NY(ep), ap, xa, ya, xb, yb) + call ep_mask (ep, mask, ap, xa, ya, xb, yb) + call ep_constant1 (Memr[EP_OUTDATA(ep)], Memi[mask], EP_NPTS(ep), + EP_VALUE(ep)) + + call mfree (mask, TY_INT) + } +end + + +# EP_CONSTANT1 -- Replace aperture by constant value. + +procedure ep_constant1 (data, mask, npts, value) + +real data[npts] # Data subraster +int mask[npts] # Mask subraster +int npts # Number of points +real value # Substitution value + +int i + +begin + do i = 1, npts + if (mask[i] == 1) + data[i] = value +end diff --git a/pkg/images/tv/imedit/epdisplay.x b/pkg/images/tv/imedit/epdisplay.x new file mode 100644 index 00000000..1b76e5b1 --- /dev/null +++ b/pkg/images/tv/imedit/epdisplay.x @@ -0,0 +1,196 @@ +include <imhdr.h> +include "epix.h" + +# EP_DISPLAY -- Display an image using the specified command. +# This is a temporary image display interface using CLCMDW to call +# the standard display task. Image sections and the fill option +# can be used to simulate zoom. One complication is that we have to +# close the image to avoid multiple access to the image. This +# requires saving the original input subraster to allow undoing +# a change after display. + +procedure ep_display (ep, image, erase) + +pointer ep # EPIX structure +char image[ARB] # Image +bool erase # Erase + +pointer temp, immap(), imgs2r(), imps2r() + +begin + # If the output has been modified save and restore the original + # input subraster for later undoing. + + if (EP_OUTDATA(ep) != NULL) { + call malloc (temp, EP_NPTS(ep), TY_REAL) + call amovr (Memr[EP_INDATA(ep)], Memr[temp], EP_NPTS(ep)) + call imunmap (EP_IM(ep)) + call ep_command (ep, image, erase) + erase = false + EP_IM(ep) = immap (image, READ_WRITE, 0) + EP_OUTDATA(ep) = imps2r (EP_IM(ep), EP_X1(ep), + EP_X2(ep), EP_Y1(ep), EP_Y2(ep)) + EP_INDATA(ep) = imgs2r (EP_IM(ep), EP_X1(ep), + EP_X2(ep), EP_Y1(ep), EP_Y2(ep)) + call amovr (Memr[EP_INDATA(ep)], Memr[EP_OUTDATA(ep)], + EP_NPTS(ep)) + call amovr (Memr[temp], Memr[EP_INDATA(ep)], EP_NPTS(ep)) + call mfree (temp, TY_REAL) + } else { + call imunmap (EP_IM(ep)) + call ep_command (ep, image, erase) + erase = false + EP_IM(ep) = immap (image, READ_WRITE, 0) + } +end + + +define PARAMS "|$image|$erase|" +define IMAGE 1 +define ERASE 2 + +# EP_COMMAND -- Format a command with argument substitution. This +# technique allows use of some other display command (such as CONTOUR). + +procedure ep_command (ep, image, erase) + +pointer ep # EPIX structure +char image[ARB] # Image name +bool erase # Erase? + +int i, j, k, nscan(), strdic(), stridxs() +pointer sp, cmd, word + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (word, SZ_LINE, TY_CHAR) + + call sscan (EP_COMMAND(ep)) + + Memc[cmd] = EOS + do i = 1, 100 { + call gargwrd (Memc[word], SZ_LINE) + if (nscan() != i) + break + j = stridxs ("$", Memc[word]) - 1 + if (j >= 0) { + k = strdic (Memc[word+j], Memc[word+j], SZ_LINE, PARAMS) + switch (k) { + case IMAGE: + call sprintf (Memc[word+j], SZ_LINE-j, "%s%s") + call pargstr (image) + call pargstr (EP_SECTION(ep)) + case ERASE: + call sprintf (Memc[word+j], SZ_LINE-j, "%b") + call pargb (erase) + } + } + call strcat (Memc[word], Memc[cmd], SZ_LINE) + call strcat (" ", Memc[cmd], SZ_LINE) + } + + if (i > 1) { + call clcmdw (Memc[cmd]) + erase = false + } + + call sfree (sp) +end + + +# EP_ZOOM -- Set an image section centered on the cursor for possible zooming. +# Zoom is simulated by loading a subraster of the image. If the image display +# supports fill the frame this will give the effect of a zoom. + +procedure ep_zoom (ep, xa, ya, xb, yb, key, erase) + +pointer ep # EPIX structure +int xa, ya # Cursor +int xb, yb # Cursor +int key # Cursor key +bool erase # Erase? + +real zoom +int nc, nl, nx, ny, zx, zy, x1, x2, y1, y2 +data zoom/1./ + +begin + erase = true + + switch (key) { + case '0': + zoom = 1. + case 'E': + nc = IM_LEN(EP_IM(ep),1) + nl = IM_LEN(EP_IM(ep),2) + nx = abs (xa - xb) + 1 + ny = abs (ya - yb) + 1 + zoom = max (1., min (nc / real (nx), nl / real (ny))) + zx = (xa + xb) / 2. + zy = (ya + yb) / 2. + case 'P': + zoom = max (1., zoom / 2) + zx = xa + zy = ya + case 'Z': + zoom = 2 * zoom + zx = xa + zy = ya + } + + if (zoom == 1.) { + EP_SECTION(ep) = EOS + return + } + + nc = IM_LEN(EP_IM(ep),1) + nl = IM_LEN(EP_IM(ep),2) + nx = nc / zoom + ny = nl / zoom + + switch (key) { + case '1': + zx = zx + .4 * nx + zy = zy + .4 * ny + case '2': + zy = zy + .4 * ny + case '3': + zx = zx - .4 * nx + zy = zy + .4 * ny + case '4': + zx = zx + .4 * nx + case '5', 'r', 'R': + erase = false + case '6': + zx = zx - .4 * nx + case '7': + zx = zx + .4 * nx + zy = zy - .4 * ny + case '8': + zy = zy - .4 * ny + case '9': + zx = zx - .4 * nx + zy = zy - .4 * ny + } + + # Insure the section is in bounds. + x1 = max (1, zx - nx / 2) + x2 = min (nc, x1 + nx) + x1 = max (1, x2 - nx) + y1 = max (1, zy - ny / 2) + y2 = min (nl, y1 + ny) + y1 = max (1, y2 - ny) + + zx = (x1 + x2) / 2 + zy = (y1 + y2) / 2 + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + + # Format the image section. + call sprintf (EP_SECTION(ep), EP_SZFNAME, "[%d:%d,%d:%d]") + call pargi (x1) + call pargi (x2) + call pargi (y1) + call pargi (y2) +end diff --git a/pkg/images/tv/imedit/epdosurface.x b/pkg/images/tv/imedit/epdosurface.x new file mode 100644 index 00000000..70866bb1 --- /dev/null +++ b/pkg/images/tv/imedit/epdosurface.x @@ -0,0 +1,35 @@ +include "epix.h" + +# EP_DOSURFACE -- Display surface plots. +# There are two modes. If there is no output subraster then just +# display the input subraster otherwise display both. The orientation +# is given by the user. + +procedure ep_dosurface (ep) + +pointer ep # EPIX structure +pointer gp, gopen() + +begin + if (EP_INDATA(ep) == NULL && EP_OUTDATA(ep) == NULL) { + call eprintf ("No region defined\n") + return + } + + gp = gopen (EP_GRAPHICS(ep), NEW_FILE, STDGRAPH) + + if (EP_OUTDATA(ep) == NULL) { + call gsview (gp, 0.03, 0.98, 0.03, 0.98) + call ep_surface (gp, Memr[EP_INDATA(ep)], EP_NX(ep), EP_NY(ep), + EP_ANGH(ep), EP_ANGV(ep)) + } else { + call gsview (gp, 0.03, 0.48, 0.03, 0.98) + call ep_surface (gp, Memr[EP_INDATA(ep)], EP_NX(ep), EP_NY(ep), + EP_ANGH(ep), EP_ANGV(ep)) + call gsview (gp, 0.53, 0.98, 0.03, 0.98) + call ep_surface (gp, Memr[EP_OUTDATA(ep)], EP_NX(ep),EP_NY(ep), + EP_ANGH(ep), EP_ANGV(ep)) + } + + call gclose (gp) +end diff --git a/pkg/images/tv/imedit/epgcur.x b/pkg/images/tv/imedit/epgcur.x new file mode 100644 index 00000000..5e424a65 --- /dev/null +++ b/pkg/images/tv/imedit/epgcur.x @@ -0,0 +1,127 @@ +include "epix.h" + +# EP_GCUR -- Get EPIX cursor value. +# This is an interface between the standard cursor input and EPIX. It +# returns an aperture consisting of an aperture type and the two integer +# pixel corners containing the aperture. This interface also provides +# for interpreting the FIXPIX type files. A default key may be +# supplied which allows simple X-Y files to be read. + +int procedure ep_gcur (ep, ap, x1, y1, x2, y2, key, strval, maxch) + +pointer ep # EPIX structure +int ap # Aperture type +int x1, y1, x2, y2 # Corners of aperture +int key # Keystroke value of cursor event +char strval[ARB] # String value, if any +int maxch + +real a, b, c, d, e +pointer sp, buf, ip +int nitems, wcs +int ctor(), clglstr(), clgcur() + +begin + # FIXPIX format consists of a rectangle with column and line ranges. + # The key returned is for interpolation across the narrow dimension + # of the rectangle. + + if (EP_FIXPIX(ep) == YES) { + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + # Read the list structured string. + if (clglstr ("cursor", Memc[buf], SZ_LINE) == EOF) { + call sfree (sp) + return (EOF) + } + + ip = buf + nitems = 0 + if (ctor (Memc, ip, a) > 0) + nitems = nitems + 1 + if (ctor (Memc, ip, b) > 0) + nitems = nitems + 1 + if (ctor (Memc, ip, c) > 0) + nitems = nitems + 1 + if (ctor (Memc, ip, d) > 0) + nitems = nitems + 1 + + e = max (a, b) + a = min (a, b) + b = e + e = max (c, d) + c = min (c, d) + d = e + x1 = nint(a) + y1 = nint(c) + x2 = nint(b) + y2 = nint(d) + ap = APRECTANGLE + if (x2 - x1 <= y2 - y1) + key = 'c' + else + key = 'l' + + call sfree (sp) + return (nitems) + } + + # The standard cursor value is read for centered apertures and + # for two values are read for rectangular apertures. The + # returned coordinates are properly defined. + + key = EP_DEFAULT(ep) + strval[1] = EOS + nitems = clgcur ("cursor", a, b, wcs, key, strval, maxch) + switch (key) { + case 'a', 'c', 'd', 'l', 'f', 'j', 'v': + call printf ("again:") + nitems = clgcur ("cursor", c, d, wcs, key, strval, SZ_LINE) + call printf ("\n") + if (!IS_INDEF(a)) + x1 = nint (a) + if (!IS_INDEF(b)) + y1 = nint (b) + if (!IS_INDEF(c)) + x2 = nint (c) + if (!IS_INDEF(d)) + y2 = nint (d) + if (key == 'f' || key == 'v') { + if (abs (x2-x1) > abs (y2-y1)) + ap = APLDIAG + else + ap = APCDIAG + } else + ap = APRECTANGLE + case 'b', 'e', 'k', 'm', 'n', 'p', 's', ' ': + if (!IS_INDEF(a)) { + x1 = nint (a - EP_RADIUS(ep)) + x2 = nint (a + EP_RADIUS(ep)) + } + if (!IS_INDEF(b)) { + y1 = nint (b - EP_RADIUS(ep)) + y2 = nint (b + EP_RADIUS(ep)) + } + ap = EP_APERTURE(ep) + case 'E': + call printf ("again:") + nitems = clgcur ("cursor", c, d, wcs, key, strval, SZ_LINE) + call printf ("\n") + if (!IS_INDEF(a)) + x1 = nint (a) + if (!IS_INDEF(b)) + y1 = nint (b) + if (!IS_INDEF(c)) + x2 = nint (c) + if (!IS_INDEF(d)) + y2 = nint (d) + default: + if (!IS_INDEF(a)) + x1 = nint (a) + if (!IS_INDEF(b)) + y1 = nint (b) + } + + return (nitems) +end diff --git a/pkg/images/tv/imedit/epgdata.x b/pkg/images/tv/imedit/epgdata.x new file mode 100644 index 00000000..163d7478 --- /dev/null +++ b/pkg/images/tv/imedit/epgdata.x @@ -0,0 +1,70 @@ +include <imhdr.h> +include "epix.h" + +# EP_GDATA -- Get input and output image subrasters with boundary checking. +# Null pointer are returned if entirely out of bounds. + +procedure ep_gdata (ep, x1, x2, y1, y2) + +pointer ep # EPIX pointer +int x1, x2, y1, y2 # Subraster limits + +int nc, nl +pointer im, imgs2r(), imps2r() + +begin + im = EP_IM(ep) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + if (x2 < 1 || x1 >= nc || y2 < 1 || y1 >= nl) { + call eprintf ("Pixel out of bounds\n") + EP_INDATA(ep) = NULL + EP_OUTDATA(ep) = NULL + return + } + + EP_X1(ep) = max (1, x1) + EP_X2(ep) = min (nc, x2) + EP_Y1(ep) = max (1, y1) + EP_Y2(ep) = min (nl, y2) + EP_NX(ep) = EP_X2(ep) - EP_X1(ep) + 1 + EP_NY(ep) = EP_Y2(ep) - EP_Y1(ep) + 1 + EP_NPTS(ep) = EP_NX(ep) * EP_NY(ep) + EP_OUTDATA(ep) = imps2r (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), EP_Y2(ep)) + EP_INDATA(ep) = imgs2r (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), EP_Y2(ep)) + call amovr (Memr[EP_INDATA(ep)], Memr[EP_OUTDATA(ep)], EP_NPTS(ep)) +end + + +# EP_GINDATA -- Get input image data only with boundary checking. +# A null pointer is returned if entirely out of bounds. + +procedure ep_gindata (ep, x1, x2, y1, y2) + +pointer ep # EPIX pointer +int x1, x2, y1, y2 # Subraster limits + +int nc, nl +pointer im, imgs2r() + +begin + im = EP_IM(ep) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + if (x2 < 1 || x1 >= nc || y2 < 1 || y1 >= nl) { + call eprintf ("Pixel out of bounds\n") + EP_INDATA(ep) = NULL + return + } + + EP_X1(ep) = max (1, x1) + EP_X2(ep) = min (nc, x2) + EP_Y1(ep) = max (1, y1) + EP_Y2(ep) = min (nl, y2) + EP_NX(ep) = EP_X2(ep) - EP_X1(ep) + 1 + EP_NY(ep) = EP_Y2(ep) - EP_Y1(ep) + 1 + EP_NPTS(ep) = EP_NX(ep) * EP_NY(ep) + EP_INDATA(ep) = imgs2r (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), EP_Y2(ep)) +end diff --git a/pkg/images/tv/imedit/epgsfit.x b/pkg/images/tv/imedit/epgsfit.x new file mode 100644 index 00000000..976af322 --- /dev/null +++ b/pkg/images/tv/imedit/epgsfit.x @@ -0,0 +1,74 @@ +include <math/gsurfit.h> +include "epix.h" + +# EP_GSFIT -- Fit the background annulus. + +procedure ep_gsfit (ep, data, mask, x, y, w, nx, ny, gs) + +pointer ep # EPIX structure +real data[nx,ny] # Data subraster +int mask[nx,ny] # Mask subraster +real x[nx,ny] # X positions +real y[nx,ny] # Y positions +real w[nx,ny] # Weights +int nx, ny # Subraster size +pointer gs # Surface pointer (returned) + +int i, j, n, npts, xo, yo +pointer sp, work +real amedr() + +begin + call smark (sp) + call salloc (work, nx * ny, TY_REAL) + + gs = NULL + npts = nx * ny + + if (EP_XORDER(ep) == 0 || EP_YORDER(ep) == 0) { + n = 0 + do j = 1, ny { + do i = 1, nx { + if (mask[i,j] == 2) { + Memr[work+n] = data[i,j] + n = n + 1 + } + } + } + call amovkr (amedr (Memr[work], n), Memr[work], npts) + xo = 1 + yo = 1 + } else { + call amovr (data, Memr[work], npts) + xo = EP_XORDER(ep) + yo = EP_YORDER(ep) + } + + n = 0 + do j = 1, ny { + do i = 1, nx { + x[i,j] = i + y[i,j] = j + if (mask[i,j] == 2) { + w[i,j] = 1. + n = n + 1 + } else + w[i,j] = 0. + } + } + + if (n > 7) { + repeat { + call gsinit (gs, GS_POLYNOMIAL, xo, yo, YES, + 1., real (nx), 1., real (ny)) + call gsfit (gs, x, y, Memr[work], w, npts, WTS_USER, n) + if (n == OK) + break + xo = max (1, xo - 1) + yo = max (1, yo - 1) + } + } else + call eprintf ("ERROR: Insufficient background points\n") + + call sfree (sp) +end diff --git a/pkg/images/tv/imedit/epimcopy.x b/pkg/images/tv/imedit/epimcopy.x new file mode 100644 index 00000000..cb0094eb --- /dev/null +++ b/pkg/images/tv/imedit/epimcopy.x @@ -0,0 +1,72 @@ +include <imhdr.h> + +# EP_IMCOPY -- Copy an image. Use sequential routines to permit copying +# images of any dimension. Perform pixel i/o in the datatype of the image, +# to avoid unnecessary type conversion. + +procedure ep_imcopy (image1, image2) + +char image1[ARB] # Input image +char image2[ARB] # Output image + +int npix, junk +pointer buf1, buf2, im1, im2 +long v1[IM_MAXDIM], v2[IM_MAXDIM] + +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx() +int impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() +pointer immap() +errchk immap +errchk imgnls, imgnli, imgnll, imgnlr, imgnld, imgnlx +errchk impnls, impnli, impnll, impnlr, impnld, impnlx + +begin + # Map images. + im1 = immap (image1, READ_ONLY, 0) + im2 = immap (image2, NEW_COPY, im1) + + # Setup start vector for sequential reads and writes. + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + + # Copy the image. + npix = IM_LEN(im1, 1) + switch (IM_PIXTYPE(im1)) { + case TY_SHORT: + while (imgnls (im1, buf1, v1) != EOF) { + junk = impnls (im2, buf2, v2) + call amovs (Mems[buf1], Mems[buf2], npix) + } + case TY_USHORT, TY_INT: + while (imgnli (im1, buf1, v1) != EOF) { + junk = impnli (im2, buf2, v2) + call amovi (Memi[buf1], Memi[buf2], npix) + } + case TY_LONG: + while (imgnll (im1, buf1, v1) != EOF) { + junk = impnll (im2, buf2, v2) + call amovl (Meml[buf1], Meml[buf2], npix) + } + case TY_REAL: + while (imgnlr (im1, buf1, v1) != EOF) { + junk = impnlr (im2, buf2, v2) + call amovr (Memr[buf1], Memr[buf2], npix) + } + case TY_DOUBLE: + while (imgnld (im1, buf1, v1) != EOF) { + junk = impnld (im2, buf2, v2) + call amovd (Memd[buf1], Memd[buf2], npix) + } + case TY_COMPLEX: + while (imgnlx (im1, buf1, v1) != EOF) { + junk = impnlx (im2, buf2, v2) + call amovx (Memx[buf1], Memx[buf2], npix) + } + default: + call error (1, "unknown pixel datatype") + } + + # Unmap the images. + call imunmap (im2) + call imunmap (im1) +end diff --git a/pkg/images/tv/imedit/epinput.x b/pkg/images/tv/imedit/epinput.x new file mode 100644 index 00000000..8b8e9c4d --- /dev/null +++ b/pkg/images/tv/imedit/epinput.x @@ -0,0 +1,55 @@ +include "epix.h" + +# EP_INPUT -- Replace aperture by data from original input image. +# The aperture is first centered. + +procedure ep_input (ep, ap, xa, ya, xb, yb) + +pointer ep # EPIX pointer +int ap # Aperture type +int xa, ya, xb, yb # Aperture coordinates + +int i, x1, x2, y1, y2 +pointer mask, indata, im, immap(), imgs2r() + +begin + i = max (5., abs (EP_SEARCH(ep)) + 1) + x1 = min (xa, xb) - i + x2 = max (xa, xb) + i + y1 = min (ya, yb) - i + y2 = max (ya, yb) + i + call ep_gdata (ep, x1, x2, y1, y2) + if (EP_OUTDATA(ep) != NULL) { + call malloc (mask, EP_NPTS(ep), TY_INT) + + call ep_search (ep, Memr[EP_OUTDATA(ep)], EP_NX(ep), + EP_NY(ep), ap, xa, ya, xb, yb) + call ep_mask (ep, mask, ap, xa, ya, xb, yb) + + im = immap (EP_INPUT(ep), READ_ONLY, 0) + indata = imgs2r (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), EP_Y2(ep)) + call ep_input1 (Memr[indata], Memi[mask], Memr[EP_OUTDATA(ep)], + EP_NPTS(ep)) + call imunmap (im) + + call mfree (mask, TY_INT) + } +end + + +# EP_INPUT1 -- Replace aperture by input data. + +procedure ep_input1 (indata, mask, outdata, npts) + +real indata[npts] # Data subraster +int mask[npts] # Mask subraster +real outdata[npts] # Input buffer data +int npts # Number of points + +int i + +begin + do i = 1, npts + if (mask[i] == 1) + outdata[i] = indata[i] +end diff --git a/pkg/images/tv/imedit/epix.h b/pkg/images/tv/imedit/epix.h new file mode 100644 index 00000000..d794ac8b --- /dev/null +++ b/pkg/images/tv/imedit/epix.h @@ -0,0 +1,50 @@ +# Parameter data structure + +define EP_SZFNAME 99 # Length of file name +define EP_SZLINE 199 # Length of line +define EP_LEN 379 # Length of EP structure + +define EP_INPUT Memc[P2C($1)] # Input image name +define EP_OUTPUT Memc[P2C($1+50)] # Output image name +define EP_WORK Memc[P2C($1+100)] # Working image name +define EP_SECTION Memc[P2C($1+150)] # Image section +define EP_GRAPHICS Memc[P2C($1+200)] # Graphics device +define EP_COMMAND Memc[P2C($1+250)] # Display command + +define EP_ANGH Memr[P2R($1+350)] # Horizontal viewing angle +define EP_ANGV Memr[P2R($1+351)] # Vertical viewing angle +define EP_APERTURE Memi[$1+352] # Aperture type +define EP_AUTODISPLAY Memi[$1+353] # Automatic image display? +define EP_AUTOSURFACE Memi[$1+354] # Automatic surface plots? +define EP_BUFFER Memr[P2R($1+355)] # Background buffer width +define EP_DEFAULT Memi[$1+356] # Default edit option +define EP_DISPLAY Memi[$1+357] # Display images? +define EP_FIXPIX Memi[$1+358] # Fixpix input? +define EP_RADIUS Memr[P2R($1+359)] # Aperture radius +define EP_SEARCH Memr[P2R($1+360)] # Search radius +define EP_SIGMA Memr[P2R($1+361)] # Added noise sigma +define EP_VALUE Memr[P2R($1+362)] # Substitution value +define EP_MINVALUE Memr[P2R($1+363)] # Minimum value for edit +define EP_MAXVALUE Memr[P2R($1+364)] # Maximum value for edit +define EP_WIDTH Memr[P2R($1+365)] # Background width +define EP_XORDER Memi[$1+366] # Background xorder +define EP_YORDER Memi[$1+367] # Background xorder + +define EP_LOGFD Memi[$1+368] # Log file descriptor +define EP_IM Memi[$1+369] # IMIO pointer +define EP_INDATA Memi[$1+370] # Input data pointer +define EP_OUTDATA Memi[$1+371] # Output data pointer +define EP_NX Memi[$1+372] # Number of columns in subraster +define EP_NY Memi[$1+373] # Number of lines in subraster +define EP_NPTS Memi[$1+374] # Number of pixels in subraster +define EP_X1 Memi[$1+375] # Starting column of subraster +define EP_Y1 Memi[$1+376] # Starting line of subraster +define EP_X2 Memi[$1+377] # Ending column of subraster +define EP_Y2 Memi[$1+378] # Ending line of subraster + +define APTYPES "|circular|square|" # Aperture types +define APRECTANGLE 0 # Rectangular aperture +define APCIRCULAR 1 # Circular aperture +define APSQUARE 2 # Square aperture +define APCDIAG 3 # Diagonal with column interp +define APLDIAG 4 # Diagonal with column interp diff --git a/pkg/images/tv/imedit/epline.x b/pkg/images/tv/imedit/epline.x new file mode 100644 index 00000000..2644beb8 --- /dev/null +++ b/pkg/images/tv/imedit/epline.x @@ -0,0 +1,80 @@ +include "epix.h" + +# EP_LINE -- Replace aperture by line interpolation from background annulus. +# The aperture is first centered. The interpolation is across lines +# from the nearest pixel in the background annulus. Gaussian noise may +# be added. + +procedure ep_line (ep, ap, xa, ya, xb, yb) + +pointer ep # EPIX pointer +int ap # Aperture type +int xa, ya, xb, yb # Aperture coordinates + +int i, x1, x2, y1, y2 +pointer mask, gs + +begin + i = abs (EP_SEARCH(ep)) + EP_BUFFER(ep) + 1 + x1 = min (xa, xb) + x2 = max (xa, xb) + y1 = min (ya, yb) - i + y2 = max (ya, yb) + i + call ep_gdata (ep, x1, x2, y1, y2) + if (EP_OUTDATA(ep) != NULL) { + call malloc (mask, EP_NPTS(ep), TY_INT) + + call ep_search (ep, Memr[EP_OUTDATA(ep)], EP_NX(ep), + EP_NY(ep), ap, xa, ya, xb, yb) + call ep_mask (ep, mask, ap, xa, ya, xb, yb) + call ep_line1 (Memr[EP_OUTDATA(ep)], Memi[mask], + EP_NX(ep), EP_NY(ep)) + if (!IS_INDEF (EP_SIGMA(ep))) + call ep_noise (EP_SIGMA(ep), Memr[EP_OUTDATA(ep)], + Memi[mask], Memr[EP_OUTDATA(ep)], Memr[EP_OUTDATA(ep)], + EP_NPTS(ep), gs) + + call mfree (mask, TY_INT) + } +end + + +# EP_LINE1 -- Interpolate across lines. + +procedure ep_line1 (data, mask, nx, ny) + +real data[nx,ny] # Data subraster +int mask[nx,ny] # Mask subraster +int nx, ny # Number of points + +int i, j, ya, yb, yc, yd +real a, b + +begin + do i = 1, nx { + for (ya=1; ya<=ny && mask[i,ya]!=1; ya=ya+1) + ; + if (ya > ny) + next + for (yb=ny; yb>ya && mask[i,yb]!=1; yb=yb-1) + ; + for (yc=ya; yc>=1 && mask[i,yc]!=2; yc=yc-1) + ; + for (yd=yb; yd<=ny && mask[i,yd]!=2; yd=yd+1) + ; + if (yc < 1 && yd > ny) + next + else if (yc < 1) + do j = ya, yb + data[i,j] = data[i,yd] + else if (yd > ny) + do j = ya, yb + data[i,j] = data[i,yc] + else { + a = data[i,yc] + b = (data[i,yd] - a) / (yd - yc) + do j = ya, yb + data[i,j] = a + b * (j - yc) + } + } +end diff --git a/pkg/images/tv/imedit/epmask.x b/pkg/images/tv/imedit/epmask.x new file mode 100644 index 00000000..12fd8fc9 --- /dev/null +++ b/pkg/images/tv/imedit/epmask.x @@ -0,0 +1,177 @@ +include <mach.h> +include "epix.h" + +# EP_MASK -- Make a mask array with 1=aperture and 2=background annulus. +# +# Exclude values outside a specified range. + +procedure ep_mask (ep, mask, ap, xa, ya, xb, yb) + +pointer ep # EPIX pointer +pointer mask # Mask pointer +int ap # Aperture type +int xa, ya, xb, yb # Aperture + +int xc, yc, i, j +real rad, r, a, b, c, d, minv, maxv +int x1a, x1b, x1c, x2a, x2b, x2c, y1a, y1b, y1c, y2a, y2b, y2c +pointer sp, line, ptr1, ptr2 + +begin + rad = max (0.5, EP_RADIUS(ep)) + + switch (ap) { + case APCIRCULAR: + xc = nint ((xa + xb) / 2.) + yc = nint ((ya + yb) / 2.) + + a = rad ** 2 + b = (rad + EP_BUFFER(ep)) ** 2 + c = (rad + EP_BUFFER(ep) + EP_WIDTH(ep)) ** 2 + + ptr1 = mask + do j = EP_Y1(ep), EP_Y2(ep) { + d = (j - yc) ** 2 + do i = EP_X1(ep), EP_X2(ep) { + r = d + (i - xc) ** 2 + if (r <= a) + Memi[ptr1] = 1 + else if (r >= b && r <= c) + Memi[ptr1] = 2 + else + Memi[ptr1] = 0 + ptr1 = ptr1 + 1 + } + } + case APCDIAG: + a = rad + b = rad + EP_BUFFER(ep) + c = rad + EP_BUFFER(ep) + EP_WIDTH(ep) + + if (yb - ya != 0) + d = real (xb - xa) / (yb - ya) + else + d = 1. + + ptr1 = mask + do j = EP_Y1(ep), EP_Y2(ep) { + xc = xa + d * (j - ya) + do i = EP_X1(ep), EP_X2(ep) { + r = abs (i - xc) + if (r <= a) + Memi[ptr1] = 1 + else if (r >= b && r <= c) + Memi[ptr1] = 2 + else + Memi[ptr1] = 0 + ptr1 = ptr1 + 1 + } + } + case APLDIAG: + a = rad + b = rad + EP_BUFFER(ep) + c = rad + EP_BUFFER(ep) + EP_WIDTH(ep) + + if (xb - xa != 0) + d = real (yb - ya) / (xb - xa) + else + d = 1. + + ptr1 = mask + do j = EP_Y1(ep), EP_Y2(ep) { + do i = EP_X1(ep), EP_X2(ep) { + yc = ya + d * (i - xa) + r = abs (j - yc) + if (r <= a) + Memi[ptr1] = 1 + else if (r >= b && r <= c) + Memi[ptr1] = 2 + else + Memi[ptr1] = 0 + ptr1 = ptr1 + 1 + } + } + default: + call smark (sp) + call salloc (line, EP_NX(ep), TY_INT) + + x1a = max (EP_X1(ep), min (xa, xb)) + x1b = max (EP_X1(ep), int (x1a - EP_BUFFER(ep))) + x1c = max (EP_X1(ep), int (x1a - EP_BUFFER(ep) - EP_WIDTH(ep))) + x2a = min (EP_X2(ep), max (xa, xb)) + x2b = min (EP_X2(ep), int (x2a + EP_BUFFER(ep))) + x2c = min (EP_X2(ep), int (x2a + EP_BUFFER(ep) + EP_WIDTH(ep))) + + y1a = max (EP_Y1(ep), min (ya, yb)) + y1b = max (EP_Y1(ep), int (y1a - EP_BUFFER(ep))) + y1c = max (EP_Y1(ep), int (y1a - EP_BUFFER(ep) - EP_WIDTH(ep))) + y2a = min (EP_Y2(ep), max (ya, yb)) + y2b = min (EP_Y2(ep), int (y2a + EP_BUFFER(ep))) + y2c = min (EP_Y2(ep), int (y2a + EP_BUFFER(ep) + EP_WIDTH(ep))) + + ptr1 = line - EP_X1(ep) + ptr2 = mask - EP_Y1(ep) * EP_NX(ep) + + for (i=EP_X1(ep); i<x1c; i=i+1) + Memi[ptr1+i] = 0 + for (; i<x1b; i=i+1) + Memi[ptr1+i] = 2 + for (; i<x1a; i=i+1) + Memi[ptr1+i] = 0 + for (; i<=x2a; i=i+1) + Memi[ptr1+i] = 1 + for (; i<=x2b; i=i+1) + Memi[ptr1+i] = 0 + for (; i<=x2c; i=i+1) + Memi[ptr1+i] = 2 + for (; i<=EP_X2(ep); i=i+1) + Memi[ptr1+i] = 0 + do i = y1a, y2a + call amovi (Memi[line], Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + + for (i=x1a; i<=x2a; i=i+1) + Memi[ptr1+i] = 0 + for (i=y1b; i<y1a; i=i+1) + call amovi (Memi[line], Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + for (i=y2a+1; i<=y2b; i=i+1) + call amovi (Memi[line], Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + + for (i=x1b; i<=x2b; i=i+1) + Memi[ptr1+i] = 2 + for (i=y1c; i<y1b; i=i+1) + call amovi (Memi[line], Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + for (i=y2b+1; i<=y2c; i=i+1) + call amovi (Memi[line], Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + + for (i=EP_Y1(ep); i<y1c; i=i+1) + call aclri (Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + for (i=y2c+1; i<=EP_Y2(ep); i=i+1) + call aclri (Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + + call sfree (sp) + } + + # Exclude data values. + ptr2 = EP_OUTDATA(ep) + if (ptr2 == NULL || + (IS_INDEFR(EP_MINVALUE(ep)) && IS_INDEFR(EP_MAXVALUE(ep)))) + return + + minv = EP_MINVALUE(ep) + maxv = EP_MAXVALUE(ep) + if (IS_INDEFR(minv)) + minv = -MAX_REAL + if (IS_INDEFR(maxv)) + maxv = MAX_REAL + ptr1 = mask + do j = EP_Y1(ep), EP_Y2(ep) { + do i = EP_X1(ep), EP_X2(ep) { + if (Memi[ptr1] != 0) { + if (Memr[ptr2] < minv || Memr[ptr2] > maxv) + Memi[ptr1] = 0 + } + ptr1 = ptr1 + 1 + ptr2 = ptr2 + 1 + } + } +end diff --git a/pkg/images/tv/imedit/epmove.x b/pkg/images/tv/imedit/epmove.x new file mode 100644 index 00000000..687a200e --- /dev/null +++ b/pkg/images/tv/imedit/epmove.x @@ -0,0 +1,129 @@ +include "epix.h" + +# EP_MOVE -- Replace the output aperture by the data in the input aperture. +# There is no centering. A background is fit to the input data and subtracted +# and then a background is fit to the output aperture and added to the +# input aperture data. + +procedure ep_move (ep, ap, xa1, ya1, xb1, yb1, xa2, ya2, xb2, yb2, key) + +pointer ep # EPIX structure +int ap # Aperture type +int xa1, ya1, xb1, yb1 # Aperture coordinates +int xa2, ya2, xb2, yb2 # Aperture coordinates +int key # Key + +int i, x1, x2, y1, y2 +pointer bufdata, mask, x, y, w + +begin + i = EP_BUFFER(ep) + EP_WIDTH(ep) + 1 + x1 = min (xa1, xb1) - i + x2 = max (xa1, xb1) + i + y1 = min (ya1, yb1) - i + y2 = max (ya1, yb1) + i + call ep_gindata (ep, x1, x2, y1, y2) + if (EP_INDATA(ep) != NULL) { + call malloc (bufdata, EP_NPTS(ep), TY_REAL) + call malloc (mask, EP_NPTS(ep), TY_INT) + call malloc (x, EP_NPTS(ep), TY_REAL) + call malloc (y, EP_NPTS(ep), TY_REAL) + call malloc (w, EP_NPTS(ep), TY_REAL) + + call amovr (Memr[EP_INDATA(ep)], Memr[bufdata], EP_NPTS(ep)) + call ep_mask (ep, mask, ap, xa1, ya1, xb1, yb1) + i = EP_BUFFER(ep) + EP_WIDTH(ep) + 1 + x1 = min (xa2, xb2) - i + x2 = max (xa2, xb2) + i + y1 = min (ya2, yb2) - i + y2 = max (ya2, yb2) + i + i = EP_NPTS(ep) + call ep_gdata (ep, x1, x2, y1, y2) + if (i != EP_NPTS(ep)) { + call eprintf ("Raster sizes don't match\n") + EP_OUTDATA(ep) = NULL + } + if (EP_OUTDATA(ep) != NULL) { + switch (key) { + case 'm': + call ep_movem (ep, Memr[bufdata], Memr[EP_OUTDATA(ep)], + Memi[mask], Memr[x], Memr[y], Memr[w], + EP_NX(ep), EP_NY(ep)) + case 'n': + call ep_moven (ep, Memr[bufdata], Memr[EP_OUTDATA(ep)], + Memi[mask], Memr[x], Memr[y], Memr[w], + EP_NX(ep), EP_NY(ep)) + } + } + + call mfree (bufdata, TY_REAL) + call mfree (mask, TY_INT) + call mfree (x, TY_REAL) + call mfree (y, TY_REAL) + call mfree (w, TY_REAL) + } +end + + +# EP_MOVEM -- Move the input aperture to the output. + +procedure ep_movem (ep, indata, outdata, mask, x, y, w, nx, ny) + +pointer ep # EPIX structure +real indata[nx,ny] # Input data subraster +real outdata[nx,ny] # Output data subraster +int mask[nx,ny] # Mask subraster +real x[nx,ny], y[nx,ny] # Coordinates +real w[nx,ny] # Weights +int nx, ny # Size of subraster + +int i, j +real gseval() +pointer gsin, gsout + +begin + call ep_gsfit (ep, indata, mask, x, y, w, nx, ny, gsin) + if (gsin == NULL) + return + call ep_gsfit (ep, outdata, mask, x, y, w, nx, ny, gsout) + if (gsout == NULL) { + call gsfree (gsin) + return + } + do j = 1, ny + do i = 1, nx + if (mask[i,j] == 1) + outdata[i,j] = indata[i,j] - gseval (gsin, x[i,j], y[i,j]) + + gseval (gsout, x[i,j], y[i,j]) + call gsfree (gsin) + call gsfree (gsout) +end + + +# EP_MOVEN -- Add the input aperture to the output. + +procedure ep_moven (ep, indata, outdata, mask, x, y, w, nx, ny) + +pointer ep # EPIX structure +real indata[nx,ny] # Input data subraster +real outdata[nx,ny] # Output data subraster +int mask[nx,ny] # Mask subraster +real x[nx,ny], y[nx,ny] # Coordinates +real w[nx,ny] # Weights +int nx, ny # Size of subraster + +int i, j +real gseval() +pointer gs + +begin + call ep_gsfit (ep, indata, mask, x, y, w, nx, ny, gs) + if (gs == NULL) + return + do j = 1, ny + do i = 1, nx + if (mask[i,j] == 1) + outdata[i,j] = indata[i,j] - gseval (gs, x[i,j], y[i,j]) + + outdata[i,j] + call gsfree (gs) +end diff --git a/pkg/images/tv/imedit/epnoise.x b/pkg/images/tv/imedit/epnoise.x new file mode 100644 index 00000000..796e5038 --- /dev/null +++ b/pkg/images/tv/imedit/epnoise.x @@ -0,0 +1,95 @@ +# EP_NOISE -- Add noise. +# If the sigma is zero add no noise. If a nonzero sigma is given then +# add gaussian random noise. If the sigma is INDEF then use histogram +# sampling from the background. The background histogram is corrected +# for a background function. The histogram is sampled by sorting the +# background values and selecting uniformly from the central 80%. + +procedure ep_noise (sigma, data, mask, x, y, npts, gs) + +real sigma # Noise sigma +real data[npts] # Image data +int mask[npts] # Mask (1=object, 2=background) +real x[npts], y[npts] # Coordinates +int npts # Number of pixels in subraster +pointer gs # Background surface + +int i, j, nbg +real a, b, urand(), gseval(), ep_gauss() +pointer bg + +long seed +data seed /1/ + +begin + # Add gaussian random noise. + if (!IS_INDEF (sigma)) { + if (sigma <= 0.) + return + do i = 1, npts { + if (mask[i] == 1) + data[i] = data[i] + sigma * ep_gauss (seed) + } + return + } + + # Add background sampling with background slope correction. + + if (gs == NULL) + return + + call malloc (bg, npts, TY_REAL) + + nbg = 0 + do i = 1, npts { + if (mask[i] == 2) { + Memr[bg+nbg] = data[i] - gseval (gs, x[i], y[i]) + nbg = nbg + 1 + } + } + if (nbg < 10) { + call mfree (bg, TY_REAL) + return + } + + call asrtr (Memr[bg], Memr[bg], nbg) + a = .1 * nbg - 1 + b = .8 * nbg + + do i = 1, npts + if (mask[i] == 1) { + j = a + b * urand (seed) + data[i] = data[i] + Memr[bg + j] + } + + call mfree (bg, TY_REAL) +end + + +# EP_GAUSS -- Gaussian random number generator based on uniform random number +# generator. + +real procedure ep_gauss (seed) + +long seed # Random number seed + +real a, b, c, d, urand() +int flag +data flag/NO/ + +begin + if (flag == NO) { + repeat { + a = 2. * urand (seed) - 1. + b = 2. * urand (seed) - 1. + c = a * a + b * b + } until (c <= 1.) + + d = sqrt (-2. * log (c) / c) + flag = YES + return (a * d) + } else { + flag = NO + return (b * d) + } +end diff --git a/pkg/images/tv/imedit/epreplace.gx b/pkg/images/tv/imedit/epreplace.gx new file mode 100644 index 00000000..df09e50b --- /dev/null +++ b/pkg/images/tv/imedit/epreplace.gx @@ -0,0 +1,167 @@ +include <mach.h> +include <imhdr.h> +include "epix.h" + + +# EP_REPLACE -- Replace all pixels that are ==, <=, or >= to the value at the +# reference pixel. Since this allocates and gets sections this may result in +# the entire image being put into memory with potential memory problems. It +# is intended for use with masks that have regions of constant values. +# +# Note that this version assumes the pixel values may be ACE object masks. + +$for (ir) +procedure ep_replace$t (ep, x, y, key) + +pointer ep #I EPIX pointer +int x, y #I Reference pixel +int key #I Key + +int i, j, nc, nl, x1, x2, y1, y2 +real minv, maxv +PIXEL val, ival, oval +pointer im, buf + +$if (datatype == i) +int andi() +$endif +pointer imgs2$t(), imps2$t() +errchk imgs2$t, imps2$t + +begin + im = EP_IM(ep) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + EP_INDATA(ep) = NULL + EP_OUTDATA(ep) = NULL + if (x < 1 || x > nc || y < 1 || y > nl) { + call eprintf ("Pixel out of bounds\n") + return + } + + # Get reference pixel value and replacement value. + buf = imgs2$t (im, x, x, y, y) + $if (datatype == i) + ival = andi (Mem$t[buf], 0777777B) + $else + ival = Mem$t[buf] + $endif + oval = EP_VALUE(ep) + minv = EP_MINVALUE(ep) + maxv = EP_MAXVALUE(ep) + if (IS_INDEFR(minv)) + minv = -MAX_REAL + if (IS_INDEFR(maxv)) + minv = MAX_REAL + + # This requires two passes to fit into the subraster model. + # First pass finds the limits of the change and the second + # makes the change. + + x1 = x+1; x2 = x-1; y1 = y+1; y2 = y-1 + do j = 1, nl { + buf = imgs2$t (im, 1, nc, j, j) + switch (key) { + case '=': + do i = 1, nc { + $if (datatype == i) + val = andi (Mem$t[buf+i-1], 0777777B) + $else + val = Mem$t[buf+i-1] + $endif + if (val != ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + case '<': + do i = 1, nc { + $if (datatype == i) + val = andi (Mem$t[buf+i-1], 0777777B) + $else + val = Mem$t[buf+i-1] + $endif + if (val > ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + case '>': + do i = 1, nc { + $if (datatype == i) + val = andi (Mem$t[buf+i-1], 0777777B) + $else + val = Mem$t[buf+i-1] + $endif + if (val < ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + } + } + + # No pixels to change. + if (x2 < x1 || y2 < y1) + return + + # Set the rasters and change the pixels. + EP_X1(ep) = x1 + EP_X2(ep) = x2 + EP_Y1(ep) = y1 + EP_Y2(ep) = y2 + EP_NX(ep) = EP_X2(ep) - EP_X1(ep) + 1 + EP_NY(ep) = EP_Y2(ep) - EP_Y1(ep) + 1 + EP_NPTS(ep) = EP_NX(ep) * EP_NY(ep) + + EP_OUTDATA(ep) = imps2$t (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), + EP_Y2(ep)) + EP_INDATA(ep) = imgs2$t (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), + EP_Y2(ep)) + + buf = EP_OUTDATA(ep) + call amov$t (Mem$t[EP_INDATA(ep)], Mem$t[buf], EP_NPTS(ep)) + switch (key) { + case '=': + do i = 1, EP_NPTS(ep) { + $if (datatype == i) + val = andi (Mem$t[buf], 0777777B) + $else + val = Mem$t[buf] + $endif + if (val == ival && val >= minv && val <= maxv) + Mem$t[buf] = oval + buf = buf + 1 + } + case '<': + do i = 1, EP_NPTS(ep) { + $if (datatype == i) + val = andi (Mem$t[buf], 0777777B) + $else + val = Mem$t[buf] + $endif + if (val <= ival && val >= minv && val <= maxv) + Mem$t[buf] = oval + buf = buf + 1 + } + case '>': + do i = 1, EP_NPTS(ep) { + $if (datatype == i) + val = andi (Mem$t[buf], 0777777B) + $else + val = Mem$t[buf] + $endif + if (val >= ival && val >= minv && val <= maxv) + Mem$t[buf] = oval + buf = buf + 1 + } + } +end +$endfor diff --git a/pkg/images/tv/imedit/epreplace.x b/pkg/images/tv/imedit/epreplace.x new file mode 100644 index 00000000..c79b943f --- /dev/null +++ b/pkg/images/tv/imedit/epreplace.x @@ -0,0 +1,260 @@ +include <mach.h> +include <imhdr.h> +include "epix.h" + + +# EP_REPLACE -- Replace all pixels that are ==, <=, or >= to the value at the +# reference pixel. Since this allocates and gets sections this may result in +# the entire image being put into memory with potential memory problems. It +# is intended for use with masks that have regions of constant values. +# +# Note that this version assumes the pixel values may be ACE object masks. + + +procedure ep_replacei (ep, x, y, key) + +pointer ep #I EPIX pointer +int x, y #I Reference pixel +int key #I Key + +int i, j, nc, nl, x1, x2, y1, y2 +real minv, maxv +int val, ival, oval +pointer im, buf + +int andi() +pointer imgs2i(), imps2i() +errchk imgs2i, imps2i + +begin + im = EP_IM(ep) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + EP_INDATA(ep) = NULL + EP_OUTDATA(ep) = NULL + if (x < 1 || x > nc || y < 1 || y > nl) { + call eprintf ("Pixel out of bounds\n") + return + } + + # Get reference pixel value and replacement value. + buf = imgs2i (im, x, x, y, y) + ival = andi (Memi[buf], 0777777B) + oval = EP_VALUE(ep) + minv = EP_MINVALUE(ep) + maxv = EP_MAXVALUE(ep) + if (IS_INDEFR(minv)) + minv = -MAX_REAL + if (IS_INDEFR(maxv)) + minv = MAX_REAL + + # This requires two passes to fit into the subraster model. + # First pass finds the limits of the change and the second + # makes the change. + + x1 = x+1; x2 = x-1; y1 = y+1; y2 = y-1 + do j = 1, nl { + buf = imgs2i (im, 1, nc, j, j) + switch (key) { + case '=': + do i = 1, nc { + val = andi (Memi[buf+i-1], 0777777B) + if (val != ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + case '<': + do i = 1, nc { + val = andi (Memi[buf+i-1], 0777777B) + if (val > ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + case '>': + do i = 1, nc { + val = andi (Memi[buf+i-1], 0777777B) + if (val < ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + } + } + + # No pixels to change. + if (x2 < x1 || y2 < y1) + return + + # Set the rasters and change the pixels. + EP_X1(ep) = x1 + EP_X2(ep) = x2 + EP_Y1(ep) = y1 + EP_Y2(ep) = y2 + EP_NX(ep) = EP_X2(ep) - EP_X1(ep) + 1 + EP_NY(ep) = EP_Y2(ep) - EP_Y1(ep) + 1 + EP_NPTS(ep) = EP_NX(ep) * EP_NY(ep) + + EP_OUTDATA(ep) = imps2i (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), + EP_Y2(ep)) + EP_INDATA(ep) = imgs2i (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), + EP_Y2(ep)) + + buf = EP_OUTDATA(ep) + call amovi (Memi[EP_INDATA(ep)], Memi[buf], EP_NPTS(ep)) + switch (key) { + case '=': + do i = 1, EP_NPTS(ep) { + val = andi (Memi[buf], 0777777B) + if (val == ival && val >= minv && val <= maxv) + Memi[buf] = oval + buf = buf + 1 + } + case '<': + do i = 1, EP_NPTS(ep) { + val = andi (Memi[buf], 0777777B) + if (val <= ival && val >= minv && val <= maxv) + Memi[buf] = oval + buf = buf + 1 + } + case '>': + do i = 1, EP_NPTS(ep) { + val = andi (Memi[buf], 0777777B) + if (val >= ival && val >= minv && val <= maxv) + Memi[buf] = oval + buf = buf + 1 + } + } +end + +procedure ep_replacer (ep, x, y, key) + +pointer ep #I EPIX pointer +int x, y #I Reference pixel +int key #I Key + +int i, j, nc, nl, x1, x2, y1, y2 +real minv, maxv +real val, ival, oval +pointer im, buf + +pointer imgs2r(), imps2r() +errchk imgs2r, imps2r + +begin + im = EP_IM(ep) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + EP_INDATA(ep) = NULL + EP_OUTDATA(ep) = NULL + if (x < 1 || x > nc || y < 1 || y > nl) { + call eprintf ("Pixel out of bounds\n") + return + } + + # Get reference pixel value and replacement value. + buf = imgs2r (im, x, x, y, y) + ival = Memr[buf] + oval = EP_VALUE(ep) + minv = EP_MINVALUE(ep) + maxv = EP_MAXVALUE(ep) + if (IS_INDEFR(minv)) + minv = -MAX_REAL + if (IS_INDEFR(maxv)) + minv = MAX_REAL + + # This requires two passes to fit into the subraster model. + # First pass finds the limits of the change and the second + # makes the change. + + x1 = x+1; x2 = x-1; y1 = y+1; y2 = y-1 + do j = 1, nl { + buf = imgs2r (im, 1, nc, j, j) + switch (key) { + case '=': + do i = 1, nc { + val = Memr[buf+i-1] + if (val != ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + case '<': + do i = 1, nc { + val = Memr[buf+i-1] + if (val > ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + case '>': + do i = 1, nc { + val = Memr[buf+i-1] + if (val < ival || val == oval || val < minv || val > maxv) + next + x1 = min (x1, i) + x2 = max (x2, i) + y1 = min (y1, j) + y2 = max (y2, j) + } + } + } + + # No pixels to change. + if (x2 < x1 || y2 < y1) + return + + # Set the rasters and change the pixels. + EP_X1(ep) = x1 + EP_X2(ep) = x2 + EP_Y1(ep) = y1 + EP_Y2(ep) = y2 + EP_NX(ep) = EP_X2(ep) - EP_X1(ep) + 1 + EP_NY(ep) = EP_Y2(ep) - EP_Y1(ep) + 1 + EP_NPTS(ep) = EP_NX(ep) * EP_NY(ep) + + EP_OUTDATA(ep) = imps2r (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), + EP_Y2(ep)) + EP_INDATA(ep) = imgs2r (im, EP_X1(ep), EP_X2(ep), EP_Y1(ep), + EP_Y2(ep)) + + buf = EP_OUTDATA(ep) + call amovr (Memr[EP_INDATA(ep)], Memr[buf], EP_NPTS(ep)) + switch (key) { + case '=': + do i = 1, EP_NPTS(ep) { + val = Memr[buf] + if (val == ival && val >= minv && val <= maxv) + Memr[buf] = oval + buf = buf + 1 + } + case '<': + do i = 1, EP_NPTS(ep) { + val = Memr[buf] + if (val <= ival && val >= minv && val <= maxv) + Memr[buf] = oval + buf = buf + 1 + } + case '>': + do i = 1, EP_NPTS(ep) { + val = Memr[buf] + if (val >= ival && val >= minv && val <= maxv) + Memr[buf] = oval + buf = buf + 1 + } + } +end + diff --git a/pkg/images/tv/imedit/epsearch.x b/pkg/images/tv/imedit/epsearch.x new file mode 100644 index 00000000..814d9a3b --- /dev/null +++ b/pkg/images/tv/imedit/epsearch.x @@ -0,0 +1,90 @@ +include <mach.h> +include "epix.h" + +# EP_SEARCH -- Search input data for maximum or minimum pixel in search radius. +# Return the new aperture positions. The magnitude of the search radius +# defines the range to be searched (bounded by the raster dimension) and +# the sign of the radius determines whether a minimum or maximum is sought. + +procedure ep_search (ep, data, nx, ny, ap, xa, ya, xb, yb) + +pointer ep # EPIX pointer +real data[nx,ny] # Subraster +int nx, ny # Subraster size +int ap # Aperture type +int xa, ya, xb, yb # Aperture (initial and final) + +real xc, yc, search2, dj2, r2, dmax +int i, j, i1, i2, j1, j2, imax, jmax + +begin + if (EP_SEARCH(ep) == 0.) + return + + search2 = abs (EP_SEARCH(ep)) + + xa = xa - EP_X1(ep) + 1 + xb = xb - EP_X1(ep) + 1 + xc = (xa + xb) / 2. + i1 = max (1., xc - search2) + i2 = min (real(nx), xc + search2) + imax = nint (xc) + + ya = ya - EP_Y1(ep) + 1 + yb = yb - EP_Y1(ep) + 1 + yc = (ya + yb) / 2. + j1 = max (1., yc - search2) + j2 = min (real(ny), yc + search2) + jmax = nint (yc) + + dmax = data[imax,jmax] + switch (ap) { + case 1: + search2 = EP_SEARCH(ep) ** 2 + do j = j1, j2 { + dj2 = (j - yc) ** 2 + do i = i1, i2 { + r2 = dj2 + (i - xc) ** 2 + if (r2 > search2) + next + + if (EP_SEARCH(ep) > 0.) { + if (data[i,j] > dmax) { + dmax = data[i,j] + imax = i + jmax = j + } + } else { + if (data[i,j] < dmax) { + dmax = data[i,j] + imax = i + jmax = j + } + } + } + } + default: + do j = j1, j2 { + do i = i1, i2 { + if (EP_SEARCH(ep) > 0.) { + if (data[i,j] > dmax) { + dmax = data[i,j] + imax = i + jmax = j + } + } else { + if (data[i,j] < dmax) { + dmax = data[i,j] + imax = i + jmax = j + } + } + } + } + } + + xa = xa + (imax - xc) + EP_X1(ep) - 1 + xb = xb + (imax - xc) + EP_X1(ep) - 1 + ya = ya + (jmax - yc) + EP_Y1(ep) - 1 + yb = yb + (jmax - yc) + EP_Y1(ep) - 1 +end diff --git a/pkg/images/tv/imedit/epsetpars.x b/pkg/images/tv/imedit/epsetpars.x new file mode 100644 index 00000000..4101ff5a --- /dev/null +++ b/pkg/images/tv/imedit/epsetpars.x @@ -0,0 +1,75 @@ +include <error.h> +include "epix.h" + +# EP_SETPARS -- Set the parameter values in the EPIX structure. +# If a logfile is given record selected parameters. + +procedure ep_setpars (ep) + +pointer ep # EPIX structure + +int fd, clgeti(), btoi(), clgwrd(), nowhite(), open() +char clgetc() +bool clgetb() +real clgetr() +pointer sp, aperture, logfile +errchk open + +begin + call smark (sp) + call salloc (aperture, SZ_FNAME, TY_CHAR) + call salloc (logfile, SZ_FNAME, TY_CHAR) + + EP_ANGH(ep) = clgetr ("angh") + EP_ANGV(ep) = clgetr ("angv") + EP_APERTURE(ep) = clgwrd ("aperture", Memc[aperture], SZ_FNAME, APTYPES) + EP_AUTODISPLAY(ep) = btoi (clgetb ("autodisplay")) + EP_AUTOSURFACE(ep) = btoi (clgetb ("autosurface")) + EP_BUFFER(ep) = clgetr ("buffer") + EP_DEFAULT(ep) = clgetc ("default") + EP_DISPLAY(ep) = btoi (clgetb ("display")) + EP_FIXPIX(ep) = btoi (clgetb ("fixpix")) + EP_RADIUS(ep) = clgetr ("radius") + EP_SEARCH(ep) = clgetr ("search") + EP_SIGMA(ep) = clgetr ("sigma") + EP_VALUE(ep) = clgetr ("value") + EP_MINVALUE(ep) = clgetr ("minvalue") + EP_MAXVALUE(ep) = clgetr ("maxvalue") + EP_WIDTH(ep) = clgetr ("width") + EP_XORDER(ep) = clgeti ("xorder") + EP_YORDER(ep) = clgeti ("yorder") + call clgstr ("command", EP_COMMAND(ep), EP_SZLINE) + call clgstr ("graphics", EP_GRAPHICS(ep), EP_SZFNAME) + + if (EP_LOGFD(ep) != NULL) + call close (EP_LOGFD(ep)) + EP_LOGFD(ep) = NULL + call clgstr ("logfile", Memc[logfile], SZ_FNAME) + if (nowhite (Memc[logfile], Memc[logfile], SZ_FNAME) > 0) { + iferr { + EP_LOGFD(ep) = open (Memc[logfile], APPEND, TEXT_FILE) + fd = EP_LOGFD(ep) + call fprintf (fd, ":aperture %s\n") + call pargstr (Memc[aperture]) + call fprintf (fd, ":search %g\n") + call pargr (EP_SEARCH(ep)) + call fprintf (fd, ":radius %g\n") + call pargr (EP_RADIUS(ep)) + call fprintf (fd, ":buffer %g\n") + call pargr (EP_BUFFER(ep)) + call fprintf (fd, ":width %g\n") + call pargr (EP_WIDTH(ep)) + call fprintf (fd, ":value %g\n") + call pargr (EP_VALUE(ep)) + call fprintf (fd, ":sigma %g\n") + call pargr (EP_SIGMA(ep)) + call fprintf (fd, ":xorder %d\n") + call pargi (EP_XORDER(ep)) + call fprintf (fd, ":yorder %d\n") + call pargi (EP_YORDER(ep)) + } then + call erract (EA_WARN) + } + + call sfree (sp) +end diff --git a/pkg/images/tv/imedit/epstatistics.x b/pkg/images/tv/imedit/epstatistics.x new file mode 100644 index 00000000..c7f075ea --- /dev/null +++ b/pkg/images/tv/imedit/epstatistics.x @@ -0,0 +1,147 @@ +include "epix.h" + +# EP_STATISTICS -- Compute and print statistics for the input aperture. + +procedure ep_statistics (ep, ap, xa, ya, xb, yb, box) + +pointer ep # EPIX structure +int ap # Aperture type +int xa, ya, xb, yb # Aperture coordinates +int box # Print box? + +int i, x1, x2, y1, y2 +pointer mask, x, y, w, gs + +begin + i = max (5., abs (EP_SEARCH(ep))+EP_BUFFER(ep)+EP_WIDTH(ep)+1) + x1 = min (xa, xb) - i + x2 = max (xa, xb) + i + y1 = min (ya, xb) - i + y2 = max (ya, yb) + i + EP_OUTDATA(ep) = NULL + call ep_gindata (ep, x1, x2, y1, y2) + if (EP_INDATA(ep) != NULL) { + call malloc (mask, EP_NPTS(ep), TY_INT) + call malloc (x, EP_NPTS(ep), TY_REAL) + call malloc (y, EP_NPTS(ep), TY_REAL) + call malloc (w, EP_NPTS(ep), TY_REAL) + + call ep_search (ep, Memr[EP_INDATA(ep)], EP_NX(ep), + EP_NY(ep), ap, xa, ya, xb, yb) + call ep_mask (ep, mask, ap, xa, ya, xb, yb) + call ep_gsfit (ep, Memr[EP_INDATA(ep)], Memi[mask], + Memr[x], Memr[y], Memr[w], EP_NX(ep), EP_NY(ep), gs) + call ep_statistics1 (Memr[EP_INDATA(ep)], Memi[mask], + EP_NX(ep), EP_NY(ep), EP_X1(ep), EP_Y1(ep), + (xa+xb)/2, (ya+yb)/2, gs) + if (box == YES) + call ep_box (Memr[EP_INDATA(ep)], EP_NX(ep), EP_NY(ep), + EP_X1(ep), EP_Y1(ep), xa, ya, xb, yb) + + call mfree (mask, TY_INT) + call mfree (x, TY_REAL) + call mfree (y, TY_REAL) + call mfree (w, TY_REAL) + call gsfree (gs) + } +end + + +# EP_STATISTICS1 -- Compute and print statistics. + +procedure ep_statistics1 (data, mask, nx, ny, x1, y1, x, y, gs) + +real data[nx,ny] # Input data subraster +int mask[nx,ny] # Mask subraster +int nx, ny # Size of subraster +int x1, y1 # Origin of subraster +int x, y # Center of object +pointer gs # GSURFIT pointer + +int i, j, area, nsky +real flux, sky, sigma, d, gseval() + +begin + flux = 0. + area = 0 + sky = 0. + sigma = 0. + nsky = 0 + + do j = 1, ny { + do i = 1, nx { + if (mask[i,j] == 1) { + d = data[i,j] + if (gs != NULL) + d = d - gseval (gs, real (i), real (j)) + flux = flux + d + area = area + 1 + } else if (mask[i,j] == 2) { + d = data[i,j] - gseval (gs, real (i), real (j)) + sky = sky + data[i,j] + sigma = sigma + d * d + nsky = nsky + 1 + } + } + } + + call printf ("x=%d y=%d z=%d mean=%g area=%d") + call pargi (x) + call pargi (y) + call pargr (data[x-x1+1,y-y1+1]) + call pargr (flux / area) + call pargi (area) + + if (nsky > 0) { + call printf (" sky=%g sigma=%g nsky=%d") + call pargr (sky / nsky) + call pargr (sqrt (sigma / nsky)) + call pargi (nsky) + } + + call printf ("\n") +end + + +# EP_BOX -- Print box of pixel values. + +procedure ep_box (data, nx, ny, xo, yo, xa, ya, xb, yb) + +real data[nx,ny] # Input data subraster +int nx, ny # Size of subraster +int xo, yo # Origin of subraster +int xa, ya, xb, yb # Aperture + +int i, j, x1, x2, y1, y2, x, y + +begin + x1 = min (xa, xb) + x2 = max (xa, xb) + y1 = min (ya, yb) + y2 = max (ya, yb) + if (x2 - x1 + 1 <= 10) { + x1 = max (xo, x1 - 1) + x2 = min (xo + nx - 1, x2 + 1) + } + y1 = max (yo, y1 - 1) + y2 = min (yo + ny - 1, y2 + 1) + + call printf ("%4w") + do x = x1, x2 { + call printf (" %4d ") + call pargi (x) + } + call printf ("\n") + + do y = y2, y1, -1 { + call printf ("%4d") + call pargi (y) + j = y - yo + 1 + do x = x1, x2 { + i = x - xo + 1 + call printf (" %5g") + call pargr (data[i,j]) + } + call printf ("\n") + } +end diff --git a/pkg/images/tv/imedit/epsurface.x b/pkg/images/tv/imedit/epsurface.x new file mode 100644 index 00000000..289c814f --- /dev/null +++ b/pkg/images/tv/imedit/epsurface.x @@ -0,0 +1,46 @@ +define DUMMY 6 + +# EP_SURFACE -- Draw a perspective view of a surface. The altitude +# and azimuth of the viewing angle are variable. + +procedure ep_surface(gp, data, ncols, nlines, angh, angv) + +pointer gp # GIO pointer +real data[ncols,nlines] # Surface data to be plotted +int ncols, nlines # Dimensions of surface +real angh, angv # Orientation of surface (degrees) + +int wkid +pointer sp, work + +int first +real vpx1, vpx2, vpy1, vpy2 +common /frstfg/ first +common /noaovp/ vpx1, vpx2, vpy1, vpy2 + +begin + call smark (sp) + call salloc (work, 2 * (2 * ncols * nlines + ncols + nlines), TY_REAL) + + # Initialize surface common blocks + first = 1 + call srfabd() + + # Define viewport. + call ggview (gp, vpx1, vpx2, vpy1, vpy2) + + # Link GKS to GIO + wkid = 1 + call gopks (STDERR) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call ezsrfc (data, ncols, nlines, angh, angv, Memr[work]) + + call gdawk (wkid) + # We don't want to close the GIO pointer. + #call gclwk (wkid) + call gclks () + + call sfree (sp) +end diff --git a/pkg/images/tv/imedit/imedit.key b/pkg/images/tv/imedit/imedit.key new file mode 100644 index 00000000..211ad94c --- /dev/null +++ b/pkg/images/tv/imedit/imedit.key @@ -0,0 +1,84 @@ + IMEDIT CURSOR KEYSTROKE COMMANDS + + ? Print help + : Colon commands (see below) + <space> Statistics + g Surface graph + i Initialize (start over without saving changes) + q Quit and save changes + p Print box of pixel values and statistics + r Redraw image display + s Surface plot at cursor + t Toggle between minimum and maximum search + + Increase radius by one + - Decrease radius by one + I Interrupt task immediately + Q Quit without saving changes + +The following editing options are available. Rectangular and line regions +are specified with two positions and aperture regions are specified by +one position. The current aperture type (circular or square) is used +in the latter case. The move option takes two positions, the position +to move from and the position to move to. + + a Background replacement (rectangle) + b Background replacement (aperture) + c Column interpolation (rectangle) + d Constant value substitution (rectangle) + e Constant value substitution (aperture) + f Interpolation across line (line) + j Replace with input data (rectangle) + k Replace with input data (aperture) + l Line interpolation (rectangle) + m Copy by replacement (aperture) + n Copy by addition (aperture) + u Undo last change (see also 'i', 'j', and 'k') + v Constant value substitution (vector) + = Constant value substitution of pixels equal + to pixel at the cursor position + < Constant value substitution of pixels less than or equal + to pixel at the cursor position + > Constant value substitution of pixels greater than or equal + to pixel at the cursor position + +When the image display provides a fill option then the effect of zoom +and roam is provided by loading image sections. This is a temporary +mechanism which will eventually be replaced by a more sophisticated +image display interface. + + E Exapnd image display + P Pan image display + R Redraw image display + Z Zoom image display + 0 Redraw image display with no zoom + 1-9 Shift display + + + IMEDIT COLON COMMANDS + +The colon either print the current value of a parameter when there is +no value or set the parameter to the specified value. + +angh [value] Horizontal viewing angle (degrees) for surface plots +angv [value] Vertical viewing angle (degrees) for surface plots +aperture [type] Aperture type (circular|square) +autodisplay [yes|no] Automatic image display? +autosurface [yes|no] Automatic surface plots? +buffer [value] Background buffer width +command [string] Display command +display [yes|no] Display image? +eparam Edit parameters +graphics [device] Graphics device +input [image] New input image to edit (output is same as input) +output [image] New output image name +radius [value] Aperture radius +search [value] Search radius +sigma [value] Noise sigma (INDEF for histrogram replacement) +value [value] Constant substitution value +minvalue [value] Minimum value for modification (INDEF=minimum) +maxvalue [value] Maximum value for modification (INDEF=maximum) +width [value] Background annulus width +write [name] Write changes to name (default current output name) +xorder [value] X order for background fitting +yorder [value] Y order for background fitting + diff --git a/pkg/images/tv/imedit/mkpkg b/pkg/images/tv/imedit/mkpkg new file mode 100644 index 00000000..438a8752 --- /dev/null +++ b/pkg/images/tv/imedit/mkpkg @@ -0,0 +1,38 @@ +# IMEDIT + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +generic: + $ifolder (epreplace.x, epreplace.gx) + $generic -k epreplace.gx -o epreplace.x + $endif + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call generic $endif + + epbackground.x epix.h + epcol.x epix.h + epcolon.x epix.h + epconstant.x epix.h + epdisplay.x epix.h <imhdr.h> + epdosurface.x epix.h + epgcur.x epix.h + epgdata.x epix.h <imhdr.h> + epgsfit.x epix.h <math/gsurfit.h> + epimcopy.x <imhdr.h> + epinput.x epix.h + epline.x epix.h + epmask.x epix.h + epmove.x epix.h + epnoise.x + epreplace.x epix.h <imhdr.h> + epsearch.x epix.h <mach.h> + epsetpars.x epix.h <error.h> + epstatistics.x epix.h + epsurface.x + t_imedit.x epix.h <error.h> <imhdr.h> + ; diff --git a/pkg/images/tv/imedit/t_imedit.x b/pkg/images/tv/imedit/t_imedit.x new file mode 100644 index 00000000..984ce86b --- /dev/null +++ b/pkg/images/tv/imedit/t_imedit.x @@ -0,0 +1,305 @@ +include <error.h> +include <imhdr.h> +include "epix.h" + +define HELP "imedit_help$" +define PROMPT "imedit options" + +# T_IMEDIT -- Edit image pixels. +# This task provides selection of pixels to be edit via cursor or file +# input. The regions to be edited may be defined as a rectangle or a +# center and radius for a circular or square aperture. The replacement +# options include constant substitution, background substitution, column +# or line interpolation, and moving one region to another. In addition +# this task can be used to select and display regions in surface perspective +# and to print statistics. The image display interface temporarily +# used simple calls to a user specified display task (such as TV.DISPLAY). +# The editing is done in a temporary image buffer. The commands which +# alter the input image may be logged if a log file is given. + +procedure t_imedit () + +int inlist # List of input images +int outlist # List of output images + +int i, key, ap, xa, ya, xb, yb, x1, x2, y1, y2 +int change, changes, newdisplay, newimage +bool erase +pointer sp, ep, cmd, temp +pointer im + +bool streq() +pointer immap(), imgl2r(), impl2r() +int imtopenp(), imtlen(), imtgetim(), imaccess(), ep_gcur() +errchk immap, imdelete, ep_imcopy, ep_setpars, imgl2r, impl2r + +define newim_ 99 + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Allocate and initialize imedit descriptor. + call salloc (ep, EP_LEN, TY_STRUCT) + call aclri (Memi[ep], EP_LEN) + + # Check the input and output image lists have proper format. + inlist = imtopenp ("input") + outlist = imtopenp ("output") + if (imtlen (outlist) > 0 && imtlen (outlist) != imtlen (inlist)) + call error (1, "Input and output lists are not the same length") + + # Set the rest of the task parameters. + call ep_setpars (ep) + + # Repeat on each input image. + while (imtgetim (inlist, EP_INPUT(ep), EP_SZFNAME) != EOF) { + if (imtgetim (outlist, EP_OUTPUT(ep), EP_SZFNAME) == EOF) + call strcpy (EP_INPUT(ep), EP_OUTPUT(ep), EP_SZFNAME) + else if (imaccess (EP_OUTPUT(ep), READ_ONLY) == YES) { + call eprintf ("%s: Output image %s exists\n") + call pargstr (EP_INPUT(ep)) + call pargstr (EP_OUTPUT(ep)) + next + } + + # The editing takes place in a temporary editing image buffer. +newim_ call strcpy (EP_OUTPUT(ep), EP_WORK(ep), EP_SZFNAME) + call xt_mkimtemp (EP_OUTPUT(ep), EP_WORK(ep), EP_OUTPUT(ep), + EP_SZFNAME) + iferr (call ep_imcopy (EP_INPUT(ep), EP_WORK(ep))) { + call erract (EA_WARN) + next + } + + EP_IM(ep) = immap (EP_WORK(ep), READ_WRITE, 0) + EP_INDATA(ep) = NULL + EP_OUTDATA(ep) = NULL + + if (EP_LOGFD(ep) != NULL) { + call fprintf (EP_LOGFD(ep), "# Input image %s\n") + call pargstr (EP_INPUT(ep)) + } + + if (EP_DISPLAY(ep) == YES) { + key = '0' + call ep_zoom (ep, xa, ya, xb, yb, key, erase) + call ep_command (ep, EP_WORK(ep), erase) + } + + + # Enter the cursor loop. The apertures and commands are + # returned by the EP_GCUR procedure. + + newimage = NO + changes = 0 + while (ep_gcur (ep,ap,xa,ya,xb,yb,key,Memc[cmd],SZ_LINE) != EOF) { + newdisplay = NO + change = NO + + iferr { + switch (key) { + case '?': # Print help + call pagefile (HELP, PROMPT) + case ':': # Process colon commands + call ep_colon (ep, Memc[cmd], newimage) + if (newimage == YES) + break + case 'a', 'b': # Background replacement + call ep_background (ep, ap, xa, ya, xb, yb) + if (EP_OUTDATA(ep) != NULL) { + change = YES + changes = changes + 1 + } + case 'c': # Column interpolation + call ep_col (ep, ap, xa, ya, xb, yb) + if (EP_OUTDATA(ep) != NULL) { + change = YES + changes = changes + 1 + } + case 'd', 'e', 'v': # Constant value + call ep_constant (ep, ap, xa, ya, xb, yb) + if (EP_OUTDATA(ep) != NULL) { + change = YES + changes = changes + 1 + } + case 'f': # Diagonal aperture + if (ap == APCDIAG) + call ep_col (ep, ap, xa, ya, xb, yb) + else + call ep_line (ep, ap, xa, ya, xb, yb) + if (EP_OUTDATA(ep) != NULL) { + change = YES + changes = changes + 1 + } + case '=', '<', '>': # Replace + if (IM_PIXTYPE(EP_IM(ep)) == TY_INT) + call ep_replacei (ep, xa, ya, key) + else + call ep_replacer (ep, xa, ya, key) + if (EP_OUTDATA(ep) != NULL) { + change = YES + changes = changes + 1 + } + case 'i': # Initialize + call imunmap (EP_IM(ep)) + goto newim_ + case 'j', 'k': # Replace with input + call ep_input (ep, ap, xa, ya, xb, yb) + if (EP_OUTDATA(ep) != NULL) { + change = YES + changes = changes + 1 + } + case 'l': # Line interpolation + call ep_line (ep, ap, xa, ya, xb, yb) + if (EP_OUTDATA(ep) != NULL) { + change = YES + changes = changes + 1 + } + case 'm', 'n': # Move + i = ep_gcur (ep, ap, x1, y1, x2, y2, key, + Memc[cmd],SZ_LINE) + call ep_move (ep, ap, xa, ya, xb, yb, x1, y1, x2, y2, + key) + if (EP_OUTDATA(ep) != NULL) { + change = YES + changes = changes + 1 + } + case 'g': # Surface graph + call ep_dosurface (ep) + case ' ': # Statistics + call ep_statistics (ep, ap, xa, ya, xb, yb, NO) + case 'p': + call ep_statistics (ep, ap, xa, ya, xb, yb, YES) + case 't': + EP_SEARCH(ep) = -EP_SEARCH(ep) + call ep_colon (ep, "search", newimage) + case '+': + EP_RADIUS(ep) = EP_RADIUS(ep) + 1. + call ep_colon (ep, "radius", newimage) + case '-': + EP_RADIUS(ep) = max (0., EP_RADIUS(ep) - 1.) + call ep_colon (ep, "radius", newimage) + case 's': # Surface plot + i = max (5., + abs (EP_SEARCH(ep))+EP_BUFFER(ep)+EP_WIDTH(ep)+1) + x1 = min (xa, xb) - i + x2 = max (xa, xb) + i + y1 = min (ya, yb) - i + y2 = max (ya, yb) + i + call ep_gindata (ep, x1, x2, y1, y2) + EP_OUTDATA(ep) = NULL + call ep_dosurface (ep) + case 'q': # Quit and save + case 'u': # Undo + if (EP_OUTDATA(ep) != NULL && EP_INDATA(ep) != NULL) { + call malloc (temp, EP_NPTS(ep), TY_REAL) + call amovr (Memr[EP_OUTDATA(ep)], Memr[temp], + EP_NPTS(ep)) + call amovr (Memr[EP_INDATA(ep)], + Memr[EP_OUTDATA(ep)], EP_NPTS(ep)) + call amovr (Memr[temp], Memr[EP_INDATA(ep)], + EP_NPTS(ep)) + call mfree (temp, TY_REAL) + change = YES + } else + call eprintf ("Can't undo last change\007\n") + case 'r', 'E', 'P', 'R', 'Z', '0', '1', '2', '3', '4', '5', + '6', '7', '8', '9': + if (EP_DISPLAY(ep) == YES) { + call ep_zoom (ep, xa, ya, xb, yb, key, erase) + newdisplay = YES + } + case 'Q': # Quit and no save + changes = 0 + case 'I': # Immediate interrupt + call imdelete (EP_WORK(ep)) + call fatal (1, "Interrupt") + default: + call printf ("\007") + } + } then + call erract (EA_WARN) + + if (key == 'q' || key == 'Q') + break + + if (change == YES && EP_AUTOSURFACE(ep) == YES) + call ep_dosurface (ep) + + if (change == YES && EP_AUTODISPLAY(ep) == YES) + newdisplay = YES + if (newdisplay == YES && EP_DISPLAY(ep) == YES) + call ep_display (ep, EP_WORK(ep), erase) + + # Log certain commands. Note that this is done after + # centering. + if (EP_LOGFD(ep) != NULL) { + switch (key) { + case 'a', 'c', 'd', 'f', 'j', 'l', 'v': + call fprintf (EP_LOGFD(ep), "%d %d 1 %c\n") + call pargi (xa) + call pargi (ya) + call pargi (key) + call fprintf (EP_LOGFD(ep), "%d %d 1 %c\n") + call pargi (xb) + call pargi (yb) + call pargi (key) + case 'b', 'e', 'k': + call fprintf (EP_LOGFD(ep), "%d %d 1 %c\n") + call pargi ((xa+xb)/2) + call pargi ((ya+yb)/2) + call pargi (key) + case 'u': + if (EP_OUTDATA(ep) != NULL) { + call fprintf (EP_LOGFD(ep), "%c\n") + call pargi (key) + } + case 'm', 'n': + call fprintf (EP_LOGFD(ep), "%d %d 1 %c\n") + call pargi ((xa+xb)/2) + call pargi ((ya+yb)/2) + call pargi (key) + call fprintf (EP_LOGFD(ep), "%d %d 1 %c\n") + call pargi ((x1+x2)/2) + call pargi ((y1+y2)/2) + call pargi (key) + } + } + } + + call imunmap (EP_IM(ep)) + # Only create the output if the input has been changed. + if (changes > 0) { + if (streq (EP_INPUT(ep), EP_OUTPUT(ep))) { + EP_IM(ep) = immap (EP_OUTPUT(ep), READ_WRITE, 0) + im = immap (EP_WORK(ep), READ_ONLY, 0) + do i = 1, IM_LEN(EP_IM(ep),2) + call amovr (Memr[imgl2r(im,i)], + Memr[impl2r(EP_IM(ep),i)], IM_LEN(im,1)) + call imunmap (im) + call imunmap (EP_IM(ep)) + call imdelete (EP_WORK(ep)) + } else { + if (imaccess (EP_OUTPUT(ep), READ_ONLY) == YES) + call imdelete (EP_OUTPUT(ep)) + call imrename (EP_WORK(ep), EP_OUTPUT(ep)) + } + } else + call imdelete (EP_WORK(ep)) + + # Check for a new image based on a colon command. This case + # always uses the input image name as output. + if (newimage == YES) { + call strcpy (EP_INPUT(ep), EP_OUTPUT(ep), EP_SZFNAME) + goto newim_ + } + } + + # Finish up. + if (EP_LOGFD(ep) != NULL) + call close (EP_LOGFD(ep)) + call imtclose (inlist) + call imtclose (outlist) + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine.par b/pkg/images/tv/imexamine.par new file mode 100644 index 00000000..fc409b45 --- /dev/null +++ b/pkg/images/tv/imexamine.par @@ -0,0 +1,22 @@ +input,s,a,,,,images to be examined +output,s,h,"",,,output root image name +ncoutput,i,h,101,1,,Number of columns in image output +nloutput,i,h,101,1,,Number of lines in image output +frame,i,q,1,1,,display frame +image,s,q,,,,image name +logfile,s,h,"",,,logfile +keeplog,b,h,no,,,log output results +defkey,s,h,"a",,,default key for cursor list input +autoredraw,b,h,yes,,,automatically redraw graph +allframes,b,h,yes,,,use all frames for displaying new images +nframes,i,h,0,,,number of display frames (0 to autosense) +ncstat,i,h,5,1,,number of columns for statistics +nlstat,i,h,5,1,,number of lines for statistics +graphcur,*gcur,h,"",,,graphics cursor input +imagecur,*imcur,h,"",,,image display cursor input +wcs,s,h,"logical",,,Coordinate system +xformat,s,h,"",,,X axis coordinate format +yformat,s,h,"",,,Y axis coordinate format +graphics,s,h,"stdgraph",,,graphics device +display,s,h,"display(image='$1',frame=$2)",,,display command template +use_display,b,h,yes,,,enable direct display interaction diff --git a/pkg/images/tv/imexamine/iecimexam.x b/pkg/images/tv/imexamine/iecimexam.x new file mode 100644 index 00000000..1bcc6d65 --- /dev/null +++ b/pkg/images/tv/imexamine/iecimexam.x @@ -0,0 +1,81 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> +include "imexam.h" + +# IE_CIMEXAM -- Column plot +# If the input column is INDEF use the last column. + +procedure ie_cimexam (gp, mode, ie, x) + +pointer gp # GIO pointer +int mode # Mode +pointer ie # Structure pointer +real x # Column + +real xavg, junk +int i, x1, x2, y1, y2, nx, ny, npts +pointer sp, title, im, data, ptr, xp, yp + +real asumr() +int clgpseti() +pointer clopset(), ie_gimage(), ie_gdata() +errchk clcpset, clopset + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + if (IE_PP(ie) != NULL) + call clcpset (IE_PP(ie)) + IE_PP(ie) = clopset ("cimexam") + + if (!IS_INDEF(x)) + IE_X1(ie) = x + + nx = clgpseti (IE_PP(ie), "naverage") + x1 = IE_X1(ie) - (nx - 1) / 2 + 0.5 + x2 = IE_X1(ie) + nx / 2 + 0.5 + xavg = (x1 + x2) / 2. + y1 = INDEFI + y2 = INDEFI + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + return + } + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + call smark (sp) + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (xp, ny, TY_REAL) + + do i = 1, ny + call ie_mwctran (ie, xavg, real(i), junk, Memr[xp+i-1]) + + if (nx > 1) { + ptr = data + call salloc (yp, ny, TY_REAL) + do i = 1, ny { + Memr[yp+i-1] = asumr (Memr[ptr], nx) + ptr = ptr + nx + } + call adivkr (Memr[yp], real (nx), Memr[yp], ny) + } else + yp = data + + call sprintf (Memc[title], IE_SZTITLE, "%s: Columns %d - %d\n%s") + call pargstr (IE_IMNAME(ie)) + call pargi (x1) + call pargi (x2) + call pargstr (IM_TITLE(im)) + + call ie_graph (gp, mode, IE_PP(ie), Memc[title], Memr[xp], + Memr[yp], ny, IE_YLABEL(ie), IE_YFORMAT(ie)) + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/iecolon.x b/pkg/images/tv/imexamine/iecolon.x new file mode 100644 index 00000000..72925500 --- /dev/null +++ b/pkg/images/tv/imexamine/iecolon.x @@ -0,0 +1,1038 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> +include "imexam.h" + +# List of boundary types, marker types, and colon commands. + +define BTYPES "|constant|nearest|reflect|wrap|project|" +define MTYPES "|point|box|plus|cross|circle|hebar|vebar|hline|vline|diamond|" +define CMDS "|angh|angv|background|banner|boundary|box|buffer|ceiling|\ + |center|constant|dashpat|defkey|eparam|fill|floor|interval|\ + |label|logfile|logx|logy|magzero|majrx|majry|marker|minrx|\ + |minry|naverage|ncolumns|ncontours|ncstat|nhi|nlines|nlstat|\ + |pointmode|radius|round|rplot|select|szmarker|ticklabels|\ + |title|width|x|xlabel|xorder|y|ylabel|yorder|zero|unlearn|\ + |autoredraw|nbins|z1|z2|autoscale|top_closed|allframes|wcs|\ + |xformat|yformat|fitplot|sigma|axes|fittype|beta|iterations|\ + |output|ncoutput|nloutput|" + +define ANGH 1 +define ANGV 2 +define BACKGROUND 3 +define BANNER 4 +define BOUNDARY 5 +define BOX 6 +define BUFFER 7 +define CEILING 8 + +define CENTER 10 +define CONSTANT 11 +define DASHPAT 12 +define DEFKEY 13 +define EPARAM 14 +define FILL 15 +define FLOOR 16 +define INTERVAL 17 + +define LABEL 19 +define LOGFILE 20 +define LOGX 21 +define LOGY 22 +define MAGZERO 23 +define MAJRX 24 +define MAJRY 25 +define MARKER 26 +define MINRX 27 + +define MINRY 29 +define NAVERAGE 30 +define NCOLUMNS 31 +define NCONTOURS 32 +define NCSTAT 33 +define NHI 34 +define NLINES 35 +define NLSTAT 36 + +define POINTMODE 38 +define RADIUS 39 +define ROUND 40 +define RPLOT 41 +define SELECT 42 +define SZMARKER 43 +define TICKLABELS 44 + +define TITLE 46 +define WIDTH 47 +define X 48 +define XLABEL 49 +define XORDER 50 +define Y 51 +define YLABEL 52 +define YORDER 53 +define ZERO 54 +define UNLEARN 55 + +define AUTOREDRAW 57 +define NBINS 58 +define Z1 59 +define Z2 60 +define AUTOSCALE 61 +define TOP_CLOSED 62 +define ALLFRAMES 63 +define WCS 64 + +define XFORMAT 66 +define YFORMAT 67 +define FITPLOT 68 +define SIGMA 69 +define AXES 70 +define FITTYPE 71 +define BETA 72 +define ITERATIONS 73 + +define OUTPUT 75 +define NCOUTPUT 76 +define NLOUTPUT 77 + + +# IE_COLON -- Respond to colon commands. + +procedure ie_colon (ie, cmdstr, gp, redraw) + +pointer ie # IMEXAM data structure +char cmdstr[ARB] # Colon command +pointer gp # GIO pointer +int redraw # Redraw graph? + +char gtype +bool bval +real rval1 +int ival, ncmd +pointer sp, cmd, pp + +bool clgetb(), clgpsetb() +char clgetc() +real clgetr(), clgpsetr() +int nscan(), strdic(), clgeti() +pointer clopset() +errchk clopset, clppsetb, clppsetr, clputb, clputi, clputr + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Scan the command string and get the first word. + call sscan (cmdstr) + call gargwrd (Memc[cmd], SZ_LINE) + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS) + if (ncmd == 0) { + call printf ("Unrecognized or ambiguous command\007") + call sfree (sp) + return + } + + gtype = IE_GTYPE(ie) + pp = IE_PP(ie) + + # Special optimization for the a key. + switch (ncmd) { + case BACKGROUND, CENTER, NAVERAGE, RPLOT, XORDER, WIDTH: + if (IE_LASTKEY(ie) == 'a') { + gtype = 'r' + pp = clopset ("rimexam") + } + if (IE_LASTKEY(ie) == ',') { + gtype = '.' + pp = clopset ("rimexam") + } + } + + # Switch on the command and possibly read further arguments. + switch (ncmd) { + case ANGH: + call gargr (rval1) + if (nscan() == 1) { + call printf ("angh %g\n") + call pargr (clgetr ("simexam.angh")) + } else { + call clputr ("simexam.angh", rval1) + if (gtype == 's') + redraw = YES + } + case ANGV: + call gargr (rval1) + if (nscan() == 1) { + call printf ("angv %g\n") + call pargr (clgetr ("simexam.angv")) + } else { + call clputr ("simexam.angv", rval1) + if (gtype == 's') + redraw = YES + } + case BACKGROUND: + switch (gtype) { + case 'j', 'k', 'r', '.': + call gargb (bval) + if (nscan() == 1) { + call printf ("background %b\n") + call pargb (clgpsetb (pp, "background")) + } else { + call clppsetb (pp, "background", bval) + if (pp == IE_PP(ie)) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case BANNER: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + call gargb (bval) + if (nscan() == 2) { + call clppsetb (pp, "banner", bval) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case BOUNDARY: + call gargwrd (Memc[cmd], SZ_LINE) + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, BTYPES) + if (ncmd == 0) { + call printf ("Boundary types are %s\n") + call pargstr (BTYPES) + } else + call clpstr ("vimexam.boundary", Memc[cmd]) + case BOX: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + call gargb (bval) + if (nscan() == 2) { + call clppsetb (pp, "box", bval) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case BUFFER: + call gargr (rval1) + if (nscan() == 1) { + call printf ("buffer %g\n") + call pargr (clgetr ("rimexam.buffer")) + } else { + call clputr ("rimexam.buffer", rval1) + if (gtype == 'r' || gtype == '.') + redraw = YES + } + case CEILING: + switch (gtype) { + case 's', 'e': + call gargr (rval1) + if (nscan() == 1) { + call printf ("ceiling %g\n") + call pargr (clgpsetr (pp, "ceiling")) + } else { + call clppsetr (pp, "ceiling", rval1) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case CENTER: + switch (gtype) { + case 'j', 'k', 'r', '.': + call gargb (bval) + if (nscan() == 1) { + call printf ("center %b\n") + call pargb (clgpsetb (pp, "center")) + } else { + call clppsetb (pp, "center", bval) + if (pp == IE_PP(ie)) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case CONSTANT: + call gargr (rval1) + if (nscan() == 1) { + call printf ("constant %g\n") + call pargr (clgetr ("vimexam.constant")) + } else + call clputr ("vimexam.constant", rval1) + case DASHPAT: + call gargi (ival) + if (nscan() == 1) { + call printf ("dashpat %g\n") + call pargi (clgeti ("eimexam.dashpat")) + } else { + call clputi ("eimexam.dashpat", ival) + if (gtype == 'e') + redraw = YES + } + case DEFKEY: + call gargwrd (Memc[cmd], SZ_LINE) + if (nscan() == 1) { + call printf ("defkey %c\n") + call pargc (clgetc ("defkey")) + } else + call clputc ("defkey", Memc[cmd]) + case EPARAM: + call gargwrd (Memc[cmd], SZ_LINE) + if (nscan() == 1) + Memc[cmd] = gtype + + switch (Memc[cmd]) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 's', 'h', '.': + call gdeactivate (gp, 0) + switch (Memc[cmd]) { + case 'c': + call clcmdw ("eparam cimexam") + case 'j': + call clcmdw ("eparam jimexam") + case 'k': + call clcmdw ("eparam kimexam") + case 'l': + call clcmdw ("eparam limexam") + case 'r', '.': + call clcmdw ("eparam rimexam") + case 's': + call clcmdw ("eparam simexam") + case 'u', 'v': + call clcmdw ("eparam vimexam") + case 'e': + call clcmdw ("eparam eimexam") + case 'h': + call clcmdw ("eparam himexam") + } + if (Memc[cmd] == gtype) + redraw = YES + } + case FILL: + call gargb (bval) + if (nscan() == 1) { + call printf ("fill %b\n") + call pargb (clgetb ("eimexam.fill")) + } else { + call clputb ("eimexam.fill", bval) + if (gtype == 'e') + redraw = YES + } + case FLOOR: + switch (gtype) { + case 's', 'e': + call gargr (rval1) + if (nscan() == 1) { + call printf ("floor %g\n") + call pargr (clgpsetr (pp, "floor")) + } else { + call clppsetr (pp, "floor", rval1) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case INTERVAL: + call gargr (rval1) + if (nscan() == 1) { + call printf ("interval %g\n") + call pargr (clgetr ("eimexam.interval")) + } else { + call clputr ("eimexam.interval", rval1) + if (gtype == 'e') + redraw = YES + } + case LABEL: + call gargb (bval) + if (nscan() == 2) { + call clputb ("eimexam.label", bval) + if (gtype == 'e') + redraw = YES + } + + case LOGFILE: + call gargwrd (Memc[cmd], SZ_LINE) + if (nscan() == 1) { + call strcpy (IE_LOGFILE(ie), Memc[cmd], SZ_LINE) + if (IE_LOGFD(ie) == NULL) { + call printf ("logfile %s [closed]\n") + call pargstr (Memc[cmd]) + } else { + call printf ("logfile %s [open]\n") + call pargstr (Memc[cmd]) + } + } else { + call clpstr ("logfile", Memc[cmd]) + if (IE_LOGFD(ie) != NULL) { + call close (IE_LOGFD(ie)) + IE_LOGFD(ie) = NULL + } + + call clgstr ("logfile", IE_LOGFILE(ie), SZ_LINE) + if (clgetb ("keeplog")) + iferr (call ie_openlog (ie)) + call erract (EA_WARN) + } + + case LOGX: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'h', '.': + call gargb (bval) + if (nscan() == 2) { + call clppsetb (pp, "logx", bval) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case LOGY: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'h', '.': + call gargb (bval) + if (nscan() == 2) { + call clppsetb (pp, "logy", bval) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case MAGZERO: + call gargr (rval1) + if (nscan() == 1) { + call printf ("magzero %g\n") + call pargr (clgetr ("rimexam.magzero")) + } else { + call clputr ("rimexam.magzero", rval1) + if (gtype == 'r' || gtype == '.') + redraw = YES + } + case AUTOREDRAW: + call gargb (bval) + if (nscan() == 1) { + call printf ("autoredraw %b\n") + call pargb (clgetb ("autoredraw")) + } else + call clputb ("autoredraw", bval) + default: + call ie_colon1 (ie, ncmd, gp, pp, gtype, redraw) + } + + if (pp != IE_PP(ie)) + call clcpset (pp) + if (redraw == YES && !clgetb ("autoredraw")) + redraw = NO + call sfree (sp) +end + + +# IE_COLON1 -- Subprocedure to get around too many strings error in xc. + +procedure ie_colon1 (ie, ncmd, gp, pp, gtype, redraw) + +pointer ie # IMEXAM data structure +int ncmd # Command number +pointer gp # GIO pointer +pointer pp # Pset pointer +char gtype # Graph type +int redraw # Redraw graph? + +int ival +real rval1, rval2 +bool bval +pointer sp, cmd, im + +real clgetr(), clgpsetr() +pointer ie_gimage() +int nscan(), strdic(), clgeti(), clgpseti() +errchk ie_gimage, clppseti + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + switch (ncmd) { + case MAJRX: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + call gargi (ival) + if (nscan() == 1) { + call printf ("majrx %d\n") + call pargi (clgpseti (pp, "majrx")) + } else { + call clppseti (pp, "majrx", ival) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case MAJRY: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + call gargi (ival) + if (nscan() == 1) { + call printf ("majry %d\n") + call pargi (clgpseti (pp, "majry")) + } else { + call clppseti (pp, "majry", ival) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case MARKER: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'h', '.': + call gargwrd (Memc[cmd], SZ_LINE) + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, MTYPES) + if (ncmd == 0) { + call printf ("Marker types are %s\n") + call pargstr (MTYPES) + } else { + call clppset (pp, "marker", Memc[cmd]) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case MINRX: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + call gargi (ival) + if (nscan() == 1) { + call printf ("minrx %d\n") + call pargi (clgpseti (pp, "minrx")) + } else { + call clppseti (pp, "minrx", ival) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case MINRY: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + call gargi (ival) + if (nscan() == 1) { + call printf ("minry %d\n") + call pargi (clgpseti (pp, "minry")) + } else { + call clppseti (pp, "minry", ival) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case NAVERAGE: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'v': + call gargi (ival) + if (nscan() == 1) { + call printf ("naverage %d\n") + call pargi (clgpseti (pp, "naverage")) + } else { + call clppseti (pp, "naverage", ival) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case NCOLUMNS: + switch (gtype) { + case 's', 'e', 'h': + call gargi (ival) + if (nscan() == 1) { + call printf ("ncolumns %d\n") + call pargi (clgpseti (pp, "ncolumns")) + } else { + call clppseti (pp, "ncolumns", ival) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case NCONTOURS: + call gargi (ival) + if (nscan() == 1) { + call printf ("ncontours %g\n") + call pargi (clgeti ("eimexam.ncontours")) + } else { + call clputi ("eimexam.ncontours", ival) + if (gtype == 'e') + redraw = YES + } + case NCSTAT: + call gargi (ival) + if (nscan() == 1) { + call printf ("ncstat %g\n") + call pargi (clgeti ("ncstat")) + } else + call clputi ("ncstat", ival) + case NHI: + call gargi (ival) + if (nscan() == 1) { + call printf ("nhi %g\n") + call pargi (clgeti ("eimexam.nhi")) + } else { + call clputi ("eimexam.nhi", ival) + if (gtype == 'e') + redraw = YES + } + case NLINES: + switch (gtype) { + case 's', 'e', 'h': + call gargi (ival) + if (nscan() == 1) { + call printf ("nlines %d\n") + call pargi (clgpseti (pp, "nlines")) + } else { + call clppseti (pp, "nlines", ival) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case NLSTAT: + call gargi (ival) + if (nscan() == 1) { + call printf ("nlstat %g\n") + call pargi (clgeti ("nlstat")) + } else + call clputi ("nlstat", ival) + case POINTMODE: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'h', '.': + call gargb (bval) + if (nscan() == 2) { + call clppsetb (pp, "pointmode", bval) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case RADIUS: + call gargr (rval1) + if (nscan() == 1) { + call printf ("radius %g\n") + call pargr (clgetr ("rimexam.radius")) + } else { + call clputr ("rimexam.radius", rval1) + if (gtype == 'r' || gtype == '.') + redraw = YES + } + case ROUND: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + call gargb (bval) + if (nscan() == 2) { + call clppsetb (pp, "round", bval) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case RPLOT: + switch (gtype) { + case 'j', 'k', 'r', '.': + call gargr (rval1) + if (nscan() == 1) { + call printf ("rplot %g\n") + call pargr (clgpsetr (pp, "rplot")) + } else { + call clppsetr (pp, "rplot", rval1) + if (pp == IE_PP(ie)) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case SELECT: + call gargi (ival) + if (nscan () > 1) { + if (IE_LIST(ie) != NULL) + IE_INDEX(ie) = ival + else + IE_NEWFRAME(ie) = ival + IE_MAPFRAME(ie) = 0 + iferr (im = ie_gimage (ie, YES)) + call erract (EA_WARN) + } + case SZMARKER: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'h', '.': + call gargi (ival) + if (nscan() == 1) { + call printf ("szmarker %d\n") + call pargi (clgpseti (pp, "szmarker")) + } else { + call clppseti (pp, "szmarker", ival) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case TICKLABELS: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + call gargb (bval) + if (nscan() == 2) { + call clppsetb (pp, "ticklabels", bval) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case TITLE: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 's', 'v', 'e', 'h', '.': + Memc[cmd] = EOS + call gargstr (Memc[cmd], SZ_LINE) + call clppset (pp, "title", Memc[cmd]) + redraw = YES + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case WIDTH: + switch (gtype) { + case 'j', 'k', 'r', '.': + call gargr (rval1) + if (nscan() == 1) { + call printf ("width %g\n") + call pargr (clgpsetr (pp, "width")) + } else { + call clppsetr (pp, "width", rval1) + if (pp == IE_PP(ie)) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case X: + switch (gtype) { + case 'c', 'j', 'k', 'l', 'r', 'v', 'h', '.': + call gargr (rval1) + call gargr (rval2) + if (nscan() < 3) { + call clppsetr (pp, "x1", INDEF) + call clppsetr (pp, "x2", INDEF) + } else { + call clppsetr (pp, "x1", rval1) + call clppsetr (pp, "x2", rval2) + } + redraw = YES + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case XLABEL: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + Memc[cmd] = EOS + call gargstr (Memc[cmd], SZ_LINE) + call clppset (pp, "xlabel", Memc[cmd]) + redraw = YES + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case XORDER: + switch (gtype) { + case 'j', 'k', 'r', '.': + call gargi (ival) + if (nscan() == 1) { + call printf ("xorder %d\n") + call pargi (clgpseti (pp, "xorder")) + } else { + call clppseti (pp, "xorder", ival) + if (pp == IE_PP(ie)) + redraw = YES + } + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case Y: + switch (gtype) { + case 'c', 'j', 'k', 'l', 'r', 'v', 'h', '.': + call gargr (rval1) + call gargr (rval2) + if (nscan() < 3) { + call clppsetr (pp, "y1", INDEF) + call clppsetr (pp, "y2", INDEF) + } else { + call clppsetr (pp, "y1", rval1) + call clppsetr (pp, "y2", rval2) + } + redraw = YES + default: + call printf ("Parameter does not apply to current graph\007\n") + } + default: + call ie_colon2 (ie, ncmd, gp, pp, gtype, redraw) + } + + call sfree (sp) +end + + +# IE_COLON2 -- Subprocedure to get around too many strings error in xc. + +procedure ie_colon2 (ie, ncmd, gp, pp, gtype, redraw) + +pointer ie # IMEXAM data structure +int ncmd # Command number +pointer gp # GIO pointer +pointer pp # Pset pointer +char gtype # Graph type +int redraw # Redraw graph? + +int ival +real rval1 +bool bval +pointer sp, cmd + +real clgetr() +bool clgetb() +int nscan(), clgeti(), btoi(), strdic() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + switch (ncmd) { + case YLABEL: + switch (gtype) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 'h', '.': + Memc[cmd] = EOS + call gargstr (Memc[cmd], SZ_LINE) + call clppset (pp, "ylabel", Memc[cmd]) + redraw = YES + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case YORDER: + call gargi (ival) + if (nscan() == 1) { + call printf ("yorder %d\n") + call pargi (clgeti ("rimexam.yorder")) + } else { + call clputi ("rimexam.yorder", ival) + if (gtype == 'r' || gtype == '.') + redraw = YES + } + case ZERO: + call gargr (rval1) + if (nscan() == 1) { + call printf ("zero %g\n") + call pargr (clgetr ("eimexam.zero")) + } else { + call clputr ("eimexam.zero", rval1) + if (gtype == 'e') + redraw = YES + } + case UNLEARN: + call gargwrd (Memc[cmd], SZ_LINE) + if (nscan() == 1) + Memc[cmd] = gtype + + switch (Memc[cmd]) { + case 'c', 'u', 'j', 'k', 'l', 'r', 'v', 'e', 's', 'h', '.': + switch (Memc[cmd]) { + case 'c': + call clcmdw ("unlearn cimexam") + case 'j': + call clcmdw ("unlearn jimexam") + case 'k': + call clcmdw ("unlearn jimexam") + case 'l': + call clcmdw ("unlearn limexam") + case 'r', '.': + call clcmdw ("unlearn rimexam") + case 's': + call clcmdw ("unlearn simexam") + case 'u', 'v': + call clcmdw ("unlearn vimexam") + case 'e': + call clcmdw ("unlearn eimexam") + case 'h': + call clcmdw ("unlearn himexam") + } + if (Memc[cmd] == gtype) + redraw = YES + default: + call printf ("Parameter does not apply to current graph\007\n") + } + case NBINS: + call gargi (ival) + if (nscan() == 1) { + call printf ("nbins %d\n") + call pargi (clgeti ("himexam.nbins")) + } else { + call clputi ("himexam.nbins", ival) + if (gtype == 'h') + redraw = YES + } + case Z1: + call gargr (rval1) + if (nscan() == 1) { + call printf ("z1 %g\n") + call pargr (clgetr ("himexam.z1")) + } else { + call clputr ("himexam.z1", rval1) + if (gtype == 'h') + redraw = YES + } + case Z2: + call gargr (rval1) + if (nscan() == 1) { + call printf ("z2 %g\n") + call pargr (clgetr ("himexam.z2")) + } else { + call clputr ("himexam.z2", rval1) + if (gtype == 'h') + redraw = YES + } + case AUTOSCALE: + call gargb (bval) + if (nscan() == 1) { + call printf ("autoscale %b\n") + call pargb (clgetb ("himexam.autoscale")) + } else { + call clputb ("himexam.autoscale", bval) + if (gtype == 'h') + redraw = YES + } + case TOP_CLOSED: + call gargb (bval) + if (nscan() == 1) { + call printf ("top_closed %b\n") + call pargb (clgetb ("himexam.top_closed")) + } else { + call clputb ("himexam.top_closed", bval) + if (gtype == 'h') + redraw = YES + } + case ALLFRAMES: + call gargb (bval) + if (nscan() == 1) { + call printf ("allframes %b\n") + call pargb (clgetb ("allframes")) + } else { + call clputb ("allframes", bval) + IE_ALLFRAMES(ie) = btoi (bval) + } + case WCS: + call gargwrd (Memc[cmd], SZ_LINE) + if (nscan() == 1) { + call printf ("wcs %s\n") + call pargstr (IE_WCSNAME(ie)) + } else { + call strcpy (Memc[cmd], IE_WCSNAME(ie), SZ_FNAME) + call ie_mwinit (ie) + redraw = YES + } + case XFORMAT: + call gargwrd (Memc[cmd], SZ_LINE) + if (nscan() == 1) + call clpstr ("xformat", "") + else + call clpstr ("xformat", Memc[cmd]) + case YFORMAT: + call gargwrd (Memc[cmd], SZ_LINE) + if (nscan() == 1) + call clpstr ("yformat", "") + else + call clpstr ("yformat", Memc[cmd]) + case FITPLOT: + call gargb (bval) + if (nscan() == 1) { + call printf ("fitplot %b\n") + call pargb (clgetb ("rimexam.fitplot")) + } else { + call clputb ("rimexam.fitplot", bval) + if (gtype == 'r') + redraw = YES + } + case SIGMA: + call gargr (rval1) + if (nscan() == 1) { + call printf ("sigma %g\n") + call pargr (clgetr ("jimexam.sigma")) + } else { + call clputr ("jimexam.sigma", rval1) + if (gtype == 'j' || gtype == 'k') + redraw = YES + } + case AXES: + call gargb (bval) + if (nscan() == 2) { + call clputb ("simexam.axes", bval) + if (gtype == 's') + redraw = YES + } + case FITTYPE: + call gargwrd (Memc[cmd], SZ_LINE) + if (nscan() == 1) { + call clgstr ("rimexam.fittype", Memc[cmd], SZ_LINE) + call printf ("fittype %s\n") + call pargstr (Memc[cmd]) + } else { + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, + "|gaussian|moffat|") + if (ncmd == 0) { + call printf ("Profile fit types are %s\n") + call pargstr ("|gaussian|moffat|") + } else { + call clpstr ("rimexam.fittype", Memc[cmd]) + if (gtype == 'r' || gtype == '.') + redraw = YES + } + } + case BETA: + call gargr (rval1) + if (nscan() == 1) { + call printf ("beta %g\n") + call pargr (clgetr ("rimexam.beta")) + } else { + call clputr ("rimexam.beta", rval1) + if (gtype == 'r' || gtype == '.') + redraw = YES + } + case ITERATIONS: + call gargi (ival) + if (nscan() == 1) { + call printf ("iterations %d\n") + call pargi (clgeti ("rimexam.iterations")) + } else { + call clputi ("rimexam.iterations", ival) + if (gtype == 'r') + redraw = YES + } + + case OUTPUT: + call gargwrd (Memc[cmd], SZ_FNAME) + if (nscan() == 1) { + call clgstr ("output", Memc[cmd], SZ_FNAME) + call printf ("output `%s'\n") + call pargstr (Memc[cmd]) + } else + call clpstr ("output", Memc[cmd]) + case NCOUTPUT: + call gargi (ival) + if (nscan() == 1) { + call printf ("ncoutput %g\n") + call pargi (clgeti ("ncoutput")) + } else + call clputi ("ncoutput", ival) + case NLOUTPUT: + call gargi (ival) + if (nscan() == 1) { + call printf ("nloutput %g\n") + call pargi (clgeti ("nloutput")) + } else + call clputi ("nloutput", ival) + + default: + call printf ("Ambiguous or unrecognized command\007\n") + } + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/iedisplay.x b/pkg/images/tv/imexamine/iedisplay.x new file mode 100644 index 00000000..4015bca7 --- /dev/null +++ b/pkg/images/tv/imexamine/iedisplay.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> + +# IE_DISPLAY -- Display an image. For the sake of convenience in this +# prototype program we do this by calling a task via the cl. This is an +# interface violation which we try to mitigate by using a CL parameter to +# hide the knowledge of how to format the command (as well as make it easy +# for the user to control how images are displayed). + +procedure ie_display (ie, image, frame) + +pointer ie #I imexamine descriptor +char image[ARB] #I image to be displayed +int frame #I frame in which to display image + +int nchars +pointer sp, d_cmd, d_args, d_template, im +int gstrcpy(), strmac(), ie_getnframes() +pointer immap() + +begin + call smark (sp) + call salloc (d_cmd, SZ_LINE, TY_CHAR) + call salloc (d_args, SZ_LINE, TY_CHAR) + call salloc (d_template, SZ_LINE, TY_CHAR) + + # Verify that the named image or image section exists. + iferr (im = immap (image, READ_ONLY, 0)) { + call erract (EA_WARN) + call sfree (sp) + return + } else + call imunmap (im) + + # Get the display command template. + call clgstr ("display", Memc[d_template], SZ_LINE) + + # Construct the macro argument list, a sequence of EOS delimited + # strings terminated by a double EOS. + + call aclrc (Memc[d_args], SZ_LINE) + nchars = gstrcpy (image, Memc[d_args], SZ_LINE) + 1 + call sprintf (Memc[d_args+nchars], SZ_LINE-nchars, "%d") + call pargi (frame) + + # Expand the command template to form the CL command. + nchars = strmac (Memc[d_template], Memc[d_args], Memc[d_cmd], SZ_LINE) + + # Send the command off to the CL and wait for completion. + call clcmdw (Memc[d_cmd]) + nchars = ie_getnframes (ie) + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/ieeimexam.x b/pkg/images/tv/imexamine/ieeimexam.x new file mode 100644 index 00000000..059721ba --- /dev/null +++ b/pkg/images/tv/imexamine/ieeimexam.x @@ -0,0 +1,243 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <gset.h> +include <config.h> +include <mach.h> +include <imhdr.h> +include <xwhen.h> +include <fset.h> +include "imexam.h" + + +# IE_EIMEXAM -- Contour map +# This is an interface to the NCAR CONREC routine. + +procedure ie_eimexam (gp, mode, ie, x, y) + +pointer gp # GIO pointer +int mode # Mode +pointer ie # IE pointer +real x, y # Center + +bool banner +int nset, ncontours, dashpat, nhi +int x1, x2, y1, y2, nx, ny, npts, wkid +real vx1, vx2, vy1, vy2, xs, xe, ys, ye +real interval, floor, ceiling, zero, finc, zmin, zmax +pointer sp, title, hostid, user, xlabel, ylabel, im, data, data1 + +pointer pp, clopset(), ie_gdata(), ie_gimage() +bool clgpsetb(), fp_equalr() +int clgpseti(), btoi() +real clgpsetr() + +int isizel, isizem, isizep, nrep, ncrt, ilab, nulbll, ioffd +int ioffm, isolid, nla, nlm +real xlt, ybt, side, ext, hold[5] +common /conre4/ isizel, isizem , isizep, nrep, ncrt, ilab, nulbll, + ioffd, ext, ioffm, isolid, nla, nlm, xlt, ybt, side +int first +common /conflg/ first +common /noaolb/ hold + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + pp = IE_PP(ie) + if (pp != NULL) + call clcpset (pp) + pp = clopset ("eimexam") + IE_PP(ie) = pp + + if (!IS_INDEF(x)) + IE_X1(ie) = x + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + nx = clgpseti (pp, "ncolumns") + ny = clgpseti (pp, "nlines") + x1 = IE_X1(ie) - (nx - 1) / 2 + 0.5 + x2 = IE_X1(ie) + nx / 2 + 0.5 + y1 = IE_Y1(ie) - (ny - 1) / 2 + 0.5 + y2 = IE_Y1(ie) + ny / 2 + 0.5 + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + return + } + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + xs = x1 + xe = x2 + ys = y1 + ye = y2 + + call smark (sp) + banner = false + if (mode == NEW_FILE) { + call gclear (gp) + + # Set the WCS + call gswind (gp, xs, xe, ys, ye) + + if (!clgpsetb (pp, "fill")) + call gsetr (gp, G_ASPECT, real (ny-1) / real (nx-1)) + + call gseti (gp, G_ROUND, btoi (clgpsetb (pp, "round"))) + + if (clgpsetb (pp, "box")) { + # Get number of major and minor tick marks. + call gseti (gp, G_XNMAJOR, clgpseti (pp, "majrx")) + call gseti (gp, G_XNMINOR, clgpseti (pp, "minrx")) + call gseti (gp, G_YNMAJOR, clgpseti (pp, "majry")) + call gseti (gp, G_YNMINOR, clgpseti (pp, "minry")) + + # Label tick marks on axes? + call gseti (gp, G_LABELTICKS, + btoi (clgpsetb (pp, "ticklabels"))) + + # Labels + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (hostid, SZ_LINE, TY_CHAR) + call salloc (user, SZ_LINE, TY_CHAR) + call salloc (xlabel, SZ_LINE, TY_CHAR) + call salloc (ylabel, SZ_LINE, TY_CHAR) + + banner = clgpsetb (pp, "banner") + if (banner) { + call sysid (Memc[hostid], SZ_LINE) + # We must postpone the parameter line until after conrec. + call sprintf (Memc[title], IE_SZTITLE, "%s\n\n%s") + call pargstr (Memc[hostid]) + call pargstr (IM_TITLE(im)) + } else + Memc[title] = EOS + + call clgpset (pp, "title", Memc[user], SZ_LINE) + if (Memc[user] != EOS) { + call strcat ("\n", Memc[title], IE_SZTITLE) + call strcat (Memc[user], Memc[title], IE_SZTITLE) + } + call clgpset (pp, "xlabel", Memc[xlabel], SZ_LINE) + call clgpset (pp, "ylabel", Memc[ylabel], SZ_LINE) + + call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel]) + } + } + + # First of all, intialize conrec's block data before altering any + # parameters in common. + first = 1 + call conbd + + # Set contour parameters + zero = clgpsetr (pp, "zero") + floor = clgpsetr (pp, "floor") + ceiling = clgpsetr (pp, "ceiling") + nhi = clgpseti (pp, "nhi") + dashpat = clgpseti (pp, "dashpat") + + # Resolve INDEF limits. + if (IS_INDEF (floor) || IS_INDEF (ceiling)) { + call alimr (Memr[data], npts, zmin, zmax) + if (IS_INDEF (floor)) + floor = zmin + if (IS_INDEF (ceiling)) + ceiling = zmax + } + + # Apply the zero point shift. + if (abs (zero) > EPSILON) { + call salloc (data1, npts, TY_REAL) + call asubkr (Memr[data], zero, Memr[data1], npts) + floor = floor - zero + ceiling = ceiling - zero + } else + data1 = data + + # Avoid conrec's automatic scaling. + if (floor == 0.) + floor = EPSILON + if (ceiling == 0.) + ceiling = EPSILON + + # The user can suppress the contour labelling by setting the common + # parameter "ilab" to zero. + if (btoi (clgpsetb (pp, "label")) == NO) + ilab = 0 + else + ilab = 1 + + # User can specify either the number of contours or the contour + # interval, or let conrec pick a nice number. Get params and + # encode the FINC param expected by conrec. + + ncontours = clgpseti (pp, "ncontours") + if (ncontours <= 0) { + interval = clgpsetr (pp, "interval") + if (interval <= 0) + finc = 0 + else + finc = interval + } else + finc = - abs (ncontours) + + # Open device and make contour plot. + call gopks (STDERR) + wkid = 1 + call gopwk (wkid, 6, gp) + call gacwk (wkid) + + # Make the contour plot. + nset = 1 # No conrec viewport + ioffm = 1 # No conrec box + call gswind (gp, 1., real (nx), 1., real (ny)) + call ggview (gp, vx1, vx2, vy1, vy2) + call set (vx1, vx2, vy1, vy2, 1.0, real (nx), 1.0, real (ny), 1) + call conrec (Memr[data1], nx, nx, ny, floor, + ceiling, finc, nset, nhi, -dashpat) + + call gdawk (wkid) + call gclks () + + call gswind (gp, xs, xe, ys, ye) + if (banner) { + if (fp_equalr (hold(5), 1.0)) { + call sprintf (Memc[title], IE_SZTITLE, + "%s\n%s: Contoured from %g to %g, interval = %g\n%s") + call pargstr (Memc[hostid]) + call pargstr (IE_IMNAME(ie)) + call pargr (hold(1)) + call pargr (hold(2)) + call pargr (hold(3)) + call pargstr (IM_TITLE(im)) + } else { + call sprintf (Memc[title], IE_SZTITLE, + "%s\n%s:contoured from %g to %g, interval = %g, labels scaled by %g\n%s") + call pargstr (Memc[xlabel]) + call pargstr (IE_IMNAME(ie)) + call pargr (hold(1)) + call pargr (hold(2)) + call pargr (hold(3)) + call pargr (hold(5)) + call pargstr (IM_TITLE(im)) + } + + if (Memc[user] != EOS) { + call strcat ("\n", Memc[user], IE_SZTITLE) + call strcat (Memc[user], Memc[title], IE_SZTITLE) + } + + call gseti (gp, G_DRAWAXES, NO) + call glabax (gp, Memc[title], "", "") + + } else + call gtext (gp, xs, ys, "", "") + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/iegcur.x b/pkg/images/tv/imexamine/iegcur.x new file mode 100644 index 00000000..2b76cee5 --- /dev/null +++ b/pkg/images/tv/imexamine/iegcur.x @@ -0,0 +1,242 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <ctype.h> +include <mach.h> +include "imexam.h" + +# IE_GCUR -- Get IMEXAM cursor value. +# This is an interface between the standard cursor input and IMEXAM. +# It reads the appropriate cursor, determines the image index or frame +# type, makes the appropriate default coordinate conversions when using +# graphics cursor input, and gets any further cursor reads needed. +# Missing coordinates default to the last coordinates. + +int procedure ie_gcur (ie, curtype, x, y, key, strval, maxch) + +pointer ie #I IMEXAM structure +int curtype #I cursor type (0=image, 1=graphics, 2=text) +real x, y #O cursor position +int key #O keystroke value of cursor event +char strval[ARB] #O string value, if any +int maxch #I max chars out + +char ch +real x1, y1, x2, y2, dx, dy, r, cosa, sina +int temp, k[2], nitems, wcs, ip, i + +bool streq() +char clgetc() +int clgcur(), imd_gcur(), ctor(), cctoc() +errchk clgcur, imd_gcur + +begin + # Save last cursor value. + x1 = x; y1 = y + strval[1] = EOS + k[1] = clgetc ("defkey") + + # Get one or more cursor values from the desired cursor parameter. + # Check for missing coordinates and substitute the last value. + + do i = 1, 2 { + switch (curtype) { + case 'i': + nitems = imd_gcur ("imagecur", x, y, wcs, k[i], strval, maxch) + if (IS_INDEF(x)) + x = x1 + if (IS_INDEF(y)) + y = y1 + IE_NEWFRAME(ie) = wcs + if (IE_DFRAME(ie) <= 0) + IE_DFRAME(ie) = IE_NEWFRAME(ie) + + case 'g': + nitems = clgcur ("graphcur", x, y, wcs, k[i], strval, maxch) + + # Make any needed default coordinate conversions from the + # graphic coordinates. + + switch (IE_GTYPE(ie)) { + case 'c', 'k': # Column plot + y = x + x = IE_X1(ie) + + if (IS_INDEF(y)) + y = y1 + else if (IE_MW(ie) != NULL) { + if (streq (IE_WCSNAME(ie), "logical")) + ; + else if (streq (IE_WCSNAME(ie), "physical")) + call ie_imwctran (ie, x, y, dx, y) + else { + r = y + y = IM_LEN(IE_IM(ie),2) + call ie_mwctran (ie, x, 1., dx, y1) + call ie_mwctran (ie, x, y, dx, y2) + dy = y + while (dy > .001) { + dy = dy / 2 + if (r > y1) { + if (r < y2) + y = y - dy + else + y = y + dy + } else { + if (r < y2) + y = y + dy + else + y = y - dy + } + call ie_mwctran (ie, x, y, dx, y2) + } + } + } + case 'e': # Contour plot + if (IS_INDEF(x)) + x = x1 + if (IS_INDEF(y)) + y = y1 + case 'j', 'l': # Line plot + y = IE_Y1(ie) + + if (IS_INDEF(x)) + x = x1 + else if (IE_MW(ie) != NULL) { + if (streq (IE_WCSNAME(ie), "logical")) + ; + else if (streq (IE_WCSNAME(ie), "physical")) + call ie_imwctran (ie, x, y, x, dy) + else { + r = x + x = IM_LEN(IE_IM(ie),1) + call ie_mwctran (ie, 1., y, x1, dy) + call ie_mwctran (ie, x, y, x2, dy) + dx = x + while (dx > .001) { + dx = dx / 2 + if (r > x1) { + if (r < x2) + x = x - dx + else + x = x + dx + } else { + if (r < x2) + x = x + dx + else + x = x - dx + } + call ie_mwctran (ie, x, y, x2, dy) + } + } + } + case 'r','.': # Radial profile plot + x = IE_X1(ie) + y = IE_Y1(ie) + case 'h', 's': # Surface plot + x = IE_X1(ie) + y = IE_Y1(ie) + case 'u': # Vector plot + if (IS_INDEF(x)) + x = x1 + y = x * sina + (IE_Y1(ie) + IE_Y2(ie)) / 2 + x = x * cosa + (IE_X1(ie) + IE_X2(ie)) / 2 + case 'v': # Vector plot + if (IS_INDEF(x)) + x = x1 + y = x * sina + IE_Y1(ie) + x = x * cosa + IE_X1(ie) + } + } + + key = k[1] + switch (key) { + case 'v', 'u': + if (i == 1) { + x1 = x + y1 = y + call printf ("again:") + } else { + x2 = x + y2 = y + r = sqrt (real ((y2-y1)**2 + (x2-x1)**2)) + if (r > 0.) { + cosa = (x2 - x1) / r + sina = (y2 - y1) / r + } else { + cosa = 0. + sina = 0. + } + call printf ("\n") + switch (key) { + case 'v': + x = x1 + y = y1 + case 'u': + x = 2 * x1 - x2 + y = 2 * y1 - y2 + } + IE_X2(ie) = x2 + IE_Y2(ie) = y2 + break + } + case 'b': + if (i == 1) { + IE_IX1(ie) = x + 0.5 + IE_IY1(ie) = y + 0.5 + call printf ("again:") + } else { + IE_IX2(ie) = x + 0.5 + IE_IY2(ie) = y + 0.5 + call printf ("\n") + temp = IE_IX1(ie) + IE_IX1(ie) = min (IE_IX1(ie), IE_IX2(ie)) + IE_IX2(ie) = max (temp, IE_IX2(ie)) + temp = IE_IY1(ie) + IE_IY1(ie) = min (IE_IY1(ie), IE_IY2(ie)) + IE_IY2(ie) = max (temp, IE_IY2(ie)) + break + } + default: + break + } + } + + # Map numeric colon sequences (: x [y] key strval) to make them appear + # as ordinary "x y key" type cursor reads. This makes it possible for + # the user to access any command using typed in rather than positional + # cursor coordinates. Special treatment is also given to the syntax + # ":lN" and ":cN", provided for compatibility with IMPLOT for simple + # line and column plots. + + if (key == ':') { + for (ip=1; IS_WHITE(strval[ip]); ip=ip+1) + ; + if (IS_DIGIT(strval[ip])) { + if (ctor (strval, ip, x) <= 0) + ; + if (ctor (strval, ip, y) <= 0) + y = x + for (; IS_WHITE(strval[ip]); ip=ip+1) + ; + if (cctoc (strval, ip, ch) > 0) + key = ch + call strcpy (strval[ip], strval, maxch) + + } else if (strval[ip] == 'l' && IS_DIGIT(strval[ip+1])) { + ip = ip + 1 + if (ctor (strval, ip, x) > 0) { + y = x + key = 'l' + } + } else if (strval[ip] == 'c' && IS_DIGIT(strval[ip+1])) { + ip = ip + 1 + if (ctor (strval, ip, x) > 0) { + y = x + key = 'c' + } + } + } + + return (nitems) +end diff --git a/pkg/images/tv/imexamine/iegdata.x b/pkg/images/tv/imexamine/iegdata.x new file mode 100644 index 00000000..6e1f7e91 --- /dev/null +++ b/pkg/images/tv/imexamine/iegdata.x @@ -0,0 +1,45 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IE_GDATA -- Get image data with boundary checking. + +pointer procedure ie_gdata (im, x1, x2, y1, y2) + +pointer im # IMIO pointer +int x1, x2, y1, y2 # Subraster limits (input and output) + +int i, nc, nl +pointer imgs2r() +errchk imgs2r + +begin + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + if (IS_INDEFI (x1)) + x1 = 1 + if (IS_INDEFI (x2)) + x2 = nc + if (IS_INDEFI (y1)) + y1 = 1 + if (IS_INDEFI (y2)) + y2 = nl + + i = max (x1, x2) + x1 = min (x1, x2) + x2 = i + i = max (y1, y2) + y1 = min (y1, y2) + y2 = i + + if (x2 < 1 || x1 > nc || y2 < 1 || y1 > nl) + call error (1, "Pixels out of bounds") + + x1 = max (1, x1) + x2 = min (nc, x2) + y1 = max (1, y1) + y2 = min (nl, y2) + + return (imgs2r (im, x1, x2, y1, y2)) +end diff --git a/pkg/images/tv/imexamine/iegimage.x b/pkg/images/tv/imexamine/iegimage.x new file mode 100644 index 00000000..b0fda919 --- /dev/null +++ b/pkg/images/tv/imexamine/iegimage.x @@ -0,0 +1,261 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include "imexam.h" + +# IE_GIMAGE -- Get input image name and return IMIO pointer. +# If examining a list of images access the indexed image, displaying it if +# not already displayed. Otherwise the image loaded into the current display +# frame is displayed, if it can be accessed, or the image frame buffer itself +# is examined. If there is neither a list of images nor display access the +# user is queried for the name of the image to be examined. +# This procedure uses a prototype display interface (IMD/IW). + +pointer procedure ie_gimage (ie, select) + +pointer ie #I IMEXAM pointer +int select #I select frame? + +char errstr[SZ_FNAME] +int frame, i, j, k +pointer sp, image, dimage, imname, im + +int imtrgetim(), fnldir(), errget() +bool strne(), streq() +pointer imd_mapframe(), immap() +errchk imd_mapframe, immap, ie_display, ie_mwinit + + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (dimage, SZ_FNAME, TY_CHAR) + + # Get image name, and display image if using display. If we are + # examining a list of images, the list and the current index into + # the list determine the image to be examined. If there is no list + # we examine the currently displayed images, if any, else the + # contents of the image display frame buffers are examined as images. + + if (IE_LIST(ie) != NULL) { + # Get image name. + IE_INDEX(ie) = max(1, min(IE_LISTLEN(ie), IE_INDEX(ie))) + if (imtrgetim (IE_LIST(ie), IE_INDEX(ie), Memc[image], + SZ_FNAME) == EOF) + call error (1, "Reference outside of image list") + + # Display image. + if (IE_USEDISPLAY(ie) == YES) { + # Is named image currently loaded into the image display? + frame = 0 + if (streq (Memc[image], IE_IMAGE(ie))) + frame = IE_MAPFRAME(ie) + else { + if (IE_DS(ie) == NULL) + IE_DS(ie) = imd_mapframe (max (1, IE_NEWFRAME(ie)/100), + READ_WRITE, NO) + + do i = 1, IE_NFRAMES(ie) { + if (i == IE_MAPFRAME(ie)/100) + next + do j = 1, 99 { + k = i * 100 + j + iferr (call ie_imname (IE_DS(ie), k, + Memc[dimage], SZ_FNAME)) + break + if (streq (Memc[image], Memc[dimage])) { + frame = k + break + } + } + if (frame != 0) + break + } + } + + # Load image into display frame if not already loaded. + # If the allframes option is specified cycle through the + # available display frames, otherwise resuse the same frame. + + if (frame == 0) { + if (IE_DS(ie) != NULL) { + if (IE_IM(ie) == IE_DS(ie)) + IE_IM(ie) = NULL + call imunmap (IE_DS(ie)) + } + + frame = 100 * max (1, IE_DFRAME(ie) / 100) + 1 + call ie_display (ie, Memc[image], frame/100) + + IE_MAPFRAME(ie) = 0 + if (IE_ALLFRAMES(ie) == YES) { + IE_DFRAME(ie) = frame + 100 + if (IE_DFRAME(ie)/100 > IE_NFRAMES(ie)) + IE_DFRAME(ie) = 101 + } + } + + # Map and display-select the frame. + if (frame != IE_MAPFRAME(ie) || frame != IE_NEWFRAME(ie)) { + if (IE_DS(ie) != NULL) { + if (IE_IM(ie) == IE_DS(ie)) + IE_IM(ie) = NULL + call imunmap (IE_DS(ie)) + } + IE_DS(ie) = imd_mapframe (frame/100, READ_WRITE, select) + IE_MAPFRAME(ie) = frame + IE_NEWFRAME(ie) = frame + } + } + + } else if (IE_USEDISPLAY(ie) == YES) { + # Map the new display frame. + if (IE_NEWFRAME(ie) != IE_MAPFRAME(ie)) { + if (IE_NEWFRAME(ie)/100 != IE_MAPFRAME(ie)/100) { + if (IE_DS(ie) != NULL) { + if (IE_IM(ie) == IE_DS(ie)) + IE_IM(ie) = NULL + call imunmap (IE_DS(ie)) + } + IE_DS(ie) = imd_mapframe (IE_NEWFRAME(ie)/100, READ_WRITE, + select) + } + IE_MAPFRAME(ie) = IE_NEWFRAME(ie) + } + + # Get the image name. + call ie_imname (IE_DS(ie), IE_MAPFRAME(ie), Memc[image], SZ_FNAME) + + } else + call clgstr ("image", Memc[image], SZ_FNAME) + + # Check if the image has not been mapped and if so map it. + # Possibly log any change of image. Always map the physical image, + # not a section, since we do everything in image coordinates. + + if (IE_IM(ie) == NULL || strne (Memc[image], IE_IMAGE(ie))) { + + # Strip the path. + call imgcluster (Memc[image], Memc[imname], SZ_FNAME) + i = fnldir (Memc[imname], Memc[imname], SZ_FNAME) + call strcpy (Memc[image+i], IE_IMNAME(ie), IE_SZFNAME) + + # Map the image. + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + # Warn user once. + i = errget (Memc[imname], SZ_FNAME) + if (strne (Memc[imname], errstr)) { + call erract (EA_WARN) + call strcpy (Memc[imname], errstr, SZ_FNAME) + } + + # Access the display frame buffer as the data image. + if (IE_USEDISPLAY(ie) == YES && IE_LIST(ie) == NULL) { + if (IE_IM(ie) != NULL && IE_IM(ie) != IE_DS(ie)) + iferr (call imunmap (IE_IM(ie))) + ; + IE_IM(ie) = IE_DS(ie) + call sprintf (IE_IMAGE(ie), IE_SZFNAME, "Frame.%d(%s)") + call pargi (IE_MAPFRAME(ie)) + call pargstr (IE_IMNAME(ie)) + call strcpy ("Contents of raw image frame buffer\n", + IM_TITLE(IE_IM(ie)), SZ_IMTITLE) + } else + call erract (EA_WARN) + + } else { + # Adjust image sections. + call ie_gimage1 (im, Memc[image], Memc[imname], SZ_FNAME) + if (strne (Memc[image], Memc[imname])) { + call imunmap (im) + im = immap (Memc[imname], READ_ONLY, 0) + } + + # Make the new image the current one. + errstr[1] = EOS + call strcpy (Memc[image], IE_IMAGE(ie), IE_SZFNAME) + if (IE_IM(ie) != NULL && IE_IM(ie) != IE_DS(ie)) + iferr (call imunmap (IE_IM(ie))) + ; + if (IE_MW(ie) != NULL) + call mw_close (IE_MW(ie)) + IE_IM(ie) = im + if (IE_LOGFD(ie) != NULL) { + call fprintf (IE_LOGFD(ie), "# [%d] %s - %s\n") + call pargi (IE_INDEX(ie)) + call pargstr (IE_IMNAME(ie)) + call pargstr (IM_TITLE(IE_IM(ie))) + } + } + } + + call ie_mwinit (ie) + + call sfree (sp) + return (IE_IM(ie)) +end + + +# IE_GIMAGE1 -- Convert input image section name to a 2D physical image section. + +procedure ie_gimage1 (im, input, output, maxchar) + +pointer im #I IMIO pointer +char input[ARB] #I Input image name +char output[maxchar] #O Output image name +int maxchar #I Maximum characters in output name. + +int i, fd +pointer sp, section, lv, pv1, pv2 + +int stropen(), strlen() +bool streq() + +begin + call smark (sp) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (lv, IM_MAXDIM, TY_LONG) + call salloc (pv1, IM_MAXDIM, TY_LONG) + call salloc (pv2, IM_MAXDIM, TY_LONG) + + # Get endpoint coordinates in original image. + call amovkl (long(1), Meml[lv], IM_MAXDIM) + call aclrl (Meml[pv1], IM_MAXDIM) + call imaplv (im, Meml[lv], Meml[pv1], 2) + call amovl (IM_LEN(im,1), Meml[lv], IM_NDIM(im)) + call aclrl (Meml[pv2], IM_MAXDIM) + call imaplv (im, Meml[lv], Meml[pv2], 2) + + # Set image section. + fd = stropen (Memc[section], SZ_FNAME, NEW_FILE) + call fprintf (fd, "[") + do i = 1, IM_MAXDIM { + if (Meml[pv1+i-1] != Meml[pv2+i-1]) + call fprintf (fd, "*") + else if (Meml[pv1+i-1] != 0) { + call fprintf (fd, "%d") + call pargi (Meml[pv1+i-1]) + } else + break + call fprintf (fd, ",") + } + call close (fd) + i = strlen (Memc[section]) + Memc[section+i-1] = ']' + + if (streq ("[*,*]", Memc[section])) + Memc[section] = EOS + + # Strip existing image section and add new section. + call imgimage (input, output, maxchar) + call strcat (Memc[section], output, maxchar) + +# if (Memc[section] == EOS) +# call imgimage (input, output, maxchar) +# else +# call strcpy (input, output, maxchar) + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/iegnfr.x b/pkg/images/tv/imexamine/iegnfr.x new file mode 100644 index 00000000..0a8fb30d --- /dev/null +++ b/pkg/images/tv/imexamine/iegnfr.x @@ -0,0 +1,61 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "imexam.h" + +# IE_GETNFRAMES -- Determine the number of image display frames. If the +# display can be accessed at all we assume there is always at least one +# frame; beyond that presence of a valid WCS is used to test whether we +# are interested in looking at a frame. + +int procedure ie_getnframes (ie) + +pointer ie #I imexamine descriptor + +pointer sp, imname, ds, iw +int server, nframes, status, i + +int clgeti(), strncmp(), imd_wcsver() +pointer imd_mapframe(), iw_open() +errchk imd_mapframe, clgeti + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + nframes = clgeti ("nframes") + if (nframes == 0) { + # Try to automatically determine the number of frames. + ds = IE_DS(ie) + if (ds == NULL) + ds = imd_mapframe (1, READ_WRITE, NO) + + # If we are talking to a simple image display we assume the device + # has 4 frames (until more general display interfaces come along). + # Servers are more complicated because the number of frames is + # dynamically configurable, even while imexamine is running. + # We use the WCS query to try to count the current number of + # allocated frames in the case of a server device. + + server = IM_LEN(ds,4) + if (server == YES && imd_wcsver() != 0) { + nframes = 1 + do i = 1, MAX_FRAMES { + iferr (iw = iw_open (ds, i, Memc[imname], SZ_FNAME, status)) + next + call iw_close (iw) + if (strncmp (Memc[imname], "[NOSUCHFRAME]", 3) != 0) + nframes = max (nframes, i) + } + } else + nframes = 4 + + if (IE_DS(ie) == NULL) + call imunmap (ds) + } + + IE_NFRAMES(ie) = max (nframes, IE_DFRAME(ie)/100) + call sfree (sp) + + return (nframes) +end diff --git a/pkg/images/tv/imexamine/iegraph.x b/pkg/images/tv/imexamine/iegraph.x new file mode 100644 index 00000000..edfa28c2 --- /dev/null +++ b/pkg/images/tv/imexamine/iegraph.x @@ -0,0 +1,145 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include "imexam.h" + +define MTYPES "|point|box|plus|cross|circle|hebar|vebar|hline|vline|diamond|" +define IE_GBUF 0.10 # Buffer around data +define IE_SZTITLE 512 # Size of multiline title + + +# IE_GRAPH -- Make a graph +# This procedure is used by most of the different graph types to provide +# consistency in features and parameters. The parameters are read using +# the pset pointer. + +procedure ie_graph (gp, mode, pp, param, x, y, npts, label, format) + +pointer gp # GIO pointer +int mode # Mode +pointer pp # PSET pointer +char param[ARB] # Parameter string +real x[npts] # X data +real y[npts] # Y data +int npts # Number of points +char label # Default x label +char format # Default x format + +int i, marks[10], linepattern, patterns[4], clgpseti(), btoi(), strdic() +pointer sp, title, xlabel, ylabel +real x1, x2, y1, y2, wx1, wx2, wy1, wy2, temp, szmarker +real clgpsetr(), ie_iformatr() +bool clgpsetb(), streq() + +data patterns/GL_SOLID, GL_DASHED, GL_DOTTED, GL_DOTDASH/ +data marks/GM_POINT, GM_BOX, GM_PLUS, GM_CROSS, GM_CIRCLE, GM_HEBAR, + GM_VEBAR, GM_HLINE, GM_VLINE, GM_DIAMOND/ + +begin + call smark (sp) + call salloc (xlabel, SZ_LINE, TY_CHAR) + + # If a new graph setup all the axes and labeling options and then + # make the graph. + + if (mode == NEW_FILE) { + call gclear (gp) + + linepattern = 0 + + x1 = ie_iformatr (clgpsetr (pp, "x1"), format) + x2 = ie_iformatr (clgpsetr (pp, "x2"), format) + y1 = clgpsetr (pp, "y1") + y2 = clgpsetr (pp, "y2") + + if (IS_INDEF (x1) || IS_INDEF (x2)) + call gascale (gp, x, npts, 1) + if (IS_INDEF (y1) || IS_INDEF (y2)) + call gascale (gp, y, npts, 2) + + call gswind (gp, x1, x2, y1, y2) + call ggwind (gp, wx1, wx2, wy1, wy2) + + temp = wx2 - wx1 + if (IS_INDEF (x1)) + wx1 = wx1 - IE_GBUF * temp + if (IS_INDEF (x2)) + wx2 = wx2 + IE_GBUF * temp + + temp = wy2 - wy1 + if (IS_INDEF (y1)) + wy1 = wy1 - IE_GBUF * temp + if (IS_INDEF (y2)) + wy2 = wy2 + IE_GBUF * temp + + call gswind (gp, wx1, wx2, wy1, wy2) + call gsetr (gp, G_ASPECT, 0.) + call gseti (gp, G_ROUND, btoi (clgpsetb (pp, "round"))) + + i = GW_LINEAR + if (clgpsetb (pp, "logx")) + i = GW_LOG + call gseti (gp, G_XTRAN, i) + i = GW_LINEAR + if (clgpsetb (pp, "logy")) + i = GW_LOG + call gseti (gp, G_YTRAN, i) + + if (clgpsetb (pp, "box")) { + # Get number of major and minor tick marks. + call gseti (gp, G_XNMAJOR, clgpseti (pp, "majrx")) + call gseti (gp, G_XNMINOR, clgpseti (pp, "minrx")) + call gseti (gp, G_YNMAJOR, clgpseti (pp, "majry")) + call gseti (gp, G_YNMINOR, clgpseti (pp, "minry")) + + # Label tick marks on axes? + call gsets (gp, G_XTICKFORMAT, format) + call gseti (gp, G_LABELTICKS, + btoi (clgpsetb (pp, "ticklabels"))) + + # Fetch labels and plot title string. + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (ylabel, SZ_LINE, TY_CHAR) + + if (clgpsetb (pp, "banner")) { + call sysid (Memc[title], IE_SZTITLE) + call strcat ("\n", Memc[title], IE_SZTITLE) + call strcat (param, Memc[title], IE_SZTITLE) + } else + Memc[title] = EOS + + call clgpset (pp, "title", Memc[xlabel], SZ_LINE) + if (Memc[xlabel] != EOS) { + call strcat ("\n", Memc[title], IE_SZTITLE) + call strcat (Memc[xlabel], Memc[title], IE_SZTITLE) + } + call clgpset (pp, "xlabel", Memc[xlabel], SZ_LINE) + call clgpset (pp, "ylabel", Memc[ylabel], SZ_LINE) + + if (streq ("wcslabel", Memc[xlabel])) + call strcpy (label, Memc[xlabel], SZ_LINE) + + call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel]) + } + } + + # Draw the data. + if (clgpsetb (pp, "pointmode")) { + call clgpset (pp, "marker", Memc[xlabel], SZ_LINE) + i = strdic (Memc[xlabel], Memc[xlabel], SZ_LINE, MTYPES) + if (i == 0) + i = 2 + if (marks[i] == GM_POINT) + szmarker = 0.0 + else + szmarker = clgpsetr (pp, "szmarker") + call gpmark (gp, x, y, npts, marks[i], szmarker, szmarker) + } else { + linepattern = min (4, linepattern + 1) + call gseti (gp, G_PLTYPE, patterns[linepattern]) + call gpline (gp, x, y, npts) + } + call gflush (gp) + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/iehimexam.x b/pkg/images/tv/imexamine/iehimexam.x new file mode 100644 index 00000000..4a0fd150 --- /dev/null +++ b/pkg/images/tv/imexamine/iehimexam.x @@ -0,0 +1,193 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include "imexam.h" + +define HGM_TYPES "|line|box|" +define HGM_LINE 1 # line vectors for histogram plot +define HGM_BOX 2 # box vectors for histogram plot + +# IE_HIMEXAM -- Compute and plot or list a histogram. +# If the GIO pointer is NULL list the histogram otherwise make a graph. + +procedure ie_himexam (gp, mode, ie, x, y) + +pointer gp # GIO pointer (NULL for histogram listing) +int mode # Mode +pointer ie # Structure pointer +real x, y # Center coordinate + +real z1, z2, dz, zmin, zmax +int i, j, x1, x2, y1, y2, nx, ny, npts, nbins, nbins1, nlevels, nwide +pointer pp, sp, hgm, title, im, data, xp, yp + +int clgpseti() +real clgpsetr() +bool clgpsetb(), fp_equalr() +pointer clopset(), ie_gimage(), ie_gdata() + +begin + # Get the image and return on error. + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + # Use last graph coordinate if redrawing. Close last graph pset + # pointer if making new graph. + + if (gp != NULL) { + if (!IS_INDEF(x)) + IE_X1(ie) = x + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + z1 = IE_X1(ie) + z2 = IE_Y1(ie) + + if (IE_PP(ie) != NULL) + call clcpset (IE_PP(ie)) + } else { + z1 = x + z2 = y + } + + # Get the data. + pp = clopset ("himexam") + nx = clgpseti (pp, "ncolumns") + ny = clgpseti (pp, "nlines") + x1 = z1 - (nx - 1) / 2 + 0.5 + x2 = z1 + nx / 2 + 0.5 + y1 = z2 - (ny - 1) / 2 + 0.5 + y2 = z2 + ny / 2 + 0.5 + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + return + } + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + # Get default histogram resolution. + nbins = clgpseti (pp, "nbins") + + # Get histogram range. + z1 = clgpsetr (pp, "z1") + z2 = clgpsetr (pp, "z2") + + # Use data limits for INDEF limits. + if (IS_INDEFR(z1) || IS_INDEFR(z2)) { + call alimr (Memr[data], npts, zmin, zmax) + if (IS_INDEFR(z1)) + z1 = zmin + if (IS_INDEFR(z2)) + z2 = zmax + } + + if (z1 > z2) { + dz = z1; z1 = z2; z2 = dz + } + + # Adjust the resolution of the histogram and/or the data range + # so that an integral number of data values map into each + # histogram bin (to avoid aliasing effects). + + if (clgpsetb (pp, "autoscale")) { + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_USHORT, TY_INT, TY_LONG: + nlevels = nint (z2) - nint (z1) + nwide = max (1, nint (real (nlevels) / real (nbins))) + nbins = max (1, nint (real (nlevels) / real (nwide))) + z2 = nint (z1) + nbins * nwide + } + } + + # Test for constant valued image, which causes zero divide in ahgm. + if (fp_equalr (z1, z2)) { + call eprintf ("Warning: Image `%s' has no data range.\n") + call pargstr (IE_IMAGE(ie)) + return + } + + # The extra bin counts the pixels that equal z2 and shifts the + # remaining bins to evenly cover the interval [z1,z2]. + # Note that real numbers could be handled better - perhaps + # adjust z2 upward by ~ EPSILONR (in ahgm itself). + + nbins1 = nbins + 1 + + # Initialize the histogram buffer and image line vector. + call smark (sp) + call salloc (hgm, nbins1, TY_INT) + call aclri (Memi[hgm], nbins1) + + call ahgmr (Memr[data], npts, Memi[hgm], nbins1, z1, z2) + + # "Correct" the topmost bin for pixels that equal z2. Each + # histogram bin really wants to be half open. + + if (clgpsetb (pp, "top_closed")) + Memi[hgm+nbins-1] = Memi[hgm+nbins-1] + Memi[hgm+nbins1-1] + + # List or plot the histogram. In list format, the bin value is the + # z value of the left side (start) of the bin. + + dz = (z2 - z1) / real (nbins) + + if (gp != NULL) { + # Draw the plot. + if (clgpsetb (pp, "pointmode")) { + nbins1 = nbins + call salloc (xp, nbins1, TY_REAL) + call salloc (yp, nbins1, TY_REAL) + call achtir (Memi[hgm], Memr[yp], nbins1) + Memr[xp] = z1 + dz / 2. + do i = 1, nbins1 - 1 + Memr[xp+i] = Memr[xp+i-1] + dz + } else { + nbins1 = 2 * nbins + call salloc (xp, nbins1, TY_REAL) + call salloc (yp, nbins1, TY_REAL) + Memr[xp] = z1 + Memr[yp] = Memi[hgm] + j = 0 + do i = 1, nbins - 1 { + Memr[xp+j+1] = Memr[xp+j] + dz + Memr[yp+j+1] = Memr[yp+j] + j = j + 1 + Memr[xp+j+1] = Memr[xp+j] + Memr[yp+j+1] = Memi[hgm+i] + j = j + 1 + } + Memr[xp+j+1] = Memr[xp+j] + dz + Memr[yp+j+1] = Memr[yp+j] + } + + call salloc (title, IE_SZTITLE, TY_CHAR) + call sprintf (Memc[title], IE_SZTITLE, + "%s[%d:%d,%d:%d]: Histogram from z1=%g to z2=%g, nbins=%d\n%s") + call pargstr (IE_IMNAME(ie)) + call pargi (x1) + call pargi (x2) + call pargi (y1) + call pargi (y2) + call pargr (z1) + call pargr (z2) + call pargi (nbins) + call pargstr (IM_TITLE(im)) + call ie_graph (gp, mode, pp, Memc[title], Memr[xp], + Memr[yp], nbins1, "", "") + + IE_PP(ie) = pp + } else { + do i = 1, nbins { + call printf ("%g %d\n") + call pargr (z1 + (i-1) * dz) + call pargi (Memi[hgm+i-1]) + } + call clcpset (pp) + } + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/ieimname.x b/pkg/images/tv/imexamine/ieimname.x new file mode 100644 index 00000000..3b1bd5e9 --- /dev/null +++ b/pkg/images/tv/imexamine/ieimname.x @@ -0,0 +1,33 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# IE_IMNAME -- Get the name of the image displayed in a display frame. + +procedure ie_imname (ds, frame, imname, maxch) + +pointer ds #I display descriptor +int frame #I display frame +char imname[maxch] #O image name +int maxch #I max chars out + +int snx, sny, dx, dy, dnx, dny, status, imd_query_map() +real sx, sy +pointer sp, reg, dname, iw +pointer iw_open() +errchk imd_query_map, iw_open + +begin + call smark (sp) + call salloc (reg, SZ_FNAME, TY_CHAR) + call salloc (dname, SZ_FNAME, TY_CHAR) + + if (imd_query_map (frame, Memc[reg], sx, sy, snx, sny, dx, dy, dnx, dny, + Memc[dname]) == ERR) { + iw = iw_open (ds, frame/100, Memc[dname], SZ_FNAME, status) + call iw_close (iw) + } + + # call imgimage (Memc[dname], imname, maxch) + call strcpy (Memc[dname], imname, maxch) + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/iejimexam.x b/pkg/images/tv/imexamine/iejimexam.x new file mode 100644 index 00000000..46a4c910 --- /dev/null +++ b/pkg/images/tv/imexamine/iejimexam.x @@ -0,0 +1,473 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <gset.h> +include <mach.h> +include "imexam.h" + + +# IE_JIMEXAM -- 1D profile plot and gaussian fit parameters. +# If no GIO pointer is given then only the fit parameters are printed. +# The fitting uses a Levenberg-Marquardt nonlinear chi square minimization. + +procedure ie_jimexam (gp, mode, ie, x, y, axis) + +pointer gp +pointer ie +int mode +real x, y +int axis + +int navg, order, clgpseti() +bool center, background, clgpsetb() +real sigma, width, rplot, clgpsetr() + +int i, j, k, nx, ny, x1, x2, y1, y2, nfit, flag[5] +real xc, yc, bkg, r, dr, fit[5], xfit, yfit, asumr(), amedr() +pointer sp, title, avstr, im, pp, data, xs, ys, ptr +pointer clopset(), ie_gimage(), ie_gdata() + +errchk ie_gdata, mr_solve + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + # Get parameters + if (IE_PP(ie) != NULL) + call clcpset (IE_PP(ie)) + if (axis == 1) + IE_PP(ie) = clopset ("jimexam") + else + IE_PP(ie) = clopset ("kimexam") + pp = IE_PP(ie) + navg = clgpseti (pp, "naverage") + center = clgpsetb (pp, "center") + background = clgpsetb (pp, "background") + sigma = clgpsetr (pp, "sigma") + rplot = clgpsetr (pp, "rplot") + if (background) { + order = clgpsetr (pp, "xorder") + width = clgpsetr (pp, "width") + } + + # If the initial center is INDEF then use the previous value. + if (!IS_INDEF(x)) + IE_X1(ie) = x + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + if (axis == 1) { + xc = IE_X1(ie) + yc = IE_Y1(ie) + } else { + xc = IE_Y1(ie) + yc = IE_X1(ie) + } + + # Get data + r = max (rplot, 8 * sigma + width) + x1 = xc - r + x2 = xc + r + y1 = nint (yc) - (navg - 1) / 2 + y2 = nint (yc) + navg / 2 + iferr { + if (axis == 1) + data = ie_gdata (im, x1, x2, y1, y2) + else + data = ie_gdata (im, y1, y2, x1, x2) + } then { + call erract (EA_WARN) + return + } + + # Compute average vector + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + yc = (y1 + y2) / 2. + + call smark (sp) + call salloc (xs, nx, TY_REAL) + call salloc (ys, nx, TY_REAL) + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (avstr, SZ_LINE, TY_CHAR) + + ptr = data + if (axis == 1) { + call sprintf (Memc[avstr], SZ_LINE, "Lines %d-%d") + call pargi (y1) + call pargi (y2) + call amovr (Memr[ptr], Memr[ys], nx) + ptr = ptr + nx + do i = 2, ny { + call aaddr (Memr[ptr], Memr[ys], Memr[ys], nx) + ptr = ptr + nx + } + call adivkr (Memr[ys], real (ny), Memr[ys], nx) + } else { + call sprintf (Memc[avstr], SZ_LINE, "Columns %d-%d") + call pargi (y1) + call pargi (y2) + do i = 0, nx-1 { + Memr[ys+i] = asumr (Memr[ptr], ny) / ny + ptr = ptr + ny + } + } + + # Set default background + bkg = 0. + if (background) { + r = 4 * sigma + ptr = xs + do i = 0, nx-1 { + if (abs (xc - x1 - i) > r) { + Memr[ptr] = Memr[ys+i] + ptr = ptr + 1 + } + } + if (ptr > xs) + bkg = amedr (Memr[xs], ptr-xs) + } + + # Convert to WCS + if (axis == 1) { + call ie_mwctran (ie, xc, yc, xfit, yfit) + call ie_mwctran (ie, xc+sigma, yc, r, yfit) + dr = abs (xfit - r) + do i = 0, nx-1 + call ie_mwctran (ie, real(x1+i), yc, Memr[xs+i], yfit) + } else { + call ie_mwctran (ie, yc, xc, yfit, xfit) + call ie_mwctran (ie, yc, xc+sigma, yfit, r) + dr = abs (xfit - r) + do i = 0, nx-1 + call ie_mwctran (ie, yc, real(x1+i), yfit, Memr[xs+i]) + } + + # Set initial fit parameters + k = max (0, nint (xc - x1)) + fit[1] = bkg + fit[2] = 0. + fit[3] = Memr[ys+k] - fit[1] + fit[4] = xfit + fit[5] = dr + + # Do fitting. + nfit = 1 + flag[1] = 3 + + # Add centering if desired + if (center) { + nfit = nfit + 1 + flag[nfit] = 4 + call ie_gfit (Memr[xs], Memr[ys], nx, fit, flag, nfit) + } + + # Add sigma + nfit = nfit + 1 + flag[nfit] = 5 + call ie_gfit (Memr[xs], Memr[ys], nx, fit, flag, nfit) + + # Now add background if desired + if (background) { + if (order == 1) { + nfit = nfit + 1 + flag[nfit] = 1 + call ie_gfit (Memr[xs], Memr[ys], nx, fit, flag, nfit) + } else if (order == 2) { + nfit = nfit + 2 + flag[nfit-1] = 1 + flag[nfit] = 2 + call ie_gfit (Memr[xs], Memr[ys], nx, fit, flag, nfit) + } + } + + # Plot the profile and overplot the gaussian fit. + call sprintf (Memc[title], IE_SZTITLE, "%s: %s\n%s") + call pargstr (IE_IMNAME(ie)) + call pargstr (Memc[avstr]) + call pargstr (IM_TITLE(im)) + + j = max (0, int (xc - x1 - rplot)) + k = min (nx-1, nint (xc - x1 + rplot)) + if (axis == 1) + call ie_graph (gp, mode, pp, Memc[title], + Memr[xs+j], Memr[ys+j], k-j+1, IE_XLABEL(ie), IE_XFORMAT(ie)) + else + call ie_graph (gp, mode, pp, Memc[title], + Memr[xs+j], Memr[ys+j], k-j+1, IE_YLABEL(ie), IE_YFORMAT(ie)) + + call gseti (gp, G_PLTYPE, 2) + xfit = min (Memr[xs+j], Memr[xs+k]) + r = (xfit - fit[4]) / fit[5] + dr = abs ((Memr[xs+k] - Memr[xs+j]) / (k - j)) + if (abs (r) < 7.) + yfit = fit[1] + fit[2] * xfit + fit[3] * exp (-r**2 / 2.) + else + yfit = fit[1] + fit[2] * xfit + call gamove (gp, xfit, yfit) + repeat { + xfit = xfit + 0.2 * dr + r = (xfit - fit[4]) / fit[5] + if (abs (r) < 7.) + yfit = fit[1] + fit[2] * xfit + fit[3] * exp (-r**2 / 2.) + else + yfit = fit[1] + fit[2] * xfit + call gadraw (gp, xfit, yfit) + } until (xfit >= max (Memr[xs+j], Memr[xs+k])) + call gseti (gp, G_PLTYPE, 1) + + # Print the fit values + call printf ("%s: center=%7g peak=%7g sigma=%7.4g fwhm=%7.4g bkg=%7g\n") + call pargstr (Memc[avstr]) + call pargr (fit[4]) + call pargr (fit[3]) + call pargr (fit[5]) + call pargr (2.35482*fit[5]) + call pargr (fit[1]+fit[2]*fit[4]) + + if (IE_LOGFD(ie) != NULL) { + call fprintf (IE_LOGFD(ie), + "%s: center=%7g peak=%7g sigma=%5.3f fwhm=%5.3f bkg=%7g\n") + call pargstr (Memc[avstr]) + call pargr (fit[4]) + call pargr (fit[3]) + call pargr (fit[5]) + call pargr (2.35482*fit[5]) + call pargr (fit[1]+fit[2]*fit[4]) + } + + call sfree (sp) +end + + +# IE_GFIT -- 1D Gaussian fit. + +procedure ie_gfit (xs, ys, nx, fit, flag, nfit) + +real xs[nx], ys[nx] # Vector to be fit +int nx # Number of points +real fit[5] # Fit parameters +int flag[nfit] # Flag for parameters to be fit +int nfit # Number of parameters to be fit + +int i +real chi1, chi2, mr + +begin + chi2 = MAX_REAL + mr = -1. + i = 0 + repeat { + call mr_solve (xs, ys, nx, fit, flag, 5, nfit, mr, chi1) + if (chi2 - chi1 > 1.) + i = 0 + else + i = i + 1 + chi2 = chi1 + } until (i == 3) + mr = 0. + call mr_solve (xs, ys, nx, fit, flag, 5, nfit, mr, chi1) + + fit[5] = abs (fit[5]) +end + + +# DERIVS -- Compute model and derivatives for MR_SOLVE procedure. +# +# I(x) = A1 + A2 * x + A3 exp {-[(x - A4) / A5]**2 / 2.} +# +# where the params are A1-A5. + +procedure derivs (x, a, y, dyda, na) + +real x # X value to be evaluated +real a[na] # Parameters +real y # Function value +real dyda[na] # Derivatives +int na # Number of parameters + +real arg, ex, fac + +begin + arg = (x - a[4]) / a[5] + if (abs (arg) < 7.) + ex = exp (-arg**2 / 2.) + else + ex = 0. + fac = a[3] * ex * arg + + y = a[1] + a[2] * x + a[3] * ex + + dyda[1] = 1. + dyda[2] = x + dyda[3] = ex + dyda[4] = fac / a[5] + dyda[5] = fac * arg / a[5] +end + + +# MR_SOLVE -- Levenberg-Marquardt nonlinear chi square minimization. +# +# Use the Levenberg-Marquardt method to minimize the chi squared of a set +# of paraemters. The parameters being fit are indexed by the flag array. +# To initialize the Marquardt parameter, MR, is less than zero. After that +# the parameter is adjusted as needed. To finish set the parameter to zero +# to free memory. This procedure requires a subroutine, DERIVS, which +# takes the derivatives of the function being fit with respect to the +# parameters. There is no limitation on the number of parameters or +# data points. For a description of the method see NUMERICAL RECIPES +# by Press, Flannery, Teukolsky, and Vetterling, p523. + +procedure mr_solve (x, y, npts, params, flags, np, nfit, mr, chisq) + +real x[npts] # X data array +real y[npts] # Y data array +int npts # Number of data points +real params[np] # Parameter array +int flags[np] # Flag array indexing parameters to fit +int np # Number of parameters +int nfit # Number of parameters to fit +real mr # MR parameter +real chisq # Chi square of fit + +int i +real chisq1 +pointer new, a1, a2, delta1, delta2 + +errchk mr_invert + +begin + # Allocate memory and initialize. + if (mr < 0.) { + call mfree (new, TY_REAL) + call mfree (a1, TY_REAL) + call mfree (a2, TY_REAL) + call mfree (delta1, TY_REAL) + call mfree (delta2, TY_REAL) + + call malloc (new, np, TY_REAL) + call malloc (a1, nfit*nfit, TY_REAL) + call malloc (a2, nfit*nfit, TY_REAL) + call malloc (delta1, nfit, TY_REAL) + call malloc (delta2, nfit, TY_REAL) + + call amovr (params, Memr[new], np) + call mr_eval (x, y, npts, Memr[new], flags, np, Memr[a2], + Memr[delta2], nfit, chisq) + mr = 0.001 + } + + # Restore last good fit and apply the Marquardt parameter. + call amovr (Memr[a2], Memr[a1], nfit * nfit) + call amovr (Memr[delta2], Memr[delta1], nfit) + do i = 1, nfit + Memr[a1+(i-1)*(nfit+1)] = Memr[a2+(i-1)*(nfit+1)] * (1. + mr) + + # Matrix solution. + call mr_invert (Memr[a1], Memr[delta1], nfit) + + # Compute the new values and curvature matrix. + do i = 1, nfit + Memr[new+flags[i]-1] = params[flags[i]] + Memr[delta1+i-1] + call mr_eval (x, y, npts, Memr[new], flags, np, Memr[a1], + Memr[delta1], nfit, chisq1) + + # Check if chisq has improved. + if (chisq1 < chisq) { + mr = max (EPSILONR, 0.1 * mr) + chisq = chisq1 + call amovr (Memr[a1], Memr[a2], nfit * nfit) + call amovr (Memr[delta1], Memr[delta2], nfit) + call amovr (Memr[new], params, np) + } else + mr = 10. * mr + + if (mr == 0.) { + call mfree (new, TY_REAL) + call mfree (a1, TY_REAL) + call mfree (a2, TY_REAL) + call mfree (delta1, TY_REAL) + call mfree (delta2, TY_REAL) + } +end + + +# MR_EVAL -- Evaluate curvature matrix. This calls procedure DERIVS. + +procedure mr_eval (x, y, npts, params, flags, np, a, delta, nfit, chisq) + +real x[npts] # X data array +real y[npts] # Y data array +int npts # Number of data points +real params[np] # Parameter array +int flags[np] # Flag array indexing parameters to fit +int np # Number of parameters +real a[nfit,nfit] # Curvature matrix +real delta[nfit] # Delta array +int nfit # Number of parameters to fit +real chisq # Chi square of fit + +int i, j, k +real ymod, dy, dydpj, dydpk +pointer sp, dydp + +begin + call smark (sp) + call salloc (dydp, np, TY_REAL) + + do j = 1, nfit { + do k = 1, j + a[j,k] = 0. + delta[j] = 0. + } + + chisq = 0. + do i = 1, npts { + call derivs (x[i], params, ymod, Memr[dydp], np) + dy = y[i] - ymod + do j = 1, nfit { + dydpj = Memr[dydp+flags[j]-1] + delta[j] = delta[j] + dy * dydpj + do k = 1, j { + dydpk = Memr[dydp+flags[k]-1] + a[j,k] = a[j,k] + dydpj * dydpk + } + } + chisq = chisq + dy * dy + } + + do j = 2, nfit + do k = 1, j-1 + a[k,j] = a[j,k] + + call sfree (sp) +end + + +# MR_INVERT -- Solve a set of linear equations using Householder transforms. + +procedure mr_invert (a, b, n) + +real a[n,n] # Input matrix and returned inverse +real b[n] # Input RHS vector and returned solution +int n # Dimension of input matrices + +int krank +real rnorm +pointer sp, h, g, ip + +begin + call smark (sp) + call salloc (h, n, TY_REAL) + call salloc (g, n, TY_REAL) + call salloc (ip, n, TY_INT) + + call hfti (a, n, n, n, b, n, 1, 1E-10, krank, rnorm, + Memr[h], Memr[g], Memi[ip]) + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/ielimexam.x b/pkg/images/tv/imexamine/ielimexam.x new file mode 100644 index 00000000..9b1c490d --- /dev/null +++ b/pkg/images/tv/imexamine/ielimexam.x @@ -0,0 +1,81 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include "imexam.h" + + +# IE_LIMEXAM -- Make a line plot +# If the line is INDEF then use the last line. + +procedure ie_limexam (gp, mode, ie, y) + +pointer gp # GIO pointer +int mode # Mode +pointer ie # Structure pointer +real y # Line + +real yavg, junk +int i, x1, x2, y1, y2, nx, ny, npts +pointer sp, title, im, data, ptr, xp, yp + +int clgpseti() +pointer clopset(), ie_gimage(), ie_gdata() + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + if (IE_PP(ie) != NULL) + call clcpset (IE_PP(ie)) + IE_PP(ie) = clopset ("limexam") + + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + ny = clgpseti (IE_PP(ie), "naverage") + x1 = INDEFI + x2 = INDEFI + y1 = IE_Y1(ie) - (ny - 1) / 2 + 0.5 + y2 = IE_Y1(ie) + ny / 2 + 0.5 + yavg = (y1 + y2) / 2. + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + return + } + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + call smark (sp) + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (xp, nx, TY_REAL) + + do i = 1, nx + call ie_mwctran (ie, real(i), yavg, Memr[xp+i-1], junk) + + if (ny > 1) { + ptr = data + call salloc (yp, nx, TY_REAL) + call amovr (Memr[ptr], Memr[yp], nx) + do i = 2, ny { + ptr = ptr + nx + call aaddr (Memr[ptr], Memr[yp], Memr[yp], nx) + } + call adivkr (Memr[yp], real (ny), Memr[yp], nx) + } else + yp = data + + call sprintf (Memc[title], IE_SZTITLE, "%s: Lines %d - %d\n%s") + call pargstr (IE_IMNAME(ie)) + call pargi (y1) + call pargi (y2) + call pargstr (IM_TITLE(im)) + + call ie_graph (gp, mode, IE_PP(ie), Memc[title], Memr[xp], + Memr[yp], nx, IE_XLABEL(ie), IE_XFORMAT(ie)) + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/iemw.x b/pkg/images/tv/imexamine/iemw.x new file mode 100644 index 00000000..185cfbaa --- /dev/null +++ b/pkg/images/tv/imexamine/iemw.x @@ -0,0 +1,191 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mwset.h> +include "imexam.h" + + +# IE_MWINIT -- Initialize MWCS + +procedure ie_mwinit (ie) + +pointer ie # IMEXAM descriptor + +int i, j, wcsdim, mw_stati(), nowhite(), stridxs() +pointer im, mw, ctlw, ctwl, mw_openim(), mw_sctran() +pointer sp, axno, axval, str1, str2 +bool streq() +errchk mw_openim, mw_sctran + +begin + im = IE_IM(ie) + mw = IE_MW(ie) + + if (mw != NULL) { + call mw_close (mw) + IE_MW(ie) = mw + } + + IE_XLABEL(ie) = EOS + IE_YLABEL(ie) = EOS + call clgstr ("xformat", IE_XFORMAT(ie), IE_SZFORMAT) + call clgstr ("yformat", IE_YFORMAT(ie), IE_SZFORMAT) + i = nowhite (IE_XFORMAT(ie), IE_XFORMAT(ie), IE_SZFORMAT) + i = nowhite (IE_YFORMAT(ie), IE_YFORMAT(ie), IE_SZFORMAT) + + if (im == NULL || im == IE_DS(ie)) + return + + call smark (sp) + call salloc (axno, IM_MAXDIM, TY_INT) + call salloc (axval, IM_MAXDIM, TY_INT) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + wcsdim = mw_stati (mw, MW_NDIM) + call mw_gaxmap (mw, Memi[axno], Memi[axval], wcsdim) + IE_P1(ie) = 1 + IE_P2(ie) = 2 + do i = 1, wcsdim { + j = Memi[axno+i-1] + if (j == 0) + IE_IN(ie,i) = 1 + else if (j == 1) + IE_P1(ie) = i + else if (j == 2) + IE_P2(ie) = i + } + ctlw = mw_sctran (mw, "logical", IE_WCSNAME(ie), 0) + ctwl = mw_sctran (mw, IE_WCSNAME(ie), "logical", 0) + + # Set coordinate labels and formats + i = IE_P1(ie) + j = IE_P2(ie) + if (streq (IE_WCSNAME(ie), "logical")) { + call strcpy ("Column (pixels)", IE_XLABEL(ie), IE_SZFNAME) + call strcpy ("Line (pixels)", IE_YLABEL(ie), IE_SZFNAME) + } else if (streq (IE_WCSNAME(ie), "physical")) { + if (i == 1) + call strcpy ("Column (pixels)", IE_XLABEL(ie), IE_SZFNAME) + else if (i == 2) + call strcpy ("Line (pixels)", IE_XLABEL(ie), IE_SZFNAME) + else + call strcpy ("Pixels", IE_XLABEL(ie), IE_SZFNAME) + if (j == 1) + call strcpy ("Column (pixels)", IE_YLABEL(ie), IE_SZFNAME) + else if (j == 2) + call strcpy ("Line (pixels)", IE_YLABEL(ie), IE_SZFNAME) + else + call strcpy ("Pixels", IE_YLABEL(ie), IE_SZFNAME) + } else { + ifnoerr (call mw_gwattrs (mw, i, "label", Memc[str1], SZ_LINE)) { + ifnoerr (call mw_gwattrs (mw, i, "units", Memc[str2],SZ_LINE)) { + call sprintf (IE_XLABEL(ie), IE_SZFNAME, "%s (%s)") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + } else { + call sprintf (IE_XLABEL(ie), IE_SZFNAME, "%s") + call pargstr (Memc[str1]) + } + } + if (IE_XFORMAT(ie) != '%') + ifnoerr (call mw_gwattrs (mw, i, "format", Memc[str1], SZ_LINE)) + call strcpy (Memc[str1], IE_XFORMAT(ie), IE_SZFORMAT) + + ifnoerr (call mw_gwattrs (mw, j, "label", Memc[str1], SZ_LINE)) { + ifnoerr (call mw_gwattrs (mw, j, "units", Memc[str2],SZ_LINE)) { + call sprintf (IE_YLABEL(ie), IE_SZFNAME, "%s (%s)") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + } else { + call sprintf (IE_YLABEL(ie), IE_SZFNAME, "%s") + call pargstr (Memc[str1]) + } + } + if (IE_YFORMAT(ie) != '%') + ifnoerr (call mw_gwattrs (mw, j, "format", Memc[str1], SZ_LINE)) + call strcpy (Memc[str1], IE_YFORMAT(ie), IE_SZFORMAT) + + # Check for equitorial coordinate and reversed formats. + ifnoerr (call mw_gwattrs (mw, i, "axtype", Memc[str1], SZ_LINE)) + if ((streq(Memc[str1],"ra")&&stridxs("hm",IE_XFORMAT(ie))>0) || + (streq(Memc[str1],"dec")&&stridxs("HM",IE_XFORMAT(ie))>0)) { + call strcpy (IE_XFORMAT(ie), Memc[str1], IE_SZFORMAT) + call strcpy (IE_YFORMAT(ie), IE_XFORMAT(ie),IE_SZFORMAT) + call strcpy (Memc[str1], IE_YFORMAT(ie), IE_SZFORMAT) + } + } + + IE_MW(ie) = mw + IE_CTLW(ie) = ctlw + IE_CTWL(ie) = ctwl + IE_WCSDIM(ie) = wcsdim + + call sfree (sp) +end + + +# IE_MWCTRAN -- Evaluate MWCS coordinate + +procedure ie_mwctran (ie, xin, yin, xout, yout) + +pointer ie # IMEXAM descriptor +real xin, yin # Input coordinate +real xout, yout # Output coordinate + +begin + if (IE_MW(ie) == NULL) { + xout = xin + yout = yin + return + } + + IE_IN(ie,IE_P1(ie)) = xin + IE_IN(ie,IE_P2(ie)) = yin + call mw_ctranr (IE_CTLW(ie), IE_IN(ie,1), IE_OUT(ie,1), IE_WCSDIM(ie)) + xout = IE_OUT(ie,IE_P1(ie)) + yout = IE_OUT(ie,IE_P2(ie)) +end + + +# IE_IMWCTRAN -- Evaluate inverse MWCS coordinate + +procedure ie_imwctran (ie, xin, yin, xout, yout) + +pointer ie # IMEXAM descriptor +real xin, yin # Input coordinate +real xout, yout # Output coordinate + +begin + if (IE_MW(ie) == NULL) { + xout = xin + yout = yin + return + } + + IE_OUT(ie,IE_P1(ie)) = xin + IE_OUT(ie,IE_P2(ie)) = yin + call mw_ctranr (IE_CTWL(ie), IE_OUT(ie,1), IE_IN(ie,1), IE_WCSDIM(ie)) + xout = IE_IN(ie,IE_P1(ie)) + yout = IE_IN(ie,IE_P2(ie)) +end + + +# IE_IFORMATR -- Determine the inverse formatted real value +# This temporary routine is used to account for scaling of the H and M formats. + +real procedure ie_iformatr (value, format) + +real value # Value to be inverse formated +char format[ARB] # Format + +int strldxs() + +begin + if (!IS_INDEF(value) && strldxs ("HM", format) > 0) + return (value * 15.) + else + return (value) +end diff --git a/pkg/images/tv/imexamine/ieopenlog.x b/pkg/images/tv/imexamine/ieopenlog.x new file mode 100644 index 00000000..08f754f9 --- /dev/null +++ b/pkg/images/tv/imexamine/ieopenlog.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include "imexam.h" + + +# IE_OPENLOG -- Open the log file. + +procedure ie_openlog (ie) + +pointer ie #I imexamine descriptor + +int nowhite(), open() +errchk open, close + +begin + if (IE_LOGFD(ie) != NULL) { + call close (IE_LOGFD(ie)) + IE_LOGFD(ie) = NULL + } + + if (nowhite (IE_LOGFILE(ie), IE_LOGFILE(ie), SZ_FNAME) > 0) { + iferr { + IE_LOGFD(ie) = open (IE_LOGFILE(ie), APPEND, TEXT_FILE) + call printf ("Log file %s open\n") + call pargstr (IE_LOGFILE(ie)) + + if (IE_IM(ie) != NULL) { + call fprintf (IE_LOGFD(ie), "# [%d] %s - %s\n") + call pargi (IE_INDEX(ie)) + call pargstr (IE_IMNAME(ie)) + call pargstr (IM_TITLE(IE_IM(ie))) + } + + } then + call erract (EA_WARN) + } +end diff --git a/pkg/images/tv/imexamine/iepos.x b/pkg/images/tv/imexamine/iepos.x new file mode 100644 index 00000000..7253816b --- /dev/null +++ b/pkg/images/tv/imexamine/iepos.x @@ -0,0 +1,180 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <math.h> +include "imexam.h" + +# IE_POS -- Print cursor position and pixel value or set new origin. +# If the origin is not (0,0) print additional fields. + +procedure ie_pos (ie, x, y, key) + +pointer ie # IMEXAM structure +real x, y # Center of box +int key # Key ('x' positions, 'y' origin) + +pointer im, data +real dx, dy, r, t, wx, wy, xo, yo +int x1, x2, y1, y2 +pointer ie_gimage(), ie_gdata() + +begin + switch (key) { + case 'x': # Print position and pixel value + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + x1 = x + 0.5 + x2 = x + 0.5 + y1 = y + 0.5 + y2 = y + 0.5 + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + return + } + + call printf ("%7.2f %7.2f %7g") + call pargr (x) + call pargr (y) + call pargr (Memr[data]) + + # Print additional fields + if (IE_XORIGIN(ie) != 0. || IE_YORIGIN(ie) != 0.) { + dx = x - IE_XORIGIN(ie) + dy = y - IE_YORIGIN(ie) + r = sqrt (dx * dx + dy * dy) + t = mod (360. + RADTODEG (atan2 (dy, dx)), 360.) + call printf (" %7.f %7.2f %7.2f %7.2f %7.2f %5.1f") + call pargr (IE_XORIGIN(ie)) + call pargr (IE_YORIGIN(ie)) + call pargr (dx) + call pargr (dy) + call pargr (r) + call pargr (t) + } + call printf ("\n") + case 'y': # Set new origin + IE_XORIGIN(ie) = x + IE_YORIGIN(ie) = y + call printf ("Origin: %.2f %.2f\n") + call pargr (IE_XORIGIN(ie)) + call pargr (IE_YORIGIN(ie)) + } + + # Print to logfile if needed. + if (IE_LOGFD(ie) != NULL) { + switch (key) { + case 'x': + call fprintf (IE_LOGFD(ie), "%7.2f %7.2f %7g") + call pargr (x) + call pargr (y) + call pargr (Memr[data]) + if (IE_XORIGIN(ie) != 0. || IE_YORIGIN(ie) != 0.) { + dx = x - IE_XORIGIN(ie) + dy = y - IE_YORIGIN(ie) + r = sqrt (dx * dx + dy * dy) + t = mod (360. + RADTODEG (atan2 (dy, dx)), 360.) + call fprintf (IE_LOGFD(ie), + " %7.f %7.2f %7.2f %7.2f %7.2f %5.1f") + call pargr (IE_XORIGIN(ie)) + call pargr (IE_YORIGIN(ie)) + call pargr (dx) + call pargr (dy) + call pargr (r) + call pargr (t) + } + call fprintf (IE_LOGFD(ie), "\n") + case 'y': # Set new origin + IE_XORIGIN(ie) = x + IE_YORIGIN(ie) = y + call fprintf (IE_LOGFD(ie), "Origin: %.2f %.2f\n") + call pargr (IE_XORIGIN(ie)) + call pargr (IE_YORIGIN(ie)) + } + } + + # Print in WCS if necessary. + call ie_mwctran (ie, x, y, wx, wy) + if (x == wx && y == wy) + return + call ie_mwctran (ie, IE_XORIGIN(ie), IE_YORIGIN(ie), xo, yo) + + switch (key) { + case 'x': # Print position and pixel value + if (IE_XFORMAT(ie) == '%') + call printf (IE_XFORMAT(ie)) + else + call printf ("%7g") + call pargr (wx) + call printf (" ") + if (IE_YFORMAT(ie) == '%') + call printf (IE_YFORMAT(ie)) + else + call printf ("%7g") + call pargr (wy) + call printf (" %7g") + call pargr (Memr[data]) + + # Print additional fields + if (IE_XORIGIN(ie) != 0. || IE_YORIGIN(ie) != 0.) { + dx = wx - xo + dy = wy - yo + r = sqrt (dx * dx + dy * dy) + t = mod (360. + RADTODEG (atan2 (dy, dx)), 360.) + call printf (" %7g %7g %7g %7g %7g %5.1f") + call pargr (xo) + call pargr (yo) + call pargr (dx) + call pargr (dy) + call pargr (r) + call pargr (t) + } + call printf ("\n") + case 'y': # Set new origin + call printf ("Origin: %7g %7g\n") + call pargr (xo) + call pargr (yo) + } + + # Print to logfile if needed. + if (IE_LOGFD(ie) != NULL) { + switch (key) { + case 'x': + if (IE_XFORMAT(ie) == '%') + call fprintf (IE_LOGFD(ie), IE_XFORMAT(ie)) + else + call fprintf (IE_LOGFD(ie), "%7g") + call pargr (wx) + call fprintf (IE_LOGFD(ie), " ") + if (IE_YFORMAT(ie) == '%') + call fprintf (IE_LOGFD(ie), IE_YFORMAT(ie)) + else + call fprintf (IE_LOGFD(ie), "%7g") + call pargr (wy) + call fprintf (IE_LOGFD(ie), " %7g") + call pargr (Memr[data]) + + if (IE_XORIGIN(ie) != 0. || IE_YORIGIN(ie) != 0.) { + dx = wx - xo + dy = wy - yo + r = sqrt (dx * dx + dy * dy) + t = mod (360. + RADTODEG (atan2 (dy, dx)), 360.) + call fprintf (IE_LOGFD(ie), + " %7g %7g %7g %7g %7g %5.1f") + call pargr (xo) + call pargr (yo) + call pargr (dx) + call pargr (dy) + call pargr (r) + call pargr (t) + } + call fprintf (IE_LOGFD(ie), "\n") + case 'y': # Set new origin + call fprintf (IE_LOGFD(ie), "Origin: %7g %7g\n") + call pargr (xo) + call pargr (yo) + } + } +end diff --git a/pkg/images/tv/imexamine/ieprint.x b/pkg/images/tv/imexamine/ieprint.x new file mode 100644 index 00000000..0a7a7602 --- /dev/null +++ b/pkg/images/tv/imexamine/ieprint.x @@ -0,0 +1,67 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include "imexam.h" + +# IE_PRINT -- Print box of pixel values + +procedure ie_print (ie, x, y) + +pointer ie # IMEXAM structure +real x, y # Center of box + +int i, j, x1, x2, y1, y2, nx +pointer im, data, ie_gimage(), ie_gdata() + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + x1 = x - 5 + 0.5 + x2 = x + 5 + 0.5 + y1 = y - 5 + 0.5 + y2 = y + 5 + 0.5 + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + return + } + nx = x2 - x1 + 1 + + call printf ("%4w") + do i = x1, x2 { + call printf (" %4d ") + call pargi (i) + } + call printf ("\n") + + do j = y2, y1, -1 { + call printf ("%4d") + call pargi (j) + do i = x1, x2 { + call printf (" %5g") + call pargr (Memr[data+(j-y1)*nx+(i-x1)]) + } + call printf ("\n") + } + + if (IE_LOGFD(ie) != NULL) { + call fprintf (IE_LOGFD(ie), "%4w") + do i = x1, x2 { + call fprintf (IE_LOGFD(ie), " %4d ") + call pargi (i) + } + call fprintf (IE_LOGFD(ie), "\n") + + do j = y2, y1, -1 { + call fprintf (IE_LOGFD(ie), "%4d") + call pargi (j) + do i = x1, x2 { + call fprintf (IE_LOGFD(ie), " %5g") + call pargr (Memr[data+(j-y1)*nx+(i-x1)]) + } + call fprintf (IE_LOGFD(ie), "\n") + } + } +end diff --git a/pkg/images/tv/imexamine/ieqrimexam.x b/pkg/images/tv/imexamine/ieqrimexam.x new file mode 100644 index 00000000..68388874 --- /dev/null +++ b/pkg/images/tv/imexamine/ieqrimexam.x @@ -0,0 +1,489 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <gset.h> +include <math.h> +include <math/gsurfit.h> +include <math/nlfit.h> +include "imexam.h" + +define FITTYPES "|gaussian|moffat|" +define FITGAUSS 1 +define FITMOFFAT 2 + + +# IE_QRIMEXAM -- Radial profile plot and photometry parameters. +# If no GIO pointer is given then only the photometry parameters are printed. +# First find the center using the marginal distributions. Then subtract +# a fit to the background. Compute the moments within the aperture and +# fit a gaussian of fixed center and zero background. Make the plot +# and print the photometry values. + +procedure ie_qrimexam (gp, mode, ie, x, y) + +pointer gp +pointer ie +int mode +real x, y + +bool center, background, medsky, fitplot, clgpsetb() +real radius, buffer, width, magzero, rplot, beta, clgpsetr() +int fittype, xorder, yorder, clgpseti(), strdic() + +int i, j, ns, no, np, nx, ny, npts, x1, x2, y1, y2 +int plist[3], nplist +real bkg, xcntr, ycntr, mag, e, pa, zcntr, wxcntr, wycntr +real params[3] +real fwhm, dfwhm +pointer sp, fittypes, title, coords, im, data, pp, ws, xs, ys, zs, gs, ptr, nl +double sumo, sums, sumxx, sumyy, sumxy +real r, r1, r2, r3, dx, dy, gseval(), amedr() +pointer clopset(), ie_gimage(), ie_gdata(), locpr() +extern ie_gauss(), ie_dgauss(), ie_moffat(), ie_dmoffat() +errchk nlinit, nlfit + +string glabel "#\ + COL LINE RMAG FLUX SKY N RMOM ELLIP PA PEAK GFWHM\n" +string mlabel "#\ + COL LINE RMAG FLUX SKY N RMOM ELLIP PA PEAK MFWHM\n" + +begin + call smark (sp) + call salloc (fittypes, SZ_FNAME, TY_CHAR) + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (coords, IE_SZTITLE, TY_CHAR) + + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + call sfree (sp) + return + } + + # Open parameter set. + if (gp != NULL) { + if (IE_PP(ie) != NULL) + call clcpset (IE_PP(ie)) + } + pp = clopset ("rimexam") + + center = clgpsetb (pp, "center") + background = clgpsetb (pp, "background") + radius = clgpsetr (pp, "radius") + buffer = clgpsetr (pp, "buffer") + width = clgpsetr (pp, "width") + xorder = clgpseti (pp, "xorder") + yorder = clgpseti (pp, "yorder") + medsky = (xorder <= 0 || yorder <= 0) + + magzero = clgpsetr (pp, "magzero") + rplot = clgpsetr (pp, "rplot") + fitplot = clgpsetb (pp, "fitplot") + call clgpseta (pp, "fittype", Memc[fittypes], SZ_FNAME) + fittype = strdic (Memc[fittypes], Memc[fittypes], SZ_FNAME, FITTYPES) + if (fittype == 0) { + call eprintf ("WARNING: Unknown profile fit type `%s'.\n") + call pargstr (Memc[fittypes]) + call sfree (sp) + return + } + beta = clgpsetr (pp, "beta") + + # If the initial center is INDEF then use the previous value. + if (gp != NULL) { + if (!IS_INDEF(x)) + IE_X1(ie) = x + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + xcntr = IE_X1(ie) + ycntr = IE_Y1(ie) + } else { + xcntr = x + ycntr = y + } + + # Center + if (center) + iferr (call ie_center (im, radius, xcntr, ycntr)) { + call erract (EA_WARN) + return + } + + # Crude estimage of FHWM. + dfwhm = radius + + # Get data including a buffer and background annulus. + if (!background) { + buffer = 0. + width = 0. + } + r = max (rplot, radius + buffer + width) + x1 = xcntr - r + x2 = xcntr + r + y1 = ycntr - r + y2 = ycntr + r + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + call sfree (sp) + return + } + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + call salloc (xs, npts, TY_REAL) + call salloc (ys, npts, TY_REAL) + call salloc (ws, npts, TY_REAL) + + # Extract the background data if background subtracting. + ns = 0 + if (background && width > 0.) { + call salloc (zs, npts, TY_REAL) + + r1 = radius ** 2 + r2 = (radius + buffer) ** 2 + r3 = (radius + buffer + width) ** 2 + + ptr = data + do j = y1, y2 { + dy = (ycntr - j) ** 2 + do i = x1, x2 { + r = (xcntr - i) ** 2 + dy + if (r <= r1) + ; + else if (r >= r2 && r <= r3) { + Memr[xs+ns] = i + Memr[ys+ns] = j + Memr[zs+ns] = Memr[ptr] + ns = ns + 1 + } + ptr = ptr + 1 + } + } + } + + # Accumulate the various sums for the moments and the gaussian fit. + no = 0 + np = 0 + zcntr = 0. + sumo = 0.; sums = 0.; sumxx = 0.; sumyy = 0.; sumxy = 0. + ptr = data + gs = NULL + + if (ns > 0) { # Background subtraction + + # If background points are defined fit a surface and subtract + # the fitted background from within the object aperture. + + if (medsky) + bkg = amedr (Memr[zs], ns) + else { + repeat { + call gsinit (gs, GS_POLYNOMIAL, xorder, yorder, YES, + real (x1), real (x2), real (y1), real (y2)) + call gsfit (gs, Memr[xs], Memr[ys], Memr[zs], Memr[ws], ns, + WTS_UNIFORM, i) + if (i == OK) + break + xorder = max (1, xorder - 1) + yorder = max (1, yorder - 1) + call gsfree (gs) + } + bkg = gseval (gs, real(x1), real(y1)) + } + + do j = y1, y2 { + dy = j - ycntr + do i = x1, x2 { + dx = i - xcntr + r = sqrt (dx ** 2 + dy ** 2) + r3 = max (0., min (5., 2 * r / dfwhm - 1.)) + + if (medsky) + r2 = bkg + else { + r2 = gseval (gs, real(i), real(j)) + bkg = min (bkg, r2) + } + r1 = Memr[ptr] - r2 + + if (r <= radius) { + sumo = sumo + r1 + sums = sums + r2 + sumxx = sumxx + dx * dx * r1 + sumyy = sumyy + dy * dy * r1 + sumxy = sumxy + dx * dy * r1 + zcntr = max (r1, zcntr) + if (r <= rplot) { + Memr[xs+no] = r + Memr[ys+no] = r1 + Memr[ws+no] = exp (-r3**2) / max (.1, r**2) + no = no + 1 + } else { + np = np + 1 + Memr[xs+npts-np] = r + Memr[ys+npts-np] = r1 + Memr[ws+npts-np] = exp (-r3**2) / max (.1, r**2) + } + } else if (r <= rplot) { + np = np + 1 + Memr[xs+npts-np] = r + Memr[ys+npts-np] = r1 + } + ptr = ptr + 1 + } + } + + if (gs != NULL) + call gsfree (gs) + + } else { # No background subtraction + bkg = 0. + do j = y1, y2 { + dy = j - ycntr + do i = x1, x2 { + dx = i - xcntr + r = sqrt (dx ** 2 + dy ** 2) + r3 = max (0., min (5., 2 * r / dfwhm - 1.)) + r1 = Memr[ptr] + + if (r <= radius) { + sumo = sumo + r1 + sumxx = sumxx + dx * dx * r1 + sumyy = sumyy + dy * dy * r1 + sumxy = sumxy + dx * dy * r1 + zcntr = max (r1, zcntr) + if (r <= rplot) { + Memr[xs+no] = r + Memr[ys+no] = r1 + Memr[ws+no] = exp (-r3**2) / max (.1, r**2) + no = no + 1 + } else { + np = np + 1 + Memr[xs+npts-np] = r + Memr[ys+npts-np] = r1 + Memr[ws+npts-np] = exp (-r3**2) / max (.1, r**2) + } + } else if (r <= rplot) { + np = np + 1 + Memr[xs+npts-np] = r + Memr[ys+npts-np] = r1 + } + ptr = ptr + 1 + } + } + } + if (np > 0) { + call amovr (Memr[xs+npts-np], Memr[xs+no], np) + call amovr (Memr[ys+npts-np], Memr[ys+no], np) + call amovr (Memr[ws+npts-np], Memr[ws+no], np) + } + if (rplot <= radius) { + no = no + np + np = no - np + } else + np = no + np + + + # Compute the photometry and gaussian fit parameters. + + switch (fittype) { + case FITGAUSS: + plist[1] = 1 + plist[2] = 2 + nplist = 2 + params[2] = dfwhm**2 / (8 * log(2.)) + params[1] = zcntr + call nlinitr (nl, locpr (ie_gauss), locpr (ie_dgauss), + params, params, 2, plist, nplist, .001, 100) + call nlfitr (nl, Memr[xs], Memr[ys], Memr[ws], no, 1, WTS_USER, i) + if (i == SINGULAR || i == NO_DEG_FREEDOM) { + call eprintf ("WARNING: Gaussian fit did not converge\n") + call tsleep (5) + zcntr = INDEF + fwhm = INDEF + } else { + call nlpgetr (nl, params, i) + if (params[2] < 0.) { + zcntr = INDEF + fwhm = INDEF + } else { + zcntr = params[1] + fwhm = sqrt (8 * log (2.) * params[2]) + } + } + case FITMOFFAT: + plist[1] = 1 + plist[2] = 2 + if (IS_INDEF(beta)) { + params[3] = -3.0 + plist[3] = 3 + nplist = 3 + } else { + params[3] = -beta + nplist = 2 + } + params[2] = dfwhm / 2. / sqrt (2.**(-1./params[3]) - 1.) + params[1] = zcntr + call nlinitr (nl, locpr (ie_moffat), locpr (ie_dmoffat), + params, params, 3, plist, nplist, .001, 100) + call nlfitr (nl, Memr[xs], Memr[ys], Memr[ws], no, 1, WTS_USER, i) + if (i == SINGULAR || i == NO_DEG_FREEDOM) { + call eprintf ("WARNING: Moffat fit did not converge\n") + call tsleep (5) + zcntr = INDEF + fwhm = INDEF + beta = INDEF + } else { + call nlpgetr (nl, params, i) + if (params[2] < 0.) { + zcntr = INDEF + fwhm = INDEF + beta = INDEF + } else { + zcntr = params[1] + beta = -params[3] + fwhm = abs (params[2])*2.*sqrt (2.**(-1./params[3]) - 1.) + } + } + } + + mag = INDEF + r = INDEF + e = INDEF + pa = INDEF + if (sumo > 0.) { + mag = magzero - 2.5 * log10 (sumo) + r2 = sumxx + sumyy + if (r2 > 0.) { + switch (fittype) { + case FITGAUSS: + r = 2 * sqrt (log (2.) * r2 / sumo) + case FITMOFFAT: + if (beta > 2.) + r = 2 * sqrt ((beta-2.)*(2.**(1./beta)-1) * r2 / sumo) + } + r1 =(sumxx-sumyy)**2+(2*sumxy)**2 + if (r1 > 0.) + e = sqrt (r1) / r2 + else + e = 0. + } + if (e < 0.01) + e = 0. + else + pa = RADTODEG (0.5 * atan2 (2*sumxy, sumxx-sumyy)) + } + + call ie_mwctran (ie, xcntr, ycntr, wxcntr, wycntr) + if (xcntr == wxcntr && ycntr == wycntr) + call strcpy ("%.2f %.2f", Memc[title], IE_SZTITLE) + else { + call sprintf (Memc[title], IE_SZTITLE, "%s %s") + if (IE_XFORMAT(ie) == '%') + call pargstr (IE_XFORMAT(ie)) + else + call pargstr ("%g") + if (IE_YFORMAT(ie) == '%') + call pargstr (IE_YFORMAT(ie)) + else + call pargstr ("%g") + } + call sprintf (Memc[coords], IE_SZTITLE, Memc[title]) + call pargr (wxcntr) + call pargr (wycntr) + + # Plot the radial profile and overplot the fit. + if (gp != NULL) { + call sprintf (Memc[title], IE_SZTITLE, + "%s: Radial profile at %s\n%s") + call pargstr (IE_IMNAME(ie)) + call pargstr (Memc[coords]) + call pargstr (IM_TITLE(im)) + + call ie_graph (gp, mode, pp, Memc[title], Memr[xs], Memr[ys], + np, "", "") + + if (fitplot && !IS_INDEF (fwhm)) { + np = 51 + dx = rplot / (np - 1) + do i = 0, np - 1 + Memr[xs+i] = i * dx + call nlvectorr (nl, Memr[xs], Memr[ys], np, 1) + call gseti (gp, G_PLTYPE, 2) + call gpline (gp, Memr[xs], Memr[ys], np) + call gseti (gp, G_PLTYPE, 1) + } + } + + if (IE_LASTKEY(ie) != ',') { + switch (fittype) { + case FITGAUSS: + call printf (glabel) + case FITMOFFAT: + call printf (mlabel) + } + } + + # Print the photometry values. + call printf ( + "%7.2f %7.2f %7.2f %8.1f %8.2f %3d %5.2f %5.3f %5.1f %8.2f %5.2f\n") + call pargr (xcntr) + call pargr (ycntr) + call pargr (mag) + call pargd (sumo) + call pargd (sums / no) + call pargi (no) + call pargr (r) + call pargr (e) + call pargr (pa) + call pargr (zcntr) + call pargr (fwhm) + if (gp == NULL) { + if (xcntr != wxcntr || ycntr != wycntr) { + call printf ("%s: %s\n") + call pargstr (IE_WCSNAME(ie)) + call pargstr (Memc[coords]) + } + } + + if (IE_LOGFD(ie) != NULL) { + if (IE_LASTKEY(ie) != ',') { + switch (fittype) { + case FITGAUSS: + call fprintf (IE_LOGFD(ie), glabel) + case FITMOFFAT: + call fprintf (IE_LOGFD(ie), mlabel) + } + } + + call fprintf (IE_LOGFD(ie), + "%7.2f %7.2f %7.2f %8.1f %8.2f %3d %5.2f %5.3f %5.1f %8.2f %5.2f\n") + call pargr (xcntr) + call pargr (ycntr) + call pargr (mag) + call pargd (sumo) + call pargd (sums / no) + call pargi (no) + call pargr (r) + call pargr (e) + call pargr (pa) + call pargr (zcntr) + call pargr (fwhm) + if (xcntr != wxcntr || ycntr != wycntr) { + call fprintf (IE_LOGFD(ie), "%s: %s\n") + call pargstr (IE_WCSNAME(ie)) + call pargstr (Memc[coords]) + } + } + + if (gp == NULL) + call clcpset (pp) + else + IE_PP(ie) = pp + + call nlfreer (nl) + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/ierimexam.x b/pkg/images/tv/imexamine/ierimexam.x new file mode 100644 index 00000000..f76ff507 --- /dev/null +++ b/pkg/images/tv/imexamine/ierimexam.x @@ -0,0 +1,752 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <gset.h> +include <math.h> +include <math/gsurfit.h> +include <math/nlfit.h> +include "imexam.h" + +define FITTYPES "|gaussian|moffat|" +define FITGAUSS 1 +define FITMOFFAT 2 + + +# IE_RIMEXAM -- Radial profile plot and photometry parameters. +# If no GIO pointer is given then only the photometry parameters are printed. +# First find the center using the marginal distributions. Then subtract +# a fit to the background. Compute the moments within the aperture and +# fit a gaussian of fixed center and zero background. Make the plot +# and print the photometry values. + +procedure ie_rimexam (gp, mode, ie, x, y) + +pointer gp +pointer ie +int mode +real x, y + +bool center, background, medsky, fitplot, clgpsetb() +real radius, buffer, width, magzero, rplot, beta, clgpsetr() +int nit, fittype, xorder, yorder, clgpseti(), strdic() + +int i, j, ns, no, np, nx, ny, npts, x1, x2, y1, y2 +int coordlen, plist[3], nplist, strlen() +real bkg, xcntr, ycntr, mag, e, pa, zcntr, wxcntr, wycntr +real params[3] +real fwhm, dbkg, dfwhm, gfwhm, efwhm +pointer sp, fittypes, title, coords, im, data, pp, ws, xs, ys, zs, gs, ptr, nl +double sumo, sums, sumxx, sumyy, sumxy +real r, r1, r2, r3, dx, dy, gseval(), amedr() +pointer clopset(), ie_gimage(), ie_gdata(), locpr() +extern ie_gauss(), ie_dgauss(), ie_moffat(), ie_dmoffat() +errchk stf_measure, nlinit, nlfit + +begin + call smark (sp) + call salloc (fittypes, SZ_FNAME, TY_CHAR) + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (coords, IE_SZTITLE, TY_CHAR) + + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + call sfree (sp) + return + } + + # Open parameter set. + if (gp != NULL) { + if (IE_PP(ie) != NULL) + call clcpset (IE_PP(ie)) + } + pp = clopset ("rimexam") + + center = clgpsetb (pp, "center") + background = clgpsetb (pp, "background") + radius = clgpsetr (pp, "radius") + buffer = clgpsetr (pp, "buffer") + width = clgpsetr (pp, "width") + xorder = clgpseti (pp, "xorder") + yorder = clgpseti (pp, "yorder") + medsky = (xorder <= 0 || yorder <= 0) + nit = clgpseti (pp, "iterations") + + magzero = clgpsetr (pp, "magzero") + rplot = clgpsetr (pp, "rplot") + fitplot = clgpsetb (pp, "fitplot") + call clgpseta (pp, "fittype", Memc[fittypes], SZ_FNAME) + fittype = strdic (Memc[fittypes], Memc[fittypes], SZ_FNAME, FITTYPES) + if (fittype == 0) { + call eprintf ("WARNING: Unknown profile fit type `%s'.\n") + call pargstr (Memc[fittypes]) + call sfree (sp) + return + } + beta = clgpsetr (pp, "beta") + + # If the initial center is INDEF then use the previous value. + if (gp != NULL) { + if (!IS_INDEF(x)) + IE_X1(ie) = x + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + xcntr = IE_X1(ie) + ycntr = IE_Y1(ie) + } else { + xcntr = x + ycntr = y + } + + # Center + if (center) + iferr (call ie_center (im, radius, xcntr, ycntr)) { + call erract (EA_WARN) + call sfree (sp) + return + } + + # Do the enclosed flux and direct FWHM measurments using the + # PSFMEASURE routines. + + call stf_measure (im, xcntr, ycntr, beta, 0.5, radius, nit, buffer, + width, INDEF, NULL, NULL, dbkg, r, dfwhm, gfwhm, efwhm) + if (fittype == FITGAUSS) + efwhm = gfwhm + + # Get data including a buffer and background annulus. + if (!background) { + buffer = 0. + width = 0. + } + r = max (rplot, radius + buffer + width) + x1 = xcntr - r + x2 = xcntr + r + y1 = ycntr - r + y2 = ycntr + r + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + call sfree (sp) + return + } + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + call salloc (xs, npts, TY_REAL) + call salloc (ys, npts, TY_REAL) + call salloc (ws, npts, TY_REAL) + + # Extract the background data if background subtracting. + ns = 0 + if (background && width > 0.) { + call salloc (zs, npts, TY_REAL) + + r1 = radius ** 2 + r2 = (radius + buffer) ** 2 + r3 = (radius + buffer + width) ** 2 + + ptr = data + do j = y1, y2 { + dy = (ycntr - j) ** 2 + do i = x1, x2 { + r = (xcntr - i) ** 2 + dy + if (r <= r1) + ; + else if (r >= r2 && r <= r3) { + Memr[xs+ns] = i + Memr[ys+ns] = j + Memr[zs+ns] = Memr[ptr] + ns = ns + 1 + } + ptr = ptr + 1 + } + } + } + + # Accumulate the various sums for the moments and the gaussian fit. + no = 0 + np = 0 + zcntr = 0. + sumo = 0.; sums = 0.; sumxx = 0.; sumyy = 0.; sumxy = 0. + ptr = data + gs = NULL + + if (ns > 0) { # Background subtraction + + # If background points are defined fit a surface and subtract + # the fitted background from within the object aperture. + + if (medsky) + bkg = amedr (Memr[zs], ns) + else { + repeat { + call gsinit (gs, GS_POLYNOMIAL, xorder, yorder, YES, + real (x1), real (x2), real (y1), real (y2)) + call gsfit (gs, Memr[xs], Memr[ys], Memr[zs], Memr[ws], ns, + WTS_UNIFORM, i) + if (i == OK) + break + xorder = max (1, xorder - 1) + yorder = max (1, yorder - 1) + call gsfree (gs) + } + bkg = gseval (gs, real(x1), real(y1)) + } + + do j = y1, y2 { + dy = j - ycntr + do i = x1, x2 { + dx = i - xcntr + r = sqrt (dx ** 2 + dy ** 2) + r3 = max (0., min (5., 2 * r / dfwhm - 1.)) + + if (medsky) + r2 = bkg + else { + r2 = gseval (gs, real(i), real(j)) + bkg = min (bkg, r2) + } + r1 = Memr[ptr] - r2 + + if (r <= radius) { + sumo = sumo + r1 + sums = sums + r2 + sumxx = sumxx + dx * dx * r1 + sumyy = sumyy + dy * dy * r1 + sumxy = sumxy + dx * dy * r1 + zcntr = max (r1, zcntr) + if (r <= rplot) { + Memr[xs+no] = r + Memr[ys+no] = r1 + Memr[ws+no] = exp (-r3**2) / max (.1, r**2) + no = no + 1 + } else { + np = np + 1 + Memr[xs+npts-np] = r + Memr[ys+npts-np] = r1 + Memr[ws+npts-np] = exp (-r3**2) / max (.1, r**2) + } + } else if (r <= rplot) { + np = np + 1 + Memr[xs+npts-np] = r + Memr[ys+npts-np] = r1 + } + ptr = ptr + 1 + } + } + + if (gs != NULL) + call gsfree (gs) + + } else { # No background subtraction + bkg = 0. + do j = y1, y2 { + dy = j - ycntr + do i = x1, x2 { + dx = i - xcntr + r = sqrt (dx ** 2 + dy ** 2) + r3 = max (0., min (5., 2 * r / dfwhm - 1.)) + r1 = Memr[ptr] + + if (r <= radius) { + sumo = sumo + r1 + sumxx = sumxx + dx * dx * r1 + sumyy = sumyy + dy * dy * r1 + sumxy = sumxy + dx * dy * r1 + zcntr = max (r1, zcntr) + if (r <= rplot) { + Memr[xs+no] = r + Memr[ys+no] = r1 + Memr[ws+no] = exp (-r3**2) / max (.1, r**2) + no = no + 1 + } else { + np = np + 1 + Memr[xs+npts-np] = r + Memr[ys+npts-np] = r1 + Memr[ws+npts-np] = exp (-r3**2) / max (.1, r**2) + } + } else if (r <= rplot) { + np = np + 1 + Memr[xs+npts-np] = r + Memr[ys+npts-np] = r1 + } + ptr = ptr + 1 + } + } + } + if (np > 0) { + call amovr (Memr[xs+npts-np], Memr[xs+no], np) + call amovr (Memr[ys+npts-np], Memr[ys+no], np) + call amovr (Memr[ws+npts-np], Memr[ws+no], np) + } + if (rplot <= radius) { + no = no + np + np = no - np + } else + np = no + np + + + # Compute the photometry and profile fit parameters. + + switch (fittype) { + case FITGAUSS: + plist[1] = 1 + plist[2] = 2 + nplist = 2 + params[2] = dfwhm**2 / (8 * log(2.)) + params[1] = zcntr + call nlinitr (nl, locpr (ie_gauss), locpr (ie_dgauss), + params, params, 2, plist, nplist, .001, 100) + call nlfitr (nl, Memr[xs], Memr[ys], Memr[ws], no, 1, WTS_USER, i) + if (i == SINGULAR || i == NO_DEG_FREEDOM) { + call eprintf ("WARNING: Gaussian fit did not converge\n") + call tsleep (5) + zcntr = INDEF + fwhm = INDEF + } else { + call nlpgetr (nl, params, i) + if (params[2] < 0.) { + zcntr = INDEF + fwhm = INDEF + } else { + zcntr = params[1] + fwhm = sqrt (8 * log (2.) * params[2]) + } + } + case FITMOFFAT: + plist[1] = 1 + plist[2] = 2 + if (IS_INDEF(beta)) { + params[3] = -3.0 + plist[3] = 3 + nplist = 3 + } else { + params[3] = -beta + nplist = 2 + } + params[2] = dfwhm / 2. / sqrt (2.**(-1./params[3]) - 1.) + params[1] = zcntr + call nlinitr (nl, locpr (ie_moffat), locpr (ie_dmoffat), + params, params, 3, plist, nplist, .001, 100) + call nlfitr (nl, Memr[xs], Memr[ys], Memr[ws], no, 1, WTS_USER, i) + if (i == SINGULAR || i == NO_DEG_FREEDOM) { + call eprintf ("WARNING: Moffat fit did not converge\n") + call tsleep (5) + zcntr = INDEF + fwhm = INDEF + beta = INDEF + } else { + call nlpgetr (nl, params, i) + if (params[2] < 0.) { + zcntr = INDEF + fwhm = INDEF + beta = INDEF + } else { + zcntr = params[1] + beta = -params[3] + fwhm = abs (params[2])*2.*sqrt (2.**(-1./params[3]) - 1.) + } + } + } + + mag = INDEF + r = INDEF + e = INDEF + pa = INDEF + if (sumo > 0.) { + mag = magzero - 2.5 * log10 (sumo) + r2 = sumxx + sumyy + if (r2 > 0.) { + switch (fittype) { + case FITGAUSS: + r = 2 * sqrt (log (2.) * r2 / sumo) + case FITMOFFAT: + if (beta > 2.) + r = 2 * sqrt ((beta-2.)*(2.**(1./beta)-1) * r2 / sumo) + } + r1 =(sumxx-sumyy)**2+(2*sumxy)**2 + if (r1 > 0.) + e = sqrt (r1) / r2 + else + e = 0. + } + if (e < 0.01) + e = 0. + else + pa = RADTODEG (0.5 * atan2 (2*sumxy, sumxx-sumyy)) + } + + call ie_mwctran (ie, xcntr, ycntr, wxcntr, wycntr) + if (xcntr == wxcntr && ycntr == wycntr) + call strcpy ("%.2f %.2f", Memc[title], IE_SZTITLE) + else { + call sprintf (Memc[title], IE_SZTITLE, "%s %s") + if (IE_XFORMAT(ie) == '%') + call pargstr (IE_XFORMAT(ie)) + else + call pargstr ("%g") + if (IE_YFORMAT(ie) == '%') + call pargstr (IE_YFORMAT(ie)) + else + call pargstr ("%g") + } + call sprintf (Memc[coords], IE_SZTITLE, Memc[title]) + call pargr (wxcntr) + call pargr (wycntr) + + # Plot the radial profile and overplot the gaussian fit. + if (gp != NULL) { + call sprintf (Memc[title], IE_SZTITLE, + "%s: Radial profile at %s\n%s") + call pargstr (IE_IMNAME(ie)) + call pargstr (Memc[coords]) + call pargstr (IM_TITLE(im)) + + call ie_graph (gp, mode, pp, Memc[title], Memr[xs], Memr[ys], + np, "", "") + + if (fitplot && !IS_INDEF (fwhm)) { + np = 51 + dx = rplot / (np - 1) + do i = 0, np - 1 + Memr[xs+i] = i * dx + call nlvectorr (nl, Memr[xs], Memr[ys], np, 1) + call gseti (gp, G_PLTYPE, 2) + call gpline (gp, Memr[xs], Memr[ys], np) + call gseti (gp, G_PLTYPE, 1) + } + call gseti (gp, G_PLTYPE, 2) + + call printf ("%6.2f %6.2f %7.4g %7.4g %7.4g %4.2f %4d") + call pargr (radius) + call pargr (mag) + call pargd (sumo) + call pargd (sums / no) + call pargr (zcntr) + call pargr (e) + call pargr (pa) + switch (fittype) { + case FITGAUSS: + call printf (" %4w %8.2f %8.2f %6.2f\n") + call pargr (efwhm) + call pargr (fwhm) + call pargr (dfwhm) + case FITMOFFAT: + call printf (" %4.2f %8.2f %8.2f %6.2f\n") + call pargr (beta) + call pargr (efwhm) + call pargr (fwhm) + call pargr (dfwhm) + } + + } else { + if (IE_LASTKEY(ie) != 'a') { + coordlen = max (11, strlen (Memc[coords])) + call printf ("# %5s %7s %-*s\n# %5s %6s %7s %7s %7s %4s %4s") + call pargstr ("COL") + call pargstr ("LINE") + call pargi (coordlen) + call pargstr ("COORDINATES") + call pargstr ("R") + call pargstr ("MAG") + call pargstr ("FLUX") + call pargstr ("SKY") + call pargstr ("PEAK") + call pargstr ("E") + call pargstr ("PA") + switch (fittype) { + case FITGAUSS: + call printf (" %4w %8s %8s %6s\n") + call pargstr ("ENCLOSED") + call pargstr ("GAUSSIAN") + call pargstr ("DIRECT") + case FITMOFFAT: + call printf (" %4s %8s %8s %6s\n") + call pargstr ("BETA") + call pargstr ("ENCLOSED") + call pargstr ("MOFFAT") + call pargstr ("DIRECT") + } + } + + call printf ( + "%7.2f %7.2f %-*s\n %6.2f %6.2f %7.4g %7.4g %7.4g %4.2f %4d") + call pargr (xcntr) + call pargr (ycntr) + call pargi (coordlen) + call pargstr (Memc[coords]) + call pargr (radius) + call pargr (mag) + call pargd (sumo) + call pargd (sums / no) + call pargr (zcntr) + call pargr (e) + call pargr (pa) + switch (fittype) { + case FITGAUSS: + call printf (" %4w %8.2f %8.2f %6.2f\n") + call pargr (efwhm) + call pargr (fwhm) + call pargr (dfwhm) + case FITMOFFAT: + call printf (" %4.2f %8.2f %8.2f %6.2f\n") + call pargr (beta) + call pargr (efwhm) + call pargr (fwhm) + call pargr (dfwhm) + } + } + + if (IE_LOGFD(ie) != NULL) { + if (IE_LASTKEY(ie) != 'a') { + coordlen = max (11, strlen (Memc[coords])) + call fprintf (IE_LOGFD(ie), + "# %5s %7s %-*s %6s %6s %7s %7s %7s %4s %4s") + call pargstr ("COL") + call pargstr ("LINE") + call pargi (coordlen) + call pargstr ("COORDINATES") + call pargstr ("R") + call pargstr ("MAG") + call pargstr ("FLUX") + call pargstr ("SKY") + call pargstr ("PEAK") + call pargstr ("E") + call pargstr ("PA") + switch (fittype) { + case FITGAUSS: + call fprintf (IE_LOGFD(ie), " %4w %8s %8s %6s\n") + call pargstr ("ENCLOSED") + call pargstr ("GAUSSIAN") + call pargstr ("DIRECT") + case FITMOFFAT: + call fprintf (IE_LOGFD(ie), " %4s %8s %8s %6s\n") + call pargstr ("BETA") + call pargstr ("ENCLOSED") + call pargstr ("MOFFAT") + call pargstr ("DIRECT") + } + } + + call fprintf (IE_LOGFD(ie), + "%7.2f %7.2f %-*s %6.2f %6.2f %7.4g %7.4g %7.4g %4.2f %4d") + call pargr (xcntr) + call pargr (ycntr) + call pargi (coordlen) + call pargstr (Memc[coords]) + call pargr (radius) + call pargr (mag) + call pargd (sumo) + call pargd (sums / no) + call pargr (zcntr) + call pargr (e) + call pargr (pa) + switch (fittype) { + case FITGAUSS: + call fprintf (IE_LOGFD(ie), " %4w %8.2f %8.2f %6.2f\n") + call pargr (efwhm) + call pargr (fwhm) + call pargr (dfwhm) + case FITMOFFAT: + call fprintf (IE_LOGFD(ie), " %4.2f %8.2f %8.2f %6.2f\n") + call pargr (beta) + call pargr (efwhm) + call pargr (fwhm) + call pargr (dfwhm) + } + } + + if (gp == NULL) + call clcpset (pp) + else + IE_PP(ie) = pp + + call nlfreer (nl) + call sfree (sp) +end + + +# IE_CENTER -- Find the center of gravity from the marginal distributions. + +procedure ie_center (im, radius, xcntr, ycntr) + +pointer im +real radius +real xcntr, ycntr + +int i, j, k, x1, x2, y1, y2, nx, ny, npts +real xlast, ylast +real mean, sum, sum1, sum2, sum3, asumr() +pointer data, ptr, ie_gdata() +errchk ie_gdata + +begin + # Find the center of a star image given approximate coords. Uses + # Mountain Photometry Code Algorithm as outlined in Stellar Magnitudes + # from Digital Images. + + do k = 1, 3 { + # Extract region around center + xlast = xcntr + ylast = ycntr + x1 = xcntr - radius + 0.5 + x2 = xcntr + radius + 0.5 + y1 = ycntr - radius + 0.5 + y2 = ycntr + radius + 0.5 + data = ie_gdata (im, x1, x2, y1, y2) + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + # Find center of gravity for marginal distributions above mean. + sum = asumr (Memr[data], npts) + mean = sum / nx + sum1 = 0. + sum2 = 0. + + do i = x1, x2 { + ptr = data + i - x1 + sum3 = 0. + do j = y1, y2 { + sum3 = sum3 + Memr[ptr] + ptr = ptr + nx + } + sum3 = sum3 - mean + if (sum3 > 0.) { + sum1 = sum1 + i * sum3 + sum2 = sum2 + sum3 + } + } + xcntr = sum1 / sum2 + + ptr = data + mean = sum / ny + sum1 = 0. + sum2 = 0. + do j = y1, y2 { + sum3 = 0. + do i = x1, x2 { + sum3 = sum3 + Memr[ptr] + ptr = ptr + 1 + } + sum3 = sum3 - mean + if (sum3 > 0.) { + sum1 = sum1 + j * sum3 + sum2 = sum2 + sum3 + } + } + ycntr = sum1 / sum2 + + if (int(xcntr) == int(xlast) && int(ycntr) == int(ylast)) + break + } +end + + +# IE_GAUSS -- Gaussian function used in NLFIT. The parameters are the +# amplitude and sigma squared and the input variable is the radius. + +procedure ie_gauss (x, nvars, p, np, z) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +int np #I Number of parameters +real z #O Function return + +real r2 + +begin + r2 = x[1]**2 / (2 * p[2]) + if (abs (r2) > 20.) + z = 0. + else + z = p[1] * exp (-r2) +end + + +# IE_DGAUSS -- Gaussian function and derivatives used in NLFIT. The parameters +# are the amplitude and sigma squared and the input variable is the radius. + +procedure ie_dgauss (x, nvars, p, dp, np, z, der) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +real dp[np] #I Dummy array of parameters increments +int np #I Number of parameters +real z #O Function return +real der[np] #O Derivatives + +real r2 + +begin + r2 = x[1]**2 / (2 * p[2]) + if (abs (r2) > 20.) { + z = 0. + der[1] = 0. + der[2] = 0. + } else { + der[1] = exp (-r2) + z = p[1] * der[1] + der[2] = z * r2 / p[2] + } +end + + +# IE_MOFFAT -- Moffat function used in NLFIT. The parameters are the +# amplitude, alpha squared, and beta and the input variable is the radius. + +procedure ie_moffat (x, nvars, p, np, z) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +int np #I Number of parameters +real z #O Function return + +real y + +begin + y = 1 + (x[1] / p[2]) ** 2 + if (abs (y) > 20.) + z = 0. + else + z = p[1] * y ** p[3] +end + + +# IE_DMOFFAT -- Moffat function and derivatives used in NLFIT. The parameters +# are the amplitude, alpha squared, and beta and the input variable is the +# radius. + +procedure ie_dmoffat (x, nvars, p, dp, np, z, der) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +real dp[np] #I Dummy array of parameters increments +int np #I Number of parameters +real z #O Function return +real der[np] #O Derivatives + +real y + +begin + y = 1 + (x[1] / p[2]) ** 2 + if (abs (y) > 20.) { + z = 0. + der[1] = 0. + der[2] = 0. + der[3] = 0. + } else { + der[1] = y ** p[3] + z = p[1] * der[1] + der[2] = -2 * z / y * p[3] / p[2] * (x[1] / p[2]) ** 2 + der[3] = z * log (y) + } +end diff --git a/pkg/images/tv/imexamine/iesimexam.x b/pkg/images/tv/imexamine/iesimexam.x new file mode 100644 index 00000000..292364ee --- /dev/null +++ b/pkg/images/tv/imexamine/iesimexam.x @@ -0,0 +1,492 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include <gset.h> +include <mach.h> +include "imexam.h" + +define CSIZE 24 + + +# IE_SIMEXAM -- Draw a perspective view of a surface. The altitude +# and azimuth of the viewing angle are variable. + +procedure ie_simexam (gp, mode, ie, x, y) + +pointer gp # GIO pointer +int mode # Mode +pointer ie # IMEXAM pointer +real x, y # Center + +real angh, angv # Orientation of surface (degrees) +real floor, ceiling # Range limits + +int wkid +int x1, x2, y1, y2, nx, ny, npts +pointer pp, sp, title, str, sdata, work, im, data, ie_gimage(), ie_gdata() + +bool clgpsetb() +int clgpseti() +real clgpsetr() +pointer clopset() + +int first +real vpx1, vpx2, vpy1, vpy2 +common /frstfg/ first +common /noaovp/ vpx1, vpx2, vpy1, vpy2 + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + pp = IE_PP(ie) + if (pp != NULL) + call clcpset (pp) + pp = clopset ("simexam") + IE_PP(ie) = pp + + nx = clgpseti (pp, "ncolumns") + ny = clgpseti (pp, "nlines") + angh = clgpsetr (pp, "angh") + angv = clgpsetr (pp, "angv") + floor = clgpsetr (pp, "floor") + ceiling = clgpsetr (pp, "ceiling") + + if (!IS_INDEF(x)) + IE_X1(ie) = x + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + x1 = IE_X1(ie) - (nx - 1) / 2 + 0.5 + x2 = IE_X1(ie) + nx / 2 + 0.5 + y1 = IE_Y1(ie) - (ny - 1) / 2 + 0.5 + y2 = IE_Y1(ie) + ny / 2 + 0.5 + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + return + } + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + call smark (sp) + + # Take floor and ceiling if enabled (nonzero). + if (IS_INDEF (floor) && IS_INDEF (ceiling)) + sdata = data + else { + call salloc (sdata, npts, TY_REAL) + call amovr (Memr[data], Memr[sdata], npts) + if (!IS_INDEF (floor) && !IS_INDEF (ceiling)) { + floor = min (floor, ceiling) + ceiling = max (floor, ceiling) + } + } + iferr (call ie_surf_limits (Memr[sdata], npts, floor, ceiling)) { + call sfree (sp) + call erract (EA_WARN) + return + } + + if (mode != APPEND) { + call gclear (gp) + + # Set the viewport. + call gsview (gp, 0.1, 0.9, 0.1, 0.9) + + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + if (clgpsetb (pp, "banner")) { + call sysid (Memc[str], SZ_LINE) + call sprintf (Memc[title], IE_SZTITLE, + "%s\n%s: Surface plot of [%d:%d,%d:%d]\n%s") + call pargstr (Memc[str]) + call pargstr (IE_IMNAME(ie)) + call pargi (x1) + call pargi (x2) + call pargi (y1) + call pargi (y2) + call pargstr (IM_TITLE(im)) + } else + Memc[title] = EOS + + call clgpset (pp, "title", Memc[str], SZ_LINE) + if (Memc[str] != EOS) { + call strcat ("\n", Memc[title], IE_SZTITLE) + call strcat (Memc[str], Memc[title], IE_SZTITLE) + } + + call gseti (gp, G_DRAWAXES, NO) + call glabax (gp, Memc[title], "", "") + } + + # Open graphics device and make plot. + call gopks (STDERR) + wkid = 1 + call gopwk (wkid, 6, gp) + call gacwk (wkid) + + first = 1 + call srfabd() + call ggview (gp, vpx1, vpx2, vpy1, vpy2) + call set (vpx1, vpx2, vpy1, vpy2, 1.0, 1024., 1.0, 1024., 1) + call salloc (work, 2 * (2*nx*ny+nx+ny), TY_REAL) + call ezsrfc (Memr[sdata], nx, ny, angh, angv, Memr[work]) + + if (mode != APPEND) { + if (clgpsetb (pp, "axes")) { + call gswind (gp, real (x1), real (x2), real (y1), real (y2)) + call gseti (gp, G_CLIP, NO) + call ie_perimeter (gp, Memr[sdata], nx, ny, angh, angv) + } + } + + call gdawk (wkid) + call gclks () + call sfree (sp) +end + + +# IE_PERIMETER -- draw and label axes around the surface plot. + +procedure ie_perimeter (gp, z, ncols, nlines, angh, angv) + +pointer gp # Graphics pointer +int ncols # Number of image columns +int nlines # Number of image lines +real z[ncols, nlines] # Array of intensity values +real angh # Angle of horizontal inclination +real angv # Angle of vertical inclination + +pointer sp, x_val, y_val, kvec +char tlabel[10] +real xmin, ymin, delta, fact1, flo, hi, xcen, ycen +real x1_perim, x2_perim, y1_perim, y2_perim, z1, z2 +real wc1, wc2, wl1, wl2, del +int i, j, junk +int itoc() +data fact1 /2.0/ +real vpx1, vpx2, vpy1, vpy2 +common /noaovp/ vpx1, vpx2, vpy1, vpy2 + +begin + call smark (sp) + call salloc (x_val, ncols + 2, TY_REAL) + call salloc (y_val, nlines + 2, TY_REAL) + call salloc (kvec, max (ncols, nlines) + 2, TY_REAL) + + # Get window coordinates set up in calling procedure. + call ggwind (gp, wc1, wc2, wl1, wl2) + + # Set up window, viewport for output. The coordinates returned + # from trn32s are in the range [1-1024]. + call set (vpx1, vpx2, vpy1, vpy2, 1.0, 1024., 1.0, 1024., 1) + + # Find range of z for determining perspective + flo = MAX_REAL + hi = -flo + do j = 1, nlines { + call alimr (z[1,j], ncols, z1, z2) + flo = min (flo, z1) + hi = max (hi, z2) + } + + # Set up linear endpoints and spacing as used in surface. + + delta = (hi-flo) / (max (ncols,nlines) -1.) * fact1 + xmin = -(real (ncols/2) * delta + real (mod (ncols+1, 2)) * delta) + ymin = -(real (nlines/2) * delta + real (mod (nlines+1, 2)) * delta) + del = 2.0 * delta + + # The perimeter is separated from the surface plot by the + # width of delta. + + x1_perim = xmin - delta + y1_perim = ymin - delta + x2_perim = xmin + (real (ncols) * delta) + y2_perim = ymin + (real (nlines) * delta) + # Set up linear arrays over full perimeter range + do i = 1, ncols + 2 + Memr[x_val+i-1] = x1_perim + (i-1) * delta + do i = 1, nlines + 2 + Memr[y_val+i-1] = y1_perim + (i-1) * delta + + # Draw and label axes and tick marks. + # It is important that frame has not been called after calling srface. + # First to draw the perimeter. Which axes get drawn depends on the + # values of angh and angv. Get angles in the range [-180, 180]. + + if (angh > 180.) + angh = angh - 360. + else if (angh < -180.) + angh = angh + 360. + + if (angv > 180.) + angv = angv - 360. + else if (angv < -180.) + angv = angv + 360. + + # Calculate positions for the axis labels + xcen = 0.5 * (x1_perim + x2_perim) + ycen = 0.5 * (y1_perim + y2_perim) + + if (angh >= 0) { + if (angv >= 0) { + # Case 1: xy rotation positive, looking down from above mid Z + + # First draw x axis + call amovkr (y2_perim, Memr[kvec], ncols + 2) + call ie_draw_axis (Memr[x_val+1], Memr[kvec], flo, ncols + 1) + call ie_label_axis (xcen, y2_perim+del, flo, "X-AXIS", -1, -2) + call ie_draw_ticksx (Memr[x_val+1], y2_perim, y2_perim+delta, + flo, ncols) + junk = itoc (int (wc1), tlabel, 10) + call ie_label_axis (xmin, y2_perim+del, flo, tlabel, -1, -2) + junk = itoc (int (wc2), tlabel, 10) + call ie_label_axis (Memr[x_val+ncols], y2_perim+del, flo, + tlabel, -1, -2) + + # Now draw y axis + call amovkr (x2_perim, Memr[kvec], nlines + 2) + call ie_draw_axis (Memr[kvec], Memr[y_val+1], flo, nlines + 1) + call ie_label_axis (x2_perim+del, ycen, flo, "Y-AXIS", 2, -1) + call ie_draw_ticksy (x2_perim, x2_perim+delta, Memr[y_val+1], + flo, nlines) + junk = itoc (int (wl1), tlabel, 10) + call ie_label_axis (x2_perim+del, ymin, flo, tlabel, 2, -1) + junk = itoc (int (wl2), tlabel, 10) + call ie_label_axis (x2_perim+del, Memr[y_val+nlines], flo, + tlabel, 2, -1) + } else { + # Case 2: xy rotation positive, looking up from below mid Z + # First draw x axis + call amovkr (y1_perim, Memr[kvec], ncols + 2) + call ie_draw_axis (Memr[x_val], Memr[kvec], flo, ncols + 1) + call ie_label_axis (xcen, y1_perim-del, flo, "X-AXIS", -1, 2) + call ie_draw_ticksx (Memr[x_val+1], y1_perim, y1_perim-delta, + flo, ncols) + junk = itoc (int (wc1), tlabel, 10) + call ie_label_axis (xmin, y1_perim-del, flo, tlabel, -1, 2) + junk = itoc (int (wc2), tlabel, 10) + call ie_label_axis (Memr[x_val+ncols], y1_perim-del, flo, + tlabel, -1, 2) + + # Now draw y axis + call amovkr (x1_perim, Memr[kvec], nlines + 2) + call ie_draw_axis (Memr[kvec], Memr[y_val], flo, nlines + 1) + call ie_label_axis (x1_perim-del, ycen, flo, "Y-AXIS", 2, 1) + call ie_draw_ticksy (x1_perim, x1_perim-delta, Memr[y_val+1], + flo, nlines) + junk = itoc (int (wl1), tlabel, 10) + call ie_label_axis (x1_perim-del, ymin, flo, tlabel, 2, 1) + junk = itoc (int (wl2), tlabel, 10) + call ie_label_axis (x1_perim-del, Memr[y_val+nlines], flo, + tlabel, 2, 1) + } + } + + if (angh < 0) { + if (angv > 0) { + # Case 3: xy rotation negative, looking down from above mid Z + # (default). First draw x axis + call amovkr (y1_perim, Memr[kvec], ncols + 2) + call ie_draw_axis (Memr[x_val+1], Memr[kvec], flo, ncols + 1) + call ie_label_axis (xcen, y1_perim-del, flo, "X-AXIS", 1, 2) + call ie_draw_ticksx (Memr[x_val+1], y1_perim, y1_perim-delta, + flo, ncols) + junk = itoc (int (wc1), tlabel, 10) + call ie_label_axis (xmin, y1_perim-del, flo, tlabel, 1, 2) + junk = itoc (int (wc2), tlabel, 10) + call ie_label_axis (Memr[x_val+ncols], y1_perim-del, flo, + tlabel, 1, 2) + + # Now draw y axis + call amovkr (x2_perim, Memr[kvec], nlines + 2) + call ie_draw_axis (Memr[kvec], Memr[y_val], flo, nlines + 1) + call ie_label_axis (x2_perim+del, ycen, flo, "Y-AXIS", 2, -1) + call ie_draw_ticksy (x2_perim, x2_perim+delta, Memr[y_val+1], + flo, nlines) + junk = itoc (int (wl1), tlabel, 10) + call ie_label_axis (x2_perim+del, ymin, flo, tlabel, 2, -1) + junk = itoc (int (wl2), tlabel, 10) + call ie_label_axis (x2_perim+del, Memr[y_val+nlines], flo, + tlabel, 2, -1) + } else { + # Case 4: xy rotation negative, looking up from below mid Z + # First draw x axis + call amovkr (y2_perim, Memr[kvec], ncols + 2) + call ie_draw_axis (Memr[x_val], Memr[kvec], flo, ncols + 1) + call ie_label_axis (xcen, y2_perim+del, flo, "X-AXIS", 1, -2) + call ie_draw_ticksx (Memr[x_val+1], y2_perim, y2_perim+delta, + flo, ncols) + junk = itoc (int (wc1), tlabel, 10) + call ie_label_axis (xmin, y2_perim+del, flo, tlabel, 1, -2) + junk = itoc (int (wc2), tlabel, 10) + call ie_label_axis (Memr[x_val+ncols], y2_perim+del, flo, + tlabel, 1, -2) + + # Now draw y axis + call amovkr (x1_perim, Memr[kvec], nlines + 2) + call ie_draw_axis (Memr[kvec], Memr[y_val+1], flo, nlines + 1) + call ie_label_axis (x1_perim-del, ycen, flo, "Y-AXIS", 2, 1) + call ie_draw_ticksy (x1_perim, x1_perim-delta, Memr[y_val+1], + flo, nlines) + junk = itoc (int (wl1), tlabel, 10) + call ie_label_axis (x1_perim-del, ymin, flo, tlabel, 2, 1) + junk = itoc (int (wl2), tlabel, 10) + call ie_label_axis (x1_perim-del, Memr[y_val+nlines], flo, + tlabel, 2, 1) + } + } + + # Flush plotit buffer before returning + call plotit (0, 0, 2) + call sfree (sp) +end + + +# ?? + +procedure ie_draw_axis (xvals, yvals, zval, nvals) + +int nvals +real xvals[nvals] +real yvals[nvals] +real zval +pointer sp, xt, yt +int i +real dum + +begin + call smark (sp) + call salloc (xt, nvals, TY_REAL) + call salloc (yt, nvals, TY_REAL) + + do i = 1, nvals + call trn32s (xvals[i], yvals[i], zval, Memr[xt+i-1], Memr[yt+i-1], + dum, 1) + + call gpl (nvals, Memr[xt], Memr[yt]) + call sfree (sp) +end + + +# ?? + +procedure ie_label_axis (xval, yval, zval, sppstr, path, up) + +real xval +real yval +real zval +char sppstr[SZ_LINE] +int path +int up + +int nchars +int strlen() +% character*64 fstr + +begin + nchars = strlen (sppstr) + +% call f77pak (sppstr, fstr, 64) + call pwrzs (xval, yval, zval, fstr, nchars, CSIZE, path, up, 0) +end + + +# ?? + +procedure ie_draw_ticksx (x, y1, y2, zval, nvals) + +int nvals +real x[nvals] +real y1, y2 +real zval + +int i +real tkx[2], tky[2], dum + +begin + do i = 1, nvals { + call trn32s (x[i], y1, zval, tkx[1], tky[1], dum, 1) + call trn32s (x[i], y2, zval, tkx[2], tky[2], dum, 1) + call gpl (2, tkx[1], tky[1]) + } +end + + +# ?? + +procedure ie_draw_ticksy (x1, x2, y, zval, nvals) + +int nvals +real x1, x2 +real y[nvals] +real zval + +int i +real tkx[2], tky[2], dum + +begin + do i = 1, nvals { + call trn32s (x1, y[i], zval, tkx[1], tky[1], dum, 1) + call trn32s (x2, y[i], zval, tkx[2], tky[2], dum, 1) + call gpl (2, tkx[1], tky[1]) + } +end + + +# IE_SURF_LIMITS -- Apply the floor and ceiling constraints to the subraster. +# If either value is exactly zero, it is not applied. + +procedure ie_surf_limits (ras, m, floor, ceiling) + +real ras[m] +int m +real floor, ceiling +real val1_1 # value at ras[1] +int k +bool const_val # true if data are constant +bool bad_floor # true if no value is above floor +bool bad_ceiling # true if no value is below ceiling + +begin + const_val = true # initial values + bad_floor = true + bad_ceiling = true + val1_1 = ras[1] + + do k = 1, m + if (ras[k] != val1_1) { + const_val = false + break + } + if (!IS_INDEF(floor)) { + do k = 1, m { + if (ras[k] <= floor) + ras[k] = floor + else + bad_floor = false + } + } + if (!IS_INDEF(ceiling)) { + do k = 1, m { + if (ras[k] >= ceiling) + ras[k] = ceiling + else + bad_ceiling = false + } + } + + if (bad_floor && !IS_INDEF(floor)) + call error (1, "entire image is below (or at) specified floor") + if (bad_ceiling && !IS_INDEF(ceiling)) + call error (1, "entire image is above (or at) specified ceiling") + if (const_val) + call error (1, "all data values are the same; can't plot it") +end diff --git a/pkg/images/tv/imexamine/iestatistics.x b/pkg/images/tv/imexamine/iestatistics.x new file mode 100644 index 00000000..a3ac5f22 --- /dev/null +++ b/pkg/images/tv/imexamine/iestatistics.x @@ -0,0 +1,84 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include "imexam.h" + + +# IE_STATISTICS -- Compute and print statistics. + +procedure ie_statistics (ie, x, y) + +pointer ie # IMEXAM structure +real x, y # Aperture coordinates + +double mean, median, std +int ncstat, nlstat, x1, x2,y1, y2, npts, clgeti() +pointer sp, imname, im, data, sortdata, ie_gimage(), ie_gdata() +string label "\ +# SECTION NPIX MEAN MEDIAN STDDEV MIN MAX\n" + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + ncstat = clgeti ("ncstat") + nlstat = clgeti ("nlstat") + x1 = x - (ncstat-1) / 2 + 0.5 + x2 = x + ncstat / 2 + 0.5 + y1 = y - (nlstat-1) / 2 + 0.5 + y2 = y + nlstat / 2 + 0.5 + iferr (data = ie_gdata (im, x1, x2, y1, y2)) { + call erract (EA_WARN) + return + } + npts = (x2-x1+1) * (y2-y1+1) + + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (sortdata, npts, TY_DOUBLE) + + call achtrd (Memr[data], Memd[sortdata], npts) + call asrtd (Memd[sortdata], Memd[sortdata], npts) + call aavgd (Memd[sortdata], npts, mean, std) + if (mod (npts, 2) == 0) + median = (Memd[sortdata+npts/2-1] + Memd[sortdata+npts/2]) / 2 + else + median = Memd[sortdata+npts/2] + + call sprintf (Memc[imname], SZ_FNAME, "[%d:%d,%d:%d]") + call pargi (x1) + call pargi (x2) + call pargi (y1) + call pargi (y2) + + if (IE_LASTKEY(ie) != 'm') + call printf (label) + + call printf ("%20s %8d %8.4g %8.4g %8.4g %8.4g %8.4g\n") + call pargstr (Memc[imname]) + call pargi (npts) + call pargd (mean) + call pargd (median) + call pargd (std) + call pargd (Memd[sortdata]) + call pargd (Memd[sortdata+npts-1]) + + if (IE_LOGFD(ie) != NULL) { + if (IE_LASTKEY(ie) != 'm') + call fprintf (IE_LOGFD(ie), label) + + call fprintf (IE_LOGFD(ie), + "%20s %8d %8.4g %8.4g %8.4g %8.4g %8.4g\n") + call pargstr (Memc[imname]) + call pargi (npts) + call pargd (mean) + call pargd (median) + call pargd (std) + call pargd (Memd[sortdata]) + call pargd (Memd[sortdata+npts-1]) + } + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/ietimexam.x b/pkg/images/tv/imexamine/ietimexam.x new file mode 100644 index 00000000..869eaa4b --- /dev/null +++ b/pkg/images/tv/imexamine/ietimexam.x @@ -0,0 +1,121 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> +include "imexam.h" + + +# IE_TIMEXAM -- Extract a subraster image. +# This routine does not currently update the WCS but it does clear it. + +procedure ie_timexam (ie, x, y) + +pointer ie # IE pointer +real x, y # Center + +int i, x1, x2, y1, y2, nx, ny +pointer sp, root, extn, output +pointer im, out, data, outbuf, mw + +int clgeti(), fnextn(), iki_validextn(), strlen(), imaccess() +pointer ie_gimage(), ie_gdata(), immap(), impl2r(), mw_open() +errchk impl2r + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (extn, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + + # Get parameters. + call clgstr ("output", Memc[root], SZ_FNAME) + nx = clgeti ("ncoutput") + ny = clgeti ("nloutput") + + # Strip the extension. + call imgimage (Memc[root], Memc[root], SZ_FNAME) + if (Memc[root] == EOS) + call strcpy (IE_IMAGE(ie), Memc[root], SZ_FNAME) + i = fnextn (Memc[root], Memc[extn+1], SZ_FNAME) + Memc[extn] = EOS + if (i > 0) { + call iki_init() + if (iki_validextn (0, Memc[extn+1]) != 0) { + Memc[root+strlen(Memc[root])-i-1] = EOS + Memc[extn] = '.' + } + } + + do i = 1, ARB { + call sprintf (Memc[output], SZ_FNAME, "%s.%03d%s") + call pargstr (Memc[root]) + call pargi (i) + call pargstr (Memc[extn]) + if (imaccess (Memc[output], 0) == NO) + break + } + + # Set section to be extracted. + if (!IS_INDEF(x)) + IE_X1(ie) = x + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + x1 = IE_X1(ie) - (nx - 1) / 2 + 0.5 + x2 = IE_X1(ie) + nx / 2 + 0.5 + y1 = IE_Y1(ie) - (ny - 1) / 2 + 0.5 + y2 = IE_Y1(ie) + ny / 2 + 0.5 + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + + # Set output. + iferr (out = immap (Memc[output], NEW_COPY, im)) { + call erract (EA_WARN) + return + } + IM_NDIM(out) = 2 + IM_LEN(out,1) = nx + IM_LEN(out,2) = ny + + # Extract the section. + iferr { + do i = y1, y2 { + data = ie_gdata (im, x1, x2, i, i) + outbuf = impl2r (out, i-y1+1) + call amovr (Memr[data], Memr[outbuf], nx) + } + mw = mw_open (NULL, 2) + call mw_saveim (mw, out) + call imunmap (out) + } then { + call imunmap (out) + iferr (call imdelete (Memc[output])) + ; + call sfree (sp) + call erract (EA_WARN) + return + } + + call printf ("%s[%d:%d,%d:%d] -> %s\n") + call pargstr (IE_IMAGE(ie)) + call pargi (x1) + call pargi (x2) + call pargi (y1) + call pargi (y2) + call pargstr (Memc[output]) + if (IE_LOGFD(ie) != NULL) { + call fprintf (IE_LOGFD(ie), "%s[%d:%d,%d:%d] -> %s\n") + call pargstr (IE_IMAGE(ie)) + call pargi (x1) + call pargi (x2) + call pargi (y1) + call pargi (y2) + } + + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/ievimexam.x b/pkg/images/tv/imexamine/ievimexam.x new file mode 100644 index 00000000..a75ac2bc --- /dev/null +++ b/pkg/images/tv/imexamine/ievimexam.x @@ -0,0 +1,582 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <gset.h> +include <mach.h> +include <math.h> +include <imhdr.h> +include <imset.h> +include <math/iminterp.h> +include "imexam.h" + +define BTYPES "|constant|nearest|reflect|wrap|project|" +define SZ_BTYPE 8 # Length of boundary type string +define NLINES 16 # Number of image lines in the buffer + + +# IE_VIMEXAM -- Plot the vector of image data between two pixels. +# There are two types of plot selected by the key argument. The +# second cursor position is passed in the IMEXAM data structure. +# The first position is either the middle of the vector or the starting +# point. + +procedure ie_vimexam (gp, mode, ie, x, y, key) + +pointer gp # GIO pointer +int mode # Graph mode +pointer ie # IMEXAM pointer +real x, y # Starting or center coordinate +int key # 'u' centered vector, 'v' two endpoint vector + +int btype, nxvals, nyvals, nzvals, width +pointer sp, title, boundary, im, x_vec, y_vec, pp +real x1, y1, x2, y2, zmin, zmax, bconstant + +bool fp_equalr() +int clgpseti(), clgwrd(), clopset() +real clgpsetr() +pointer ie_gimage() +errchk malloc + +begin + iferr (im = ie_gimage (ie, NO)) { + call erract (EA_WARN) + return + } + + call smark (sp) + call salloc (title, IE_SZTITLE, TY_CHAR) + call salloc (boundary, SZ_BTYPE, TY_CHAR) + + # Get boundary extension parameters. + if (IE_PP(ie) != NULL) + call clcpset (IE_PP(ie)) + IE_PP(ie) = clopset ("vimexam") + pp = IE_PP(ie) + btype = clgwrd ("vimexam.boundary", Memc[boundary], SZ_BTYPE, BTYPES) + bconstant = clgpsetr (pp, "constant") + + nxvals = IM_LEN(im,1) + nyvals = IM_LEN(im,2) + + if (!IS_INDEF (x)) + IE_X1(ie) = x + if (!IS_INDEF(y)) + IE_Y1(ie) = y + + x1 = IE_X1(ie) + x2 = IE_X2(ie) + y1 = IE_Y1(ie) + y2 = IE_Y2(ie) + width = clgpseti (pp, "naverage") + + # Check the boundary and compute the length of the output vector. + x1 = max (1.0, min (x1, real (nxvals))) + x2 = min (real(nxvals), max (1.0, x2)) + y1 = max (1.0, min (y1, real (nyvals))) + y2 = min (real(nyvals), max (1.0, y2)) + nzvals = int (sqrt ((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))) + 1 + + # Check for cases which should be handled by pcols or prows. + call malloc (x_vec, nzvals, TY_REAL) + call malloc (y_vec, nzvals, TY_REAL) + if (fp_equalr (x1, x2)) + call ie_get_col (im, x1, y1, x2, y2, nzvals, width, btype, + bconstant, Memr[x_vec], Memr[y_vec], zmin, zmax) + else if (fp_equalr (y1, y2)) + call ie_get_row (im, x1, y1, x2, y2, nzvals, width, btype, + bconstant, Memr[x_vec], Memr[y_vec], zmin, zmax) + else + call ie_get_vector (im, x1, y1, x2, y2, nzvals, width, btype, + bconstant, Memr[x_vec], Memr[y_vec], zmin, zmax) + + # Convert endpoint plot coordinates to centered coordinates. + if (key == 'u') { + zmin = (IE_X1(ie) + IE_X2(ie)) / 2 + zmax = (IE_Y1(ie) + IE_Y2(ie)) / 2 + zmin = sqrt ((zmin-x1)**2 + (zmax-y1)**2) + call asubkr (Memr[x_vec], zmin, Memr[x_vec], nzvals) + } + + call sprintf (Memc[title], IE_SZTITLE, + "%s: Vector %.1f,%.1f to %.1f,%.1f naverage: %d\n%s") + call pargstr (IE_IMNAME(ie)) + call pargr (x1) + call pargr (y1) + call pargr (x2) + call pargr (y2) + call pargi (width) + call pargstr (IM_TITLE(im)) + + call ie_graph (gp, mode, pp, Memc[title], Memr[x_vec], Memr[y_vec], + nzvals, "", "") + + # Finish up + call mfree (x_vec, TY_REAL) + call mfree (y_vec, TY_REAL) + call sfree (sp) +end + + +# IE_GET_VECTOR -- Average a strip perpendicular to a given vector and return +# vectors of point number and average pixel value. Also returned is the min +# and max value in the data vector. + +procedure ie_get_vector (im, x1, y1, x2, y2, nvals, width, btype, + bconstant, x_vector, y_vector, zmin, zmax) + +pointer im # pointer to image header +real x1, y1 # starting pixel of vector +real x2, y2 # ending pixel of pixel +real bconstant # Boundary extension constant +int btype # Boundary extension type +int nvals # number of samples along the vector +int width # width of strip to average over +real x_vector[ARB] # Pixel numbers +real y_vector[ARB] # Average pixel values (returned) +real zmin, zmax # min, max of data vector + +double dx, dy, dpx, dpy, ratio, xoff, yoff, noff, xv, yv +int i, j, k, nedge, col1, col2, line1, line2 +int colb, colc, line, linea, lineb, linec +pointer sp, oxs, oys, xs, ys, yvals, msi, buf +real sum , lim1, lim2, lim3, lim4 +pointer imgs2r() +errchk msiinit + +begin + call smark (sp) + call salloc (oxs, width, TY_REAL) + call salloc (oys, width, TY_REAL) + call salloc (xs, width, TY_REAL) + call salloc (ys, width, TY_REAL) + call salloc (yvals, width, TY_REAL) + + # Determine sampling perpendicular to vector. + dx = (x2 - x1) / (nvals - 1) + dy = (y2 - y1) / (nvals - 1) + if (x1 < x2) { + dpx = -dy + dpy = dx + } else { + dpx = dy + dpy = -dx + } + + # Compute offset from the nominal vector to the first sample point. + ratio = dx / dy + nedge = width + 1 + noff = (real (width) - 1.0) / 2.0 + xoff = noff * dpx + yoff = noff * dpy + + # Initialize the interpolator and the image data buffer. + call msiinit (msi, II_BILINEAR) + buf = NULL + + # Set the boundary. + col1 = int (min (x1, x2)) - nedge + col2 = nint (max (x1, x2)) + nedge + line1 = int (min (y1, y2)) - nedge + line2 = nint (max (y2, y1)) + nedge + call ie_setboundary (im, col1, col2, line1, line2, btype, bconstant) + + # Initialize. + xv = x1 - xoff + yv = y1 - yoff + do j = 1, width { + Memr[oxs+j-1] = double (j - 1) * dpx + Memr[oys+j-1] = double (j - 1) * dpy + } + + # Loop over the output image lines. + do i = 1, nvals { + x_vector[i] = real (i) + line = yv + + # Get the input image data and fit an interpolator to the data. + # The input data is buffered in a section of size NLINES + 2 * + # NEDGE. + + if (dy >= 0.0 && (buf == NULL || line > (linea))) { + linea = min (line2, line + NLINES - 1) + lineb = max (line1, line - nedge) + linec = min (line2, linea + nedge) + lim1 = xv + lim2 = lim1 + double (width - 1) * dpx + lim3 = xv + double (linea - line + 1) * ratio + lim4 = lim3 + double (width - 1) * dpx + colb = max (col1, int (min (lim1, lim2, lim3, lim4)) - 1) + colc = min (col2, nint (max (lim1, lim2, lim3, lim4)) + 1) + buf = imgs2r (im, colb, colc, lineb, linec) + call msifit (msi, Memr[buf], colc - colb + 1, linec - lineb + + 1, colc - colb + 1) + + } else if (dy < 0.0 && (buf == NULL || line < linea)) { + linea = max (line1, line - NLINES + 1) + lineb = max (line1, linea - nedge) + linec = min (line2, line + nedge) + lim1 = xv + lim2 = lim1 + double (width - 1) * dpx + lim3 = xv + double (linea - line - 1) * ratio + lim4 = lim3 + double (width - 1) * dpx + colb = max (col1, int (min (lim1, lim2, lim3, lim4)) - 1) + colc = min (col2, nint (max (lim1, lim2, lim3, lim4)) + 1) + buf = imgs2r (im, colb, colc, lineb, linec) + call msifit (msi, Memr[buf], colc - colb + 1, linec - lineb + + 1, colc - colb + 1) + } + + # Evaluate the interpolant. + call aaddkr (Memr[oxs], real (xv - colb + 1), Memr[xs], width) + call aaddkr (Memr[oys], real (yv - lineb + 1), Memr[ys], width) + call msivector (msi, Memr[xs], Memr[ys], Memr[yvals], width) + + if (width == 1) + y_vector[i] = Memr[yvals] + else { + sum = 0.0 + do k = 1, width + sum = sum + Memr[yvals+k-1] + y_vector[i] = sum / width + } + + xv = xv + dx + yv = yv + dy + } + + # Compute min and max values. + call alimr (y_vector, nvals, zmin, zmax) + + # Free memory . + call msifree (msi) + call sfree (sp) +end + + +# IE_GET_COL -- Average a strip perpendicular to a column vector and return +# vectors of point number and average pixel value. Also returned is the min +# and max value in the data vector. + +procedure ie_get_col (im, x1, y1, x2, y2, nvals, width, btype, + bconstant, x_vector, y_vector, zmin, zmax) + +pointer im # pointer to image header +real x1, y1 # starting pixel of vector +real x2, y2 # ending pixel of pixel +int nvals # number of samples along the vector +int width # width of strip to average over +int btype # Boundary extension type +real bconstant # Boundary extension constant +real x_vector[ARB] # Pixel numbers +real y_vector[ARB] # Average pixel values (returned) +real zmin, zmax # min, max of data vector + +real sum +int line, linea, lineb, linec +pointer sp, xs, ys, msi, yvals, buf +double dx, dy, xoff, noff, xv, yv +int i, j, k, nedge, col1, col2, line1, line2 +pointer imgs2r() +errchk msiinit + +begin + call smark (sp) + call salloc (xs, width, TY_REAL) + call salloc (ys, width, TY_REAL) + call salloc (yvals, width, TY_REAL) + + # Initialize the interpolator and the image data buffer. + call msiinit (msi, II_BILINEAR) + buf = NULL + + # Set the boundary. + nedge = max (2, width / 2 + 1) + col1 = int (x1) - nedge + col2 = nint (x1) + nedge + line1 = int (min (y1, y2)) - nedge + line2 = nint (max (y1, y2)) + nedge + call ie_setboundary (im, col1, col2, line1, line2, btype, bconstant) + + # Determine sampling perpendicular to vector. + dx = 1.0d0 + if (nvals == 1) + dy = 0.0d0 + else + dy = (y2 - y1) / (nvals - 1) + + # Compute offset from the nominal vector to the first sample point. + noff = (real (width) - 1.0) / 2.0 + xoff = noff * dx + xv = x1 - xoff + do j = 1, width + Memr[xs+j-1] = xv + double (j - col1) + yv = y1 + + # Loop over the output image lines. + do i = 1, nvals { + x_vector[i] = real (i) + line = yv + + # Get the input image data and fit an interpolator to the data. + # The input data is buffered in a section of size NLINES + 2 * + # NEDGE. + + if (dy >= 0.0 && (buf == NULL || line > (linea))) { + linea = min (line2, line + NLINES - 1) + lineb = max (line1, line - nedge) + linec = min (line2, linea + nedge) + buf = imgs2r (im, col1, col2, lineb, linec) + call msifit (msi, Memr[buf], col2 - col1 + 1, linec - lineb + + 1, col2 - col1 + 1) + } else if (dy < 0.0 && (buf == NULL || line < linea)) { + linea = max (line1, line - NLINES + 1) + lineb = max (line1, linea - nedge) + linec = min (line2, line + nedge) + buf = imgs2r (im, col1, col2, lineb, linec) + call msifit (msi, Memr[buf], col2 - col1 + 1, linec - lineb + + 1, col2 - col1 + 1) + } + + # Evaluate the interpolant. + call amovkr (real (yv - lineb + 1), Memr[ys], width) + call msivector (msi, Memr[xs], Memr[ys], Memr[yvals], width) + + if (width == 1) + y_vector[i] = Memr[yvals] + else { + sum = 0.0 + do k = 1, width + sum = sum + Memr[yvals+k-1] + y_vector[i] = sum / width + } + + yv = yv + dy + } + + # Compute min and max values. + call alimr (y_vector, nvals, zmin, zmax) + + # Free memory . + call msifree (msi) + call sfree (sp) +end + + +# IE_GET_ROW -- Average a strip parallel to a row vector and return +# vectors of point number and average pixel value. Also returned is the min +# and max value in the data vector. + +procedure ie_get_row (im, x1, y1, x2, y2, nvals, width, btype, bconstant, + x_vector, y_vector, zmin, zmax) + +pointer im # pointer to image header +real x1, y1 # starting pixel of vector +real x2, y2 # ending pixel of pixel +int nvals # number of samples along the vector +int width # width of strip to average over +int btype # Boundary extension type +real bconstant # Boundary extension constant +real x_vector[ARB] # Pixel numbers +real y_vector[ARB] # Average pixel values (returned) +real zmin, zmax # min, max of data vector + +double dx, dy, yoff, noff, xv, yv +int i, j, nedge, col1, col2, line1, line2 +int line, linea, lineb, linec +pointer sp, oys, xs, ys, yvals, msi, buf +errchk imgs2r, msifit, msiinit +pointer imgs2r() + +begin + call smark (sp) + call salloc (oys, width, TY_REAL) + call salloc (xs, nvals, TY_REAL) + call salloc (ys, nvals, TY_REAL) + call salloc (yvals, nvals, TY_REAL) + + # Initialize the interpolator and the image data buffer. + call msiinit (msi, II_BILINEAR) + buf = NULL + + # Set the boundary. + nedge = max (2, width / 2 + 1) + col1 = int (min (x1, x2)) - nedge + col2 = nint (max (x1, x2)) + nedge + line1 = int (y1) - nedge + line2 = nint (y1) + nedge + call ie_setboundary (im, col1, col2, line1, line2, btype, bconstant) + + # Determine sampling perpendicular to vector. + if (nvals == 1) + dx = 0.0d0 + else + dx = (x2 - x1) / (nvals - 1) + dy = 1.0 + + # Compute offset from the nominal vector to the first sample point. + noff = (real (width) - 1.0) / 2.0 + xv = x1 - col1 + 1 + do i = 1, nvals { + Memr[xs+i-1] = xv + xv = xv + dx + } + yoff = noff * dy + yv = y1 - yoff + do j = 1, width + Memr[oys+j-1] = yv + double (j - 1) + + # Clear the accululator. + call aclrr (y_vector, nvals) + + # Loop over the output image lines. + do i = 1, width { + line = yv + + # Get the input image data and fit an interpolator to the data. + # The input data is buffered in a section of size NLINES + 2 * + # NEDGE. + + if (dy >= 0.0 && (buf == NULL || line > (linea))) { + linea = min (line2, line + NLINES - 1) + lineb = max (line1, line - nedge) + linec = min (line2, linea + nedge) + buf = imgs2r (im, col1, col2, lineb, linec) + if (buf == NULL) + call error (0, "Error reading input image.") + call msifit (msi, Memr[buf], col2 - col1 + 1, linec - lineb + + 1, col2 - col1 + 1) + } else if (dy < 0.0 && (buf == NULL || line < linea)) { + linea = max (line1, line - NLINES + 1) + lineb = max (line1, linea - nedge) + linec = min (line2, line + nedge) + buf = imgs2r (im, col1, col2, lineb, linec) + if (buf == NULL) + call error (0, "Error reading input image.") + call msifit (msi, Memr[buf], col2 - col1 + 1, linec - lineb + + 1, col2 - col1 + 1) + } + + # Evaluate the interpolant. + call amovkr (real (Memr[oys+i-1] - lineb + 1), Memr[ys], nvals) + call msivector (msi, Memr[xs], Memr[ys], Memr[yvals], nvals) + + if (width == 1) + call amovr (Memr[yvals], y_vector, nvals) + else + call aaddr (Memr[yvals], y_vector, y_vector, nvals) + + yv = yv + dy + } + + # Compute the x and y vectors. + do i = 1, nvals + x_vector[i] = real (i) + if (width > 1) + call adivkr (y_vector, real (width), y_vector, nvals) + + # Compute min and max values. + call alimr (y_vector, nvals, zmin, zmax) + + # Free memory . + call msifree (msi) + call sfree (sp) +end + + +# IE_SETBOUNDARY -- Set boundary extension. + +procedure ie_setboundary (im, col1, col2, line1, line2, btype, bconstant) + +pointer im # IMIO pointer +int col1, col2 # Range of columns +int line1, line2 # Range of lines +int btype # Boundary extension type +real bconstant # Constant for constant boundary extension + +int btypes[5] +int nbndrypix +data btypes /BT_CONSTANT, BT_NEAREST, BT_REFLECT, BT_WRAP, BT_PROJECT/ + +begin + nbndrypix = 0 + nbndrypix = max (nbndrypix, 1 - col1) + nbndrypix = max (nbndrypix, col2 - IM_LEN(im, 1)) + nbndrypix = max (nbndrypix, 1 - line1) + nbndrypix = max (nbndrypix, line2 - IM_LEN(im, 2)) + + call imseti (im, IM_TYBNDRY, btypes[btype]) + call imseti (im, IM_NBNDRYPIX, nbndrypix + 1) + if (btypes[btype] == BT_CONSTANT) + call imsetr (im, IM_BNDRYPIXVAL, bconstant) +end + + +# IE_BUFL2R -- Maintain buffer of image lines. A new buffer is created when +# the buffer pointer is null or if the number of lines requested is changed. +# The minimum number of image reads is used. + +procedure ie_bufl2r (im, col1, col2, line1, line2, buf) + +pointer im # Image pointer +int col1 # First image column of buffer +int col2 # Last image column of buffer +int line1 # First image line of buffer +int line2 # Last image line of buffer +pointer buf # Buffer + +pointer buf1, buf2 +int i, ncols, nlines, nclast, llast1, llast2, nllast +errchk malloc, realloc, imgs2r +pointer imgs2r() + +begin + ncols = col2 - col1 + 1 + nlines = line2 - line1 + 1 + + # If the buffer pointer is undefined then allocate memory for the + # buffer. If the number of columns or lines requested changes + # reallocate the buffer. Initialize the last line values to force + # a full buffer image read. + + if (buf == NULL) { + call malloc (buf, ncols * nlines, TY_REAL) + llast1 = line1 - nlines + llast2 = line2 - nlines + } else if ((nlines != nllast) || (ncols != nclast)) { + call realloc (buf, ncols * nlines, TY_REAL) + llast1 = line1 - nlines + llast2 = line2 - nlines + } + + # Read only the image lines with are different from the last buffer. + + if (line1 < llast1) { + do i = line2, line1, -1 { + if (i > llast1) + buf1 = buf + (i - llast1) * ncols + else + buf1 = imgs2r (im, col1, col2, i, i) + + buf2 = buf + (i - line1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } else if (line2 > llast2) { + do i = line1, line2 { + if (i < llast2) + buf1 = buf + (i - llast1) * ncols + else + buf1 = imgs2r (im, col1, col2, i, i) + + buf2 = buf + (i - line1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } + + # Save the buffer parameters. + + llast1 = line1 + llast2 = line2 + nclast = ncols + nllast = nlines +end diff --git a/pkg/images/tv/imexamine/imexam.h b/pkg/images/tv/imexamine/imexam.h new file mode 100644 index 00000000..f1fe00d8 --- /dev/null +++ b/pkg/images/tv/imexamine/imexam.h @@ -0,0 +1,55 @@ +# IMEXAM.H -- IMEXAMINE global definitions. + +define MAX_FRAMES 16 # max display frames + +# IMEXAMINE data structure. + +define IE_LEN 370 # length of IE structure +define IE_SZFNAME 99 # length of file name +define IE_SZFORMAT 9 # length of format strings +define IE_SZTITLE 512 # length of multiline title + +define IE_IM Memi[$1] # IMIO pointer +define IE_MW Memi[$1+1] # MWCS pointer +define IE_CTLW Memi[$1+2] # CT-MWCS pointer (L -> W) +define IE_CTWL Memi[$1+3] # CT-MWCS pointer (W -> L) +define IE_DS Memi[$1+4] # display frame pointer +define IE_GP Memi[$1+5] # GIO pointer +define IE_PP Memi[$1+6] # pset pointer +define IE_LIST Memi[$1+7] # image list +define IE_LISTLEN Memi[$1+8] # number of images in list +define IE_USEDISPLAY Memi[$1+9] # use image display? +define IE_INDEX Memi[$1+10] # image index +define IE_DFRAME Memi[$1+11] # frame used to display images +define IE_MAPFRAME Memi[$1+12] # mapped display frame +define IE_NEWFRAME Memi[$1+13] # new (current) display frame +define IE_NFRAMES Memi[$1+14] # number of image frames +define IE_ALLFRAMES Memi[$1+15] # use all frames for display? +define IE_LOGFD Memi[$1+16] # log file descriptor +define IE_MAGZERO Memr[P2R($1+17)] # magnitude zero point +define IE_XORIGIN Memr[P2R($1+18)] # X origin +define IE_YORIGIN Memr[P2R($1+19)] # Y origin +define IE_GTYPE Memi[$1+20] # current graph type +define IE_X1 Memr[P2R($1+21)] # current graph x1 +define IE_X2 Memr[P2R($1+22)] # current graph x2 +define IE_Y1 Memr[P2R($1+23)] # current graph y1 +define IE_Y2 Memr[P2R($1+24)] # current graph y2 +define IE_IX1 Memi[$1+25] # image section coordinate +define IE_IX2 Memi[$1+26] # image section coordinate +define IE_IY1 Memi[$1+27] # image section coordinate +define IE_IY2 Memi[$1+28] # image section coordinate +define IE_P1 Memi[$1+29] # Physical axis for logical x +define IE_P2 Memi[$1+30] # Physical axis for logical y +define IE_IN Memr[P2R($1+31)+$2-1] # Input coordinate vector +define IE_OUT Memr[P2R($1+38)+$2-1] # Output coordinate vector +define IE_WCSDIM Memi[$1+45] # WCS dimension +define IE_LASTKEY Memi[$1+46] # last type of keyed output + # (available) +define IE_IMAGE Memc[P2C($1+50)] # full image name +define IE_IMNAME Memc[P2C($1+100)] # short image name for labels +define IE_LOGFILE Memc[P2C($1+150)] # logfile name +define IE_WCSNAME Memc[P2C($1+200)] # WCS name +define IE_XLABEL Memc[P2C($1+250)] # WCS label +define IE_YLABEL Memc[P2C($1+300)] # WCS label +define IE_XFORMAT Memc[P2C($1+350)] # WCS format +define IE_YFORMAT Memc[P2C($1+360)] # WCS format diff --git a/pkg/images/tv/imexamine/imexamine.par b/pkg/images/tv/imexamine/imexamine.par new file mode 100644 index 00000000..fc409b45 --- /dev/null +++ b/pkg/images/tv/imexamine/imexamine.par @@ -0,0 +1,22 @@ +input,s,a,,,,images to be examined +output,s,h,"",,,output root image name +ncoutput,i,h,101,1,,Number of columns in image output +nloutput,i,h,101,1,,Number of lines in image output +frame,i,q,1,1,,display frame +image,s,q,,,,image name +logfile,s,h,"",,,logfile +keeplog,b,h,no,,,log output results +defkey,s,h,"a",,,default key for cursor list input +autoredraw,b,h,yes,,,automatically redraw graph +allframes,b,h,yes,,,use all frames for displaying new images +nframes,i,h,0,,,number of display frames (0 to autosense) +ncstat,i,h,5,1,,number of columns for statistics +nlstat,i,h,5,1,,number of lines for statistics +graphcur,*gcur,h,"",,,graphics cursor input +imagecur,*imcur,h,"",,,image display cursor input +wcs,s,h,"logical",,,Coordinate system +xformat,s,h,"",,,X axis coordinate format +yformat,s,h,"",,,Y axis coordinate format +graphics,s,h,"stdgraph",,,graphics device +display,s,h,"display(image='$1',frame=$2)",,,display command template +use_display,b,h,yes,,,enable direct display interaction diff --git a/pkg/images/tv/imexamine/mkpkg b/pkg/images/tv/imexamine/mkpkg new file mode 100644 index 00000000..38c3fef7 --- /dev/null +++ b/pkg/images/tv/imexamine/mkpkg @@ -0,0 +1,48 @@ +# IMEXAMINE + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +standalone: + $set LIBS1 = "-lds -liminterp -lncar -lgks -lxtools" + $set LIBS2 = "-lgsurfit -lnlfit -lcurfit -lllsq" + $update libpkg.a + $omake x_imexam.x + $link x_imexam.o libpkg.a $(LIBS1) $(LIBS2) -o xx_imexam.e + ; + +libpkg.a: + iecimexam.x imexam.h <error.h> <imhdr.h> + iecolon.x imexam.h <error.h> <imhdr.h> + iedisplay.x <error.h> + ieeimexam.x imexam.h <config.h> <error.h> <fset.h> <gset.h>\ + <imhdr.h> <mach.h> <xwhen.h> + iegcur.x imexam.h <imhdr.h> <ctype.h> <mach.h> + iegdata.x <imhdr.h> + iegimage.x imexam.h <error.h> <imhdr.h> + iegnfr.x imexam.h <imhdr.h> + iegraph.x imexam.h <gset.h> + iehimexam.x imexam.h <error.h> <imhdr.h> + ieimname.x + iejimexam.x imexam.h <error.h> <imhdr.h> <gset.h> <mach.h> + ielimexam.x imexam.h <error.h> <imhdr.h> + iemw.x imexam.h <imhdr.h> <mwset.h> + ieopenlog.x imexam.h <error.h> <imhdr.h> + iepos.x imexam.h <error.h> <math.h> + ieprint.x imexam.h <error.h> + ieqrimexam.x imexam.h <error.h> <imhdr.h> <gset.h> <math.h>\ + <math/gsurfit.h> <math/nlfit.h> + ierimexam.x imexam.h <error.h> <gset.h> <imhdr.h> <math.h>\ + <math/gsurfit.h> <math/nlfit.h> + iesimexam.x imexam.h <error.h> <gset.h> <imhdr.h> <mach.h> + iestatistics.x imexam.h <error.h> + ietimexam.x imexam.h <error.h> <imhdr.h> + ievimexam.x imexam.h <error.h> <gset.h> <imhdr.h> <mach.h>\ + <imset.h> <math.h> <math/iminterp.h> + stfmeasure.x starfocus.h <error.h> <imhdr.h> <imset.h> <math/nlfit.h> + stfprofile.x starfocus.h <imhdr.h> <mach.h>\ + <math.h> <math/nlfit.h> <math/iminterp.h> + t_imexam.x imexam.h <error.h> <gset.h> <imhdr.h> + ; diff --git a/pkg/images/tv/imexamine/starfocus.h b/pkg/images/tv/imexamine/starfocus.h new file mode 100644 index 00000000..cf397e50 --- /dev/null +++ b/pkg/images/tv/imexamine/starfocus.h @@ -0,0 +1,140 @@ +# STARFOCUS + +# Types of coordinates +define SF_TYPES "|center|mark1|markall|" +define SF_CENTER 1 # Star at center of image +define SF_MARK1 2 # Mark stars in first image +define SF_MARKALL 3 # Mark stars in all images + +# Task type +define STARFOCUS 1 +define PSFMEASURE 2 + +# Radius types +define SF_WTYPES "|Radius|FWHM|GFWHM|MFWHM|" + +define SF_RMIN 16 # Minimum centering search radius +define MAX_FRAMES 8 # Maximum number of display frames + +# Data structures for STARFOCUS + +define NBNDRYPIX 0 # Number of boundary pixels +define TYBNDRY BT_REFLECT # Type of boundary extension +define SAMPLE .2 # Subpixel sampling size +define SF_SZFNAME 79 # Length of file names +define SF_SZWTYPE 7 # Length of width type string + +# Main data structure +define SF 40 +define SF_TASK Memi[$1] # Task type +define SF_WTYPE Memc[P2C($1+1)] # Width type string +define SF_WCODE Memi[$1+5] # Width code +define SF_BETA Memr[P2R($1+6)] # Moffat beta +define SF_SCALE Memr[P2R($1+7)] # Pixel scale +define SF_LEVEL Memr[P2R($1+8)] # Profile measurement level +define SF_RADIUS Memr[P2R($1+9)] # Profile radius +define SF_SBUF Memr[P2R($1+10)] # Sky region buffer +define SF_SWIDTH Memr[P2R($1+11)] # Sky region width +define SF_SAT Memr[P2R($1+12)] # Saturation +define SF_NIT Memi[$1+13] # Number of iterations for radius +define SF_OVRPLT Memi[$1+14] # Overplot the best profile? +define SF_NCOLS Memi[$1+15] # Number of image columns +define SF_NLINES Memi[$1+16] # Number of image lines +define SF_XF Memr[P2R($1+17)] # X field center +define SF_YF Memr[P2R($1+18)] # Y field center +define SF_GP Memi[$1+19] # GIO pointer +define SF_F Memr[P2R($1+20)] # Best focus +define SF_W Memr[P2R($1+21)] # Width at best focus +define SF_M Memr[P2R($1+22)] # Brightest star magnitude +define SF_XP1 Memr[P2R($1+23)] # First derivative point to plot +define SF_XP2 Memr[P2R($1+24)] # Last derivative point to plot +define SF_YP1 Memr[P2R($1+25)] # Minimum of derivative profile +define SF_YP2 Memr[P2R($1+26)] # Maximum of derivative profile +define SF_N Memi[$1+27] # Number of points not deleted +define SF_NSFD Memi[$1+28] # Number of data points +define SF_SFDS Memi[$1+29] # Pointer to data structures +define SF_NS Memi[$1+30] # Number of stars not deleted +define SF_NSTARS Memi[$1+31] # Number of stars +define SF_STARS Memi[$1+32] # Pointer to star groups +define SF_NF Memi[$1+33] # Number of focuses not deleted +define SF_NFOCUS Memi[$1+34] # Number of different focus values +define SF_FOCUS Memi[$1+35] # Pointer to focus groups +define SF_NI Memi[$1+36] # Number of images not deleted +define SF_NIMAGES Memi[$1+37] # Number of images +define SF_IMAGES Memi[$1+38] # Pointer to image groups +define SF_BEST Memi[$1+39] # Pointer to best focus star + +define SF_SFD Memi[SF_SFDS($1)+$2-1] +define SF_SFS Memi[SF_STARS($1)+$2-1] +define SF_SFF Memi[SF_FOCUS($1)+$2-1] +define SF_SFI Memi[SF_IMAGES($1)+$2-1] + +# Basic data structure. +define SFD 94 +define SFD_IMAGE Memc[P2C($1)] # Image name +define SFD_DATA Memi[$1+40] # Pointer to real image raster +define SFD_RADIUS Memr[P2R($1+41)] # Profile radius +define SFD_NP Memi[$1+42] # Number of profile points +define SFD_NPMAX Memi[$1+43] # Maximum number of profile points +define SFD_X1 Memi[$1+44] # Image raster limits +define SFD_X2 Memi[$1+45] +define SFD_Y1 Memi[$1+46] +define SFD_Y2 Memi[$1+47] +define SFD_ID Memi[$1+48] # Star ID +define SFD_X Memr[P2R($1+49)] # Star X position +define SFD_Y Memr[P2R($1+50)] # Star Y position +define SFD_F Memr[P2R($1+51)] # Focus +define SFD_W Memr[P2R($1+52)] # Width to use +define SFD_M Memr[P2R($1+53)] # Magnitude +define SFD_E Memr[P2R($1+54)] # Ellipticity +define SFD_PA Memr[P2R($1+55)] # Position angle +define SFD_R Memr[P2R($1+56)] # Radius at given level +define SFD_DFWHM Memr[P2R($1+57)] # Direct FWHM +define SFD_GFWHM Memr[P2R($1+58)] # Gaussian FWHM +define SFD_MFWHM Memr[P2R($1+59)] # Moffat FWHM +define SFD_ASI1 Memi[$1+60] # Pointer to enclosed flux profile +define SFD_ASI2 Memi[$1+61] # Pointer to derivative profile +define SFD_YP1 Memr[P2R($1+62)] # Minimum of derivative profile +define SFD_YP2 Memr[P2R($1+63)] # Maximum of derivative profile +define SFD_FWHM Memr[P2R($1+$2+63)] # FWHM vs level=0.5*i (i=1-19) +define SFD_BKGD Memr[P2R($1+83)] # Background value +define SFD_BKGD1 Memr[P2R($1+84)] # Original background value +define SFD_MISO Memr[P2R($1+85)] # Moment isophote +define SFD_SIGMA Memr[P2R($1+86)] # Moffat alpha +define SFD_ALPHA Memr[P2R($1+87)] # Moffat alpha +define SFD_BETA Memr[P2R($1+88)] # Moffat beta +define SFD_STATUS Memi[$1+89] # Status +define SFD_NSAT Memi[$1+90] # Number of saturated pixels +define SFD_SFS Memi[$1+91] # Pointer to star group +define SFD_SFF Memi[$1+92] # Pointer to focus group +define SFD_SFI Memi[$1+93] # Pointer to image group + + +# Structure grouping data by star. +define SFS ($1+7) +define SFS_ID Memi[$1] # Star ID +define SFS_F Memr[P2R($1+1)] # Best focus +define SFS_W Memr[P2R($1+2)] # Best width +define SFS_M Memr[P2R($1+3)] # Average magnitude +define SFS_N Memi[$1+4] # Number of points used +define SFS_NF Memi[$1+5] # Number of focuses +define SFS_NSFD Memi[$1+6] # Number of data points +define SFS_SFD Memi[$1+$2+6] # Array of data structures + + +# Structure grouping stars by focus values. +define SFF ($1+5) +define SFF_F Memr[P2R($1)] # Focus +define SFF_W Memr[P2R($1+1)] # Average width +define SFF_N Memi[$1+2] # Number in average +define SFF_NI Memi[$1+3] # Number of images +define SFF_NSFD Memi[$1+4] # Number of data points +define SFF_SFD Memi[$1+$2+4] # Array of data structures + + +# Structure grouping stars by image. +define SFI ($1+42) +define SFI_IMAGE Memc[P2C($1)] # Image +define SFI_N Memi[$1+40] # Number in imagE +define SFI_NSFD Memi[$1+41] # Number of data points +define SFI_SFD Memi[$1+$2+41] # Array of data structures diff --git a/pkg/images/tv/imexamine/stfmeasure.x b/pkg/images/tv/imexamine/stfmeasure.x new file mode 100644 index 00000000..7390bf1c --- /dev/null +++ b/pkg/images/tv/imexamine/stfmeasure.x @@ -0,0 +1,147 @@ +include <error.h> +include <imhdr.h> +include <imset.h> +include <math/nlfit.h> +include "starfocus.h" + + +# STF_MEASURE -- PSF measuring routine. +# This is a stand-alone routine that can be called to return the FWHM. +# It is a greatly abbreviated version of starfocus. + +procedure stf_measure (im, xc, yc, beta, level, radius, nit, + sbuffer, swidth, saturation, gp, logfd, + bkg, renclosed, dfwhm, gfwhm, mfwhm) + +pointer im #I Image pointer +real xc #I Initial X center +real yc #I Initial Y center +real beta #I Moffat beta +real level #I Measurement level +real radius #U Profile radius +int nit #I Number of iterations on radius +real sbuffer #I Sky buffer (pixels) +real swidth #I Sky width (pixels) +real saturation #I Saturation +pointer gp #I Graphics output if not NULL +int logfd #I Log output if not NULL +real bkg #O Background used +real renclosed #O Enclosed flux radius +real dfwhm #O Direct FWHM +real gfwhm #O Gaussian FWHM +real mfwhm #O Moffat FWHM + +int i +bool ignore_sat +pointer sp, str, sf, sfd, sfds + +int strdic() +real stf_r2i() +errchk stf_find, stf_bkgd, stf_profile, stf_widths, stf_fwhms, stf_organize + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (sf, SF, TY_STRUCT) + call salloc (sfd, SFD, TY_STRUCT) + call salloc (sfds, 1, TY_POINTER) + call aclri (Memi[sf], SF) + call aclri (Memi[sfd], SFD) + Memi[sfds] = sfd + + # Initialize parameters. + SF_TASK(sf) = PSFMEASURE + SF_WCODE(sf) = strdic ("FWHM", SF_WTYPE(sf), SF_SZWTYPE, SF_WTYPES) + SF_SCALE(sf) = 1. + SF_LEVEL(sf) = level + SF_BETA(sf) = beta + SF_RADIUS(sf) = radius + SF_SBUF(sf) = sbuffer + SF_SWIDTH(sf) = swidth + SF_SAT(sf) = saturation + SF_NIT(sf) = nit + SF_OVRPLT(sf) = NO + SF_NCOLS(sf) = IM_LEN(im,1) + SF_NLINES(sf) = IM_LEN(im,2) + SF_XF(sf) = (IM_LEN(im,1) + 1) / 2. + SF_YF(sf) = (IM_LEN(im,2) + 1) / 2. + ignore_sat = false + + call imstats (im, IM_IMAGENAME, SFD_IMAGE(sfd), SF_SZFNAME) + SFD_ID(sfd) = 1 + SFD_X(sfd) = xc + SFD_Y(sfd) = yc + SFD_F(sfd) = INDEF + SFD_STATUS(sfd) = 0 + SFD_SFS(sfd) = NULL + SFD_SFF(sfd) = NULL + SFD_SFI(sfd) = NULL + + if (SF_LEVEL(sf) > 1.) + SF_LEVEL(sf) = SF_LEVEL(sf) / 100. + SF_LEVEL(sf) = max (0.05, min (0.95, SF_LEVEL(sf))) + + # Evaluate PSF data. + iferr { + do i = 1, SF_NIT(sf) { + if (i == 1) + SFD_RADIUS(sfd) = SF_RADIUS(sf) + else + SFD_RADIUS(sfd) = 3. * SFD_DFWHM(sfd) + SFD_NPMAX(sfd) = stf_r2i (SFD_RADIUS(sfd)) + 1 + SFD_NP(sfd) = SFD_NPMAX(sfd) + call stf_find (sf, sfd, im) + call stf_bkgd (sf, sfd) + if (SFD_NSAT(sfd) > 0 && i == 1) { + if (ignore_sat) + call error (0, + "Saturated pixels found - ignoring object") + else + call eprintf ( + "WARNING: Saturated pixels found.\n") + } + call stf_profile (sf, sfd) + call stf_widths (sf, sfd) + call stf_fwhms (sf, sfd) + } + + # Set output results. + radius = SFD_RADIUS(sfd) + bkg = SFD_BKGD(sfd) + renclosed = SFD_R(sfd) + dfwhm = SFD_DFWHM(sfd) + mfwhm = SFD_MFWHM(sfd) + gfwhm = SFD_GFWHM(sfd) + + call asifree (SFD_ASI1(sfd)) + call asifree (SFD_ASI2(sfd)) + } then + call erract (EA_WARN) + + # Finish up + call stf_free (sf) + call sfree (sp) +end + + +# STF_FREE -- Free the starfocus data structures. + +procedure stf_free (sf) + +pointer sf #I Starfocus structure +int i + +begin + do i = 1, SF_NSTARS(sf) + call mfree (SF_SFS(sf,i), TY_STRUCT) + do i = 1, SF_NFOCUS(sf) + call mfree (SF_SFF(sf,i), TY_STRUCT) + do i = 1, SF_NIMAGES(sf) + call mfree (SF_SFI(sf,i), TY_STRUCT) + call mfree (SF_STARS(sf), TY_POINTER) + call mfree (SF_FOCUS(sf), TY_POINTER) + call mfree (SF_IMAGES(sf), TY_POINTER) + SF_NSTARS(sf) = 0 + SF_NFOCUS(sf) = 0 + SF_NIMAGES(sf) = 0 +end diff --git a/pkg/images/tv/imexamine/stfprofile.x b/pkg/images/tv/imexamine/stfprofile.x new file mode 100644 index 00000000..d26c085d --- /dev/null +++ b/pkg/images/tv/imexamine/stfprofile.x @@ -0,0 +1,1189 @@ +include <imhdr.h> +include <mach.h> +include <math.h> +include <math/iminterp.h> +include <math/nlfit.h> +include "starfocus.h" + + +# STF_FIND -- Find the object and return the data raster and object center. +# STF_BKGD -- Compute the background. +# STF_PROFILE -- Compute enclosed flux profile, derivative, and moments. +# STF_NORM -- Renormalized enclosed flux profile +# STF_WIDTHS -- Set widths. +# STF_I2R -- Radius from sample index. +# STF_R2I -- Sample index from radius. +# STF_R2N -- Number of subsamples from radius. +# STF_MODEL -- Return model values. +# STF_DFWHM -- Direct FWHM from profile. +# STF_FWHMS -- Measure FWHM vs level. +# STF_RADIUS -- Measure the radius at the specified level. +# STF_FIT -- Fit model. +# STF_GAUSS1 -- Gaussian function used in NLFIT. +# STF_GAUSS2 -- Gaussian function and derivatives used in NLFIT. +# STF_MOFFAT1 -- Moffat function used in NLFIT. +# STF_MOFFAT2 -- Moffat function and derivatives used in NLFIT. + + +# STF_FIND -- Find the object and return the data raster and object center. +# Centering uses centroid of marginal distributions of data above the mean. + +procedure stf_find (sf, sfd, im) + +pointer sf #I Starfocus pointer +pointer sfd #I Object pointer +pointer im #I Image pointer + +long lseed +int i, j, k, x1, x2, y1, y2, nx, ny, npts +real radius, buffer, width, xc, yc, xlast, ylast, r1, r2 +real mean, sum, sum1, sum2, sum3, asumr(), urand() +pointer data, ptr, imgs2r() +errchk imgs2r + +begin + radius = max (3., SFD_RADIUS(sfd)) + buffer = SF_SBUF(sf) + width = SF_SWIDTH(sf) + + xc = SFD_X(sfd) + yc = SFD_Y(sfd) + r1 = radius + buffer + width + r2 = radius + + # Iterate on the center finding. + do k = 1, 3 { + + # Extract region around current center. + xlast = xc + ylast = yc + + x1 = max (1-NBNDRYPIX, nint (xc - r2)) + x2 = min (IM_LEN(im,1)+NBNDRYPIX, nint (xc + r2)) + nx = x2 - x1 + 1 + y1 = max (1-NBNDRYPIX, nint (yc - r2)) + y2 = min (IM_LEN(im,2)+NBNDRYPIX, nint (yc + r2)) + ny = y2 - y1 + 1 + npts = nx * ny + data = imgs2r (im, x1, x2, y1, y2) + + # Find center of gravity of marginal distributions above mean. + npts = nx * ny + sum = asumr (Memr[data], npts) + mean = sum / nx + sum1 = 0. + sum2 = 0. + + do i = x1, x2 { + ptr = data + i - x1 + sum3 = 0. + do j = y1, y2 { + sum3 = sum3 + Memr[ptr] + ptr = ptr + nx + } + sum3 = sum3 - mean + if (sum3 > 0.) { + sum1 = sum1 + i * sum3 + sum2 = sum2 + sum3 + } + } + if (sum2 <= 0) + call error (1, "Centering failed to converge") + xc = sum1 / sum2 + if (xlast - xc > 0.2 * nx) + xc = xlast - 0.2 * nx + if (xc - xlast > 0.2 * nx) + xc = xlast + 0.2 * nx + + ptr = data + mean = sum / ny + sum1 = 0. + sum2 = 0. + do j = y1, y2 { + sum3 = 0. + do i = x1, x2 { + sum3 = sum3 + Memr[ptr] + ptr = ptr + 1 + } + sum3 = sum3 - mean + if (sum3 > 0.) { + sum1 = sum1 + j * sum3 + sum2 = sum2 + sum3 + } + } + if (sum2 <= 0) + call error (1, "Centering failed to converge") + yc = sum1 / sum2 + if (ylast - yc > 0.2 * ny) + yc = ylast - 0.2 * ny + if (yc - ylast > 0.2 * ny) + yc = ylast + 0.2 * ny + + if (nint(xc) == nint(xlast) && nint(yc) == nint(ylast)) + break + } + + # Get a new centered raster if necessary. + if (nint(xc) != nint(xlast) || nint(yc) != nint(ylast) || r2 < r1) { + x1 = max (1-NBNDRYPIX, nint (xc - r1)) + x2 = min (IM_LEN(im,1)+NBNDRYPIX, nint (xc + r1)) + nx = x2 - x1 + 1 + y1 = max (1-NBNDRYPIX, nint (yc - r1)) + y2 = min (IM_LEN(im,2)+NBNDRYPIX, nint (yc + r1)) + ny = y2 - y1 + 1 + npts = nx * ny + data = imgs2r (im, x1, x2, y1, y2) + } + + # Add a dither for integer data. The random numbers are always + # the same to provide reproducibility. + + i = IM_PIXTYPE(im) + if (i == TY_SHORT || i == TY_INT || i == TY_LONG) { + lseed = 1 + do i = 0, npts-1 + Memr[data+i] = Memr[data+i] + urand(lseed) - 0.5 + } + + SFD_DATA(sfd) = data + SFD_X1(sfd) = x1 + SFD_X2(sfd) = x2 + SFD_Y1(sfd) = y1 + SFD_Y2(sfd) = y2 + SFD_X(sfd) = xc + SFD_Y(sfd) = yc +end + + +# STF_BKGD -- Compute the background. +# A mode is estimated from the minimum slope in the sorted background pixels +# with a bin width of 5%. + +procedure stf_bkgd (sf, sfd) + +pointer sf #I Parameter structure +pointer sfd #I Star structure + +int i, j, x1, x2, y1, y2, xc, yc, nx, ny, npts, ns, nsat +real sat, bkgd, miso +real r, r1, r2, r3, dx, dy, dz +pointer sp, data, bdata, ptr + +begin + data = SFD_DATA(sfd) + x1 = SFD_X1(sfd) + x2 = SFD_X2(sfd) + y1 = SFD_Y1(sfd) + y2 = SFD_Y2(sfd) + xc = SFD_X(sfd) + yc = SFD_Y(sfd) + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + ns = 0 + nsat = 0 + r1 = SFD_RADIUS(sfd) ** 2 + r2 = (SFD_RADIUS(sfd) + SF_SBUF(sf)) ** 2 + r3 = (SFD_RADIUS(sfd) + SF_SBUF(sf) + SF_SWIDTH(sf)) ** 2 + sat = SF_SAT(sf) + if (IS_INDEF(sat)) + sat = MAX_REAL + + call smark (sp) + call salloc (bdata, npts, TY_REAL) + + ptr = data + do j = y1, y2 { + dy = (yc - j) ** 2 + do i = x1, x2 { + dx = (xc - i) ** 2 + r = dx + dy + if (r <= r1) { + if (Memr[ptr] >= sat) + nsat = nsat + 1 + } else if (r >= r2 && r <= r3) { + Memr[bdata+ns] = Memr[ptr] + ns = ns + 1 + } + ptr = ptr + 1 + } + } + + if (ns > 9) { + call asrtr (Memr[bdata], Memr[bdata], ns) + r = Memr[bdata+ns-1] - Memr[bdata] + bkgd = Memr[bdata] + r / 2 + miso = r / 2 + + j = 1 + 0.50 * ns + do i = 0, ns - j { + dz = Memr[bdata+i+j-1] - Memr[bdata+i] + if (dz < r) { + r = dz + bkgd = Memr[bdata+i] + dz / 2 + miso = dz / 2 + } + } + } else { + bkgd = 0. + miso = 0. + } + + SFD_BKGD1(sfd) = bkgd + SFD_BKGD(sfd) = bkgd + SFD_MISO(sfd) = miso + SFD_NSAT(sfd) = nsat + + call sfree (sp) +end + + +# STF_PROFILE -- Compute enclosed flux profile, derivative, direct FWHM, and +# profile moments.. +# 1. The flux profile is normalized at the maximum value. +# 2. The radial profile is computed from the numerical derivative of the +# enclose flux profile. + +procedure stf_profile (sf, sfd) + +pointer sf #I Parameter structure +pointer sfd #I Star structure + +int np +real radius, xc, yc + +int i, j, k, l, m, ns, nx, ny, x1, x2, y1, y2 +real bkgd, miso, sigma, peak +real r, r1, r2, r3, dx, dy, dx1, dx2, dy1, dy2, dz, xx, yy, xy, ds, da +pointer sp, data, profile, ptr, asi, msi, gs +int stf_r2n() +real asieval(), msieval(), gseval(), stf_i2r(), stf_r2i() +errchk asiinit, asifit, msiinit, msifit, gsrestore + +real gsdata[24] +data gsdata/ 1., 4., 4., 1., 0., 0.6726812, 1., 2., 1.630641, 0.088787, + 0.00389378, -0.001457133, 0.3932125, -0.1267456, -0.004864541, + 0.00249941, 0.03078612, 0.02731274, -4.875850E-4, 2.307464E-4, + -0.002134843, 0.007603908, -0.002552385, -8.010564E-4/ + +begin + data = SFD_DATA(sfd) + x1 = SFD_X1(sfd) + x2 = SFD_X2(sfd) + y1 = SFD_Y1(sfd) + y2 = SFD_Y2(sfd) + xc = SFD_X(sfd) + yc = SFD_Y(sfd) + bkgd = SFD_BKGD(sfd) + miso = SFD_MISO(sfd) + radius = SFD_RADIUS(sfd) + np = SFD_NP(sfd) + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + + # Use an image interpolator fit to the data. + call msiinit (msi, II_BISPLINE3) + call msifit (msi, Memr[data], nx, ny, nx) + + # To avoid trying to interpolate outside the center of the + # edge pixels, a requirement of the interpolator functions, + # we reset the data limits. + x1 = x1 + 1 + x2 = x2 - 1 + y1 = y1 + 1 + y2 = y2 - 1 + + # Compute the enclosed flux profile, its derivative, and moments. + call smark (sp) + call salloc (profile, np, TY_REAL) + call aclrr (Memr[profile], np) + + xx = 0. + yy = 0. + xy = 0. + do j = y1, y2 { + ptr = data + (j-y1+1)*nx + 1 + dy = j - yc + do i = x1, x2 { + dx = i - xc + + # Set the subpixel sampling which may be a function of radius. + r = sqrt (dx * dx + dy * dy) + ns = stf_r2n (r) + ds = 1. / ns + da = ds * ds + dz = 0.5 + 0.5 * ds + + # Sum the interpolator values over the subpixels and compute + # an offset to give the correct total for the pixel. + + r2 = 0. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) + r2 = r2 + r1 + } + } + + r1 = Memr[ptr] - bkgd + ptr = ptr + 1 + r2 = r1 - r2 * da + + # Accumulate the enclosed flux over the sub pixels. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r = max (0., sqrt (dx2 + dy2) - ds / 2) + if (r < radius) { + r1 = da * (msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) + + r2) + + # Use approximation for fractions of a subpixel. + for (m=stf_r2i(r)+1; m<=np; m=m+1) { + r3 = (stf_i2r (real(m)) - r) / ds + if (r3 >= 1.) + break + Memr[profile+m-1] = Memr[profile+m-1] + r3 * r1 + } + + # The subpixel is completely within these radii. + for (; m<=np; m=m+1) + Memr[profile+m-1] = Memr[profile+m-1] + r1 + + # Accumulate the moments above an isophote. + if (r1 > miso) { + xx = xx + dx2 * r1 + yy = yy + dy2 * r1 + xy = xy + dx1 * dy1 * r1 + } + } + } + } + } + } + + call msifree (msi) + + # Compute the ellipticity and position angle from the moments. + r = (xx + yy) + if (r > 0.) { + r1 = (xx - yy) / r + r2 = 2 * xy / r + SFD_E(sfd) = sqrt (r1**2 + r2**2) + SFD_PA(sfd) = RADTODEG (atan2 (r2, r1) / 2.) + } else { + SFD_E(sfd) = 0. + SFD_PA(sfd) = 0. + } + + # The magnitude and profile normalization is from the max enclosed flux. + call alimr (Memr[profile], np, r, SFD_M(sfd)) + if (SFD_M(sfd) <= 0.) + call error (1, "Invalid flux profile") + call adivkr (Memr[profile], SFD_M(sfd), Memr[profile], np) + + # Fit interpolator to the enclosed flux profile. + call asiinit (asi, II_SPLINE3) + call asifit (asi, Memr[profile], np) + SFD_ASI1(sfd) = asi + + # Estimate a gaussian sigma (actually sqrt(2)*sigma) and if it is + # it is small subtract the gaussian so that the image interpolator + # can more accurately estimate subpixel values. + + #call stf_radius (sf, sfd, SF_LEVEL(sf), r) + #sigma = r / sqrt (log (1/(1-SF_LEVEL(sf)))) + call stf_radius (sf, sfd, 0.8, r) + r = r / SF_SCALE(sf) + sigma = 2 * r * sqrt (log(2.) / log (1/(1-0.8))) + if (sigma < 5.) { + if (sigma <= 2.) { + call gsrestore (gs, gsdata) + dx = xc - nint (xc) + dy = yc - nint (yc) + r = sqrt (dx * dx + dy * dy) + dx = 1. + ds = abs (sigma - gseval (gs, r, dx)) + for (da = 1.; da <= 2.; da = da + .01) { + dz = abs (sigma - gseval (gs, r, da)) + if (dz < ds) { + ds = dz + dx = da + } + } + sigma = dx + call gsfree (gs) + } + + sigma = sigma / (2 * sqrt (log(2.))) + sigma = sigma * sigma + + # Compute the peak that gives the correct central pixel value. + i = nint (xc) + j = nint (yc) + dx = i - xc + dy = j - yc + r = sqrt (dx * dx + dy * dy) + ns = stf_r2n (r) + ds = 1. / ns + da = ds * ds + dz = 0.5 + 0.5 * ds + + r1 = 0. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r2 = (dx2 + dy2) / sigma + if (r2 < 25.) + r1 = r1 + exp (-r2) + } + } + ptr = data + (j - y1 + 1) * nx + (i - x1 + 1) + peak = (Memr[ptr] - bkgd) / (r1 * da) + + # Subtract the gaussian from the data. + do j = y1, y2 { + ptr = data + (j - y1 + 1) * nx + 1 + dy = j - yc + do i = x1, x2 { + dx = i - xc + r = sqrt (dx * dx + dy * dy) + ns = stf_r2n (r) + ds = 1. / ns + da = ds * ds + dz = 0.5 + 0.5 * ds + + r1 = 0. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r2 = (dx2 + dy2) / sigma + if (r2 < 25.) + r1 = r1 + peak * exp (-r2) + } + } + Memr[ptr] = Memr[ptr] - r1 * da + ptr = ptr + 1 + } + } + + # Fit the image interpolator to the residual data. + call msiinit (msi, II_BISPLINE3) + call msifit (msi, Memr[data], nx, ny, nx) + + # Recompute the enclosed flux profile and moments + # using the gaussian plus image interpolator fit to the residuals. + + call aclrr (Memr[profile], np) + + xx = 0. + yy = 0. + xy = 0. + do j = y1, y2 { + ptr = data + (j - y1 + 1) * nx + 1 + dy = j - yc + do i = x1, x2 { + dx = i - xc + r = sqrt (dx * dx + dy * dy) + ns = stf_r2n (r) + ds = 1. / ns + da = ds * ds + dz = 0.5 + 0.5 * ds + + # Compute interpolator correction. + r2 = 0. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) + r2 = r2 + r1 + } + } + + r1 = Memr[ptr] - bkgd + ptr = ptr + 1 + r2 = r1 - r2 * da + + # Accumulate the enclosed flux and moments. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r3 = (dx2 + dy2) / sigma + if (r3 < 25.) + r3 = peak * exp (-r3) + else + r3 = 0. + r = max (0., sqrt (dx2 + dy2) - ds / 2) + if (r < radius) { + r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) + r1 = da * (r1 + r2 + r3) + + for (m=stf_r2i(r)+1; m<=np; m=m+1) { + r3 = (stf_i2r (real(m)) - r) / ds + if (r3 >= 1.) + break + Memr[profile+m-1] = Memr[profile+m-1] + + r3 * r1 + } + for (; m<=np; m=m+1) + Memr[profile+m-1] = Memr[profile+m-1] + r1 + + if (r1 > miso) { + xx = xx + dx2 * r1 + yy = yy + dy2 * r1 + xy = xy + dx1 * dy1 * r1 + } + } + } + } + } + } + + call msifree (msi) + + # Recompute the moments, magnitude, normalized flux, and interp. + r = (xx + yy) + if (r > 0.) { + r1 = (xx - yy) / r + r2 = 2 * xy / r + SFD_E(sfd) = sqrt (r1**2 + r2**2) + SFD_PA(sfd) = RADTODEG (atan2 (r2, r1) / 2.) + } else { + SFD_E(sfd) = 0. + SFD_PA(sfd) = 0. + } + + call alimr (Memr[profile], np, r, SFD_M(sfd)) + if (SFD_M(sfd) <= 0.) + call error (1, "Invalid flux profile") + call adivkr (Memr[profile], SFD_M(sfd), Memr[profile], np) + + call asifit (asi, Memr[profile], np) + SFD_ASI1(sfd) = asi + } + + # Compute derivative of enclosed flux profile and fit an image + # interpolator. + + dx = 0.25 + Memr[profile] = 0. + ns = 0 + do i = 1, np { + r = stf_i2r (real(i)) + r2 = stf_r2i (r + dx) + if (r2 > np) { + k = i + break + } + r1 = stf_r2i (r - dx) + if (r1 < 1) { + if (i > 1) { + dy = asieval (asi, real(i)) / r**2 + Memr[profile] = (ns * Memr[profile] + dy) / (ns + 1) + ns = ns + 1 + } + j = i + } else { + dy = (asieval (asi, r2) - asieval (asi, r1)) / + (4 * r * dx) + Memr[profile+i-1] = dy + } + } + do i = 2, j + Memr[profile+i-1] = (Memr[profile+j] - Memr[profile]) / j * + (i - 1) + Memr[profile] + do i = k, np + Memr[profile+i-1] = Memr[profile+k-2] + + call adivkr (Memr[profile], SF_SCALE(sf)**2, Memr[profile], np) + call alimr (Memr[profile], np, SFD_YP1(sfd), SFD_YP2(sfd)) + call asiinit (asi, II_SPLINE3) + call asifit (asi, Memr[profile], np) + SFD_ASI2(sfd) = asi + #SF_XP1(sf) = j+1 + SF_XP1(sf) = 1 + SF_XP2(sf) = k-1 + + call sfree (sp) +end + + +# STF_NORM -- Renormalize the enclosed flux profile. + +procedure stf_norm (sf, sfd, x, y) + +pointer sf #I Parameter structure +pointer sfd #I Star structure +real x #I Radius +real y #I Flux + +int npmax, np +pointer asi + +int i, j, k +real r, r1, r2, dx, dy +pointer sp, profile +real asieval(), stf_i2r(), stf_r2i() +errchk asifit + +begin + npmax = SFD_NPMAX(sfd) + np = SFD_NP(sfd) + asi = SFD_ASI1(sfd) + + call smark (sp) + call salloc (profile, npmax, TY_REAL) + + # Renormalize the enclosed flux profile. + if (IS_INDEF(x) || x <= 0.) { + dy = SFD_BKGD(sfd) - SFD_BKGD1(sfd) + SFD_BKGD(sfd) = SFD_BKGD(sfd) - dy + do i = 1, npmax + Memr[profile+i-1] = asieval (asi, real(i)) + + dy * stf_i2r(real(i)) ** 2 + call alimr (Memr[profile], np, r1, r2) + call adivkr (Memr[profile], r2, Memr[profile], npmax) + } else if (IS_INDEF(y)) { + r = max (1., min (real(np), stf_r2i (x))) + r2 = asieval (asi, r) + if (r2 <= 0.) + return + do i = 1, npmax + Memr[profile+i-1] = asieval (asi, real(i)) + call adivkr (Memr[profile], r2, Memr[profile], npmax) + } else { + r = max (1., min (real(np), stf_r2i (x))) + r1 = asieval (asi, r) + dy = (y - r1) / x ** 2 + SFD_BKGD(sfd) = SFD_BKGD(sfd) - dy + do i = 1, npmax + Memr[profile+i-1] = asieval (asi, real(i)) + + dy * stf_i2r(real(i)) ** 2 + } + + call asifit (asi, Memr[profile], npmax) + SFD_ASI1(sfd) = asi + + # Compute derivative of enclosed flux profile and fit an image + # interpolator. + + dx = 0.25 + do i = 1, npmax { + r = stf_i2r (real(i)) + r2 = stf_r2i (r + dx) + if (r2 > np) { + k = i + break + } + r1 = stf_r2i (r - dx) + if (r1 < 1) { + if (i > 1) { + dy = asieval (asi, real(i)) / r**2 + Memr[profile] = dy + } + j = i + } else { + dy = (asieval (asi, r2) - asieval (asi, r1)) / + (4 * r * dx) + Memr[profile+i-1] = dy + } + } + do i = 2, j + Memr[profile+i-1] = (Memr[profile+j] - Memr[profile]) / j * + (i - 1) + Memr[profile] + do i = k, npmax + Memr[profile+i-1] = Memr[profile+k-2] + + call adivkr (Memr[profile], SF_SCALE(sf)**2, Memr[profile], np) + call alimr (Memr[profile], np, SFD_YP1(sfd), SFD_YP2(sfd)) + asi = SFD_ASI2(sfd) + call asifit (asi, Memr[profile], np) + SFD_ASI2(sfd) = asi + #SF_XP1(sf) = min (j+1, np) + SF_XP1(sf) = 1 + SF_XP2(sf) = min (k-1, np) + + call sfree (sp) +end + + +# STF_WIDTHS -- Set the widhts. + +procedure stf_widths (sf, sfd) + +pointer sf #I Main data structure +pointer sfd #I Star data structure + +errchk stf_radius, stf_dfwhm, stf_fit + +begin + call stf_radius (sf, sfd, SF_LEVEL(sf), SFD_R(sfd)) + call stf_dfwhm (sf, sfd) + call stf_fit (sf, sfd) + + switch (SF_WCODE(sf)) { + case 1: + SFD_W(sfd) = SFD_R(sfd) + case 2: + SFD_W(sfd) = SFD_DFWHM(sfd) + case 3: + SFD_W(sfd) = SFD_GFWHM(sfd) + case 4: + SFD_W(sfd) = SFD_MFWHM(sfd) + } +end + + +# STF_I2R -- Compute radius from sample index. + +real procedure stf_i2r (i) + +real i #I Index +real r #O Radius + +begin + if (i < 20) + r = 0.05 * i + else if (i < 30) + r = 0.1 * i - 1 + else if (i < 40) + r = 0.2 * i - 4 + else if (i < 50) + r = 0.5 * i - 16 + else + r = i - 41 + return (r) +end + + +# STF_R2I -- Compute sample index from radius. + +real procedure stf_r2i (r) + +real r #I Radius +real i #O Index + +begin + if (r < 1) + i = 20 * r + else if (r < 2) + i = 10 * (r + 1) + else if (r < 4) + i = 5 * (r + 4) + else if (r < 9) + i = 2 * (r + 16) + else + i = r + 41 + return (i) +end + + +# STF_R2N -- Compute number of subsamples from radius. + +int procedure stf_r2n (r) + +real r #I Radius +int n #O Number of subsamples + +begin + if (r < 1) + n = 20 + else if (r < 2) + n = 10 + else if (r < 4) + n = 5 + else if (r < 9) + n = 2 + else + n = 1 + return (n) +end + + +# STF_MODEL -- Return model value. + +procedure stf_model (sf, sfd, r, profile, flux) + +pointer sf #I Main data structure +pointer sfd #I Star data structure +real r #I Radius at level +real profile #I Profile value +real flux #I Enclosed flux value + +real x, x1, x2, r1, r2, dr + +begin + dr = 0.25 * SF_SCALE(sf) + r1 = r - dr + r2 = r + dr + if (r1 < 0.) { + r1 = dr + r2 = r1 + dr + } + + switch (SF_WCODE(sf)) { + case 3: + x = r**2 / (2. * SFD_SIGMA(sfd)**2) + if (x < 20.) + flux = 1 - exp (-x) + else + flux = 0. + + x1 = r1**2 / (2. * SFD_SIGMA(sfd)**2) + x2 = r2**2 / (2. * SFD_SIGMA(sfd)**2) + if (x2 < 20.) { + x1 = 1 - exp (-x1) + x2 = 1 - exp (-x2) + } else { + x1 = 1. + x2 = 1. + } + if (r <= dr) { + x1 = x1 / dr ** 2 + x2 = x2 / (4 * dr ** 2) + profile = (x2 - x1) / dr * r + x1 + } else { + profile = (x2 - x1) / (4 * r * dr) + } + default: + x = 1 + (r / SFD_ALPHA(sfd)) ** 2 + flux = 1 - x ** (1 - SFD_BETA(sfd)) + + x1 = 1 + (r1 / SFD_ALPHA(sfd)) ** 2 + x2 = 1 + (r2 / SFD_ALPHA(sfd)) ** 2 + x1 = 1 - x1 ** (1 - SFD_BETA(sfd)) + x2 = 1 - x2 ** (1 - SFD_BETA(sfd)) + if (r <= dr) { + x1 = x1 / dr ** 2 + x2 = x2 / (4 * dr ** 2) + profile = (x2 - x1) / dr * r + x1 + } else { + profile = (x2 - x1) / (4 * r * dr) + } + } +end + + +# STF_DFWHM -- Direct FWHM from profile. + +procedure stf_dfwhm (sf, sfd) + +pointer sf #I Main data structure +pointer sfd #I Star data structure + +int np +real r, rpeak, profile, peak, asieval(), stf_i2r() +pointer asi + +begin + asi = SFD_ASI2(sfd) + np = SFD_NP(sfd) + + rpeak = 1. + peak = 0. + for (r=1.; r <= np; r = r + 0.01) { + profile = asieval (asi, r) + if (profile > peak) { + rpeak = r + peak = profile + } + } + + peak = peak / 2. + for (r=rpeak; r <= np && asieval (asi, r) > peak; r = r + 0.01) + ; + + SFD_DFWHM(sfd) = 2 * stf_i2r (r) * SF_SCALE(sf) +end + + +# STF_FWHMS -- Measure FWHM vs level. + +procedure stf_fwhms (sf, sfd) + +pointer sf #I Main data structure +pointer sfd #I Star data structure + +int i +real level, r + +begin + do i = 1, 19 { + level = i * 0.05 + call stf_radius (sf, sfd, level, r) + switch (SF_WCODE(sf)) { + case 3: + SFD_FWHM(sfd,i) = 2 * r * sqrt (log (2.) / log (1/(1-level))) + default: + r = r / sqrt ((1.-level)**(1./(1.-SFD_BETA(sfd))) - 1.) + SFD_FWHM(sfd,i) = 2 * r * sqrt (2.**(1./SFD_BETA(sfd))-1.) + } + } +end + + +# STF_RADIUS -- Measure the radius at the specified level. + +procedure stf_radius (sf, sfd, level, r) + +pointer sf #I Main data structure +pointer sfd #I Star data structure +real level #I Level to measure +real r #O Radius + +int np +pointer asi +real f, fmax, rmax, asieval(), stf_i2r() + +begin + np = SFD_NP(sfd) + asi = SFD_ASI1(sfd) + + for (r=1; r <= np && asieval (asi, r) < level; r = r + 0.01) + ; + if (r > np) { + fmax = 0. + rmax = 0. + for (r=1; r <= np; r = r + 0.01) { + f = asieval (asi, r) + if (f > fmax) { + fmax = f + rmax = r + } + } + r = rmax + } + r = stf_i2r (r) * SF_SCALE(sf) +end + + +# STF_FIT -- Fit models to enclosed flux. + +procedure stf_fit (sf, sfd) + +pointer sf #I Main data structure +pointer sfd #I Star data structure + +int i, j, n, np, pfit[2] +real beta, z, params[3] +pointer asi, nl +pointer sp, x, y, w + +int locpr() +real asieval(), stf_i2r() +extern stf_gauss1(), stf_gauss2(), stf_moffat1(), stf_moffat2() +errchk nlinitr, nlfitr + +data pfit/2,3/ + +begin + np = SFD_NP(sfd) + asi = SFD_ASI1(sfd) + + call smark (sp) + call salloc (x, np, TY_REAL) + call salloc (y, np, TY_REAL) + call salloc (w, np, TY_REAL) + + n = 0 + j = 0 + do i = 1, np { + z = 1. - max (0., asieval (asi, real(i))) + if (n > np/3 && z < 0.5) + break + if ((n < np/3 && z > 0.01) || z > 0.5) + j = n + + Memr[x+n] = stf_i2r (real(i)) * SF_SCALE(sf) + Memr[y+n] = z + Memr[w+n] = 1. + n = n + 1 + } + + # Gaussian. + np = 1 + params[2] = Memr[x+j] / sqrt (2. * log (1./min(0.99,Memr[y+j]))) + params[1] = 1 + call nlinitr (nl, locpr (stf_gauss1), locpr (stf_gauss2), + params, params, 2, pfit, np, .001, 100) + call nlfitr (nl, Memr[x], Memr[y], Memr[w], n, 1, WTS_USER, i) + if (i != SINGULAR && i != NO_DEG_FREEDOM) { + call nlpgetr (nl, params, i) + if (params[2] < 0.) + params[2] = Memr[x+j] / sqrt (2. * log (1./min(0.99,Memr[y+j]))) + } + SFD_SIGMA(sfd) = params[2] + SFD_GFWHM(sfd) = 2 * SFD_SIGMA(sfd) * sqrt (2. * log (2.)) + + # Moffat. + if (SF_BETA(sf) < 1.1) { + call nlfreer (nl) + call sfree (sp) + call error (1, "Cannot measure FWHM - Moffat beta too small") + } + + beta = SF_BETA(sf) + if (IS_INDEFR(beta)) { + beta = 2.5 + np = 2 + } else { + np = 1 + } + params[3] = 1 - beta + params[2] = Memr[x+j] / sqrt (min(0.99,Memr[y+j])**(1./params[3]) - 1.) + params[1] = 1 + call nlinitr (nl, locpr (stf_moffat1), locpr (stf_moffat2), + params, params, 3, pfit, np, .001, 100) + call nlfitr (nl, Memr[x], Memr[y], Memr[w], n, 1, WTS_USER, i) + if (i != SINGULAR && i != NO_DEG_FREEDOM) { + call nlpgetr (nl, params, i) + if (params[2] < 0.) { + params[3] = 1. - beta + params[2] = Memr[x+j] / + sqrt (min(0.99,Memr[y+j])**(1./params[3]) - 1.) + } + } + SFD_ALPHA(sfd) = params[2] + SFD_BETA(sfd) = 1 - params[3] + SFD_MFWHM(sfd) = 2 * SFD_ALPHA(sfd) * sqrt (2.**(1./SFD_BETA(sfd))-1.) + + call nlfreer (nl) + call sfree (sp) +end + + +# STF_GAUSS1 -- Gaussian function used in NLFIT. The parameters are the +# amplitude and sigma and the input variable is the radius. + +procedure stf_gauss1 (x, nvars, p, np, z) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +int np #I Number of parameters +real z #O Function return + +real r2 + +begin + r2 = x[1]**2 / (2 * p[2]**2) + if (abs (r2) > 20.) + z = 0. + else + z = p[1] * exp (-r2) +end + + +# STF_GAUSS2 -- Gaussian function and derivatives used in NLFIT. The parameters +# are the amplitude and sigma and the input variable is the radius. + +procedure stf_gauss2 (x, nvars, p, dp, np, z, der) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +real dp[np] #I Dummy array of parameters increments +int np #I Number of parameters +real z #O Function return +real der[np] #O Derivatives + +real r2 + +begin + r2 = x[1]**2 / (2 * p[2]**2) + if (abs (r2) > 20.) { + z = 0. + der[1] = 0. + der[2] = 0. + } else { + der[1] = exp (-r2) + z = p[1] * der[1] + der[2] = z * 2 * r2 / p[2] + } +end + + +# STF_MOFFAT1 -- Moffat function used in NLFIT. The parameters are the +# amplitude, alpha squared, and beta and the input variable is the radius. + +procedure stf_moffat1 (x, nvars, p, np, z) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +int np #I Number of parameters +real z #O Function return + +real y + +begin + y = 1 + (x[1] / p[2]) ** 2 + if (abs (y) > 20.) + z = 0. + else + z = p[1] * y ** p[3] +end + + +# STF_MOFFAT2 -- Moffat function and derivatives used in NLFIT. The +# parameters are the amplitude, alpha squared, and beta and the input +# variable is the radius. + +procedure stf_moffat2 (x, nvars, p, dp, np, z, der) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +real dp[np] #I Dummy array of parameters increments +int np #I Number of parameters +real z #O Function return +real der[np] #O Derivatives + +real y + +begin + y = 1 + (x[1] / p[2]) ** 2 + if (abs (y) > 20.) { + z = 0. + der[1] = 0. + der[2] = 0. + der[3] = 0. + } else { + der[1] = y ** p[3] + z = p[1] * der[1] + der[2] = -2 * z / y * p[3] / p[2] * (x[1] / p[2]) ** 2 + der[3] = z * log (y) + } +end diff --git a/pkg/images/tv/imexamine/t_imexam.x b/pkg/images/tv/imexamine/t_imexam.x new file mode 100644 index 00000000..089e74fc --- /dev/null +++ b/pkg/images/tv/imexamine/t_imexam.x @@ -0,0 +1,352 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <gset.h> +include <imhdr.h> +include "imexam.h" + +define HELP "iraf$lib/scr/imexamine.key" +define PROMPT "imexamine options" +define SZ_IMLIST 512 + + +# T_IMEXAMINE -- Examine images using image display, graphics, and text output. + +procedure t_imexamine () + +real x, y +pointer sp, cmd, imname, imlist, gp, ie, im +int curtype, key, redraw, mode, nframes, nargs + +bool clgetb() +pointer gopen(), ie_gimage(), imtopen() +int imd_wcsver(), ie_gcur(), ie_getnframes() +int btoi(), clgeti(), imtlen() + +begin + call smark (sp) + call salloc (ie, IE_LEN, TY_STRUCT) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (imlist, SZ_IMLIST, TY_CHAR) + + # Initialize the imexamine descriptor. + call aclri (Memi[ie], IE_LEN) + + # Determine if we will be accessing the image display, and if so, + # the maximum number of frames to be accessed. + + IE_USEDISPLAY(ie) = btoi (clgetb ("use_display")) + if (IE_USEDISPLAY(ie) == YES) { + if (imd_wcsver() == 0) + ; + iferr (nframes = ie_getnframes (ie)) { + call eprintf ("cannot access display\n") + IE_USEDISPLAY(ie) = NO + } + } + + # Get the list of images to be examined, if given on the command + # line. If no images are explicitly listed use the display to + # determine the images to be examined. + + nargs = clgeti ("$nargs") + if (nargs > 0) { + call clgstr ("input", Memc[imlist], SZ_IMLIST) + IE_LIST(ie) = imtopen (Memc[imlist]) + IE_LISTLEN(ie) = imtlen (IE_LIST(ie)) + IE_INDEX(ie) = 1 + + if (nargs >= 1) { + # Set user specified display frame. + IE_DFRAME(ie) = 100 * clgeti ("frame") + 1 + IE_NEWFRAME(ie) = IE_DFRAME(ie) + if (IE_USEDISPLAY(ie) == YES) { + nframes = max (IE_NEWFRAME(ie)/100, nframes) + IE_NFRAMES(ie) = nframes + } + } else { + # If we have to display an image and no frame was specified, + # default to frame 1 (should use the current display frame + # but we don't have a cursor read yet to tell us what it is). + + IE_DFRAME(ie) = 101 + IE_NEWFRAME(ie) = 101 + } + + } else { + IE_INDEX(ie) = 1 + IE_DFRAME(ie) = 101 + IE_NEWFRAME(ie) = 101 + } + + # Set the wcs, logfile and graphics. + call clgstr ("wcs", IE_WCSNAME(ie), IE_SZFNAME) + IE_LOGFD(ie) = NULL + call clgstr ("logfile", IE_LOGFILE(ie), IE_SZFNAME) + if (clgetb ("keeplog")) + iferr (call ie_openlog (ie)) + call erract (EA_WARN) + + call clgstr ("graphics", Memc[cmd], SZ_LINE) + gp = gopen (Memc[cmd], NEW_FILE+AW_DEFER, STDGRAPH) + + # Initialize the data structure. + IE_IM(ie) = NULL + IE_DS(ie) = NULL + IE_PP(ie) = NULL + IE_MAPFRAME(ie) = 0 + IE_NFRAMES(ie) = nframes + IE_ALLFRAMES(ie) = btoi (clgetb ("allframes")) + IE_GTYPE(ie) = NULL + IE_XORIGIN(ie) = 0. + IE_YORIGIN(ie) = 0. + + # Access the first image. If an image list was specified and the + # display is being used, this will set the display frame to the first + # image listed, or display the first image if not already loaded into + # the display. + + if (IE_LIST(ie) != NULL) + im = ie_gimage (ie, YES) + + # Enter the cursor loop. The commands are returned by the + # IE_GCUR procedure. + + x = 1. + y = 1. + redraw = NO + curtype = 'i' + mode = NEW_FILE + + while (ie_gcur (ie, curtype, x,y, key, Memc[cmd], SZ_LINE) != EOF) { + # Check to see if the user has changed frames on us while in + # examine-image-list mode. + + if (IE_USEDISPLAY(ie) == YES && IE_LIST(ie) != NULL && + IE_NEWFRAME(ie)/100 != IE_MAPFRAME(ie)/100) { + call ie_imname (IE_DS(ie), IE_NEWFRAME(ie), Memc[imname], + SZ_FNAME) + call ie_addimage (ie, Memc[imname], imlist) + } + + # Set workstation state. + switch (key) { + case 'a', 'b', 'd', 'm', 't', 'w', 'x', 'y', 'z', ',': + call gdeactivate (gp, 0) + } + + # Act on the command key. + switch (key) { + case '?': # Print help + call gpagefile (gp, HELP, PROMPT) + case ':': # Process colon commands + call ie_colon (ie, Memc[cmd], gp, redraw) + if (redraw == YES) { + x = INDEF + y = INDEF + } + case 'f': # Redraw frame + redraw = YES + x = INDEF + y = INDEF + case 'a': # Aperture photometry + call ie_rimexam (NULL, NULL, ie, x, y) + case ',': # Aperture photometry + call ie_qrimexam (NULL, NULL, ie, x, y) + + case 'b': # Print image region coordinates + call printf ("%4d %4d %4d %4d\n") + call pargi (IE_IX1(ie)) + call pargi (IE_IX2(ie)) + call pargi (IE_IY1(ie)) + call pargi (IE_IY2(ie)) + + if (IE_LOGFD(ie) != NULL) { + call fprintf (IE_LOGFD(ie), "%4d %4d %4d %4d\n") + call pargi (IE_IX1(ie)) + call pargi (IE_IX2(ie)) + call pargi (IE_IY1(ie)) + call pargi (IE_IY2(ie)) + } + + case 'c','e','h','j','k','s','l','r','u','v','.': # Graphs + IE_GTYPE(ie) = key + redraw = YES + + case 'd': # Load the display. + # Query the user for the frame to be loaded, the current + # display frame being the default. + + call clgstr ("image", Memc[imname], SZ_FNAME) + call clputi ("frame", IE_NEWFRAME(ie)/100) + IE_DFRAME(ie) = 100 * clgeti ("frame") + 1 + IE_NEWFRAME(ie) = IE_DFRAME(ie) + + if (IE_LIST(ie) != NULL) + call ie_addimage (ie, Memc[imname], imlist) + else + call ie_display (ie, Memc[imname], IE_DFRAME(ie)/100) + + case 'g': # Graphics cursor + curtype = 'g' + case 'i': # Image cursor + curtype = 'i' + case 'm': # Image statistics + call ie_statistics (ie, x, y) + + case 'n': # Next frame + if (IE_LIST(ie) != NULL) { + IE_INDEX(ie) = IE_INDEX(ie) + 1 + if (IE_INDEX(ie) > IE_LISTLEN(ie)) + IE_INDEX(ie) = 1 + } else { + IE_NEWFRAME(ie) = 100 * (IE_NEWFRAME(ie)/100 + 1) + 1 + if (IE_NEWFRAME(ie)/100 > IE_NFRAMES(ie)) + IE_NEWFRAME(ie) = 101 + } + im = ie_gimage (ie, YES) + + case 'o': # Overplot + mode = APPEND + + case 'p': # Previous frame + if (IE_LIST(ie) != NULL) { + IE_INDEX(ie) = IE_INDEX(ie) - 1 + if (IE_INDEX(ie) <= 0) + IE_INDEX(ie) = IE_LISTLEN(ie) + } else { + IE_NEWFRAME(ie) = 100 * (IE_NEWFRAME(ie)/100 - 1) + 1 + if (IE_NEWFRAME(ie)/100 <= 0) + IE_NEWFRAME(ie) = 100 * IE_NFRAMES(ie) + 1 + } + im = ie_gimage (ie, YES) + + case 'q': # Quit + break + + case 't': # Extract a section. + call ie_timexam (ie, x, y) + + case 'w': # Toggle logfile + if (IE_LOGFD(ie) == NULL) { + if (IE_LOGFILE(ie) == EOS) + call printf ("No log file defined\n") + else { + iferr (call ie_openlog (ie)) + call erract (EA_WARN) + } + } else { + call close (IE_LOGFD(ie)) + IE_LOGFD(ie) = NULL + call printf ("Logfile %s closed\n") + call pargstr (IE_LOGFILE(ie)) + } + + case 'x', 'y': # Positions + call ie_pos (ie, x, y, key) + case 'z': # Print grid + call ie_print (ie, x, y) + case 'I': # Immediate interrupt + call fatal (1, "Interrupt") + default: # Unrecognized command + call printf ("\007") + } + + switch (key) { + case '?', 'a', 'b', 'd', 'm', 'w', 'x', 'y', 'z', ',': + IE_LASTKEY(ie) = key + } + + # Draw or overplot a graph. + if (redraw == YES) { + switch (IE_GTYPE(ie)) { + case 'c': # column plot + call ie_cimexam (gp, mode, ie, x) + case 'e': # contour plot + call ie_eimexam (gp, mode, ie, x, y) + case 'h': # histogram plot + call ie_himexam (gp, mode, ie, x, y) + case 'j': # line plot + call ie_jimexam (gp, mode, ie, x, y, 1) + case 'k': # line plot + call ie_jimexam (gp, mode, ie, x, y, 2) + case 'l': # line plot + call ie_limexam (gp, mode, ie, y) + case 'r': # radial profile plot + call ie_rimexam (gp, mode, ie, x, y) + case 's': # surface plot + call ie_simexam (gp, mode, ie, x, y) + case 'u', 'v': # vector cut plot + call ie_vimexam (gp, mode, ie, x, y, IE_GTYPE(ie)) + case '.': # radial profile plot + call ie_qrimexam (gp, mode, ie, x, y) + } + redraw = NO + mode = NEW_FILE + } + } + + # Finish up. + call gclose (gp) + if (IE_IM(ie) != NULL && IE_IM(ie) != IE_DS(ie)) + call imunmap (IE_IM(ie)) + if (IE_MW(ie) != NULL) + call mw_close (IE_MW(ie)) + if (IE_PP(ie) != NULL) + call clcpset (IE_PP(ie)) + if (IE_DS(ie) != NULL) + call imunmap (IE_DS(ie)) + if (IE_LOGFD(ie) != NULL) + call close (IE_LOGFD(ie)) + if (IE_LIST(ie) != NULL) + call imtclose (IE_LIST(ie)) + call sfree (sp) +end + + +# IE_ADDIMAGE -- Add an image to the image list if not already present in +# the list, and display the image. + +procedure ie_addimage (ie, image, imlist) + +pointer ie #I imexamine descriptor +char image[ARB] #I image name +pointer imlist #I image list + +int i +bool inlist +pointer im, sp, lname +pointer ie_gimage(), imtopen() +int imtrgetim(), imtlen() +bool streq() + +begin + call smark (sp) + call salloc (lname, SZ_FNAME, TY_CHAR) + + # Is image already in list? + inlist = false + do i = 1, IE_LISTLEN(ie) { + if (imtrgetim (IE_LIST(ie), i, Memc[lname], SZ_FNAME) > 0) + if (streq (Memc[lname], image)) { + inlist = true + IE_INDEX(ie) = i + break + } + } + + # Add to list if missing. + if (!inlist) { + call strcat (",", Memc[imlist], SZ_IMLIST) + call strcat (image, Memc[imlist], SZ_IMLIST) + call imtclose (IE_LIST(ie)) + IE_LIST(ie) = imtopen (Memc[imlist]) + IE_LISTLEN(ie) = imtlen (IE_LIST(ie)) + IE_INDEX(ie) = IE_LISTLEN(ie) + } + + # Display the image. + im = ie_gimage (ie, YES) + call sfree (sp) +end diff --git a/pkg/images/tv/imexamine/x_imexam.x b/pkg/images/tv/imexamine/x_imexam.x new file mode 100644 index 00000000..100a6756 --- /dev/null +++ b/pkg/images/tv/imexamine/x_imexam.x @@ -0,0 +1 @@ +task imexamine = t_imexamine diff --git a/pkg/images/tv/jimexam.par b/pkg/images/tv/jimexam.par new file mode 100644 index 00000000..96acb75a --- /dev/null +++ b/pkg/images/tv/jimexam.par @@ -0,0 +1,29 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +xlabel,s,h,"wcslabel",,,"X-axis label" +ylabel,s,h,"Pixel Value",,,"Y-axis label" + +naverage,i,h,5,1,,"Number of liness or columns to average" +center,b,h,yes,,,"Solve for center?" +background,b,h,yes,,,"Solve for background?" +sigma,r,h,1.,0.1,,"Initial sigma (pixels)" +width,r,h,10.,1.,,Background width (pixels) +xorder,i,h,0,0,2,Background terms to fit (0=median) + +rplot,r,h,10.,1.,,"Plotting radius (pixels)" +x1,r,h,INDEF,,,X-axis window limit +x2,r,h,INDEF,,,X-axis window limit +y1,r,h,INDEF,,,Y-axis window limit +y2,r,h,INDEF,,,Y-axis window limit +pointmode,b,h,yes,,,plot points instead of lines? +marker,s,h,"plus",,,point marker character? +szmarker,r,h,1.,,,marker size +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +box,b,h,yes,,,draw box around periphery of window +ticklabels,b,h,yes,,,label tick marks +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values? diff --git a/pkg/images/tv/kimexam.par b/pkg/images/tv/kimexam.par new file mode 100644 index 00000000..96acb75a --- /dev/null +++ b/pkg/images/tv/kimexam.par @@ -0,0 +1,29 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +xlabel,s,h,"wcslabel",,,"X-axis label" +ylabel,s,h,"Pixel Value",,,"Y-axis label" + +naverage,i,h,5,1,,"Number of liness or columns to average" +center,b,h,yes,,,"Solve for center?" +background,b,h,yes,,,"Solve for background?" +sigma,r,h,1.,0.1,,"Initial sigma (pixels)" +width,r,h,10.,1.,,Background width (pixels) +xorder,i,h,0,0,2,Background terms to fit (0=median) + +rplot,r,h,10.,1.,,"Plotting radius (pixels)" +x1,r,h,INDEF,,,X-axis window limit +x2,r,h,INDEF,,,X-axis window limit +y1,r,h,INDEF,,,Y-axis window limit +y2,r,h,INDEF,,,Y-axis window limit +pointmode,b,h,yes,,,plot points instead of lines? +marker,s,h,"plus",,,point marker character? +szmarker,r,h,1.,,,marker size +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +box,b,h,yes,,,draw box around periphery of window +ticklabels,b,h,yes,,,label tick marks +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values? diff --git a/pkg/images/tv/limexam.par b/pkg/images/tv/limexam.par new file mode 100644 index 00000000..bdec3493 --- /dev/null +++ b/pkg/images/tv/limexam.par @@ -0,0 +1,22 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +xlabel,s,h,"wcslabel",,,"X-axis label" +ylabel,s,h,"Pixel Value",,,"Y-axis label" + +naverage,i,h,1,,,Number of lines to average +x1,r,h,INDEF,,,X-axis window limit +x2,r,h,INDEF,,,X-axis window limit +y1,r,h,INDEF,,,Y-axis window limit +y2,r,h,INDEF,,,Y-axis window limit +pointmode,b,h,no,,,plot points instead of lines? +marker,s,h,"plus",,,point marker character? +szmarker,r,h,1.,,,marker size +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +box,b,h,yes,,,draw box around periphery of window +ticklabels,b,h,yes,,,label tick marks +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values? diff --git a/pkg/images/tv/mkpkg b/pkg/images/tv/mkpkg new file mode 100644 index 00000000..3ad9be17 --- /dev/null +++ b/pkg/images/tv/mkpkg @@ -0,0 +1,37 @@ +# TV package. + +$call relink +$exit + +update: + $ifeq (USE_IIS, yes) @iis $endif + $call relink + $call install + ; + +relink: + $set LIBS1 = "-liminterp -lncar -lgks -lds -lxtools" + $set LIBS2 = "-lgsurfit -lnlfit -lcurfit -lllsq -liminterp" + $checkout libds.a lib$ + $update libds.a + $checkin libds.a lib$ + $update libpkg.a + $omake x_tv.x + $link x_tv.o libpkg.a $(LIBS1) $(LIBS2) -o xx_tv.e + ; + +install: + $move xx_tv.e bin$x_tv.e + ; + +libds.a: + @display + @wcslab + ; + +libpkg.a: + @imedit + @imexamine + @tvmark + @wcslab + ; diff --git a/pkg/images/tv/rimexam.par b/pkg/images/tv/rimexam.par new file mode 100644 index 00000000..c2dddf15 --- /dev/null +++ b/pkg/images/tv/rimexam.par @@ -0,0 +1,35 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +xlabel,s,h,"Radius",,,"X-axis label" +ylabel,s,h,"Pixel Value",,,"Y-axis label" +fitplot,b,h,yes,,,"Overplot profile fit?" +fittype,s,h,"moffat","gaussian|moffat",,"Profile type to fit" + +center,b,h,yes,,,"Center object in aperture?" +background,b,h,yes,,,"Fit and subtract background?" +radius,r,h,5.,1.,,"Object radius" +buffer,r,h,5.,0.,,Background buffer width +width,r,h,5.,1.,,Background width +iterations,i,h,3,1,,"Number of radius adjustment iterations" +xorder,i,h,0,0,,Background x order +yorder,i,h,0,0,,Background y order +magzero,r,h,25.,,,Magnitude zero point +beta,r,h,INDEF,,,Moffat beta parameter + +rplot,r,h,8.,1.,,"Plotting radius" +x1,r,h,INDEF,,,X-axis window limit +x2,r,h,INDEF,,,X-axis window limit +y1,r,h,INDEF,,,Y-axis window limit +y2,r,h,INDEF,,,Y-axis window limit +pointmode,b,h,yes,,,plot points instead of lines? +marker,s,h,"plus",,,point marker character? +szmarker,r,h,1.,,,marker size +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +box,b,h,yes,,,draw box around periphery of window +ticklabels,b,h,yes,,,label tick marks +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values? diff --git a/pkg/images/tv/simexam.par b/pkg/images/tv/simexam.par new file mode 100644 index 00000000..ccdde3bc --- /dev/null +++ b/pkg/images/tv/simexam.par @@ -0,0 +1,10 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +axes,b,h,yes,,,Draw axes? + +ncolumns,i,h,21,2,,"Number of columns" +nlines,i,h,21,2,,"Number of lines" +angh,r,h, -33.,,,Horizontal viewing angle (degrees) +angv,r,h,25.,,,Vertical viewing angle (degrees) +floor,r,h,INDEF,,,Minimum value to be plotted +ceiling,r,h,INDEF,,,Maximum value to be plotted diff --git a/pkg/images/tv/tv.cl b/pkg/images/tv/tv.cl new file mode 100644 index 00000000..b136fff5 --- /dev/null +++ b/pkg/images/tv/tv.cl @@ -0,0 +1,43 @@ +#{ TV -- Image Display Control package. + +set tv = "images$tv/" +set iis = "tv$iis/" + +package tv + +set imedit_help = "tv$imedit/imedit.key" + +# Tasks. + +task _dcontrol, + display, + imedit, + imexamine, + tvmark, + wcslab = "tv$x_tv.e" + +task bpmedit = "tv$imedit/bpmedit.cl" + +# Sub-packages. + +task iis.pkg = "iis$iis.cl" + +# Imexamine psets. + +task cimexam = tv$cimexam.par; hidetask cimexam +task eimexam = tv$eimexam.par; hidetask eimexam +task himexam = tv$himexam.par; hidetask himexam +task jimexam = tv$jimexam.par; hidetask jimexam +task kimexam = tv$kimexam.par; hidetask kimexam +task limexam = tv$limexam.par; hidetask limexam +task rimexam = tv$rimexam.par; hidetask rimexam +task simexam = tv$simexam.par; hidetask simexam +task vimexam = tv$vimexam.par; hidetask vimexam + +# Wcslab psets. + +task wcspars = tv$wcspars.par; hidetask wcspars +task wlpars = tv$wlpars.par; hidetask wlpars + + +clbye() diff --git a/pkg/images/tv/tv.hd b/pkg/images/tv/tv.hd new file mode 100644 index 00000000..d04a92f2 --- /dev/null +++ b/pkg/images/tv/tv.hd @@ -0,0 +1,23 @@ +# Help directory for the TV package + +$doc = "images$tv/doc/" +$display = "images$tv/display/" +$imedit = "images$tv/imedit/" +$imexamine = "images$tv/imexamine/" +$tvmark = "images$tv/tvmark/" +$wcslab = "images$tv/wcslab/" +$iis = "images$tv/iis/" + +_dcontrol hlp=doc$dcontrol.hlp, sys=.. +bpmedit hlp=doc$bpmedit.hlp, src=imedit$bpmedit.cl +display hlp=doc$display.hlp, src=display$t_display.x +imedit hlp=doc$imedit.hlp, src=imedit$t_imedit.x +imexamine hlp=doc$imexamine.hlp, src=imexamine$t_imexam.x +tvmark hlp=doc$tvmark.hlp, src=tvmark$t_tvmark.x +wcslab hlp=doc$wcslab.hlp, src=wcslab$t_wcslab.x +revisions sys=Revisions + +iis men=iis$iis.men, + hlp=.., + src=iis$iis.cl, + pkg=iis$iis.hd diff --git a/pkg/images/tv/tv.men b/pkg/images/tv/tv.men new file mode 100644 index 00000000..3485447f --- /dev/null +++ b/pkg/images/tv/tv.men @@ -0,0 +1,7 @@ + bpmedit - examine and edit bad pixel masks associated with images + display - Load an image or image section into the display + iis - IIS image display control package + imedit - Examine and edit pixels in images + imexamine - Examine images using image display, graphics, and text + tvmark - Mark objects on the image display + wcslab - Overlay a displayed image with a world coordinate grid diff --git a/pkg/images/tv/tv.par b/pkg/images/tv/tv.par new file mode 100644 index 00000000..db706f09 --- /dev/null +++ b/pkg/images/tv/tv.par @@ -0,0 +1 @@ +version,s,h,"Apr91" diff --git a/pkg/images/tv/tvmark.par b/pkg/images/tv/tvmark.par new file mode 100644 index 00000000..28d69fd0 --- /dev/null +++ b/pkg/images/tv/tvmark.par @@ -0,0 +1,23 @@ +# TVMARK + +frame,i,a,1,,,Default frame number for display +coords,f,a,,,,Input coordinate list +logfile,f,h,"",,,Output log file +autolog,b,h,no,,,Automatically log each marking command +outimage,f,h,"",,,Output snapped image +deletions,f,h,"",,,Output coordinate deletions list +commands,*imcur,h,"",,,"Image cursor: [x y wcs] key [cmd]" +mark,s,h,"point","point|circle|rectangle|line|plus|cross|none",,The mark type +radii,s,h,"0",,,Radii in image pixels of concentric circles +lengths,s,h,"0",,,Lengths and width in image pixels of concentric rectangles +font,s,h,"raster",,,Default font +color,i,h,255,,,Gray level of marks to be drawn +label,b,h,no,,,Label the marked coordinates +number,b,h,no,,,Number the marked coordinates +nxoffset,i,h,0,,,X offset in display pixels of number +nyoffset,i,h,0,,,Y offset in display pixels of number +pointsize,i,h,3,,,Size of mark type point in display pixels +txsize,i,h,1,,,Size of text and numbers in font units +tolerance,r,h,1.5,,,Tolerance for deleting coordinates in image pixels +interactive,b,h,no,,,Mode of use +mode,s,h,'ql' diff --git a/pkg/images/tv/tvmark/asciilook.inc b/pkg/images/tv/tvmark/asciilook.inc new file mode 100644 index 00000000..68974d34 --- /dev/null +++ b/pkg/images/tv/tvmark/asciilook.inc @@ -0,0 +1,19 @@ +data (asciilook[i], i=1,7) / 449, 449, 449, 449, 449, 449, 449 / +data (asciilook[i], i=8,14) / 449, 449, 449, 449, 449, 449, 449 / +data (asciilook[i], i=15,21) / 449, 449, 449, 449, 449, 449, 449 / +data (asciilook[i], i=22,28) / 449, 449, 449, 449, 449, 449, 449 / +data (asciilook[i], i=29,35) / 449, 449, 449, 449, 001, 008, 015 / +data (asciilook[i], i=36,42) / 022, 029, 036, 043, 050, 057, 064 / +data (asciilook[i], i=43,49) / 071, 078, 085, 092, 099, 106, 113 / +data (asciilook[i], i=50,56) / 120, 127, 134, 141, 148, 155, 162 / +data (asciilook[i], i=57,63) / 169, 176, 183, 190, 197, 204, 211 / +data (asciilook[i], i=64,70) / 218, 225, 232, 239, 246, 253, 260 / +data (asciilook[i], i=71,77) / 267, 274, 281, 288, 295, 302, 309 / +data (asciilook[i], i=78,84) / 316, 323, 330, 337, 344, 351, 358 / +data (asciilook[i], i=85,91) / 365, 372, 379, 386, 393, 400, 407 / +data (asciilook[i], i=92,98) / 414, 421, 428, 435, 442, 449, 232 / +data (asciilook[i], i=99,105) / 239, 246, 253, 260, 267, 274, 281 / +data (asciilook[i], i=106,112) / 288, 295, 302, 309, 316, 323, 330 / +data (asciilook[i], i=113,119) / 337, 344, 351, 358, 365, 372, 379 / +data (asciilook[i], i=120,126) / 386, 393, 400, 407, 449, 449, 449 / +data (asciilook[i], i=127,128) / 449, 449/ diff --git a/pkg/images/tv/tvmark/mkbmark.x b/pkg/images/tv/tvmark/mkbmark.x new file mode 100644 index 00000000..5ece5d4a --- /dev/null +++ b/pkg/images/tv/tvmark/mkbmark.x @@ -0,0 +1,561 @@ +include <imhdr.h> +include "tvmark.h" + +# MK_BMARK -- Procedure to mark symbols in the frame buffer given a coordinate +# list and a mark type. + +procedure mk_bmark (mk, im, iw, cl, ltid, fnt) + +pointer mk # pointer to the mark structure +pointer im # frame image descriptor +pointer iw # pointer to the wcs structure +int cl # coordinate file descriptor +int ltid # current number in the list +int fnt # font file descriptor + +int ncols, nlines, nr, nc, x1, x2, y1, y2 +pointer sp, str, lengths, radii, label +real x, y, fx, fy, ofx, ofy, xmag, ymag, lmax, lratio, rmax, ratio +int fscan(), nscan(), mk_stati(), itoc() +int mk_plimits(), mk_llimits(), mk_rlimits(), mk_climits() +pointer mk_statp() +real mk_statr() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (label, SZ_LINE, TY_CHAR) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Get the magnification factors. + call mk_mag (im, iw, xmag, ymag) + + # Define the rectangles in terms of device coordinates. + if (mk_stati (mk, MKTYPE) == MK_RECTANGLE) { + nr = mk_stati (mk, NRECTANGLES) + call salloc (lengths, nr, TY_REAL) + if (xmag <= 0.0) { + lmax = 0.0 + call amovkr (0.0, Memr[lengths], nr) + } else { + call adivkr (Memr[mk_statp(mk,RLENGTHS)], xmag, Memr[lengths], + nr) + lmax = Memr[lengths+nr-1] + } + if (ymag <= 0.) + lratio = 0.0 + else + lratio = mk_statr (mk, RATIO) * xmag / ymag + } + + # Define the circles in terms of device coordinates. + if (mk_stati (mk, MKTYPE) == MK_CIRCLE) { + nc = mk_stati (mk, NCIRCLES) + call salloc (radii, nc, TY_REAL) + if (xmag <= 0) { + rmax = 0.0 + call amovkr (0.0, Memr[radii], nc) + } else { + call adivkr (Memr[mk_statp(mk,RADII)], xmag, Memr[radii], nc) + rmax = Memr[radii+nc-1] + } + if (ymag <= 0.0) + ratio = 0.0 + else + ratio = xmag / ymag + } + + # Run through the coordinate list sequentially plotting the + # points, circles or rectangles. Speed it up later by reading + # all the points in first, sorting and accessing the frame + # buffer sequentially instead of randomly. + + ofx = INDEFR + ofy = INDEFR + while (fscan (cl) != EOF) { + + # Get the x and y coords (possibly add an id number later). + call gargr (x) + call gargr (y) + if (nscan() < 2) + next + if (IS_INDEFR(x) || IS_INDEFR(y)) + next + call gargwrd (Memc[label], SZ_LINE) + call iw_im2fb (iw, x, y, fx, fy) + + switch (mk_stati (mk, MKTYPE)) { + + case MK_POINT: + if (mk_plimits (fx, fy, mk_stati (mk, SZPOINT), + ncols, nlines, x1, x2, y1, y2) == YES) + call mk_drawpt (im, x1, x2, y1, y2, mk_stati (mk, + GRAYLEVEL)) + + case MK_LINE: + if (! IS_INDEFR(ofx) && ! IS_INDEFR(ofy)) { + if (mk_llimits (ofx, ofy, fx, fy, ncols, nlines, x1, x2, + y1, y2) == YES) + call mk_drawline (im, ofx, ofy, fx, fy, x1, x2, y1, y2, + mk_stati (mk, GRAYLEVEL)) + } + + case MK_RECTANGLE: + if (mk_rlimits (fx, fy, lmax, lratio, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawbox (im, fx, fy, x1, x2, y1, y2, Memr[lengths], + lratio, nr, mk_stati (mk, GRAYLEVEL)) + } + + case MK_CIRCLE: + if (mk_climits (fx, fy, rmax, ratio, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawcircles (im, fx, fy, x1, x2, y1, y2, + Memr[radii], ratio, nc, mk_stati (mk, + GRAYLEVEL)) + call imflush (im) + } + + case MK_PLUS: + call mk_textim (im, "+", nint (fx), nint (fy), mk_stati (mk, + SIZE), mk_stati (mk, SIZE), mk_stati (mk, GRAYLEVEL), YES) + call imflush (im) + + case MK_CROSS: + call mk_textim (im, "x", nint (fx), nint (fy), mk_stati (mk, + SIZE), mk_stati (mk, SIZE), mk_stati (mk, GRAYLEVEL), YES) + call imflush (im) + + default: + } + + # Number the text file. + ltid = ltid + 1 + if (mk_stati (mk, LABEL) == YES) { + if (Memc[label] != EOS) { + call mk_textim (im, Memc[label], nint (fx) + + mk_stati(mk, NXOFFSET), nint (fy) + mk_stati (mk, + NYOFFSET), mk_stati (mk, SIZE), mk_stati (mk, SIZE), + mk_stati (mk, GRAYLEVEL), NO) + call imflush (im) + } + } else if (mk_stati (mk, NUMBER) == YES) { + if (itoc (ltid, Memc[str], SZ_FNAME) > 0) { + call mk_textim (im, Memc[str], nint (fx) + + mk_stati(mk, NXOFFSET), nint (fy) + mk_stati (mk, + NYOFFSET), mk_stati (mk, SIZE), mk_stati (mk, SIZE), + mk_stati (mk, GRAYLEVEL), NO) + call imflush (im) + } + } + + ofx = fx + ofy = fy + } + + call imflush (im) + call sfree (sp) +end + + +# MK_DRAWPT -- Procedure to draw a point into the frame buffer. + +procedure mk_drawpt (im, x1, x2, y1, y2, graylevel) + +pointer im # pointer to the frame image +int x1, x2 # column limits +int y1, y2 # line limits +int graylevel # color of dot to be marked + +int i, npix +pointer vp +pointer imps2s() + +begin + npix = (x2 - x1 + 1) * (y2 - y1 + 1) + vp = imps2s (im, x1, x2, y1, y2) + do i = 1, npix + Mems[vp+i-1] = graylevel +end + + +# MK_PLIMITS -- Compute the extent of a dot. + +int procedure mk_plimits (fx, fy, szdot, ncols, nlines, x1, x2, y1, y2) + +real fx, fy # frame buffer coordinates of point +int szdot # size of a dot +int ncols, nlines # dimensions of the frame buffer +int x1, x2 # column limits +int y1, y2 # line limits + +begin + x1 = nint (fx) - szdot + x2 = x1 + 2 * szdot + if (x1 > ncols || x2 < 1) + return (NO) + x1 = max (1, min (ncols, x1)) + x2 = min (ncols, max (1, x2)) + + y1 = nint (fy) - szdot + y2 = y1 + 2 * szdot + if (y1 > nlines || y2 < 1) + return (NO) + y1 = max (1, min (nlines, y1)) + y2 = min (nlines, max (1, y2)) + + return (YES) +end + + +# MK_DRAWLINE -- Procedure to draw lines. + +procedure mk_drawline (im, ofx, ofy, fx, fy, x1, x2, y1, y2, graylevel) + +pointer im # pointer to the frame buffer image +real ofx, ofy # previous coordinates +real fx, fy # current coordinates +int x1, x2 # column limits +int y1, y2 # line limits +int graylevel # picture gray level + +int i, j, ix1, ix2, npix, itemp +pointer vp +real m, b +pointer imps2s() + +begin + # Compute the slope and intercept. + if (x2 == x1) { + vp = imps2s (im, x1, x2, y1, y2) + npix = y2 - y1 + 1 + do i = 1, npix + Mems[vp+i-1] = graylevel + } else if (y2 == y1) { + vp = imps2s (im, x1, x2, y1, y2) + npix = x2 - x1 + 1 + do i = 1, npix + Mems[vp+i-1] = graylevel + } else { + m = (fy - ofy ) / (fx - ofx) + b = ofy - m * ofx + #if (m > 0.0) + #b = y1 - m * x1 + #else + #b = y2 - m * x1 + do i = y1, y2 { + if (i == y1) { + ix1 = nint ((i - b) / m) + ix2 = nint ((i + 0.5 - b) / m) + } else if (i == y2) { + ix1 = nint ((i - 0.5 - b) / m) + ix2 = nint ((i - b) / m) + } else { + ix1 = nint ((i - 0.5 - b) / m) + ix2 = nint ((i + 0.5 - b) / m) + } + itemp = min (ix1, ix2) + ix2 = max (ix1, ix2) + ix1 = itemp + if (ix1 < x1 || ix2 > x2) + next + vp = imps2s (im, ix1, ix2, i, i) + npix = ix2 - ix1 + 1 + do j = 1, npix + Mems[vp+j-1] = graylevel + } + } +end + + +# MK_LLIMITS -- Compute the limits of a line segment. + +int procedure mk_llimits (ofx, ofy, fx, fy, ncols, nlines, x1, x2, y1, y2) + +real ofx, ofy # previous coordinates +real fx, fy # current coordinates +int ncols, nlines # number of lines +int x1, x2 # column limits +int y1, y2 # line limits + +begin + x1 = nint (min (ofx, fx)) + x2 = nint (max (ofx, fx)) + if (x2 < 1 || x1 > ncols) + return (NO) + x1 = max (1, min (ncols, x1)) + x2 = min (ncols, max (1, x2)) + + y1 = nint (min (ofy, fy)) + y2 = nint (max (ofy, fy)) + if (y2 < 1 || y1 > nlines) + return (NO) + y1 = max (1, min (nlines, y1)) + y2 = min (nlines, max (1, y2)) + + return (YES) +end + + +# MK_DRAWCIRCLES -- Draw concentric circles around a point. + +procedure mk_drawcircles (im, fx, fy, x1, x2, y1, y2, cradii, ratio, ncircles, + graylevel) + +pointer im # pointer to frame buffer image +real fx, fy # center of circle +int x1, x2 # column limits +int y1, y2 # line limits +real cradii[ARB] # sorted list of radii +real ratio # ratio of the magnifications +int ncircles # number of circles +int graylevel # gray level for marking + +int i, j, k, ix1, ix2, npix +pointer ovp +real dy2, dym, dyp, r2, dx1, dx2 +pointer imps2s() + +begin + if (ratio <= 0) + return + + npix = x2 - x1 + 1 + + do i = y1, y2 { + + dy2 = (i - fy) ** 2 + if (i >= fy) { + dym = ((i - .5 - fy) / ratio) ** 2 + dyp = ((i + .5 - fy) / ratio) ** 2 + } else { + dyp = ((i - .5 - fy) / ratio) ** 2 + dym = ((i + .5 - fy) / ratio) ** 2 + } + + do j = 1, ncircles { + + r2 = cradii[j] ** 2 + if (r2 < dym ) + next + + dx1 = r2 - dym + if (dx1 >= 0.0) + dx1 = sqrt (dx1) + else + dx1 = 0.0 + dx2 = r2 - dyp + if (dx2 >= 0.0) + dx2 = sqrt (dx2) + else + dx2 = 0.0 + + ix1 = nint (fx - dx1) + ix2 = nint (fx - dx2) + if (ix1 <= IM_LEN(im,1) && ix2 >= 1) { + ix1 = max (1, ix1) + ix2 = min (ix2, IM_LEN(im,1)) + ovp = imps2s (im, ix1, ix2, i, i) + do k = 1, ix2 - ix1 + 1 + Mems[ovp+k-1] = graylevel + } + + ix1 = nint (fx + dx1) + ix2 = nint (fx + dx2) + if (ix2 <= IM_LEN(im,1) && ix1 >= 1) { + ix2 = max (1, ix2) + ix1 = min (ix1, IM_LEN(im,1)) + ovp = imps2s (im, ix2, ix1, i, i) + do k = 1, ix2 - ix1 + 1 + Mems[ovp+k-1] = graylevel + } + } + } + +end + + +# MK_CLIMITS -- Compute the extent of a circle. + +int procedure mk_climits (fx, fy, rmax, ratio, ncols, nlines, x1, x2, y1, y2) + +real fx, fy # center of rectangle +real rmax # maximum half length of box +real ratio # ratio of the magnifications +int ncols, nlines # dimension of the image +int x1, x2 # column limits +int y1, y2 # line limits + +begin + x1 = nint (fx - rmax) + x2 = nint (fx + rmax) + if (x1 > ncols || x2 < 1) + return (NO) + x1 = max (1, min (ncols, x1)) + x2 = min (ncols, max (1, x2)) + + y1 = nint (fy - rmax * ratio) + y2 = nint (fy + rmax * ratio) + if (y1 > nlines || y2 < 1) + return (NO) + y1 = max (1, min (nlines, y1)) + y2 = min (nlines, max (1, y2)) + + return (YES) +end + + +# MK_DRAWBOX -- Procedure to draw a box into the frame buffer. + +procedure mk_drawbox (im, fx, fy, x1, x2, y1, y2, length, ratio, nbox, + graylevel) + +pointer im # pointer to frame buffer image +real fx, fy # center of rectangle +int x1, x2 # column limits +int y1, y2 # line limits +real length[ARB] # list of rectangle lengths +real ratio # ratio of width/length +int nbox # number of boxes +int graylevel # value of graylevel + +int i, j, k, npix, ydist, bdist, ix1, ix2 +pointer ovp +real hlength +pointer imps2s() + +begin + if (x1 == x2) { + ovp = imps2s (im, x1, x2, y1, y2) + npix = y2 - y1 + 1 + do i = 1, npix + Mems[ovp+i-1] = graylevel + } else if (y1 == y2) { + ovp = imps2s (im, x1, x2, y1, y2) + npix = x2 - x1 + 1 + do i = 1, npix + Mems[ovp+i-1] = graylevel + } else { + npix = x2 - x1 + 1 + do i = y1, y2 { + ydist = nint (abs (i - fy)) + do j = 1, nbox { + hlength = length[j] / 2.0 + bdist = nint (hlength * ratio) + if (ydist > bdist) + next + ix1 = max (x1, nint (fx - hlength)) + ix2 = min (x2, nint (fx + hlength)) + if (ix1 < 1 || ix1 > IM_LEN(im,1) || ix2 < 1 || + ix2 > IM_LEN(im,1)) + next + if (ydist == bdist) { + ovp = imps2s (im, ix1, ix2, i, i) + do k = 1, ix2 - ix1 + 1 + Mems[ovp+k-1] = graylevel + } else { + ovp = imps2s (im, ix1, ix1, i, i) + Mems[ovp] = graylevel + ovp = imps2s (im, ix2, ix2, i, i) + Mems[ovp] = graylevel + } + } + } + } +end + + +# MK_RLIMITS -- Compute the extent of a rectangle. + +int procedure mk_rlimits (fx, fy, lmax, lratio, ncols, nlines, x1, x2, y1, y2) + +real fx, fy # center of rectangle +real lmax # maximum half length of box +real lratio # ratio of width to length +int ncols, nlines # dimension of the image +int x1, x2 # column limits +int y1, y2 # line limits + +real hlmax, wmax + +begin + hlmax = lmax / 2.0 + wmax = lmax * lratio + + x1 = nint (fx - hlmax) + x2 = nint (fx + hlmax) + if (x1 > ncols || x2 < 1) + return (NO) + x1 = max (1, min (ncols, x1)) + x2 = min (ncols, max (1, x2)) + + y1 = fy - wmax + y2 = fy + wmax + if (y1 > nlines || y2 < 1) + return (NO) + y1 = max (1, min (nlines, y1)) + y2 = min (nlines, max (1, y2)) + + return (YES) +end + + +# MK_PBOX -- Plot a box + +procedure mk_pbox (im, x1, x2, y1, y2, graylevel) + +pointer im # pointer to the image +int x1, x2 # column limits +int y1, y2 # line limits +int graylevel # line value + +int i, j, npix +pointer ovp +pointer imps2s() + +begin + do i = y1, y2 { + if (i == y1) { + npix = x2 - x1 + 1 + ovp = imps2s (im, x1, x2, i, i) + do j = 1, npix + Mems[ovp+j-1] = graylevel + } else if (i == y2) { + npix = x2 - x1 + 1 + ovp = imps2s (im, x1, x2, i, i) + do j = 1, npix + Mems[ovp+j-1] = graylevel + } else { + ovp = imps2s (im, x1, x1, i, i) + Mems[ovp] = graylevel + ovp = imps2s (im, x2, x2, i, i) + Mems[ovp] = graylevel + } + } +end + + +# MK_BLIMITS -- Procedure to compute the boundary limits for drawing +# a box. + +procedure mk_blimits (ofx, ofy, fx, fy, ncols, nlines, x1, x2, y1, y2) + +real ofx, ofy # first point +real fx, fy # second point +int ncols, nlines # dimensions of the image +int x1, x2 # column limits +int y1, y2 # line limits + +begin + x1 = nint (min (ofx, fx)) + x1 = max (1, min (x1, ncols)) + x2 = nint (max (ofx, fx)) + x2 = min (ncols, max (x2, 1)) + + y1 = nint (min (ofy, fy)) + y1 = max (1, min (y1, nlines)) + y2 = nint (max (ofy, fy)) + y2 = min (nlines, max (y2, 1)) +end diff --git a/pkg/images/tv/tvmark/mkcolon.x b/pkg/images/tv/tvmark/mkcolon.x new file mode 100644 index 00000000..e4dfe01a --- /dev/null +++ b/pkg/images/tv/tvmark/mkcolon.x @@ -0,0 +1,394 @@ +include <imhdr.h> +include <error.h> +include <fset.h> +include "tvmark.h" + +# MK_COLON -- Procedure to process immark colon commands. + +procedure mk_colon (mk, cmdstr, im, iw, sim, log, cl, ltid, dl) + +pointer mk # pointer to the immark structure +char cmdstr[ARB] # command string +pointer im # pointer to the frame buffer +pointer iw # pointer to the wcs information +pointer sim # pointer to a scratch image +int log # log file descriptor +int cl # coords file descriptor +int ltid # coords file sequence number +int dl # deletions file descriptor + +bool bval +real rval +pointer sp, cmd, str, outim, deletions, ext +int ncmd, mark, font, ival, ip, nchars, wcs_status + +real mk_statr() +bool itob(), streq() +pointer immap(), imd_mapframe(), iw_open() +int open(), strdic(), nscan(), mk_stati(), btoi(), ctowrd() +errchk imd_mapframe(), iw_open(), immap(), imunmap(), open() + +begin + # Allocate some working memory. + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (deletions, SZ_FNAME, TY_CHAR) + call salloc (ext, SZ_FNAME, TY_CHAR) + + # Get the command. + ip = 1 + call sscan (cmdstr) + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call sfree (sp) + return + } + + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, MKCMDS) + switch (ncmd) { + case MKCMD_IMAGE: + + case MKCMD_OUTIMAGE: + call gargstr (Memc[cmd], SZ_LINE) + call mk_stats (mk, OUTIMAGE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_OUTIMAGE) + call pargstr (Memc[str]) + } else { + nchars = ctowrd (Memc[cmd], ip, Memc[str], SZ_LINE) + call mk_sets (mk, OUTIMAGE, Memc[str]) + } + + case MKCMD_DELETIONS: + call gargstr (Memc[cmd], SZ_LINE) + call mk_stats (mk, DELETIONS, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_DELETIONS) + call pargstr (Memc[str]) + } else { + nchars = ctowrd (Memc[cmd], ip, Memc[str], SZ_LINE) + call mk_sets (mk, DELETIONS, Memc[str]) + } + + case MKCMD_SNAP: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call mk_stats (mk, OUTIMAGE, Memc[str], SZ_FNAME) + if (Memc[str] == EOS) + call mk_stats (mk, IMAGE, Memc[str], SZ_FNAME) + call mk_imname (Memc[str], "", "snap", Memc[cmd], SZ_FNAME) + } + + iferr { + outim = immap (Memc[cmd], NEW_COPY, im) + call printf ("Creating image: %s - ") + call pargstr (Memc[cmd]) + call flush (STDOUT) + call mk_imcopy (im, outim) + call imunmap (outim) + } then { + call printf ("\n") + call erract (EA_WARN) + } else { + call printf ("done\n") + } + + case MKCMD_COORDS: + call gargstr (Memc[cmd], SZ_LINE) + call mk_stats (mk, COORDS, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_COORDS) + call pargstr (Memc[str]) + } else { + nchars = ctowrd (Memc[cmd], ip, Memc[str], SZ_LINE) + if (cl != NULL) { + call close( cl) + call close (dl) + cl = NULL + dl = NULL + } + iferr { + if (Memc[str] != EOS) { + iferr (cl = open (Memc[str], READ_WRITE, TEXT_FILE)) { + cl = open (Memc[str], NEW_FILE, TEXT_FILE) + call close (cl) + cl = open (Memc[str], READ_WRITE, TEXT_FILE) + call mk_stats (mk, DELETIONS, Memc[ext], SZ_FNAME) + call sprintf (Memc[deletions], SZ_FNAME, "%s.%s") + call pargstr (Memc[str]) + if (Memc[ext] == EOS) + call pargstr ("del") + else + call pargstr (Memc[ext]) + } + } + } then { + cl = NULL + dl = NULL + call erract (EA_WARN) + call mk_sets (mk, COORDS, "") + } else { + call mk_sets (mk, COORDS, Memc[str]) + } + ltid = 0 + } + + case MKCMD_LOGFILE: + call gargstr (Memc[cmd], SZ_LINE) + call mk_stats (mk, LOGFILE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_LOGFILE) + call pargstr (Memc[str]) + } else { + nchars = ctowrd (Memc[cmd], ip, Memc[str], SZ_LINE) + if (log != NULL) { + call close (log) + log = NULL + } + iferr { + if (Memc[str] != EOS) + log = open (Memc[str], NEW_FILE, TEXT_FILE) + } then { + log = NULL + call erract (EA_WARN) + call mk_sets (mk, LOGFILE, "") + call printf ("Log file is undefined.\n") + } else + call mk_sets (mk, LOGFILE, Memc[str]) + } + + case MKCMD_AUTOLOG: + call gargb (bval) + if (nscan () == 1) { + call printf ("%s = %b\n") + call pargstr (KY_AUTOLOG) + call pargb (itob (mk_stati (mk, AUTOLOG))) + } else + call mk_seti (mk, AUTOLOG, btoi (bval)) + + case MKCMD_FRAME: + call gargi (ival) + if (nscan () == 1) { + call printf ("%s = %g\n") + call pargstr (KY_FRAME) + call pargi (mk_stati (mk, FRAME)) + } else if (ival != mk_stati (mk, FRAME)) { + call iw_close (iw) + call imunmap (im) + iferr { + im = imd_mapframe (ival, READ_WRITE, YES) + iw = iw_open (im, ival, Memc[str], SZ_FNAME, wcs_status) + call mk_sets (mk, IMAGE, Memc[str]) + } then { + call erract (EA_WARN) + im = imd_mapframe (mk_stati(mk,FRAME), READ_WRITE, YES) + iw = iw_open (im, mk_stati(mk,FRAME), + Memc[str], SZ_FNAME, wcs_status) + call mk_sets (mk, IMAGE, Memc[str]) + } else + call mk_seti (mk, FRAME, ival) + } + + case MKCMD_FONT: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call mk_stats (mk, FONT, Memc[cmd], SZ_LINE) + call printf ("%s = %s\n") + call pargstr (KY_FONT) + call pargstr (Memc[cmd]) + } else { + font = strdic (Memc[cmd], Memc[cmd], SZ_LINE, MKFONTLIST) + if (font > 0) + call mk_sets (mk, FONT, Memc[cmd]) + } + + case MKCMD_LABEL: + call gargb (bval) + if (nscan () == 1) { + call printf ("%s = %b\n") + call pargstr (KY_LABEL) + call pargb (itob (mk_stati (mk, LABEL))) + } else + call mk_seti (mk, LABEL, btoi (bval)) + + case MKCMD_NUMBER: + call gargb (bval) + if (nscan () == 1) { + call printf ("%s = %b\n") + call pargstr (KY_NUMBER) + call pargb (itob (mk_stati (mk, NUMBER))) + } else + call mk_seti (mk, NUMBER, btoi (bval)) + + case MKCMD_NXOFFSET: + call gargi (ival) + if (nscan () == 1) { + call printf ("%s = %g\n") + call pargstr (KY_NXOFFSET) + call pargi (mk_stati (mk, NXOFFSET)) + } else + call mk_seti (mk, NXOFFSET, ival) + + case MKCMD_NYOFFSET: + call gargi (ival) + if (nscan () == 1) { + call printf ("%s = %g\n") + call pargstr (KY_NYOFFSET) + call pargi (mk_stati (mk, NYOFFSET)) + } else + call mk_seti (mk, NYOFFSET, ival) + + case MKCMD_GRAYLEVEL: + call gargi (ival) + if (nscan () == 1) { + call printf ("%s = %d\n") + call pargstr (KY_GRAYLEVEL) + call pargi (mk_stati (mk, GRAYLEVEL)) + } else + call mk_seti (mk, GRAYLEVEL, ival) + + case MKCMD_SZPOINT: + call gargi (ival) + if (nscan () == 1) { + call printf ("%s = %d\n") + call pargstr (KY_SZPOINT) + call pargi (2 * mk_stati (mk, SZPOINT) + 1) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + ival = ival / 2 + call mk_seti (mk, SZPOINT, ival) + } + + case MKCMD_SIZE: + call gargi (ival) + if (nscan () == 1) { + call printf ("%s = %d\n") + call pargstr (KY_SIZE) + call pargi (mk_stati (mk, SIZE)) + } else + call mk_seti (mk, SIZE, ival) + + case MKCMD_TOLERANCE: + call gargr (rval) + if (nscan () == 1) { + call printf ("%s = %g\n") + call pargstr (KY_TOLERANCE) + call pargr (mk_statr (mk, TOLERANCE)) + } else + call mk_setr (mk, TOLERANCE, rval) + + case MKCMD_MARK: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call mk_stats (mk, MARK, Memc[cmd], SZ_LINE) + call printf ("%s = %s\n") + call pargstr (KY_MARK) + call pargstr (Memc[cmd]) + } else { + mark = strdic (Memc[cmd], Memc[cmd], SZ_LINE, MKTYPELIST) + if (mark > 0) { + call mk_seti (mk, MKTYPE, mark) + call mk_sets (mk, MARK, Memc[cmd]) + } + } + + case MKCMD_CIRCLES: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call mk_stats (mk, CSTRING, Memc[cmd], SZ_LINE) + call printf ("%s = %s %s\n") + call pargstr (KY_CIRCLES) + if (Memc[cmd] == EOS) + call pargstr ("0") + else + call pargstr (Memc[cmd]) + call pargstr ("pixels") + } else + call mk_sets (mk, CSTRING, Memc[cmd]) + + case MKCMD_RECTANGLES: + call gargwrd (Memc[cmd], SZ_LINE) + call gargr (rval) + if (Memc[cmd] == EOS) { + call mk_stats (mk, RSTRING, Memc[cmd], SZ_LINE) + call printf ("%s = %s %g\n") + call pargstr (KY_RECTANGLE) + if (Memc[cmd] == EOS) + call pargstr ("0") + else + call pargstr (Memc[cmd]) + call pargr (mk_statr (mk, RATIO)) + } else { + call mk_sets (mk, RSTRING, Memc[cmd]) + if (nscan () < 3) + call mk_setr (mk, RATIO, 1.0) + else + call mk_setr (mk, RATIO, rval) + } + + case MKCMD_SHOW: + call mk_show (mk) + + case MKCMD_SAVE: + iferr { + + # Check that the sizes agree. + if (sim == NULL) { + call mktemp ("scratch", Memc[cmd], SZ_FNAME) + sim = immap (Memc[cmd], NEW_COPY, im) + } else if (IM_LEN(im,1) != IM_LEN(sim,1) || IM_LEN(im,2) != + IM_LEN(sim,2)) { + call strcpy (IM_HDRFILE(sim), Memc[cmd], SZ_FNAME) + call imunmap (sim) + call imdelete (Memc[cmd]) + call mktemp ("scratch", Memc[cmd], SZ_FNAME) + sim = immap (Memc[cmd], NEW_COPY, im) + } + + # Copy the image. + call printf ("Saving frame: %d - ") + call pargi (mk_stati (mk, FRAME)) + call flush (STDOUT) + call mk_imcopy (im, sim) + + } then { + call erract (EA_WARN) + call printf ("\n") + } else { + call printf ("done\n") + } + + case MKCMD_RESTORE: + if (sim == NULL) { + call printf ("Use :save to define a scratch image.\n") + } else if (IM_LEN(sim,1) != IM_LEN(im,1) || IM_LEN(sim,2) != + IM_LEN(im,2)) { + call printf ( + "Scatch image and the frame buffer have different sizes.\n") + } else { + iferr { + call printf ("Restoring frame: %d - ") + call pargi (mk_stati (mk, FRAME)) + call flush (STDOUT) + call mk_imcopy (sim, im) + } then { + call erract (EA_WARN) + call printf ("\n") + } else { + call printf ("done\n") + } + } + + + default: + call printf ("Unrecognized or ambiguous colon command.\7\n") + } + + call sfree (sp) +end diff --git a/pkg/images/tv/tvmark/mkfind.x b/pkg/images/tv/tvmark/mkfind.x new file mode 100644 index 00000000..5824422a --- /dev/null +++ b/pkg/images/tv/tvmark/mkfind.x @@ -0,0 +1,52 @@ +include <mach.h> + +# MK_FIND -- Procedure to detect the object in a file closest to the +# input cursor position. + +int procedure mk_find (cl, xcur, ycur, xlist, ylist, label, id, ltid, tol) + +int cl # coordinates file descriptor +real xcur, ycur # x and y cursor position +real xlist, ylist # x and y list position +char label[ARB] # label string +int id # sequence number of detected object in list +int ltid # current sequence number in the list +real tol # tolerance for detection + +real x, y, dist2, ldist2, tol2 +int fscan(), nscan() + +begin + if (cl == NULL) + return (0) + call seek (cl, BOF) + ltid = 0 + + # Initialize + id = 0 + dist2 = MAX_REAL + tol2 = tol ** 2 + + # Fetch the coordinates. + while (fscan (cl) != EOF) { + call gargr (x) + call gargr (y) + call gargwrd (label, SZ_LINE) + if (nscan () < 2) + next + if (nscan () < 3) + label[1] = EOS + ltid = ltid + 1 + ldist2 = (x - xcur) ** 2 + (y - ycur) ** 2 + if (ldist2 > tol2) + next + if (ldist2 > dist2) + next + xlist = x + ylist = y + dist2 = ldist2 + id = ltid + } + + return (id) +end diff --git a/pkg/images/tv/tvmark/mkgmarks.x b/pkg/images/tv/tvmark/mkgmarks.x new file mode 100644 index 00000000..46e9bf05 --- /dev/null +++ b/pkg/images/tv/tvmark/mkgmarks.x @@ -0,0 +1,214 @@ +include <lexnum.h> +include <ctype.h> + +# MK_GMARKS -- Procedure to extract mark values from a string + +int procedure mk_gmarks (str, marks, max_nmarks) + +char str[ARB] # string +real marks[ARB] # number of marks +int max_nmarks # maximum number of marks + +int fd, nmarks +int open(), mk_rdmarks(), mk_decmarks() +errchk open(), close() + +begin + nmarks = 0 + + iferr { + fd = open (str, READ_ONLY, TEXT_FILE) + nmarks = mk_rdmarks (fd, marks, max_nmarks) + call close (fd) + } then { + nmarks = mk_decmarks (str, marks, max_nmarks) + } + + return (nmarks) +end + + +# MK_RDMARKS -- Procedure to read out the marks listed one per line +# from a file. + +int procedure mk_rdmarks (fd, marks, max_nmarks) + +int fd # aperture list file descriptor +real marks[ARB] # list of marks +int max_nmarks # maximum number of apertures + +int nmarks +pointer sp, line +int getline(), mk_decmarks() + +begin + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + nmarks = 0 + while (getline (fd, Memc[line]) != EOF && nmarks < max_nmarks) { + nmarks = nmarks + mk_decmarks (Memc[line], marks[1+nmarks], + max_nmarks - nmarks) + } + + call sfree (sp) + + return (nmarks) +end + + +# MK_DECAPERTS -- Procedure to decode the mark string. + +int procedure mk_decmarks (str, marks, max_nmarks) + +char str[ARB] # aperture string +real marks[ARB] # aperture array +int max_nmarks # maximum number of apertures + +char outstr[SZ_LINE] +int nmarks, ip, op, ndecode, nmk +real mkstart, mkend, mkstep +bool fp_equalr() +int gctor() + +begin + nmarks = 0 + + for (ip = 1; str[ip] != EOS && nmarks < max_nmarks;) { + + mkstart = 0.0 + mkend = 0.0 + mkstep = 0.0 + ndecode = 0 + + # Skip past white space and commas. + while (IS_WHITE(str[ip])) + ip = ip + 1 + if (str[ip] == ',') + ip = ip + 1 + + # Get the number. + op = 1 + while (IS_DIGIT(str[ip]) || str[ip] == '.') { + outstr[op] = str[ip] + ip = ip + 1 + op = op + 1 + } + outstr[op] = EOS + + # Decode the starting aperture. + op = 1 + if (gctor (outstr, op, mkstart) > 0) { + mkend = mkstart + ndecode = 1 + } else + mkstart = 0.0 + + # Skip past white space and commas. + while (IS_WHITE(str[ip])) + ip = ip + 1 + if (str[ip] == ',') + ip = ip + 1 + + # Get the ending aperture + if (str[ip] == ':') { + ip = ip + 1 + + # Get the ending aperture. + op = 1 + while (IS_DIGIT(str[ip]) || str[ip] == '.') { + outstr[op] = str[ip] + ip = ip + 1 + op = op + 1 + } + outstr[op] = EOS + + # Decode the ending aperture. + op = 1 + if (gctor (outstr, op, mkend) > 0) { + ndecode = 2 + mkstep = mkend - mkstart + } + } + + # Skip past white space and commas. + while (IS_WHITE(str[ip])) + ip = ip + 1 + if (str[ip] == ',') + ip = ip + 1 + + # Get the step size. + if (str[ip] == ':') { + ip = ip + 1 + + # Get the step size. + op = 1 + while (IS_DIGIT(str[ip]) || str[ip] == '.') { + outstr[op] = str[ip] + ip = ip + 1 + op = op + 1 + } + outstr[op] = EOS + + # Decode the step size. + op = 1 + if (gctor (outstr, op, mkstep) > 0) { + if (fp_equalr (mkstep, 0.0)) + mkstep = mkend - mkstart + else + ndecode = (mkend - mkstart) / mkstep + 1 + if (ndecode < 0) { + ndecode = -ndecode + mkstep = - mkstep + } + } + } + + # Negative apertures are not permitted. + if (mkstart <= 0.0 || mkend <= 0.0) + break + + # Fill in the apertures. + if (ndecode == 0) { + ; + } else if (ndecode == 1) { + nmarks = nmarks + 1 + marks[nmarks] = mkstart + } else if (ndecode == 2) { + nmarks = nmarks + 1 + marks[nmarks] = mkstart + if (nmarks >= max_nmarks) + break + nmarks = nmarks + 1 + marks[nmarks] = mkend + } else { + for (nmk = 1; nmk <= ndecode && nmarks < max_nmarks; + nmk = nmk + 1) { + nmarks = nmarks + 1 + marks[nmarks] = mkstart + (nmk - 1) * mkstep + } + } + } + + return (nmarks) +end + + +# GCTOR -- Procedure to convert a character variable to a real number. +# This routine is just an interface routine to the IRAF procedure gctod. + +int procedure gctor (str, ip, rval) + +char str[ARB] # string to be converted +int ip # pointer to the string +real rval # real value + +double dval +int nchars +int gctod() + +begin + nchars = gctod (str, ip, dval) + rval = dval + return (nchars) +end diff --git a/pkg/images/tv/tvmark/mkgpars.x b/pkg/images/tv/tvmark/mkgpars.x new file mode 100644 index 00000000..095ed3f7 --- /dev/null +++ b/pkg/images/tv/tvmark/mkgpars.x @@ -0,0 +1,65 @@ +include <ctype.h> +include "tvmark.h" + +# MK_GPARS -- Fetch the parameters required for the imark task from the cl. + +procedure mk_gpars (mk) + +pointer mk # pointer to the immark structure + +int mark, dotsize, ip +pointer sp, str +real ratio +bool clgetb() +int clgwrd(), clgeti(), nscan(), btoi(), mk_stati() +real clgetr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Initialize the immark structure. + call mk_init (mk) + + # Get the mark parameters. + mark = clgwrd ("mark", Memc[str], SZ_FNAME, MKTYPELIST) + if (mark > 0) { + call mk_sets (mk, MARK, Memc[str]) + call mk_seti (mk, MKTYPE, mark) + } else { + call mk_sets (mk, MARK, "point") + call mk_seti (mk, MKTYPE, MK_POINT) + } + + # Get the circles descriptor. + call clgstr ("radii", Memc[str], SZ_FNAME) + call mk_sets (mk, CSTRING, Memc[str]) + + # Get the rectangles descriptor. + ip = 1 + call clgstr ("lengths", Memc[str], SZ_LINE) + call sscan (Memc[str]) + call gargwrd (Memc[str], SZ_LINE) + call mk_sets (mk, RSTRING, Memc[str]) + call gargr (ratio) + if (nscan () < 2 || mk_stati (mk, NRECTANGLES) < 1) + call mk_setr (mk, RATIO, 1.0) + else + call mk_setr (mk, RATIO, ratio) + + # Get the rest of the parameters. + call mk_seti (mk, NUMBER, btoi (clgetb ("number"))) + call mk_seti (mk, LABEL, btoi (clgetb ("label"))) + call mk_seti (mk, SIZE, clgeti ("txsize")) + dotsize = clgeti ("pointsize") + if (mod (dotsize, 2) == 0) + dotsize = dotsize + 1 + call mk_seti (mk, SZPOINT, dotsize / 2) + call mk_seti (mk, GRAYLEVEL, clgeti ("color")) + call mk_seti (mk, NXOFFSET, clgeti ("nxoffset")) + call mk_seti (mk, NYOFFSET, clgeti ("nyoffset")) + call mk_setr (mk, TOLERANCE, clgetr ("tolerance")) + + call sfree (sp) +end diff --git a/pkg/images/tv/tvmark/mkgscur.x b/pkg/images/tv/tvmark/mkgscur.x new file mode 100644 index 00000000..529ccc9c --- /dev/null +++ b/pkg/images/tv/tvmark/mkgscur.x @@ -0,0 +1,87 @@ +include <gset.h> +include <fset.h> + +# MK_GSCUR -- Procedure to fetch x and y positions from a file and move +# the cursor to those positions. + +int procedure mk_gscur (sl, gd, xcur, ycur, label, prev_num, req_num, num) + +pointer sl # pointer to text file containing cursor coords +pointer gd # pointer to graphics stream +real xcur, ycur # x cur and y cur +char label[ARB] # label string +int prev_num # previous number +int req_num # requested number +int num # list number + +int stdin, nskip, ncount +pointer sp, fname +int fscan(), nscan(), strncmp() +errchk greactivate, gdeactivate, gscur + +begin + if (sl == NULL) + return (EOF) + + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + # Find the number of objects to be skipped. + call fstats (sl, F_FILENAME, Memc[fname], SZ_FNAME) + if (strncmp ("STDIN", Memc[fname], 5) == 0) { + stdin = YES + nskip = 1 + } else { + stdin = NO + if (req_num <= prev_num) { + call seek (sl, BOF) + nskip = req_num + } else + nskip = req_num - prev_num + } + + ncount = 0 + num = prev_num + repeat { + + # Print the prompt if file is STDIN. + if (stdin == YES) { + call printf ("Type object x and y coordinates: ") + call flush (STDOUT) + } + + # Fetch the coordinates. + if (fscan (sl) != EOF) { + call gargr (xcur) + call gargr (ycur) + call gargwrd (label, SZ_LINE) + if (nscan () >= 2) { + ncount = ncount + 1 + num = num + 1 + } + } else + ncount = EOF + + # Move the cursor. + if (gd != NULL && (ncount == nskip || ncount == EOF)) { + iferr { + call greactivate (gd, 0) + call gscur (gd, xcur, ycur) + call gdeactivate (gd, 0) + } then + ; + } + + } until (ncount == EOF || ncount == nskip) + + call sfree (sp) + + if (ncount == EOF) { + return (EOF) + } else if (nskip == req_num) { + num = ncount + return (ncount) + } else { + return (num) + } +end diff --git a/pkg/images/tv/tvmark/mkmag.x b/pkg/images/tv/tvmark/mkmag.x new file mode 100644 index 00000000..956f50b4 --- /dev/null +++ b/pkg/images/tv/tvmark/mkmag.x @@ -0,0 +1,20 @@ +include <imhdr.h> + +# MK_MAG -- Procedure to compute the x and y magnification factors. + +procedure mk_mag (im, iw, xmag, ymag) + +pointer im # pointer to the frame buffer +pointer iw # pointer to the wcs structure +real xmag, ymag # x and y magnifications + +real xll, yll, xur, yur + +begin + # Compute the x and y magnification. + call iw_fb2im (iw, 1.0, 1.0, xll, yll) + call iw_fb2im (iw, real (IM_LEN(im,1)), real (IM_LEN(im,2)), xur, yur) + + xmag = abs (xur - xll) / (IM_LEN(im,1) - 1) + ymag = abs (yur - yll) / (IM_LEN(im,2) - 1) +end diff --git a/pkg/images/tv/tvmark/mkmark.x b/pkg/images/tv/tvmark/mkmark.x new file mode 100644 index 00000000..72583fcb --- /dev/null +++ b/pkg/images/tv/tvmark/mkmark.x @@ -0,0 +1,482 @@ +include <fset.h> +include <imhdr.h> +include "tvmark.h" + +define HELPFILE "iraf$lib/scr/tvmark.key" + +# MK_MARK -- Procedure to mark symbols in the frame buffer interactively. + +int procedure mk_mark (mk, im, iw, cl, dl, log, fnt, autolog, interactive) + +pointer mk # pointer to the mark structure +pointer im # frame image descriptor +pointer iw # pointer to the wcs structure +int cl # coordinate file descriptor +int dl # pointer to the deletions file +int log # output log file descriptor +int fnt # font file descriptor +int autolog # automatic logging enabled +int interactive # interactive mode + +int ncmd, ncols, nlines, nc, nr +int wcs, bkey, skey, vkey, ekey, fkey, okey, key +int id, ltid, ndelete, req_num, lreq_num, prev_num, newlist +pointer sim, sp, scratchim, cmd, str, keepcmd, label +real cwx, cwy, wx, wy, owx, owy, fx, fy, ofx, ofy +real xlist, ylist, oxlist, oylist, rmax + +int imd_gcur(), mk_stati(), strdic(), mk_gscur(), nscan(), mk_new() +int mk_find(), fstati() +real mk_statr() + +begin + # Allocate working memory. + call smark (sp) + call salloc (scratchim, SZ_FNAME, TY_CHAR) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (keepcmd, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (label, SZ_LINE, TY_CHAR) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + sim = NULL + + # Reinitialize. + ekey = ' ' + fkey = ' ' + okey = ' ' + skey = ' ' + vkey = ' ' + bkey = ' ' + ltid = 0 + ndelete = 0 + newlist = NO + owx = INDEFR + owy = INDEFR + Memc[cmd] = EOS + Memc[keepcmd] = EOS + + while (imd_gcur ("commands", wx,wy,wcs,key,Memc[cmd],SZ_LINE) != EOF) { + + # Save current cursor coordinates. + cwx = wx + cwy = wy + + # Check for new object. + if (mk_new (wx, wy, owx, owy, xlist, ylist, newlist) == YES) + ; + + # Transform to frame buffer coordinates. + call iw_im2fb (iw, wx, wy, fx, fy) + + switch (key) { + + # Print the help page. + case '?': + if (interactive == YES) + call pagefile (HELPFILE, "Type ? for help, q to quit") + + # Quit the task. + case 'q': + break + + # Keep the previous cursor command. + case 'k': + if (log != NULL) + if (autolog == YES) + call printf ("Automatic logging is already enabled.\n") + else + call mk_logcmd (log, Memc[keepcmd]) + else { + if (interactive == YES) + call printf ("The log file is undefined.\n") + } + + # Rewind the coordinate list. + case 'o': + if (cl != NULL) { + call seek (cl, BOF) + oxlist = INDEFR + oylist = INDEFR + ltid = 0 + } else if (interactive == YES) + call printf ("Coordinate list is undefined.\n") + + # Move to the previous object. + case '-': + if (cl != NULL) { + prev_num = ltid + req_num = ltid - 1 + if (req_num < 1) { + if (interactive == YES) + call printf ("Requested object is less than 1.\n") + } else if (mk_gscur (cl, NULL, xlist, ylist, Memc[label], + prev_num, req_num, ltid) != EOF) { + if (interactive == YES) + call printf ("Moved to object: %d %g %g\n") + call pargi (ltid) + call pargr (xlist) + call pargr (ylist) + newlist = YES + } else if (interactive == YES) + call printf ( + "End of coordinate list, type o to rewind.\n") + } else if (interactive == YES) + call printf ("Coordinate file is undefined.\n") + + # Mark the previous object. + case 'p': + if (cl != NULL) { + prev_num = ltid + req_num = ltid - 1 + if (req_num < 1) { + if (interactive == YES) + call printf ("Requested object is less than 1.\n") + } else if (mk_gscur (cl, NULL, xlist, ylist, Memc[label], + prev_num, req_num, ltid) != EOF) { + call mk_onemark (mk, im, iw, xlist, ylist, oxlist, + oylist, Memc[label], ltid) + newlist = YES + } else if (interactive == YES) { + call printf ( + "End of coordinate list, type o to rewind.\n") + } + } else if (interactive == YES) + call printf ("Coordinate file is undefined.\n") + + # Move to the next object. + case 'm': + if (cl != NULL) { + prev_num = ltid + req_num = ltid + 1 + if (mk_gscur (cl, NULL, xlist, ylist, Memc[label], + prev_num, req_num, ltid) != EOF) { + if (interactive == YES) + call printf ("Moved to object: %d %g %g\n") + call pargi (ltid) + call pargr (xlist) + call pargr (ylist) + newlist = YES + } else if (interactive == YES) + call printf ( + "End of coordinate list, type o to rewind.\n") + } else if (interactive == YES) + call printf ("Coordinate file is undefined.\n") + + # Mark the next object. + case 'n': + if (cl != NULL) { + prev_num = ltid + req_num = ltid + 1 + if (mk_gscur (cl, NULL, xlist, ylist, Memc[label], + prev_num, req_num, ltid) != EOF) { + call mk_onemark (mk, im, iw, xlist, ylist, oxlist, + oylist, Memc[label], ltid) + newlist = YES + } else if (interactive == YES) + call printf ( + "End of coordinate list, type o to rewind.\n") + } else if (interactive == YES) + call printf ("Coordinate file is undefined.\n") + + # Mark the entire list. + case 'l': + if (cl != NULL) { + call seek (cl, BOF) + ltid = 0 + call mk_bmark (mk, im, iw, cl, ltid, fnt) + } else if (interactive == YES) + call printf ("Coordinate list is undefined.\n") + + # Append to the coordinate list. + case 'a': + if (cl == NULL) { + if (interactive == YES) + call printf ("Coordinate file is undefined.\n") + } else if (fstati (cl, F_MODE) != READ_WRITE) { + if (interactive == YES) + call printf ( + "No write permission on coordinate file.\n") + } else { + + # Move to the end of the list. + prev_num = ltid + req_num = ltid + 1 + while (mk_gscur (cl, NULL, xlist, ylist, Memc[label], + prev_num, req_num, ltid) != EOF) { + prev_num = ltid + req_num = ltid + 1 + } + + # Add the object. + call fprintf (cl, "%g %g\n") + call pargr (wx) + call pargr (wy) + call flush (cl) + ltid = ltid + 1 + #call seek (cl, EOF) + + # Mark the object. + call mk_onemark (mk, im, iw, wx, wy, oxlist, oylist, "", + ltid) + + } + + # Delete an object. + case 'd': + if (cl == NULL) { + if (interactive == YES) + call printf ("Coordinate file is undefined.\n") + } else if (fstati (cl, F_MODE) != READ_WRITE) { + if (interactive == YES) + call printf ( + "No write permission on coordinate file.\n") + } else { + + # Find the nearest object to the cursor and delete. + if (mk_find (cl, wx, wy, xlist, ylist, Memc[label], id, + ltid, mk_statr (mk, TOLERANCE)) > 0) { + call fprintf (dl, "%d\n") + call pargi (id) + ndelete = ndelete + 1 + call mk_onemark (mk, im, iw, xlist, ylist, oxlist, + oylist, Memc[label], ltid) + } else if (interactive == YES) + call printf ("Object not in coordinate list.\n") + + } + + # Draw a dot. + case '.': + call mk_dmark (mk, im, fx, fy) + + # Draw a plus sign. + case '+': + call mk_tmark (mk, im, "+", fx, fy, YES) + + # Draw a cross. + case 'x': + call mk_tmark (mk, im, "x", fx, fy, YES) + + # Mark and erase a region. + case 'e': + if (sim != NULL) { + if ((key == ekey) && (okey == 'e' || okey == 'k')) { + call mk_imsection (mk, sim, im, nint (ofx), nint (fx), + nint (ofy), nint (fy)) + ekey = ' ' + } else { + if (interactive == YES) + call printf ("Type e again to define region.\n") + ekey = key + ofx = fx + ofy = fy + } + } else if (interactive == YES) + call printf ("Define a scratch image with :save.\n") + + # Fill region + case 'f': + if ((key == fkey) && (okey == 'f' || okey == 'k')) { + call mk_imsection (mk, NULL, im, nint (ofx), nint (fx), + nint (ofy), nint (fy)) + fkey = ' ' + } else { + if (interactive == YES) + call printf ("Type f again to define region.\n") + fkey = key + ofx = fx + ofy = fy + } + + # Mark a single circle. + case 'v': + if ((key == vkey) && (okey == 'v' || okey == 'k')) { + rmax = sqrt ((fx - ofx) ** 2 + (fy - ofy) ** 2) + call mk_ocmark (mk, im, iw, ofx, ofy, rmax) + vkey = ' ' + } else { + if (interactive == YES) + call printf ("Type v again to draw circle.\n") + vkey = key + ofx = fx + ofy = fy + } + + # Draw concentric circles. + case 'c': + nc = mk_stati (mk, NCIRCLES) + if (nc > 0) { + call mk_cmark (mk, im, iw, fx, fy) + } else if (interactive == YES) + call printf ("Use :radii to specifiy radii.\n") + + # Draw concentric rectangles. + case 'r': + nr = mk_stati (mk, NRECTANGLES) + if (nr > 0) { + call mk_rmark (mk, im, iw, fx, fy) + } else if (interactive == YES) + call printf ("Use :lengths to specify box lengths.\n") + + # Draw a vector segment. + case 's': + if ((skey == key) && (okey == 's' || okey == 'k')) + call mk_lmark (mk, im, ofx, ofy, fx, fy) + if (interactive == YES) + call printf ("Type s again to draw line segment.\n") + ofx = fx + ofy = fy + skey = key + + # Draw a box + case 'b': + if ((key == bkey) && (okey == 'b' || okey == 'k')) { + call mk_xmark (mk, im, ofx, ofy, fx, fy) + bkey = ' ' + } else { + if (interactive == YES) + call printf ("Type b again to draw box.\n") + bkey = key + ofx = fx + ofy = fy + } + + # Execute the colon command. + case ':': + call sscan (Memc[cmd]) + call gargwrd (Memc[str], SZ_LINE) + ncmd = strdic (Memc[str], Memc[str], SZ_LINE, MKCMDS2) + + if (ncmd <= 0) + call mk_colon (mk, Memc[cmd], im, iw, sim, log, cl, ltid, + dl) + + else if (ncmd == MKCMD2_WTEXT) { + call gargstr (Memc[str], SZ_LINE) + if (Memc[str] != EOS) + call mk_tmark (mk, im, Memc[str], fx, fy, NO) + + } else if (ncmd == MKCMD2_MOVE) { + if (cl != NULL) { + call gargi (req_num) + prev_num = ltid + if (nscan () < 2) + req_num = ltid + 1 + if (req_num < 1) { + if (interactive == YES) + call printf ( + "Requested object is less than 1.\n") + } else if (mk_gscur (cl, NULL, xlist, ylist, + Memc[label], prev_num, req_num, ltid) != EOF) { + if (interactive == YES) + call printf ("Moved to object: %d %g %g\n") + call pargi (ltid) + call pargr (xlist) + call pargr (ylist) + newlist = YES + } else if (interactive == YES) { + call printf ( + "End of coordinate list, type o to rewind.\n") + } + } else if (interactive == YES) + call printf ("Coordinate file is undefined.\n") + + } else if (ncmd == MKCMD2_NEXT) { + if (cl != NULL) { + call gargi (req_num) + call gargi (lreq_num) + prev_num = ltid + if (nscan () < 2) { + req_num = ltid + 1 + lreq_num = req_num + } else if (nscan () < 3) + lreq_num = req_num + while (mk_gscur (cl, NULL, xlist, ylist, Memc[label], + prev_num, req_num, ltid) != EOF) { + if (ltid > lreq_num) + break + call mk_onemark (mk, im, iw, xlist, ylist, oxlist, + oylist, Memc[label], ltid) + newlist = YES + prev_num = ltid + req_num = ltid + 1 + } + } else if (interactive == YES) + call printf ("Coordinate field is undefined.\n") + } + + default: + call printf ("Unrecognized keystroke command.\7\n") + } + + # Encode and log the last cursor command. Do not encode any + # keep commands if autologging is turned off. + + if (autolog == YES) { + call mk_encodecmd (wx, wy, wcs, key, Memc[cmd], Memc[keepcmd]) + if (log == NULL) { + if (interactive == YES) + call printf ("The logfile is undefined.\n") + } else + call mk_logcmd (log, Memc[keepcmd]) + } else if (key != 'k') + call mk_encodecmd (wx, wy, wcs, key, Memc[cmd], Memc[keepcmd]) + + # Get set up for next cursor command. + owx = cwx + owy = cwy + okey = key + Memc[cmd] = EOS + if (newlist == YES) { + oxlist = xlist + oylist = ylist + } + } + + # Delete scratch image. + if (sim != NULL) { + call strcpy (IM_HDRFILE(sim), Memc[scratchim], SZ_FNAME) + call imunmap (sim) + call imdelete (Memc[scratchim]) + } + + call sfree (sp) + + return (ndelete) +end + + +# MK_ENCODECMD -- Encode the cursor command. + +procedure mk_encodecmd (wx, wy, wcs, key, cmd, keepcmd) + +real wx, wy # cursor position +int wcs # world coordinate system +int key # cursor keystroke command +char cmd[ARB] # command +char keepcmd[ARB] # encode cursor command + +begin + call sprintf (keepcmd, SZ_LINE, "%g %g %d %c %s") + call pargr (wx) + call pargr (wy) + call pargi (wcs) + call pargi (key) + call pargstr (cmd) +end + + +# MK_LOGCMD -- Log the command. + +procedure mk_logcmd (log, cmd) + +int log # logfile descriptor +char cmd[ARB] # command + +begin + call fprintf (log, "%s\n") + call pargstr (cmd) +end diff --git a/pkg/images/tv/tvmark/mknew.x b/pkg/images/tv/tvmark/mknew.x new file mode 100644 index 00000000..27a5a3af --- /dev/null +++ b/pkg/images/tv/tvmark/mknew.x @@ -0,0 +1,42 @@ +# MK_NEW -- Procedure to determine whether the current star is the same as +# the previous star and/or whether the current star belongs to the coordinate +# list or not. + +int procedure mk_new (wx, wy, owx, owy, xlist, ylist, newlist) + +real wx # x cursor coordinate +real wy # y cursor coordinate +real owx # old x cursor coordinate +real owy # old y cursor coordinate +real xlist # x list coordinate +real ylist # y list coordinate +int newlist # integer new list + +int newobject +real deltaxy +bool fp_equalr() + +begin + deltaxy = 1.0 + + if (newlist == NO) { + if (! fp_equalr (wx, owx) || ! fp_equalr (wy, owy)) + newobject = YES + else + newobject = NO + } else if ((abs (xlist - wx) <= deltaxy) && + (abs (ylist - wy) <= deltaxy)) { + wx = xlist + wy = ylist + newobject = NO + } else if (fp_equalr (wx, owx) && fp_equalr (wy, owy)) { + wx = xlist + wy = ylist + newobject = NO + } else { + newlist = NO + newobject = YES + } + + return (newobject) +end diff --git a/pkg/images/tv/tvmark/mkonemark.x b/pkg/images/tv/tvmark/mkonemark.x new file mode 100644 index 00000000..91bd9ee0 --- /dev/null +++ b/pkg/images/tv/tvmark/mkonemark.x @@ -0,0 +1,392 @@ +include <imhdr.h> +include "tvmark.h" + +# MK_ONEMARK -- Procedure to mark symbols in the frame buffer given a +# coordinate list and a mark type. + +procedure mk_onemark (mk, im, iw, wx, wy, owx, owy, label, ltid) + +pointer mk # pointer to the mark structure +pointer im # frame image descriptor +pointer iw # pointer to the wcs structure +real wx, wy # coordinates of current list object +real owx, owy # coordinates of previous list member +char label[ARB] # current label +int ltid # list sequence number + +int ncols, nlines, nr, nc, x1, x2, y1, y2 +pointer sp, str, lengths, radii +real fx, fy, ofx, ofy, xmag, ymag, lmax, lratio, rmax, ratio +int mk_stati(), itoc() +int mk_plimits(), mk_llimits(), mk_rlimits(), mk_climits() +pointer mk_statp() +real mk_statr() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (lengths, MAX_NMARKS, TY_REAL) + call salloc (radii, MAX_NMARKS, TY_REAL) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Convert from image to frame buffer coordinates. + if (IS_INDEFR(owx) || IS_INDEFR(owy)) { + owx = INDEFR + owy = INDEFR + } else + call iw_im2fb (iw, owx, owy, ofx, ofy) + call iw_im2fb (iw, wx, wy, fx, fy) + call mk_mag (im, iw, xmag, ymag) + + switch (mk_stati (mk, MKTYPE)) { + + case MK_POINT: + if (mk_plimits (fx, fy, mk_stati (mk, SZPOINT), + ncols, nlines, x1, x2, y1, y2) == YES) { + call mk_drawpt (im, x1, x2, y1, y2, mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + + case MK_LINE: + if (! IS_INDEFR(ofx) && ! IS_INDEFR(ofy)) { + if (mk_llimits (ofx, ofy, fx, fy, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawline (im, ofx, ofy, fx, fy, x1, x2, y1, y2, + mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + } + + case MK_RECTANGLE: + nr = mk_stati (mk, NRECTANGLES) + if (xmag <= 0.0) { + lmax = 0.0 + call amovkr (0.0, Memr[lengths], nr) + } else { + call adivkr (Memr[mk_statp(mk,RLENGTHS)], xmag, Memr[lengths], + nr) + lmax = Memr[lengths+nr-1] + } + if (ymag <= 0.0) + lratio = 0.0 + else + lratio = mk_statr (mk, RATIO) * xmag / ymag + if (mk_rlimits (fx, fy, lmax, lratio, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawbox (im, fx, fy, x1, x2, y1, y2, Memr[lengths], + lratio, nr, mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + + case MK_CIRCLE: + nc = mk_stati (mk, NCIRCLES) + if (xmag <= 0.0) { + rmax = 0.0 + call amovkr (0.0, Memr[radii], nc) + } else { + call adivkr (Memr[mk_statp(mk, RADII)], xmag, Memr[radii], nc) + rmax = Memr[radii+nc-1] + } + if (ymag <= 0.0) + ratio = 0.0 + else + ratio = xmag / ymag + if (mk_climits (fx, fy, rmax, ratio, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawcircles (im, fx, fy, x1, x2, y1, y2, + Memr[radii], ratio, nc, mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + + case MK_PLUS: + call mk_textim (im, "+", nint (fx), nint (fy), mk_stati (mk, SIZE), + mk_stati (mk, SIZE), mk_stati (mk, GRAYLEVEL), YES) + call imflush (im) + + case MK_CROSS: + call mk_textim (im, "*", nint (fx), nint (fy), mk_stati (mk, SIZE), + mk_stati (mk, SIZE), mk_stati (mk, GRAYLEVEL), YES) + call imflush (im) + + default: + # Do nothing gracefully + } + + # Number the text file. + if (mk_stati (mk, LABEL) == YES) { + if (label[1] != EOS) { + call mk_textim (im, label, nint (fx) + mk_stati (mk, + NXOFFSET), nint (fy) + mk_stati (mk, NYOFFSET), + mk_stati (mk, SIZE), mk_stati (mk, SIZE), mk_stati (mk, + GRAYLEVEL), NO) + call imflush (im) + } + } else if (mk_stati (mk, NUMBER) == YES) { + if (itoc (ltid, Memc[str], SZ_FNAME) > 0) { + call mk_textim (im, Memc[str], nint (fx) + mk_stati (mk, + NXOFFSET), nint (fy) + mk_stati (mk, NYOFFSET), + mk_stati (mk, SIZE), mk_stati (mk, SIZE), mk_stati (mk, + GRAYLEVEL), NO) + call imflush (im) + } + } + + call sfree (sp) +end + + +# MK_DMARK -- Mark a dot. + +procedure mk_dmark (mk, im, fx, fy) + +pointer mk # pointer to the mark structure +pointer im # pointer to the frame buffer +real fx, fy # real coordinates + +int ncols, nlines, x1, y1, x2, y2 +int mk_stati(), mk_plimits() + +begin + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + if (mk_plimits (fx, fy, mk_stati (mk, SZPOINT), ncols, nlines, + x1, x2, y1, y2) == YES) { + call mk_drawpt (im, x1, x2, y1, y2, mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + + #call mk_seti (mk, X1, x1) + #call mk_seti (mk, Y1, y1) + #call mk_seti (mk, X2, x2) + #call mk_seti (mk, Y2, x2) +end + + +# MK_CMARK -- Mark concentric circle(s). + +procedure mk_cmark (mk, im, iw, fx, fy) + +pointer mk # pointer to the mark structure +pointer im # pointer to the frame buffer image +pointer iw # pointer to the wcs structure +real fx, fy # center of circle + +int nc, ncols, nlines, x1, x2, y1, y2 +pointer sp, radii +real xmag, ymag, rmax, ratio +int mk_stati(), mk_climits() +pointer mk_statp() + +begin + nc = mk_stati (mk, NCIRCLES) + if (nc <= 0) + return + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + call mk_mag (im, iw, xmag, ymag) + + call smark (sp) + call salloc (radii, nc, TY_REAL) + + if (xmag <= 0.0) { + rmax = 0.0 + call amovkr (0.0, Memr[radii], nc) + } else { + call adivkr (Memr[mk_statp(mk,RADII)], xmag, Memr[radii], nc) + rmax = Memr[radii+nc-1] + } + if (ymag <= 0.0) + ratio = 0.0 + else + ratio = xmag / ymag + + if (mk_climits (fx, fy, rmax, ratio, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawcircles (im, fx, fy, x1, x2, y1, y2, Memr[radii], + ratio, nc, mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + + #call mk_seti (mk, X1, x1) + #call mk_seti (mk, Y1, y1) + #call mk_seti (mk, X2, x2) + #call mk_seti (mk, Y2, y2) + + call sfree (sp) +end + + +# MK_OCMARK -- Mark one circle. + +procedure mk_ocmark (mk, im, iw, fx, fy, rmax) + +pointer mk # pointer to the mark structure +pointer im # pointer to the frame buffer image +pointer iw # pointer to the wcs structure +real fx, fy # center of circle +real rmax # maximum radius + +int ncols, nlines, x1, x2, y1, y2 +int mk_climits(), mk_stati() + +begin + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + if (mk_climits (fx, fy, rmax, 1.0, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawcircles (im, fx, fy, x1, x2, y1, y2, rmax, + 1.0, 1, mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + + #call mk_seti (mk, X1, x1) + #call mk_seti (mk, Y1, y1) + #call mk_seti (mk, X2, x2) + #call mk_seti (mk, Y2, y2) +end + + +# MK_LMARK -- Mark s line segment + +procedure mk_lmark (mk, im, ofx, ofy, fx, fy) + +pointer mk # pointer to the mark structure +pointer im # pointer to the frame buffer +real ofx, ofy # coords of first point +real fx, fy # coords of second point + +int ncols, nlines, x1, y1, x2, y2 +int mk_stati(), mk_llimits() + +begin + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + if (mk_llimits (ofx, ofy, fx, fy, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawline (im, ofx, ofy, fx, fy, x1, x2, y1, y2, + mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + + #call mk_seti (mk, X1, x1) + #call mk_seti (mk, Y1, y1) + #call mk_seti (mk, X2, x2) + #call mk_seti (mk, Y2, y2) +end + + +# MK_TMARK -- Mark a text string + +procedure mk_tmark (mk, im, str, fx, fy, center) + +pointer mk # pointer to the mark structure +pointer im # pointer to the frame buffer image +char str[ARB] # character string to be drawn +real fx, fy # lower left coords of string +int center # center the string + +int ncols, nlines +#int x1, x2, y1, y2 +int mk_stati() + +begin + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + call mk_textim (im, str, nint (fx), nint (fy), mk_stati (mk, SIZE), + mk_stati(mk, SIZE), mk_stati (mk, GRAYLEVEL), center) + call imflush (im) + + #call mk_seti (mk, X1, x1) + #call mk_seti (mk, Y1, y1) + #call mk_seti (mk, X2, x1) + #call mk_seti (mk, Y2, y2) +end + + +# MK_RMARK -- Mark concentric rectangles. + +procedure mk_rmark (mk, im, iw, fx, fy) + +pointer mk # pointer to the mark structure +pointer im # pointer to the frame buffer +pointer iw # pointer to the wcs structure +real fx, fy # x and y center coordinates + +int nr, ncols, nlines, x1, y1, x2, y2 +pointer sp, lengths +real xmag, ymag, lmax, lratio +int mk_stati(), mk_rlimits() +pointer mk_statp() +real mk_statr() + +begin + nr = mk_stati (mk, NRECTANGLES) + if (nr <= 0) + return + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + call mk_mag (im, iw, xmag, ymag) + + call smark (sp) + call salloc (lengths, nr, TY_REAL) + + if (xmag <= 0.0) { + lmax = 0.0 + call amovkr (0.0, Memr[lengths], nr) + } else { + lmax = Memr[mk_statp(mk, RLENGTHS)+nr-1] / xmag + call adivkr (Memr[mk_statp(mk,RLENGTHS)], xmag, Memr[lengths], nr) + } + if (ymag <= 0.0) + lratio = 0.0 + else + lratio = mk_statr (mk, RATIO) * xmag / ymag + + if (mk_rlimits (fx, fy, lmax, lratio, ncols, nlines, x1, x2, + y1, y2) == YES) { + call mk_drawbox (im, fx, fy, x1, x2, y1, y2, Memr[lengths], + lratio, nr, mk_stati (mk, GRAYLEVEL)) + call imflush (im) + } + + #call mk_seti (mk, X1, x1) + #call mk_seti (mk, Y1, y1) + #call mk_seti (mk, X2, x2) + #call mk_seti (mk, Y2, y2) + + call sfree (sp) +end + + +# MK_XMARK -- Procedure to mark a box. + +procedure mk_xmark (mk, im, ofx, ofy, fx, fy) + +pointer mk # pointer to the mark structure +pointer im # pointer to the frame buffer image +real ofx, ofy # first corner coordinates +real fx, fy # second corner coordinates + +int ncols, nlines, x1, x2, y1, y2 +int mk_stati() + +begin + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + call mk_blimits (ofx, ofy, fx, fy, ncols, nlines, x1, x2, y1, y2) + call mk_pbox (im, x1, x2, y1, y2, mk_stati (mk, GRAYLEVEL)) + call imflush (im) + + #call mk_seti (mk, X1, x1) + #call mk_seti (mk, Y1, y1) + #call mk_seti (mk, X2, x2) + #call mk_seti (mk, Y2, y2) +end diff --git a/pkg/images/tv/tvmark/mkoutname.x b/pkg/images/tv/tvmark/mkoutname.x new file mode 100644 index 00000000..a4ec4f22 --- /dev/null +++ b/pkg/images/tv/tvmark/mkoutname.x @@ -0,0 +1,273 @@ +# MK_OUTNAME -- Procedure to construct an daophot 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 mk_outname (image, output, ext, name, maxch) +# +#char image[ARB] # image name +#char output[ARB] # output directory or name +#char ext[ARB] # extension +#char name[ARB] # output name +#int maxch # maximum size of name +# +#int ndir +#pointer sp, root +#int fnldir(), strlen(), mk_imroot() +# +#begin +# call smark (sp) +# call salloc (root, SZ_FNAME, TY_CHAR) +# call imgimage (image, Memc[root], maxch) +# +# ndir = fnldir (output, name, maxch) +# if (strlen (output) == ndir) { +# ndir = ndir + mk_imroot (Memc[root], name[ndir+1], maxch) +# call sprintf (name[ndir+1], maxch, ".%s.*") +# call pargstr (ext) +# call mk_version (name, name, maxch) +# } else +# call strcpy (output, name, maxch) +# +# call sfree (sp) +#end + + +# MK_IMROOT -- Procedure to fetch the root image name minus the directory +# specification and the section notation. The length of the root name is +# returned. +# +#int procedure mk_imroot (image, root, maxch) +# +#char image[ARB] # image specification +#char root[ARB] # rootname +#int maxch # maximum number of characters +# +#int nchars +#pointer sp, str +#int fnldir(), strlen() +# +#begin +# call smark (sp) +# call salloc (str, SZ_FNAME, TY_CHAR) +# +# call imgimage (image, root, maxch) +# nchars = fnldir (root, Memc[str], maxch) +# call strcpy (root[nchars+1], root, maxch) +# +# call sfree (sp) +# return (strlen (root)) +#end + + +# MK_VERSION -- Routine to compute the next available version number of a given +# file name template and output the new files name. +# +#procedure mk_version (template, filename, maxch) +# +#char template[ARB] # name template +#char filename[ARB] # output name +#int maxch # maximum number of characters +# +#char period +#int newversion, version, len, ip +#pointer sp, list, name +#int fntgfnb() strldx(), ctoi() +#pointer fntopnb() +# +#begin +# # Allocate temporary space +# call smark (sp) +# call salloc (name, maxch, TY_CHAR) +# period = '.' +# list = fntopnb (template, NO) +# len = strldx (period, template) +# +# # 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]) +# ip = len + 1 +# if (ctoi (Memc[name], ip, version) <= 0) +# next +# newversion = max (newversion, version) +# } +# +# # Make new output file name. +# call strcpy (template, filename, len) +# call sprintf (filename[len+1], maxch, "%d") +# call pargi (newversion + 1) +# +# call fntclsb (list) +# call sfree (sp) +#end + + +# MK_IMNAME -- Procedure to 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 mk_imname (image, output, ext, name, maxch) + +char image[ARB] # image name +char output[ARB] # output directory or name +char ext[ARB] # extension +char name[ARB] # output name +int maxch # maximum size of name + +int ndir, nimdir, clindex, clsize +pointer sp, root, str +int fnldir(), strlen() + +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) + if (clindex >= 0) { + call sprintf (name[ndir+1], maxch, "%s%d.%s.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + call pargstr (ext) + } else { + call sprintf (name[ndir+1], maxch, "%s.%s.*") + call pargstr (Memc[root+nimdir]) + call pargstr (ext) + } + call mk_oimversion (name, name, maxch) + } else + call strcpy (output, name, maxch) + + call sfree (sp) +end + + +# MK_OIMVERSION -- Routine to compute the next available version number of +# a given file name template and output the new files name. + +procedure mk_oimversion (template, filename, maxch) + +char template[ARB] # name template +char filename[ARB] # output name +int maxch # 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 + + + +# MK_IMNAME -- Procedure to construct an daophot 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 mk_imname (image, output, ext, name, maxch) +# +#char image[ARB] # image name +#char output[ARB] # output directory or name +#char ext[ARB] # extension +#char name[ARB] # output name +#int maxch # maximum size of name +# +#int ndir +#pointer sp, root +#int fnldir(), strlen(), mk_imroot() +# +#begin +# call smark (sp) +# call salloc (root, SZ_FNAME, TY_CHAR) +# call imgimage (image, Memc[root], maxch) +# +# ndir = fnldir (output, name, maxch) +# if (strlen (output) == ndir) { +# ndir = ndir + mk_imroot (Memc[root], name[ndir+1], maxch) +# call sprintf (name[ndir+1], maxch, ".%s.*") +# call pargstr (ext) +# call mk_imversion (name, name, maxch) +# } else +# call strcpy (output, name, maxch) +# +# call sfree (sp) +#end + + +# MK_VERSION -- Routine to compute the next available version number of a given +# file name template and output the new files name. +# +#procedure mk_imversion (template, filename, maxch) +# +#char template[ARB] # name template +#char filename[ARB] # output name +#int maxch # maximum number of characters +# +#char period +#int newversion, version, len, ip +#pointer sp, list, name +#int fntgfnb() strldx(), ctoi() +#pointer fntopnb() +# +#begin +# # Allocate temporary space +# call smark (sp) +# call salloc (name, maxch, TY_CHAR) +# period = '.' +# list = fntopnb (template, NO) +# len = strldx (period, template) +# +# # 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]) +# Memc[name+len-1] = EOS +# len = strldx (period, Memc[name]) +# ip = len + 1 +# if (ctoi (Memc[name], ip, version) <= 0) +# next +# newversion = max (newversion, version) +# } +# +# # Make new output file name. +# call strcpy (template, filename, len) +# call sprintf (filename[len+1], maxch, "%d") +# call pargi (newversion + 1) +# +# call fntclsb (list) +# call sfree (sp) +#end diff --git a/pkg/images/tv/tvmark/mkpkg b/pkg/images/tv/tvmark/mkpkg new file mode 100644 index 00000000..0fb0af3b --- /dev/null +++ b/pkg/images/tv/tvmark/mkpkg @@ -0,0 +1,27 @@ +# Make the TVMARK package + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + + +libpkg.a: + mkbmark.x "tvmark.h" <imhdr.h> + mkcolon.x "tvmark.h" <imhdr.h> <fset.h> <error.h> + mkgmarks.x <ctype.h> <lexnum.h> + mkgpars.x <ctype.h> "tvmark.h" + mkgscur.x <gset.h> <fset.h> + mkremove.x + mkfind.x <mach.h> + mkppars.x <ctype.h> "tvmark.h" + mkmag.x <imhdr.h> + mkmark.x <imhdr.h> <fset.h> "tvmark.h" + mknew.x + mkonemark.x <imhdr.h> "tvmark.h" + mkoutname.x + mkshow.x "tvmark.h" + mktext.x "pixelfont.inc" "asciilook.inc" <imhdr.h> <mach.h> + mktools.x <ctype.h> "tvmark.h" + t_tvmark.x <imhdr.h> <imset.h> <fset.h> <gset.h> "tvmark.h" + ; diff --git a/pkg/images/tv/tvmark/mkppars.x b/pkg/images/tv/tvmark/mkppars.x new file mode 100644 index 00000000..16fdf8c5 --- /dev/null +++ b/pkg/images/tv/tvmark/mkppars.x @@ -0,0 +1,40 @@ +include <ctype.h> +include "tvmark.h" + +# MK_PPARS -- Store the IMMARK parameters. + +procedure mk_ppars (mk) + +pointer mk # pointer to the immark structure + +pointer sp, str +bool itob() +int mk_stati() +real mk_statr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Store the mark type. + call mk_stats (mk, MARK, Memc[str], SZ_LINE) + call clpstr ("mark", Memc[str]) + + # Store the circle and rectangles descriptors. + call mk_stats (mk, CSTRING, Memc[str], SZ_LINE) + call clpstr ("radii", Memc[str]) + call mk_stats (mk, RSTRING, Memc[str], SZ_LINE) + call clpstr ("lengths", Memc[str]) + + call clputb ("number", itob (mk_stati (mk, NUMBER))) + call clputb ("label", itob (mk_stati (mk, LABEL))) + call clputi ("txsize", mk_stati (mk, SIZE)) + call clputi ("pointsize", 2 * mk_stati (mk, SZPOINT) + 1) + call clputi ("color", mk_stati (mk, GRAYLEVEL)) + call clputi ("nxoffset", mk_stati (mk, NXOFFSET)) + call clputi ("nyoffset", mk_stati (mk, NYOFFSET)) + call clputr ("tolerance", mk_statr (mk, TOLERANCE)) + + call sfree (sp) +end diff --git a/pkg/images/tv/tvmark/mkremove.x b/pkg/images/tv/tvmark/mkremove.x new file mode 100644 index 00000000..589fc039 --- /dev/null +++ b/pkg/images/tv/tvmark/mkremove.x @@ -0,0 +1,98 @@ +# MK_REMOVE -- Check the deletions for uniqueness and delete unwanted objects +# from the coordinates file. + +procedure mk_remove (coords, deletions, cl, dl, ndelete) + +char coords[ARB] # coordinate file name +char deletions[ARB] # deletions file name +int cl # coordinate file descriptor +int dl # deletions file descriptor +int ndelete # number of deletions + +int i, ndel, nobj, obj, tcl, tdl, stat +pointer sp, id, tclname, tdlname, line +real xval, yval +int fscan(), nscan(), open(), getline() + +begin + call smark (sp) + call salloc (id, ndelete, TY_INT) + call salloc (tclname, SZ_FNAME, TY_CHAR) + call salloc (tdlname, SZ_FNAME, TY_CHAR) + call salloc (line, SZ_LINE, TY_CHAR) + + # Rewind both files to the beginning. + call seek (cl, BOF) + call seek (dl, BOF) + + # Read in the ids of objects to be deleted. + ndel = 0 + while (fscan (dl) != EOF) { + call gargi (Memi[id+ndel]) + ndel = ndel + 1 + } + + # Sort the id numbers. + call asrti (Memi[id], Memi[id], ndelete) + + # Remove id numbers that are not unique. + ndel = 1 + do i = 2, ndelete { + if (Memi[id+i-1] == Memi[id+i-2]) + next + ndel = ndel + 1 + Memi[id+ndel-1] = Memi[id+i-1] + } + + # Open two temporary files. + call mktemp ("tcl", Memc[tclname], SZ_FNAME) + call mktemp ("tdl", Memc[tdlname], SZ_FNAME) + tcl = open (Memc[tclname], NEW_FILE, TEXT_FILE) + tdl = open (Memc[tdlname], NEW_FILE, TEXT_FILE) + + nobj = 0 + do i = 1, ndel { + + obj = Memi[id+i-1] + + repeat { + + stat = getline (cl, Memc[line]) + if (stat == EOF) + break + + call sscan (Memc[line]) + call gargr (xval) + call gargr (yval) + if (nscan () < 2) { + call putline (tcl, Memc[line]) + next + } + + nobj = nobj + 1 + if (nobj < obj) + call putline (tcl, Memc[line]) + else + call putline (tdl, Memc[line]) + + } until (nobj >= obj) + } + + # Copy the remainder of the file. + while (getline (cl, Memc[line]) != EOF) + call putline (tcl, Memc[line]) + + # Cleanup the coords file. + call close (cl) + call close (tcl) + call delete (coords) + call rename (Memc[tclname], coords) + + # Cleanup the delete file. + call close (dl) + call close (tdl) + call delete (deletions) + call rename (Memc[tdlname], deletions) + + call sfree (sp) +end diff --git a/pkg/images/tv/tvmark/mkshow.x b/pkg/images/tv/tvmark/mkshow.x new file mode 100644 index 00000000..cd48992b --- /dev/null +++ b/pkg/images/tv/tvmark/mkshow.x @@ -0,0 +1,95 @@ +include "tvmark.h" + +# MK_SHOW -- Procedure to show the immark parameters + +procedure mk_show (mk) + +pointer mk # pointer to the immark structure + +pointer sp, str +bool itob() +int mk_stati() +real mk_statr() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Print a blank line. + call printf ("\n") + + # Print the frame info. + call printf ("%s: %d %s: %s\n") + call pargstr (KY_FRAME) + call pargi (mk_stati (mk, FRAME)) + call pargstr (KY_COORDS) + call mk_stats (mk, COORDS, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + + # Print the output info. + call printf (" %s: %s %s: %s %s: %b\n") + call pargstr (KY_OUTIMAGE) + call mk_stats (mk, OUTIMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call mk_stats (mk, LOGFILE, Memc[str], SZ_FNAME) + call pargstr (KY_LOGFILE) + call pargstr (Memc[str]) + call pargstr (KY_AUTOLOG) + call pargb (itob (mk_stati (mk, AUTOLOG))) + + # Print the deletions file info. + call printf (" %s: %s %s: %g\n") + call pargstr (KY_DELETIONS) + call mk_stats (mk, DELETIONS, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call pargstr (KY_TOLERANCE) + call pargr (mk_statr (mk, TOLERANCE)) + + # Print the font info. + call printf (" %s: %s %s: %d\n") + call pargstr (KY_FONT) + call mk_stats (mk, FONT, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call pargstr (KY_GRAYLEVEL) + call pargi (mk_stati (mk, GRAYLEVEL)) + + # Print the mark type info. + call printf (" %s: %s ") + call pargstr (KY_MARK) + call mk_stats (mk, MARK, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + + call printf ("%s: %s ") + call pargstr (KY_CIRCLES) + call mk_stats (mk, CSTRING, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + + call printf ("%s: %s %g\n") + call pargstr (KY_RECTANGLE) + call mk_stats (mk, RSTRING, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call pargr (mk_statr (mk, RATIO)) + + call printf (" %s: %d %s: %d\n") + call pargstr (KY_SZPOINT) + call pargi (2 * mk_stati (mk, SZPOINT) + 1) + call pargstr (KY_SIZE) + call pargi (mk_stati (mk, SIZE)) + + call printf (" %s: %b ") + call pargstr (KY_LABEL) + call pargb (itob (mk_stati (mk, LABEL))) + call printf ("%s: %b ") + call pargstr (KY_NUMBER) + call pargb (itob (mk_stati (mk, NUMBER))) + call printf (" %s: %d %s: %d\n") + call pargstr (KY_NXOFFSET) + call pargi (mk_stati (mk, NXOFFSET)) + call pargstr (KY_NYOFFSET) + call pargi (mk_stati (mk, NYOFFSET)) + + # Print a blank line. + call printf ("\n") + + call sfree (sp) +end diff --git a/pkg/images/tv/tvmark/mktext.x b/pkg/images/tv/tvmark/mktext.x new file mode 100644 index 00000000..06a99b37 --- /dev/null +++ b/pkg/images/tv/tvmark/mktext.x @@ -0,0 +1,164 @@ +include <mach.h> +include <imhdr.h> + +define FONTWIDE 6 +define FONTHIGH 7 +define SZ_LOOKUP 128 +define SZ_FONT 455 +define SZ_PIXARY 5 + +# MK_TEXTIM -- Write a text string into an image using a pixel font for speed. +# Characters are made twice as big as the font by doubling in both axes. + +procedure mk_textim (im, s, x, y, xmag, ymag, value, center) + +pointer im # image to put the text in. +char s[ARB] # text to put in the image. +int x, y # x, y position in the image. +int xmag, ymag # x, y magnification values. +int value # value to use in image for text. +int center # center the string + +int numrow, numcol, numchars, fonthigh, fontwide, xinit, yinit +int i, l, ch, nchar, line, ip, pixary[SZ_PIXARY] +pointer lineget, lineput + +int strlen() +pointer imgl2s(), impl2s() +errchk imgl2s, impl2s + +begin + # Find the length of the string. + numchars = strlen (s) + if (numchars <= 0) + return + + # Calculate height and width of magnified font. + fonthigh = FONTHIGH * ymag + fontwide = FONTWIDE * xmag + + # Check for row/col out of bounds. + numcol= IM_LEN(im,1) + numrow = IM_LEN(im,2) + + # Compute the initial position of the string truncating characters + # is necessary. + if (center == YES) + xinit = x - fontwide * numchars / 2 + else + xinit = x + for (ip = 1; ip <= numchars; ip = ip + 1) { + if (xinit >= 1) + break + xinit = xinit + fontwide + } + + # Return if beginning of string is off image. + if (xinit < 1 || xinit > numcol) + return + + # Truncate the string. + if (xinit > numcol - fontwide * (numchars - ip + 1)) { + numchars = int ((numcol - xinit) / fontwide) + if (numchars <= 0) + return + } + + # Return if the text does not fit in the image. + if (center == YES) + yinit = y - fonthigh * numchars / 2 + else + yinit = y + if ((yinit <= 0) || (yinit > numrow - fonthigh)) + return + + # For each line of the text (backward). + for (i = 1; i <= 7; i = i + 1) { + + line = yinit + (i-1) * ymag + + do l = 1, ymag { + + # Get and put the line of the image. + lineput = impl2s (im, line+(l-1)) + lineget = imgl2s (im, line+(l-1)) + call amovs (Mems[lineget], Mems[lineput], numcol) + + # Put out the font. + do ch = ip, numchars { + nchar = int (s[ch]) + call mk_pixbit (nchar, 8 - i, pixary) + call mk_putpix (pixary, Mems[lineput], numcol, + xinit+(ch-1)*fontwide, value, xmag) + } + + } + } +end + + +# MK_PIXBIT -- Look up which bits should be set for this character on this line. + +procedure mk_pixbit (code, line, bitarray) + +int code # character we are writing +int line # line of the character we are writing +int bitarray[ARB] # bit-array to receive data + +int pix, i +short asciilook[SZ_LOOKUP], font[SZ_FONT] +int bitupk() + +include "pixelfont.inc" +include "asciilook.inc" + +begin + pix = font[asciilook[code+1]+line-1] + bitarray[5] = bitupk (pix, 1, 1) + bitarray[4] = bitupk (pix, 4, 1) + bitarray[3] = bitupk (pix, 7, 1) + bitarray[2] = bitupk (pix, 10, 1) + bitarray[1] = bitupk (pix, 13, 1) +end + + +# MK_PUTPIX -- Put one line of one character into the data array. + +procedure mk_putpix (pixary, array, size, position, value, xmag) + +int pixary[ARB] # array of pixels in character +int size, position # size of data array +short array[size] # data array in which to put character line +int value # value to use for character pixels +int xmag # x-magnification of text + +int i, k, x + +begin + do i = 1, 5 { + if (pixary[i] == 1) { + x = position + (i-1) * xmag + do k = 1, xmag + array[x+(k-1)] = value + } + } +end + + +# MK_TLIMITS -- Compute the column and line limits of a text string. + +procedure mk_tlimits (str, x, y, xmag, ymag, ncols, nlines, x1, x2, y1, y2) + +char str[ARB] # string to be written to the image +int x, y # starting position of the string +int xmag, ymag # magnification factor +int ncols, nlines # dimensions of the image +int x1, x2 # column limits +int y1, y2 # line limits + +begin + x1 = max (1, min (y, ncols)) + x2 = min (ncols, max (1, y + 5 * xmag)) + y1 = max (1, min (y, nlines)) + y2 = min (nlines, max (1, y + 6 * ymag)) +end diff --git a/pkg/images/tv/tvmark/mktools.x b/pkg/images/tv/tvmark/mktools.x new file mode 100644 index 00000000..33f1424b --- /dev/null +++ b/pkg/images/tv/tvmark/mktools.x @@ -0,0 +1,505 @@ +include <ctype.h> +include "tvmark.h" + +# MK_INIT -- Procedure to initialize the image marking code. + +procedure mk_init (mk) + +pointer mk # pointer to immark structure + +begin + call malloc (mk, LEN_MARKSTRUCT, TY_STRUCT) + + # Initialize the mark type parameters. + MK_MARK(mk) = EOS + MK_CSTRING(mk) = EOS + MK_RSTRING(mk) = EOS + MK_MKTYPE(mk) = 0 + MK_NCIRCLES(mk) = 0 + MK_NELLIPSES(mk) = 0 + MK_NSQUARES(mk) = 0 + MK_NRECTANGLES(mk) = 0 + MK_NXOFFSET(mk) = 0 + MK_NYOFFSET(mk) = 0 + + # Initialize the mark shape parameters. + MK_RATIO(mk) = 1.0 + MK_ELLIPTICITY(mk) = 0.0 + MK_RTHETA(mk) = 0.0 + MK_ETHETA(mk) = 0.0 + + # Initialize the pointers. + MK_RADII(mk) = NULL + MK_AXES(mk) = NULL + MK_SLENGTHS(mk) = NULL + MK_RLENGTHS(mk) = NULL + + MK_X1(mk) = INDEFI + MK_Y1(mk) = INDEFI + MK_X2(mk) = INDEFI + MK_Y2(mk) = INDEFI + + # Initialize actual drawing parameters. + MK_NUMBER(mk) = NO + MK_LABEL(mk) = NO + MK_FONT(mk) = EOS + MK_GRAYLEVEL(mk) = 0 + MK_SIZE(mk) = 1 + MK_SZPOINT(mk) = 1 + + # Initialize file parameters strings. + MK_IMAGE(mk) = EOS + MK_OUTIMAGE(mk) = EOS + MK_COORDS(mk) = EOS + MK_DELETIONS(mk) = EOS + MK_LOGFILE(mk) = EOS + MK_AUTOLOG(mk) = NO + + # Initilize the display command parameters. + MK_FRAME(mk) = 1 + MK_TOLERANCE(mk) = 1.0 + + # Initialize the buffers. + call mk_rinit (mk) +end + + +# MK_RINIT -- Procedure to initialize the immark structure. + +procedure mk_rinit (mk) + +pointer mk # pointer to immark structure + +begin + call mk_rfree (mk) + call malloc (MK_RADII(mk), MAX_NMARKS, TY_REAL) + call malloc (MK_AXES(mk), MAX_NMARKS, TY_REAL) + call malloc (MK_SLENGTHS(mk), MAX_NMARKS, TY_REAL) + call malloc (MK_RLENGTHS(mk), MAX_NMARKS, TY_REAL) +end + + +# MK_INDEFR -- Procedure to reinitialize the size dependent buffers. + +procedure mk_indefr (mk) + +pointer mk # pointer to immark + +int ncircles, nsquares, nellipses, nrectangles +int mk_stati() + +begin + ncircles = mk_stati (mk, NCIRCLES) + nellipses = mk_stati (mk, NELLIPSES) + nsquares = mk_stati (mk, NSQUARES) + nrectangles = mk_stati (mk, NRECTANGLES) + + if (ncircles > 0) + call amovkr (INDEFR, Memr[MK_RADII(mk)], ncircles) + if (nellipses > 0) + call amovkr (INDEFR, Memr[MK_AXES(mk)], nellipses) + if (nsquares > 0) + call amovkr (INDEFR, Memr[MK_SLENGTHS(mk)], nsquares) + if (nrectangles > 0) + call amovkr (INDEFR, Memr[MK_RLENGTHS(mk)], nrectangles) + +end + + +# MK_REALLOC -- Procedure to reallocate regions buffers. + +procedure mk_realloc (mk, ncircles, nellipses, nsquares, nrectangles) + +pointer mk # pointer to immark structure +int ncircles # number of circles +int nellipses # number of ellipses +int nsquares # number of squares +int nrectangles # number of rectangles + +int nc, ne, ns, nr +int mk_stati() + +begin + if (ncircles > 0) + call realloc (MK_RADII(mk), ncircles, TY_REAL) + else { + call mfree (MK_RADII(mk), TY_REAL) + MK_RADII(mk) = NULL + } + + if (nellipses > 0) + call realloc (MK_AXES(mk), nellipses, TY_REAL) + else { + call mfree (MK_AXES(mk), TY_REAL) + MK_AXES(mk) = NULL + } + + if (nsquares > 0) + call realloc (MK_SLENGTHS(mk), nsquares, TY_REAL) + else { + call mfree (MK_SLENGTHS(mk), TY_REAL) + MK_SLENGTHS(mk) = NULL + } + + if (nrectangles > 0) + call realloc (MK_RLENGTHS(mk), nrectangles, TY_REAL) + else { + call mfree (MK_RLENGTHS(mk), TY_REAL) + MK_RLENGTHS(mk) = NULL + } + + nc = mk_stati (mk, NCIRCLES) + ne = mk_stati (mk, NELLIPSES) + ns = mk_stati (mk, NSQUARES) + nr = mk_stati (mk, NRECTANGLES) + + if (ncircles > nc) + call amovkr (INDEFR, Memr[MK_RADII(mk)+nc], ncircles - nc) + if (nellipses > ne) + call amovkr (INDEFR, Memr[MK_AXES(mk)+ne], nellipses - ne) + if (nsquares > ns) + call amovkr (INDEFR, Memr[MK_SLENGTHS(mk)+ns], nsquares - ns) + if (nrectangles > nr) + call amovkr (INDEFR, Memr[MK_RLENGTHS(mk)+nr], nrectangles - nr) +end + + +# MK_FREE -- Procedure to free the immark structure. + +procedure mk_free (mk) + +pointer mk # pointer to immark structure + +begin + call mk_rfree (mk) + call mfree (mk, TY_STRUCT) +end + + +# MK_RFREE -- Procedure to free the regions portion of the immark structure. + +procedure mk_rfree (mk) + +pointer mk # pointer to immark structure + +begin + if (MK_RADII(mk) != NULL) + call mfree (MK_RADII(mk), TY_REAL) + MK_RADII(mk) = NULL + if (MK_AXES(mk) != NULL) + call mfree (MK_AXES(mk), TY_REAL) + MK_AXES(mk) = NULL + if (MK_SLENGTHS(mk) != NULL) + call mfree (MK_SLENGTHS(mk), TY_REAL) + MK_SLENGTHS(mk) = NULL + if (MK_RLENGTHS(mk) != NULL) + call mfree (MK_RLENGTHS(mk), TY_REAL) + MK_RLENGTHS(mk) = NULL +end + + +# MK_STATI -- Procedure to fetch the value of an immark integer parameter. + +int procedure mk_stati (mk, param) + +pointer mk # pointer to immark structure +int param # parameter to be fetched + +begin + switch (param) { + case AUTOLOG: + return (MK_AUTOLOG(mk)) + case NUMBER: + return (MK_NUMBER(mk)) + case LABEL: + return (MK_LABEL(mk)) + case GRAYLEVEL: + return (MK_GRAYLEVEL(mk)) + case SIZE: + return (MK_SIZE(mk)) + case SZPOINT: + return (MK_SZPOINT(mk)) + case FRAME: + return (MK_FRAME(mk)) + case NCIRCLES: + return (MK_NCIRCLES(mk)) + case NELLIPSES: + return (MK_NELLIPSES(mk)) + case NSQUARES: + return (MK_NSQUARES(mk)) + case NRECTANGLES: + return (MK_NRECTANGLES(mk)) + case MKTYPE: + return (MK_MKTYPE(mk)) + case X1: + return (MK_X1(mk)) + case Y1: + return (MK_Y1(mk)) + case X2: + return (MK_X2(mk)) + case Y2: + return (MK_Y2(mk)) + case NXOFFSET: + return (MK_NXOFFSET(mk)) + case NYOFFSET: + return (MK_NYOFFSET(mk)) + default: + call error (0, "MK_STATI: Unknown integer parameter.") + } +end + + +# MK_STATP -- Procedure to fetch the value of a pointer parameter. + +pointer procedure mk_statp (mk, param) + +pointer mk # pointer to immark structure +int param # parameter to be fetched + +begin + switch (param) { + case RADII: + return (MK_RADII(mk)) + case AXES: + return (MK_AXES(mk)) + case SLENGTHS: + return (MK_SLENGTHS(mk)) + case RLENGTHS: + return (MK_RLENGTHS(mk)) + default: + call error (0, "MK_STATP: Unknown pointer parameter.") + } +end + + +# MK_STATR -- Procedure to fetch the value of a real parameter. + +real procedure mk_statr (mk, param) + +pointer mk # pointer to immark structure +int param # parameter to be fetched + +begin + switch (param) { + case RATIO: + return (MK_RATIO(mk)) + case ELLIPTICITY: + return (MK_ELLIPTICITY(mk)) + case RTHETA: + return (MK_RTHETA(mk)) + case ETHETA: + return (MK_ETHETA(mk)) + case TOLERANCE: + return (MK_TOLERANCE(mk)) + default: + call error (0, "MK_STATR: Unknown real parameter.") + } +end + + +# MK_STATS -- Procedure to fetch the value of a string parameter. + +procedure mk_stats (mk, param, str, maxch) + +pointer mk # pointer to immark structure +int param # parameter to be fetched +char str[ARB] # output string +int maxch # maximum number of characters + +begin + switch (param) { + case IMAGE: + call strcpy (MK_IMAGE(mk), str, maxch) + case OUTIMAGE: + call strcpy (MK_OUTIMAGE(mk), str, maxch) + case COORDS: + call strcpy (MK_COORDS(mk), str, maxch) + case DELETIONS: + call strcpy (MK_DELETIONS(mk), str, maxch) + case LOGFILE: + call strcpy (MK_LOGFILE(mk), str, maxch) + case FONT: + call strcpy (MK_FONT(mk), str, maxch) + case MARK: + call strcpy (MK_MARK(mk), str, maxch) + case CSTRING: + call strcpy (MK_CSTRING(mk), str, maxch) + case RSTRING: + call strcpy (MK_RSTRING(mk), str, maxch) + default: + call error (0, "MK_STATS: Unknown string parameter.") + } +end + + +# MK_SETI -- Procedure to set the value of an integer parameter. + +procedure mk_seti (mk, param, value) + +pointer mk # pointer to immark structure +int param # parameter to be fetched +int value # value of the integer parameter + +begin + switch (param) { + case AUTOLOG: + MK_AUTOLOG(mk) = value + case NUMBER: + MK_NUMBER(mk) = value + case LABEL: + MK_LABEL(mk) = value + case GRAYLEVEL: + MK_GRAYLEVEL(mk) = value + case SIZE: + MK_SIZE(mk) = value + case SZPOINT: + MK_SZPOINT(mk) = value + case FRAME: + MK_FRAME(mk) = value + case NCIRCLES: + MK_NCIRCLES(mk) = value + case NELLIPSES: + MK_NELLIPSES(mk) = value + case NSQUARES: + MK_NSQUARES(mk) = value + case NRECTANGLES: + MK_NRECTANGLES(mk) = value + case MKTYPE: + MK_MKTYPE(mk) = value + case X1: + MK_X1(mk) = value + case Y1: + MK_Y1(mk) = value + case X2: + MK_X2(mk) = value + case Y2: + MK_Y2(mk) = value + case NXOFFSET: + MK_NXOFFSET(mk) = value + case NYOFFSET: + MK_NYOFFSET(mk) = value + default: + call error (0, "MK_SETI: Unknown integer parameter.") + } +end + + +# MK_SETP -- Procedure to set the value of a pointer parameter. + +procedure mk_setp (mk, param, value) + +pointer mk # pointer to immark structure +int param # parameter to be fetched +pointer value # value of the pointer parameter + +begin + switch (param) { + case RADII: + MK_RADII(mk) = value + case AXES: + MK_AXES(mk) = value + case SLENGTHS: + MK_SLENGTHS(mk) = value + case RLENGTHS: + MK_RLENGTHS(mk) = value + default: + call error (0, "MK_SETP: Unknown pointer parameter.") + } +end + + +# MK_SETR -- Procedure to set the value of a real parameter. + +procedure mk_setr (mk, param, value) + +pointer mk # pointer to immark structure +int param # parameter to be fetched +real value # real parameter + +begin + switch (param) { + case RATIO: + MK_RATIO(mk) = value + case ELLIPTICITY: + MK_ELLIPTICITY(mk) = value + case RTHETA: + MK_RTHETA(mk) = value + case ETHETA: + MK_ETHETA(mk) = value + case TOLERANCE: + MK_TOLERANCE(mk) = value + default: + call error (0, "MK_SETR: Unknown real parameter.") + } +end + + +# MK_SETS -- Procedure to set the value of a string parameter. + +procedure mk_sets (mk, param, str) + +pointer mk # pointer to immark structure +int param # parameter to be fetched +char str[ARB] # output string + +int rp, ntemp +pointer sp, rtemp +int fnldir(), mk_gmarks() + +begin + switch (param) { + case IMAGE: + call strcpy (str, MK_IMAGE(mk), SZ_FNAME) + + case OUTIMAGE: + call strcpy (str, MK_OUTIMAGE(mk), SZ_FNAME) + + case COORDS: + rp = fnldir (str, MK_COORDS(mk), SZ_FNAME) + call strcpy (str[rp+1], MK_COORDS(mk), SZ_FNAME) + + case DELETIONS: + rp = fnldir (str, MK_DELETIONS(mk), SZ_FNAME) + call strcpy (str[rp+1], MK_DELETIONS(mk), SZ_FNAME) + + case LOGFILE: + rp = fnldir (str, MK_LOGFILE(mk), SZ_FNAME) + call strcpy (str[rp+1], MK_LOGFILE(mk), SZ_FNAME) + + case FONT: + rp = fnldir (str, MK_FONT(mk), SZ_FNAME) + call strcpy (str[rp+1], MK_FONT(mk), SZ_FNAME) + + case MARK: + call strcpy (str, MK_MARK(mk), SZ_FNAME) + + case CSTRING: + call smark (sp) + call salloc (rtemp, MAX_NMARKS, TY_REAL) + ntemp = mk_gmarks (str, Memr[rtemp], MAX_NMARKS) + if (ntemp > 0) { + call strcpy (str, MK_CSTRING(mk), SZ_FNAME) + MK_NCIRCLES(mk) = ntemp + call realloc (MK_RADII(mk), ntemp, TY_REAL) + call amovr (Memr[rtemp], Memr[MK_RADII(mk)], ntemp) + call asrtr (Memr[MK_RADII(mk)], Memr[MK_RADII(mk)], ntemp) + } + call sfree (sp) + + case RSTRING: + call smark (sp) + call salloc (rtemp, MAX_NMARKS, TY_REAL) + ntemp = mk_gmarks (str, Memr[rtemp], MAX_NMARKS) + if (ntemp > 0) { + call strcpy (str, MK_RSTRING(mk), SZ_FNAME) + MK_NRECTANGLES(mk) = ntemp + call realloc (MK_RLENGTHS(mk), ntemp, TY_REAL) + call amovr (Memr[rtemp], Memr[MK_RLENGTHS(mk)], ntemp) + call asrtr (Memr[MK_RLENGTHS(mk)], Memr[MK_RLENGTHS(mk)], ntemp) + } + call sfree (sp) + + default: + call error (0, "MK_SETS: Unknown string parameter.") + } +end diff --git a/pkg/images/tv/tvmark/pixelfont.inc b/pkg/images/tv/tvmark/pixelfont.inc new file mode 100644 index 00000000..92216e6d --- /dev/null +++ b/pkg/images/tv/tvmark/pixelfont.inc @@ -0,0 +1,519 @@ +data (font[i], i=1,7) / 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00000B / # (space) + +data (font[i], i=8,14) / 00100B, + 00100B, + 00100B, + 00100B, + 00100B, + 00000B, + 00100B / # ! + +data (font[i], i=15,21) / 01010B, + 01010B, + 01010B, + 00000B, + 00000B, + 00000B, + 00000B / # " + +data (font[i], i=22,28) / 01010B, + 01010B, + 11111B, + 01010B, + 11111B, + 01010B, + 01010B / # # + +data (font[i], i=29,35) / 00100B, + 01111B, + 10100B, + 01110B, + 00101B, + 11110B, + 00100B / # $ + +data (font[i], i=36,42) / 11000B, + 11001B, + 00010B, + 00100B, + 01000B, + 10011B, + 00011B / # % + +data (font[i], i=43,49) / 01000B, + 10100B, + 10100B, + 01000B, + 10101B, + 10010B, + 01101B / # & + +data (font[i], i=50,56) / 00100B, + 00100B, + 00100B, + 00000B, + 00000B, + 00000B, + 00000B / # ' + +data (font[i], i=57,63) / 00100B, + 01000B, + 10000B, + 10000B, + 10000B, + 01000B, + 00100B / # ( + +data (font[i], i=64,70) / 00100B, + 00010B, + 00001B, + 00001B, + 00001B, + 00010B, + 00100B / # ) + +data (font[i], i=71,77) / 00100B, + 10101B, + 01110B, + 00100B, + 01110B, + 10101B, + 00100B / # * + +data (font[i], i=78,84) / 00000B, + 00100B, + 00100B, + 11111B, + 00100B, + 00100B, + 00000B / # + + +data (font[i], i=85,91) / 00000B, + 00000B, + 00000B, + 00000B, + 00100B, + 00100B, + 01000B / # , + +data (font[i], i=92,98) / 00000B, + 00000B, + 00000B, + 11111B, + 00000B, + 00000B, + 00000B / # - + +data (font[i], i=99,105) / 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00100B / # . + +data (font[i], i=106,112) / 00000B, + 00001B, + 00010B, + 00100B, + 01000B, + 10000B, + 00000B / # / + +data (font[i], i=113,119) / 01110B, + 10001B, + 10011B, + 10101B, + 11001B, + 10001B, + 01110B / # 0 + +data (font[i], i=120,126) / 00100B, + 01100B, + 00100B, + 00100B, + 00100B, + 00100B, + 01110B / # 1 + +data (font[i], i=127,133) / 01110B, + 10001B, + 00001B, + 00110B, + 01000B, + 10000B, + 11111B / # 2 + +data (font[i], i=134,140) / 11111B, + 00001B, + 00010B, + 00110B, + 00001B, + 10001B, + 11111B / # 3 + +data (font[i], i=141,147) / 00010B, + 00110B, + 01010B, + 11111B, + 00010B, + 00010B, + 00010B / # 4 + +data (font[i], i=148,154) / 11111B, + 10000B, + 11110B, + 00001B, + 00001B, + 10001B, + 01110B / # 5 + +data (font[i], i=155,161) / 00111B, + 01000B, + 10000B, + 11110B, + 10001B, + 10001B, + 01110B / # 6 + +data (font[i], i=162,168) / 11111B, + 00001B, + 00010B, + 00100B, + 01000B, + 01000B, + 01000B / # 7 + +data (font[i], i=169,175) / 01110B, + 10001B, + 10001B, + 01110B, + 10001B, + 10001B, + 01110B / # 8 + +data (font[i], i=176,182) / 01110B, + 10001B, + 10001B, + 01111B, + 00001B, + 00010B, + 11100B / # 9 + +data (font[i], i=183,189) / 00000B, + 00000B, + 00100B, + 00000B, + 00100B, + 00000B, + 00000B / # : + +data (font[i], i=190,196) / 00000B, + 00000B, + 00100B, + 00000B, + 00100B, + 00100B, + 01000B / # ; + +data (font[i], i=197,203) / 00010B, + 00100B, + 01000B, + 10000B, + 01000B, + 00100B, + 00010B / # < + +data (font[i], i=204,210) / 00000B, + 00000B, + 11111B, + 00000B, + 11111B, + 00000B, + 00000B / # = + +data (font[i], i=211,217) / 01000B, + 00100B, + 00010B, + 00001B, + 00010B, + 00100B, + 01000B / # > + +data (font[i], i=218,224) / 01110B, + 10001B, + 00010B, + 00100B, + 00100B, + 00000B, + 00100B / # ? + +data (font[i], i=225,231) / 01110B, + 10001B, + 10101B, + 10111B, + 10110B, + 10000B, + 01111B / # @ + +data (font[i], i=232,238) / 00100B, + 01010B, + 10001B, + 10001B, + 11111B, + 10001B, + 10001B / # A + +data (font[i], i=239,245) / 11110B, + 10001B, + 10001B, + 11110B, + 10001B, + 10001B, + 11110B / # B + +data (font[i], i=246,252) / 01110B, + 10001B, + 10000B, + 10000B, + 10000B, + 10001B, + 01110B / # C + +data (font[i], i=253,259) / 11110B, + 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 11110B / # D + +data (font[i], i=260,266) / 11111B, + 10000B, + 10000B, + 11110B, + 10000B, + 10000B, + 11111B / # E + +data (font[i], i=267,273) / 11111B, + 10000B, + 10000B, + 11110B, + 10000B, + 10000B, + 10000B / # F + +data (font[i], i=274,280) / 01111B, + 10000B, + 10000B, + 10000B, + 10011B, + 10001B, + 01111B / # G + +data (font[i], i=281,287) / 10001B, + 10001B, + 10001B, + 11111B, + 10001B, + 10001B, + 10001B / # H + +data (font[i], i=288,294) / 01110B, + 00100B, + 00100B, + 00100B, + 00100B, + 00100B, + 01110B / # I + +data (font[i], i=295,301) / 00001B, + 00001B, + 00001B, + 00001B, + 00001B, + 10001B, + 01110B / # J + +data (font[i], i=302,308) / 10001B, + 10010B, + 10100B, + 11000B, + 10100B, + 10010B, + 10001B / # K + +data (font[i], i=309,315) / 10000B, + 10000B, + 10000B, + 10000B, + 10000B, + 10000B, + 11111B / # L + +data (font[i], i=316,322) / 10001B, + 11011B, + 10101B, + 10101B, + 10001B, + 10001B, + 10001B / # M + +data (font[i], i=323,329) / 10001B, + 10001B, + 11001B, + 10101B, + 10011B, + 10001B, + 10001B / # N + +data (font[i], i=330,336) / 01110B, + 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 01110B / # O + +data (font[i], i=337,343) / 11110B, + 10001B, + 10001B, + 11110B, + 10000B, + 10000B, + 10000B / # P + +data (font[i], i=344,350) / 01110B, + 10001B, + 10001B, + 10001B, + 10101B, + 10010B, + 01101B / # Q + +data (font[i], i=351,357) / 11110B, + 10001B, + 10001B, + 11110B, + 10100B, + 10010B, + 10001B / # R + +data (font[i], i=358,364) / 01110B, + 10001B, + 10000B, + 01110B, + 00001B, + 10001B, + 01110B / # S + +data (font[i], i=365,371) / 11111B, + 00100B, + 00100B, + 00100B, + 00100B, + 00100B, + 00100B / # T + +data (font[i], i=372,378) / 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 01110B / # U + +data (font[i], i=379,385) / 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 01010B, + 00100B / # V + +data (font[i], i=386,392) / 10001B, + 10001B, + 10001B, + 10101B, + 10101B, + 11011B, + 10001B / # W + +data (font[i], i=393,399) / 10001B, + 10001B, + 01010B, + 00100B, + 01010B, + 10001B, + 10001B / # X + +data (font[i], i=400,406) / 10001B, + 10001B, + 01010B, + 00100B, + 00100B, + 00100B, + 00100B / # Y + +data (font[i], i=407,413) / 11111B, + 00001B, + 00010B, + 00100B, + 01000B, + 10000B, + 11111B / # Z + +data (font[i], i=414,420) / 11111B, + 11000B, + 11000B, + 11000B, + 11000B, + 11000B, + 11111B / # [ + +data (font[i], i=421,427) / 00000B, + 10000B, + 01000B, + 00100B, + 00010B, + 00001B, + 00000B / # \ + +data (font[i], i=428,434) / 11111B, + 00011B, + 00011B, + 00011B, + 00011B, + 00011B, + 11111B / # ] + +data (font[i], i=435,441) / 00000B, + 00000B, + 00100B, + 01010B, + 10001B, + 00000B, + 00000B / # ^ + +data (font[i], i=442,448) / 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 11111B / # _ + +data (font[i], i=449,455) / 11111B, + 10001B, + 11011B, + 10101B, + 11011B, + 10001B, + 11111B / # (unknown) diff --git a/pkg/images/tv/tvmark/t_tvmark.x b/pkg/images/tv/tvmark/t_tvmark.x new file mode 100644 index 00000000..d1485ae1 --- /dev/null +++ b/pkg/images/tv/tvmark/t_tvmark.x @@ -0,0 +1,267 @@ +include <fset.h> +include <gset.h> +include <imhdr.h> +include <imset.h> +include "tvmark.h" + +define TV_NLINES 128 + +# T_TVMARK -- Mark dots circles and squares on the image in the image display +# with optional numbering. + +procedure t_tvmark () + +pointer image # pointer to name of the image +pointer outimage # pointer to output image +pointer coords # pointer to coordinate file +pointer deletions # the name of the deletions file +pointer logfile # pointer to the log file +pointer font # pointer to the font +int autolog # automatically log commands +int interactive # interactive mode + +pointer sp, mk, im, iw, outim, cfilename, tmpname +int cl, dl, log, ft, frame, ltid, wcs_status, ndelete, bufsize + +bool clgetb() +int access(), btoi(), clgeti(), imstati(), mk_mark() +int imd_wcsver() +pointer immap(), open(), imd_mapframe(), iw_open() + +begin + # Set standard output to flush on newline. + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate working space. + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (coords, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (deletions, SZ_FNAME, TY_CHAR) + call salloc (logfile, SZ_FNAME, TY_CHAR) + call salloc (font, SZ_FNAME, TY_CHAR) + call salloc (cfilename, SZ_FNAME, TY_CHAR) + call salloc (tmpname, SZ_FNAME, TY_CHAR) + + # Query server to get the WCS version, this also tells us whether + # we can use the all 16 supported frames. + if (imd_wcsver() == 0) + call clputi ("tvmark.frame.p_max", 4) + else + call clputi ("tvmark.frame.p_max", 16) + + frame = clgeti ("frame") + call clgstr ("coords", Memc[coords], SZ_FNAME) + call clgstr ("outimage", Memc[outimage], SZ_FNAME) + call clgstr ("deletions", Memc[deletions], SZ_FNAME) + call clgstr ("logfile", Memc[logfile], SZ_FNAME) + call clgstr ("font", Memc[font], SZ_FNAME) + call clgstr ("commands.p_filename", Memc[cfilename], SZ_FNAME) + autolog = btoi (clgetb ("autolog")) + interactive = btoi (clgetb ("interactive")) + + # Fetch the marking parameters. + call mk_gpars (mk) + + # Open the frame as an image. + im = imd_mapframe (frame, READ_WRITE, YES) + bufsize = max (imstati (im, IM_BUFSIZE), TV_NLINES * + int (IM_LEN(im,1)) * SZ_SHORT) + call imseti (im, IM_BUFSIZE, bufsize) + iw = iw_open (im, frame, Memc[image], SZ_FNAME, wcs_status) + call mk_sets (mk, IMAGE, Memc[image]) + call mk_seti (mk, FRAME, frame) + + # Open the coordinate file. + if (Memc[coords] != EOS) { + if ((interactive == NO) && (Memc[cfilename] == EOS)) { + cl = open (Memc[coords], READ_ONLY, TEXT_FILE) + dl = NULL + } else { + if (access (Memc[coords], READ_WRITE, TEXT_FILE) == YES) + cl = open (Memc[coords], READ_WRITE, TEXT_FILE) + else if (access (Memc[coords], READ_ONLY, TEXT_FILE) == YES) { + cl = open (Memc[coords], READ_ONLY, TEXT_FILE) + call printf ("Warning: File %s is read only.\n") + call pargstr (Memc[coords]) + } else { + cl = open (Memc[coords], NEW_FILE, TEXT_FILE) + call close (cl) + cl = open (Memc[coords], READ_WRITE, TEXT_FILE) + } + call sprintf (Memc[tmpname], SZ_FNAME, "%s.%s") + call pargstr (Memc[coords]) + if (Memc[deletions] == EOS) + call pargstr ("del") + else + call pargstr (Memc[deletions]) + dl = open (Memc[tmpname], NEW_FILE, TEXT_FILE) + call close (dl) + dl = open (Memc[tmpname], READ_WRITE, TEXT_FILE) + } + } else { + cl = NULL + dl = NULL + } + call mk_sets (mk, COORDS, Memc[coords]) + call mk_sets (mk, DELETIONS, Memc[deletions]) + + # Save the output mage name + call mk_sets (mk, OUTIMAGE, Memc[outimage]) + + # Open the font file. + #if (Memc[font] != EOS) + #ft = open (Memc[font], READ_ONLY, TEXT_FILE) + #else + ft = NULL + call mk_sets (mk, FONT, Memc[font]) + + # Mark the image frame. + if (interactive == NO) { + if (Memc[cfilename] != EOS) + ndelete = mk_mark (mk, im, iw, cl, dl, NULL, ft, autolog, NO) + + else { + + # Open the output image. + if (Memc[outimage] != EOS) + outim = immap (Memc[outimage], NEW_COPY, im) + else + outim = NULL + + # Do the marking. + ltid = 0 + if (cl != NULL) + call mk_bmark (mk, im, iw, cl, ltid, ft) + + # Copy / close image. + if (outim != NULL) { + call mk_imcopy (im, outim) + call imunmap (outim) + } + + ndelete = 0 + } + + } else { + + # Open the log file. + if (Memc[logfile] != EOS) + log = open (Memc[logfile], NEW_FILE, TEXT_FILE) + else + log = NULL + call mk_sets (mk, LOGFILE, Memc[logfile]) + call mk_seti (mk, AUTOLOG, autolog) + + ndelete = mk_mark (mk, im, iw, cl, dl, log, ft, autolog, YES) + + if (log != NULL) + call close (log) + } + + # Close up the file lists and free memory. + call iw_close (iw) + call imunmap (im) + if (ft != NULL) + call close (ft) + if (ndelete > 0) { + call mk_remove (Memc[coords], Memc[tmpname], cl, dl, ndelete) + if (Memc[deletions] == EOS) + call delete (Memc[tmpname]) + } else { + if (dl != NULL) { + call close (dl) + call delete (Memc[tmpname]) + } + if (cl != NULL) + call close (cl) + } + + # Free immark structure. + call mkfree (mk) + + call sfree (sp) +end + + +# MK_IMCOPY -- Make a snap of the frame buffer. + +procedure mk_imcopy (in, out) + +pointer in # pointer to the input image +pointer out # pointe to the output image + +int i, ncols, nlines +pointer sp, vin, vout, inbuf, outbuf +pointer imgnls(), impnls() +errchk imgnls(), impnls() + +begin + call smark (sp) + call salloc (vin, IM_MAXDIM, TY_LONG) + call salloc (vout, IM_MAXDIM, TY_LONG) + + ncols = IM_LEN(in, 1) + nlines = IM_LEN(in, 2) + call amovkl (long(1), Meml[vin], IM_MAXDIM) + call amovkl (long(1), Meml[vout], IM_MAXDIM) + + do i = 1, nlines { + if (impnls (out, outbuf, Meml[vout]) == EOF) + call error (0, "Error writing output image.\n") + if (imgnls (in, inbuf, Meml[vin]) == EOF) + call error (0, "Error reading frame buffer.\n") + call amovs (Mems[inbuf], Mems[outbuf], ncols) + } + + call imflush (out) + call sfree (sp) +end + + +# MK_IMSECTION -- Restore a section of an image to an image of the same +# size. + +procedure mk_imsection (mk, in, out, x1, x2, y1, y2) + +pointer mk # pointer to the mark structure +pointer in # input image +pointer out # output image +int x1, x2 # column limits +int y1, y2 # line limits + +short value +int i, ix1, ix2, iy1, iy2, ncols, nlines, mk_stati() +pointer ibuf, obuf +pointer imps2s(), imgs2s() + +begin + ncols = IM_LEN(out,1) + nlines = IM_LEN(out,2) + + ix1 = min (x1, x2) + ix2 = max (x1, x2) + ix1 = max (1, min (ncols, ix1)) + ix2 = min (ncols, max (1, ix2)) + + iy1 = min (y1, y2) + iy2 = max (y1, y2) + iy1 = max (1, min (ncols, iy1)) + iy2 = min (ncols, max (1, iy2)) + + if (in == NULL) { + value = mk_stati (mk, GRAYLEVEL) + do i = iy1, iy2 { + obuf = imps2s (out, ix1, ix2, i, i) + call amovks (value, Mems[obuf], ix2 - ix1 + 1) + } + } else { + do i = iy1, iy2 { + obuf = imps2s (out, ix1, ix2, i, i) + ibuf = imgs2s (in, ix1, ix2, i, i) + call amovs (Mems[ibuf], Mems[obuf], ix2 - ix1 + 1) + } + } + + call imflush (out) +end diff --git a/pkg/images/tv/tvmark/tvmark.h b/pkg/images/tv/tvmark/tvmark.h new file mode 100644 index 00000000..3ff484e2 --- /dev/null +++ b/pkg/images/tv/tvmark/tvmark.h @@ -0,0 +1,165 @@ +# IMMARK Task Header File + +# define IMMARK structure + +define LEN_MARKSTRUCT (40 + 10 * SZ_FNAME + SZ_LINE + 11) + +define MK_AUTOLOG Memi[$1] # Enable auto logging +define MK_NUMBER Memi[$1+1] # Number coordinate list entries +define MK_LABEL Memi[$1+2] # Label coordinate list entries +define MK_GRAYLEVEL Memi[$1+3] # Gray level of marks +define MK_SIZE Memi[$1+4] # Size of numbers and text +define MK_FRAME Memi[$1+5] # Frame number for display +define MK_NCIRCLES Memi[$1+6] # Number of circles +define MK_NELLIPSES Memi[$1+7] # Number of ellipses +define MK_NSQUARES Memi[$1+8] # Number of squares +define MK_NRECTANGLES Memi[$1+9] # Number of rectangles +define MK_MKTYPE Memi[$1+10] # Type of mark +define MK_SZPOINT Memi[$1+11] # Size of point +define MK_NXOFFSET Memi[$1+12] # X offset of number +define MK_NYOFFSET Memi[$1+13] # X offset of number + +define MK_RADII Memi[$1+14] # Pointer to list of radii +define MK_AXES Memi[$1+15] # Pointer to list of semi-major axes +define MK_SLENGTHS Memi[$1+16] # Pointer to list of square lengths +define MK_RLENGTHS Memi[$1+17] # Pointer to list of rectangle lengths + +define MK_RATIO Memr[P2R($1+18)] # Ratio of width/length rectangles +define MK_ELLIPTICITY Memr[P2R($1+19)] # Ellipticity of ellipses +define MK_RTHETA Memr[P2R($1+20)] # Position angle of rectangle +define MK_ETHETA Memr[P2R($1+21)] # Position angle of ellipse + +define MK_X1 Memi[$1+22] # LL corner x coord +define MK_Y1 Memi[$1+23] # LL corner y coord +define MK_X2 Memi[$1+24] # UR corner x coord +define MK_Y2 Memi[$1+25] # UR corner y coord + +define MK_TOLERANCE Memr[P2R($1+26)] # Tolerance for deleting objects + +define MK_IMAGE Memc[P2C($1+40)] # Image name +define MK_OUTIMAGE Memc[P2C($1+40+SZ_FNAME+1)] # Output image +define MK_COORDS Memc[P2C($1+40+2*SZ_FNAME+2)] # Coordinate file +define MK_DELETIONS Memc[P2C($1+40+3*SZ_FNAME+3)] # Deletions files +define MK_LOGFILE Memc[P2C($1+40+4*SZ_FNAME+4)] # Log file +define MK_FONT Memc[P2C($1+40+5*SZ_FNAME+5)] # Font +define MK_MARK Memc[P2C($1+40+6*SZ_FNAME+6)] # Default mark +define MK_CSTRING Memc[P2C($1+40+7*SZ_FNAME+7)] # Default circles +define MK_RSTRING Memc[P2C($1+40+8*SZ_FNAME+8)] # Default rectangles + +# define IMMARK ID's + +define AUTOLOG 1 +define NUMBER 2 +define GRAYLEVEL 3 +define SIZE 4 +define FRAME 5 +define NCIRCLES 6 +define NELLIPSES 7 +define NSQUARES 8 +define NRECTANGLES 9 +define MKTYPE 10 +define RADII 11 +define AXES 12 +define SLENGTHS 13 +define RLENGTHS 14 +define RATIO 15 +define ELLIPTICITY 16 +define RTHETA 17 +define ETHETA 18 +define IMAGE 19 +define OUTIMAGE 20 +define COORDS 21 +define LOGFILE 22 +define FONT 23 +define MARK 25 +define CSTRING 26 +define RSTRING 27 +define SZPOINT 28 +define X1 29 +define Y1 30 +define X2 31 +define Y2 32 +define NXOFFSET 33 +define NYOFFSET 34 +define LABEL 35 +define TOLERANCE 36 +define DELETIONS 37 + +# define mark types + +define MKTYPELIST "|point|circle|rectangle|line|plus|cross|none|" + +define MK_POINT 1 +define MK_CIRCLE 2 +define MK_RECTANGLE 3 +define MK_LINE 4 +define MK_PLUS 5 +define MK_CROSS 6 +define MK_NONE 7 + +# define the fonts + +define MKFONTLIST "|raster|" + +# define IMMARK commands + +define MKCMD_IMAGE 1 +define MKCMD_OUTIMAGE 2 +define MKCMD_COORDS 3 +define MKCMD_LOGFILE 4 +define MKCMD_AUTOLOG 5 +define MKCMD_FRAME 6 +define MKCMD_FONT 7 +define MKCMD_NUMBER 8 +define MKCMD_GRAYLEVEL 9 +define MKCMD_SIZE 10 +define MKCMD_SZPOINT 11 +define MKCMD_MARK 12 +define MKCMD_CIRCLES 13 +define MKCMD_RECTANGLES 14 +define MKCMD_SHOW 15 +define MKCMD_SNAP 16 +define MKCMD_NXOFFSET 17 +define MKCMD_NYOFFSET 18 +define MKCMD_SAVE 19 +define MKCMD_RESTORE 20 +define MKCMD_LABEL 21 +define MKCMD_TOLERANCE 22 +define MKCMD_DELETIONS 23 + +define MKCMD2_WTEXT 1 +define MKCMD2_MOVE 2 +define MKCMD2_NEXT 3 + + +# define IMMARK keywords + +define KY_IMAGE "image" +define KY_OUTIMAGE "outimage" +define KY_COORDS "coords" +define KY_LOGFILE "logfile" +define KY_AUTOLOG "autolog" +define KY_FRAME "frame" +define KY_FONT "font" +define KY_NUMBER "number" +define KY_GRAYLEVEL "color" +define KY_SIZE "txsize" +define KY_SZPOINT "pointsize" +define KY_MARK "mark" +define KY_CIRCLES "radii" +define KY_RECTANGLE "lengths" +define KY_NXOFFSET "nxoffset" +define KY_NYOFFSET "nyoffset" +define KY_RATIO "ratio" +define KY_LABEL "label" +define KY_TOLERANCE "tolerance" +define KY_DELETIONS "deletions" + + +define MKCMDS "|junk|outimage|coords|logfile|autolog|frame|font|number|color|txsize|pointsize|mark|radii|lengths|show|write|nxoffset|nyoffset|save|restore|label|tolerance|deletions|" + +define MKCMDS2 "|text|move|next|" + +# miscellaneous + +define MAX_NMARKS 100 diff --git a/pkg/images/tv/vimexam.par b/pkg/images/tv/vimexam.par new file mode 100644 index 00000000..1e77fb54 --- /dev/null +++ b/pkg/images/tv/vimexam.par @@ -0,0 +1,24 @@ +banner,b,h,yes,,,"Standard banner" +title,s,h,"",,,"Title" +xlabel,s,h,"Vector Distance",,,"X-axis label" +ylabel,s,h,"Pixel Value",,,"Y-axis label" +naverage,i,h,1,1,,"averaging width of strip" +boundary,s,h,"constant",constant|nearest|reflect|wrap|project,,"type of boundary extension to use" +constant,r,h,0.,,,"the constant for constant-valued boundary extension" + +x1,r,h,INDEF,,,X-axis window limit +x2,r,h,INDEF,,,X-axis window limit +y1,r,h,INDEF,,,Y-axis window limit +y2,r,h,INDEF,,,Y-axis window limit +pointmode,b,h,no,,,plot points instead of lines? +marker,s,h,"plus",,,point marker character? +szmarker,r,h,1.,,,marker size +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +box,b,h,yes,,,draw box around periphery of window +ticklabels,b,h,yes,,,label tick marks +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values? diff --git a/pkg/images/tv/wcslab.par b/pkg/images/tv/wcslab.par new file mode 100644 index 00000000..6407cc5a --- /dev/null +++ b/pkg/images/tv/wcslab.par @@ -0,0 +1,15 @@ +# Parameter file for WCSLAB + +image,f,a,,,,"Input image" +frame,i,a,1,,,"Default frame number for image display" +usewcs,b,h,no,,,"Use the world coordinate system definition parameters" +wcspars,pset,h,"",,,"World coordinate system definition parameters" +wlpars,pset,h,"",,,"World coordinate system labeling parameters" +fill,b,h,yes,,,"Fill the viewport ?" +vl,r,h,INDEF,0.0,1.0,"Left edge of viewport (0.0:1.1)" +vr,r,h,INDEF,0.0,1.0,"Right edge of viewport (0.0:1.0)" +vb,r,h,INDEF,0.0,1.0,"Bottom edge of viewport (0.0:1.0)" +vt,r,h,INDEF,0.0,1.0,"Top edge of viewport (0.0:1.0)" +overplot,b,h,no,,,"Overplot to an existing plot?" +append,b,h,no,,,"Append to an existing plot?" +device,s,h,"imd",,,"Graphics device" diff --git a/pkg/images/tv/wcslab/mkpkg b/pkg/images/tv/wcslab/mkpkg new file mode 100644 index 00000000..e88e46cb --- /dev/null +++ b/pkg/images/tv/wcslab/mkpkg @@ -0,0 +1,24 @@ +# WCSLAB + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$checkout libds.a ../ +$update libds.a +$checkin libds.a ../ +$exit + +libpkg.a: + t_wcslab.x <gset.h> <imhdr.h> + ; + +libds.a: + wlutil.x <imio.h> <imhdr.h> <gset.h> <math.h> + wcslab.x <gset.h> <imhdr.h> <mwset.h> <math.h> "wcslab.h"\ + "wcs_desc.h" <ctype.h> + wlwcslab.x <gio.h> <gset.h> "wcslab.h" "wcs_desc.h" + wlsetup.x <gset.h> <mach.h> <math.h> <math/curfit.h>\ + "wcslab.h" "wcs_desc.h" + wlgrid.x <gset.h> <math.h> "wcslab.h" "wcs_desc.h" + wllabel.x <gset.h> <math.h> "wcslab.h" "wcs_desc.h" + ; diff --git a/pkg/images/tv/wcslab/t_wcslab.x b/pkg/images/tv/wcslab/t_wcslab.x new file mode 100644 index 00000000..53d5f352 --- /dev/null +++ b/pkg/images/tv/wcslab/t_wcslab.x @@ -0,0 +1,137 @@ +include <gset.h> +include <imhdr.h> + +# T_WCSLAB -- Procedure to draw labels and grids in sky projection coordinates. +# +# Description +# T_wcslab produces a labelling and grid based on the MWCS of a +# specified image. This is the task interface to the programmer interface +# wcslab. See wcslab.x for more information. +# +# Bugs +# Can only handle sky projections for Right Ascension/Declination. This +# should be able to deal with any of the projections for this system, but +# has only been tested with the Tangent projection. +# + +procedure t_wcslab() + +pointer image # I: name of the image +int frame # I: display frame containing the image +bool do_fill # I: true if the graph fills the specified viewport +int mode # I: the graphics stream mode +pointer device # I: the name of the graphics device +real vl, vr, vb, vt # I: the edges of the graphics viewport + +pointer sp, title, gp, im, mw +real c1, c2, l1, l2 +bool clgetb() +int clgeti(), strncmp() +pointer gopen(), immap(), mw_openim() +real clgetr() + +begin + # Get memory. + call smark (sp) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + + # Since all the MWCS information comes from an image open it. + call clgstr ("image", Memc[image], SZ_FNAME) + + if (Memc[image] != EOS) { + + # Open the image. + im = immap (Memc[image], READ_ONLY, 0) + + # Quit if the image is not 2-dimensional. + if (IM_NDIM(im) != 2) { + call eprintf ("Image: %s is not 2-dimensional\n") + call pargstr (Memc[image]) + call sfree (sp) + return + } + + # Set the default input image column and line limits. + c1 = 1.0 + c2 = real (IM_LEN(im,1)) + l1 = 1.0 + l2 = real (IM_LEN(im,2)) + + # Open the WCS. + mw = mw_openim (im) + + # Set up the default image title. + call strcpy (Memc[image], Memc[title], SZ_LINE) + call strcat (": ", Memc[title], SZ_LINE) + call strcat (IM_TITLE(im), Memc[title], SZ_LINE) + + } else { + + # Set the image information to undefined. All this will + # be determined in wcslab. + Memc[title] = EOS + im = NULL + mw = NULL + c1 = 0.0 + c2 = 1.0 + l1 = 0.0 + l2 = 1.0 + } + + # Set the graphics mode depending on whether we are appending to a plot + # or starting a new plot. + do_fill = clgetb ("fill") + if (clgetb ("overplot")) + mode = APPEND + else + mode = NEW_FILE + + # Open graphics. + call clgstr ("device", Memc[device], SZ_FNAME) + + # If we are appending, get the previous viewing parameters. + if (clgetb ("append")) { + + gp = gopen (Memc[device], APPEND, STDGRAPH) + call ggview (gp, vl, vr, vb, vt) + do_fill = true + + # If drawing on the image display device try to match viewports. + } else if (strncmp (Memc[device], "imd", 3) == 0) { + + frame = clgeti ("frame") + vl = clgetr ("vl") + vr = clgetr ("vr") + vb = clgetr ("vb") + vt = clgetr ("vt") + if (im != NULL) + call wl_imd_viewport (frame, im, c1, c2, l1, l2, vl, vr, vb, vt) + gp = gopen (Memc[device], mode, STDGRAPH) + + # Otherwise set up a standard viewport. + } else { + vl = clgetr ("vl") + vr = clgetr ("vr") + vb = clgetr ("vb") + vt = clgetr ("vt") + gp = gopen (Memc[device], mode, STDGRAPH) + } + + # Set the viewport. + call gseti (gp, G_WCS, 1) + call wl_map_viewport (gp, c1, c2, l1, l2, vl, vr, vb, vt, do_fill) + + # All reading from CL parameters is now done. Everything necessary to + # do the plotting is in the WCSLAB descriptor. Do it. + call wcslab (mw, c1, c2, l1, l2, gp, Memc[title]) + + # Release the memory. + call gclose (gp) + if (mw != NULL) + call mw_close (mw) + if (im != NULL) + call imunmap (im) + call sfree (sp) +end diff --git a/pkg/images/tv/wcslab/wcs_desc.h b/pkg/images/tv/wcslab/wcs_desc.h new file mode 100644 index 00000000..4f6b2a30 --- /dev/null +++ b/pkg/images/tv/wcslab/wcs_desc.h @@ -0,0 +1,219 @@ +# WCS_DESC - The definition of the WCSLAB descriptor memory structure. +# +# Description +# This include file defines the memory structures and macros needed to +# access elements of a WCSLAB descriptor. The descriptor provides all +# the necessary elements for the routine wcslab to produce a labeled +# graph. +# +# History +# 9May91 - Created the descriptor. Jonathan D. Eisenhamer, STScI. +# 15May91 - Modified the descriptor to contain only pointers to arrays. +# Two routines, wcs_create and wcs_destroy are required to +# create the arrays that are pointed to in the descriptor. +# Also seperated the include file from the wcslab.h file. jde +# 12Jun91 - Rewrote some of the labelling parameters. jde +# 20Jun91 - Redesigned much of the parameters. jde +#--------------------------------------------------------------------------- + +# Value of opposite axis that polar labels should appear along. +define WL_POLAR_LABEL_POSITION Memd[P2D($1)] + +# The rotation between the Logical and World coordinate systems. +define WL_ROTA Memd[P2D($1+2)] + +# Size of the axis titles. +define WL_AXIS_TITLE_SIZE Memr[P2R($1+4)] + +# The offset required to properly calculate positions in the image display. +define WL_IMAGE_X_OFF Memr[P2R($1+5)] +define WL_IMAGE_Y_OFF Memr[P2R($1+6)] + +# Size of the grid labels. +define WL_LABEL_SIZE Memr[P2R($1+7)] + +# Major tick mark size. +define WL_MAJ_TICK_SIZE Memr[P2R($1+8)] + +# Minor tick mark size. +define WL_MIN_TICK_SIZE Memr[P2R($1+9)] + +# Magnification of the text size for the title. +define WL_TITLE_SIZE Memr[P2R($1+10)] + +# The side in polar/near-polar plots not to put Axis 1 labels. +define WL_BAD_LABEL_SIDE Memi[$1+11] + +# The type of graph that will be produced. The possible value are: +# +# UNKNOWN -> Graph type will be determined +# NORMAL -> Approximate a cartesian grid +# POLAR -> Graph center on a pole +# NEAR_POLAR -> Graph very close to a pole + +define WL_GRAPH_TYPE Memi[$1+12] + +# Number of segments each line should be broken into to plot it. +define WL_LINE_SEGMENTS Memi[$1+13] + +# The grid line type for major grids. The possible values are to standard +# IRAF GIO polyline types. +define WL_MAJ_LINE_TYPE Memi[$1+14] + +# The grid line type for minor grids. The possible values are to standard +# IRAF GIO polyline types. +define WL_MIN_LINE_TYPE Memi[$1+15] + +# The number of label points. +define WL_N_LABELS Memi[$1+16] + +# The graphic WCS that is set to NDC units. +define WL_NDC_WCS Memi[$1+17] + +# The graphic WCS used to plot the grid lines. +define WL_PLOT_WCS Memi[$1+18] + +# The direction of the latitude labelling on polar graphs. Possible values are: +# +# BOTTOM -> Towards the bottom of the graph. +# TOP -> Towards the top of the graph. +# RIGHT -> Towards the right of the graph. +# LEFT -> Towards the left of the graph. + +define WL_POLAR_LABEL_DIRECTION Memi[$1+19] + +# The possible axis types. The possible values are: +# +# RA_DEC_TAN - The tangential display in right ascension and declination. +# LINEAR - General linear systems. + +define WL_SYSTEM_TYPE Memi[$1+20] + +# Define which side of the graph will have the title. +define WL_TITLE_SIDE Memi[$1+21] + +# True if the axis mapping has reversed the order of the axis relative +# to the logical system. +define WL_AXIS_FLIP Memi[$1+22] + +# TRUE if the labels should always be printed in full form. +define WL_ALWAYS_FULL_LABEL Memi[$1+23] + +# TRUE if the grid labels should rotate with the grid lines. +define WL_LABEL_ROTATE Memi[$1+26] + +# True if coordinate labels are to be written. +define WL_LABON Memi[$1+27] + +# True if we are to write labels outside the window borders. Else, write +# them inside. +define WL_LABOUT Memi[$1+28] + +# True if we are to draw the major grid lines. +define WL_MAJ_GRIDON Memi[$1+29] + +# True if we are to draw the minor grid lines. +define WL_MIN_GRIDON Memi[$1+30] + +# True if the graph parameters should be written back out to the +# parameter file. +define WL_REMEMBER Memi[$1+31] + +# TRUE if tick marks should point into the graph. +define WL_TICK_IN Memi[$1+32] + +# Titles to label each axis. +define WL_AXIS_TITLE_PTR Memi[$1+33] +define WL_AXIS_TITLE Memc[WL_AXIS_TITLE_PTR($1)+(($2-1)*SZ_LINE)] + +# The sides the axis titles will appear. +define WL_AXIS_TITLE_SIDE_PTR Memi[$1+34] +define WL_AXIS_TITLE_SIDE Memi[WL_AXIS_TITLE_SIDE_PTR($1)+$2-1] + +# Beginning values to start labeling the axes. +define WL_BEGIN_PTR Memi[$1+35] +define WL_BEGIN Memd[WL_BEGIN_PTR($1)+$2-1] + +# The name of the graphics device. +#define WL_DEVICE_PTR Memi[$1+36] +#define WL_DEVICE Memc[WL_DEVICE_PTR($1)] + +# Value to stop labeling the axes. +define WL_END_PTR Memi[$1+37] +define WL_END Memd[WL_END_PTR($1)+$2-1] + +# The graphics descriptor. +define WL_GP Memi[$1+38] + +# The angle of text at this label point. +define WL_LABEL_ANGLE_PTR Memi[$1+40] +define WL_LABEL_ANGLE Memd[WL_LABEL_ANGLE_PTR($1)+$2-1] + +# Which axis the label represents. +define WL_LABEL_AXIS_PTR Memi[$1+41] +define WL_LABEL_AXIS Memi[WL_LABEL_AXIS_PTR($1)+$2-1] + +# The positions of tick mark/grid labels. +define WL_LABEL_POSITION_PTR Memi[$1+42] +define WL_LABEL_POSITION Memd[WL_LABEL_POSITION_PTR($1)+$2-1+(($3-1)*MAX_LABEL_POINTS)] +# +# NOTE: If the axis are transposed, the positions represented here are +# the corrected, transposed values. + +# The sides the labels for each axis should appear on. +define WL_LABEL_SIDE_PTR Memi[$1+43] +define WL_LABEL_SIDE Memb[WL_LABEL_SIDE_PTR($1)+$2-1+(($3-1)*N_SIDES)] + +# The value of the label. +define WL_LABEL_VALUE_PTR Memi[$1+44] +define WL_LABEL_VALUE Memd[WL_LABEL_VALUE_PTR($1)+$2-1] + +# The center of the transformations in the logical system. +define WL_LOGICAL_CENTER_PTR Memi[$1+45] +define WL_LOGICAL_CENTER Memd[WL_LOGICAL_CENTER_PTR($1)+$2-1] + +# The coordinate transformation from Logical to World. +define WL_LWCT Memi[$1+46] + +# Major grid intervals for the axis. +define WL_MAJ_I_PTR Memi[$1+47] +define WL_MAJOR_INTERVAL Memd[WL_MAJ_I_PTR($1)+$2-1] + +# The minor intervals for the axis. +define WL_MIN_I_PTR Memi[$1+48] +define WL_MINOR_INTERVAL Memi[WL_MIN_I_PTR($1)+$2-1] + +# Remember the extent of the labels around the plot box. +define WL_NV_PTR Memi[$1+49] +define WL_NEW_VIEW Memr[WL_NV_PTR($1)+$2-1] + +# The MWL structure. +define WL_MW Memi[$1+50] + +# The values of the sides of the screen. The indexes are defined as follows: +# +# TOP -> Y-axis value at the top of display. +# BOTTOM -> Y-axis value at bottom of display +# RIGHT -> X-axis value at right of display. +# LEFT -> X-axis value at left of display. +# +define WL_SCREEN_BOUNDARY_PTR Memi[$1+51] +define WL_SCREEN_BOUNDARY Memd[WL_SCREEN_BOUNDARY_PTR($1)+$2-1] + +# The title that will be placed on the plot. +define WL_TITLE_PTR Memi[$1+52] +define WL_TITLE Memc[WL_TITLE_PTR($1)] + +# The coordinate transformation from World to Logical. +define WL_WLCT Memi[$1+53] + +# The center of the transformations in the world system. +define WL_WORLD_CENTER_PTR Memi[$1+54] +define WL_WORLD_CENTER Memd[WL_WORLD_CENTER_PTR($1)+$2-1] + +# The length of this structure. +define WL_LEN 55+1 + +#--------------------------------------------------------------------------- +# End of wcs_desc +#--------------------------------------------------------------------------- diff --git a/pkg/images/tv/wcslab/wcslab.h b/pkg/images/tv/wcslab/wcslab.h new file mode 100644 index 00000000..d458d8da --- /dev/null +++ b/pkg/images/tv/wcslab/wcslab.h @@ -0,0 +1,98 @@ +# Definitions file for WCSLAB + +# Define various important dimensions + +define MAX_DIM 10 # Maximum number of dimensions +define N_DIM 2 # Dimensionality of plotting space +define N_SIDES 4 # Number of sides to a window +define MAX_LABEL_POINTS 100 # The maximum number of possible label points +define N_EDGES 20 # Number of edges being examined from the window + +# Define the types of graphs possible. + +define GRAPHTYPES "|normal|polar|near_polar|" +define NORMAL 1 +define POLAR 2 +define NEAR_POLAR 3 + +# Define the graph sides. The ordering matches the calls to the GIO package. + +define GRAPHSIDES "|left|right|bottom|top|" +define LEFT 1 +define RIGHT 2 +define BOTTOM 3 +define TOP 4 + +# Define which index refers to the X-axis and which refers to the Y-axis. + +define X_DIM 1 +define Y_DIM 2 +define AXIS1 1 +define AXIS2 2 + +# Define which axis is longitude and which axis is latitude. + +define LONGITUDE 1 +define LATITUDE 2 + +# Define the available precisions for labelling + +define HOUR 1 +define DEGREE 1 +define MINUTE 2 +define SECOND 3 +define SUBSEC_LOW 4 +define SUBSEC_HIGH 5 + +# Define the possible MWCS transformation types. + +define RA_DEC_DICTIONARY "|tan|arc|sin|tnx|" +define LINEAR_DICTIONARY "|linear|" + +define NUMBER_OF_SUPPORTED_TYPES 2 +define RA_DEC 1 +define LINEAR 2 + +define AXIS 3B # transform all axes in any MWCS call + +# Some useful graphics definitions and defaults + +define NDC_WCS 0 # the base graphics WCS +define POLE_MARK_SHAPE 4 # the pole mark is a cross +define POLE_MARK_SIZE 3.0 # the half-size of the cross +define DISTANCE_TO_POLE 0.1 # % distance to pole for lines of longitude +define LINE_SIZE 1. # line width for lines and ticks +define MIN_ANGLE 10. # minimum angle for text rotation +define BOTTOM_LEFT .1 # default bottom left corner of viewport +define TOP_RIGHT .9 # default top right corner of viewport + +# Units conversion macros + +define RADTOST (240*RADTODEG($1)) # Radians to seconds of time +define RADTOSA (3600*RADTODEG($1)) # Radians to seconds of arc +define STTORAD (DEGTORAD(($1)/240)) # Seconds of time to radians +define SATORAD (DEGTORAD(($1)/3600)) # Seconds of arc to radians +define RADTOHRS (RADTODEG(($1)/15)) # Radians to hours +define HRSTORAD (DEGTORAD(15*($1))) # Hours to radians +define DEGTOST (240*($1)) # Degrees to seconds of time. +define STTODEG (($1)/240) # Seconds of time to degrees. +define DEGTOSA (3600*($1)) # Degrees to seconds of arc. +define SATODEG (($1)/3600) # Seconds of arc to degrees. +define HRSTODEG (($1)*15) # Hours to degrees. +define DEGTOHRS (($1)/15) # Degrees to hours. +define STPERDAY 86400 # Seconds per day + +# Other useful macros + +define INVERT ($1 < 45 || $1 > 315 || ( $1 > 135 && $1 < 225 )) + +# Define the latitudes of the north and south poles + +define NORTH_POLE_LATITUDE 90.0D0 +define SOUTH_POLE_LATITUDE -90.0D0 + +# Define sections of a circle + +define QUARTER_CIRCLE 90.0D0 +define HALF_CIRCLE 180.0D0 +define FULL_CIRCLE 360.0D0 diff --git a/pkg/images/tv/wcslab/wcslab.x b/pkg/images/tv/wcslab/wcslab.x new file mode 100644 index 00000000..a084ae91 --- /dev/null +++ b/pkg/images/tv/wcslab/wcslab.x @@ -0,0 +1,940 @@ +include <gset.h> +include <imhdr.h> +include <math.h> +include <mwset.h> +include "wcslab.h" +include "wcs_desc.h" +include <ctype.h> + + +# WCSLAB -- Procedure to draw labels and grids in sky projection coordinates. +# +# Description +# Wcslab produces a labelling and grid based on the MWCS of a +# specified image. +# +# The only things necessary to run this routine are: +# 1) Open an image and pass the image descriptor in im. +# 2) Open the graphics device and set the desired viewport (with a +# gsview call). +# 3) Make sure that the wlpars pset is available. +# +# Upon return, the graphics system will be in the state that it had been +# left in and a "virtual viewport" will be returned in the arguments +# left, right, bottom, top. This viewport defines the region where labels +# and/or titles were written. If any graphics is performed within this +# region, chances are that something will be overwritten. If any other +# graphics remain outside this region, then what was produced by this +# subroutine will remain untouched. +# +# Bugs +# Can only handle sky projections for Right Ascension/Declination. This +# should be able to deal with any of the projections for this system, but +# has only been tested with the Tangent projection. + +procedure wcslab (mw, log_x1, log_x2, log_y1, log_y2, gp, title) + +pointer mw # I: the wcs descriptor +real log_x1, log_x2 # I/O: the viewport +real log_y1, log_y2 # I/O: the viewport +pointer gp # I: the graphics descriptor +char title[ARB] # I: the image title + +pointer wd +real junkx1, junkx2, junky1, junky2 +bool clgetb() +pointer wl_create() +errchk clgstr + +begin + # Allocate the descriptor. + wd = wl_create() + + # Set the title name. + call strcpy (title, WL_TITLE(wd), SZ_LINE) + + # Set the WCS descriptor. If the descriptor is NULL or if + # the use_wcs parameter is yes, retrieve the parameter + # specified wcs. + if (mw == NULL) + call wl_wcs_params (mw, log_x1, log_x2, log_y1, log_y2) + else if (clgetb ("usewcs")) { + call mw_close (mw) + call wl_wcs_params (mw, junkx1, junkx2, junky1, junky2) + } + WL_MW(wd) = mw + + # Determine axis types. + call wl_get_system_type (WL_MW(wd), WL_SYSTEM_TYPE(wd), + WL_LOGICAL_CENTER(wd,1), WL_WORLD_CENTER(wd,1), WL_AXIS_FLIP(wd)) + if (IS_INDEFI(WL_SYSTEM_TYPE(wd))) + call error (0, "WCSLAB: Image WCS is unsupported\n") + + # Get the parameters. + call wl_gr_inparams (wd) + + # Copy the graphics descriptor. + WL_GP(wd) = gp + + # Set the plot window in pixels (the logical space of the WCS). + WL_SCREEN_BOUNDARY(wd,LEFT) = log_x1 + WL_SCREEN_BOUNDARY(wd,RIGHT) = log_x2 + WL_SCREEN_BOUNDARY(wd,BOTTOM) = log_y1 + WL_SCREEN_BOUNDARY(wd,TOP) = log_y2 + + # Plot and label the coordinate grid. + call wl_wcslab (wd) + + # Return the possibly modified graphics descriptor and viewport. + gp = WL_GP(wd) + call gsview (gp, WL_NEW_VIEW(wd,LEFT), WL_NEW_VIEW(wd,RIGHT), + WL_NEW_VIEW(wd,BOTTOM), WL_NEW_VIEW(wd,TOP)) + + # Save the current parameters. + if (WL_REMEMBER(wd) == YES) + call wl_gr_remparams (wd) + + # Release the memory. + call wl_destroy (wd) +end + + +# WL_CREATE -- Create a WCSLAB descriptor and initialize it. +# +# Description +# This routine allocates the memory for the WCSLAB descriptor and +# subarrays and initializes values. +# +# Returns +# the pointer to the WCSLAB descriptor. + +pointer procedure wl_create() + +int i,j +pointer wd + +begin + # Allocate the descriptor memory. + call malloc (wd, WL_LEN, TY_STRUCT) + + # Allocate the subarrays. + call malloc (WL_AXIS_TITLE_PTR(wd), SZ_LINE * N_DIM, TY_CHAR) + call malloc (WL_AXIS_TITLE_SIDE_PTR(wd), N_SIDES * N_DIM, TY_INT) + call malloc (WL_BEGIN_PTR(wd), N_DIM, TY_DOUBLE) + call malloc (WL_END_PTR(wd), N_DIM, TY_DOUBLE) + call malloc (WL_LABEL_ANGLE_PTR(wd), MAX_LABEL_POINTS, TY_DOUBLE) + call malloc (WL_LABEL_AXIS_PTR(wd), MAX_LABEL_POINTS, TY_INT) + call malloc (WL_LABEL_POSITION_PTR(wd), N_DIM * MAX_LABEL_POINTS, + TY_DOUBLE) + call malloc (WL_LABEL_SIDE_PTR(wd), N_DIM * N_SIDES, TY_INT) + call malloc (WL_LABEL_VALUE_PTR(wd), MAX_LABEL_POINTS, TY_DOUBLE) + call malloc (WL_LOGICAL_CENTER_PTR(wd), N_DIM, TY_DOUBLE) + call malloc (WL_MAJ_I_PTR(wd), N_DIM, TY_DOUBLE) + call malloc (WL_MIN_I_PTR(wd), N_DIM, TY_INT) + call malloc (WL_NV_PTR(wd), N_SIDES, TY_REAL) + call malloc (WL_SCREEN_BOUNDARY_PTR(wd), N_SIDES, TY_DOUBLE) + call malloc (WL_TITLE_PTR(wd), SZ_LINE, TY_CHAR) + call malloc (WL_WORLD_CENTER_PTR(wd), N_DIM, TY_DOUBLE) + + # Initialize the simple values (should be the same as the parameter + # file). + WL_POLAR_LABEL_POSITION(wd) = INDEF + WL_AXIS_TITLE_SIZE(wd) = 1.5 + WL_LABEL_SIZE(wd) = 1.0 + WL_MAJ_TICK_SIZE(wd) = .03 + WL_MIN_TICK_SIZE(wd) = .01 + WL_TITLE_SIZE(wd) = 2.0 + WL_GRAPH_TYPE(wd) = INDEFI + WL_MAJ_LINE_TYPE(wd) = GL_SOLID + WL_MIN_LINE_TYPE(wd) = GL_DOTTED + WL_TITLE_SIDE(wd) = TOP + WL_ALWAYS_FULL_LABEL(wd) = NO + WL_LABEL_ROTATE(wd) = YES + WL_LABON(wd) = YES + WL_LABOUT(wd) = YES + WL_MAJ_GRIDON(wd) = YES + WL_MIN_GRIDON(wd) = NO + WL_REMEMBER(wd) = NO + WL_TICK_IN(wd) = YES + + # Initialize any strings. + call strcpy ("imtitle", WL_TITLE(wd), SZ_LINE) + + # Initialize the axis dependent values. + do i = 1, N_DIM { + WL_AXIS_TITLE(wd,i) = EOS + WL_AXIS_TITLE_SIDE(wd,i) = INDEFI + WL_BEGIN(wd,i) = INDEFD + WL_END(wd,i) = INDEFD + WL_MAJOR_INTERVAL(wd,i) = INDEFD + WL_MINOR_INTERVAL(wd,i) = 5 + do j = 1, N_SIDES + WL_LABEL_SIDE(wd,j,i) = false + } + + # Return the descriptor. + return (wd) +end + + +# WL_WCS_PARAMS -- Read the WCS descriptor from the parameters. +# +# Description +# This procedure returns the WCS descriptor created from task parameters +# and the logical space that will be graphed. +# +# Bugs +# This only deals with two axes. + +procedure wl_wcs_params (mw, log_x1, log_x2, log_y1, log_y2) + +pointer mw # O: The MWCS descriptor. +real log_x1, log_x2, # O: The extent of the logical space to graph. +real log_y1, log_y2 + +real cd[2,2], r[2], w[2] +pointer sp, input, pp +pointer clopset(), mw_open() +real clgpsetr() + +begin + call smark (sp) + call salloc (input, SZ_LINE, TY_CHAR) + + # Open the pset. + pp = clopset ("wcspars") + + # Create an MWCS descriptor. + mw = mw_open (NULL, 2) + + # Get the types. + call clgpset (pp, "ctype1", Memc[input], SZ_LINE) + call wl_decode_ctype (mw, Memc[input], 1) + call clgpset (pp, "ctype2", Memc[input], SZ_LINE) + call wl_decode_ctype (mw, Memc[input], 2) + + # Get the reference coordinates. + r[1] = clgpsetr (pp, "crpix1") + r[2] = clgpsetr (pp, "crpix2") + w[1] = clgpsetr (pp, "crval1") + w[2] = clgpsetr (pp, "crval2") + + # Get the CD matrix. + cd[1,1] = clgpsetr (pp, "cd1_1") + cd[1,2] = clgpsetr (pp, "cd1_2") + cd[2,1] = clgpsetr (pp, "cd2_1") + cd[2,2] = clgpsetr (pp, "cd2_2") + + # Set the Wterm. + call mw_swtermr (mw, r, w, cd, 2) + + # Get the extent of the logical space. + log_x1 = clgpsetr (pp, "log_x1") + log_x2 = clgpsetr (pp, "log_x2") + log_y1 = clgpsetr (pp, "log_y1") + log_y2 = clgpsetr (pp, "log_y2") + + # Close the pset. + call clcpset (pp) + + call sfree (sp) +end + + +# WL_DECODE_CTYPE -- Decode the ctype string into axis type and system type. +# +# Description +# The CTYPE is what is found in FITS keywords CTYPEn. The value may +# contain two pieces of information, always the system type and possibly +# an individual axis type. For systems such as plain old linear systems +# just a system type is defined. However, for celestial systems, both +# types are defined in the form "axistype-systemtype". There may be +# any number of '-' in between the values. + +procedure wl_decode_ctype (mw, input, axno) + +pointer mw # I: the MWCS descriptor +char input[ARB] # I: the string input +int axno # I: the axis being worked on + +int i, input_len, axes[2] +int strncmp(), strldx(), strlen() +string empty "" + +begin + input_len = strlen (input) + + # Fix some characters. + do i = 1, input_len { + if (input[i] == ' ' || input[i] == '\'') + break + else if (IS_UPPER(input[i])) + input[i] = TO_LOWER(input[i]) + else if (input[i] == '_') + input[i] = '-' + } + + # Determine the type of function on this axis. + if (strncmp (input, "linear", 6) == 0) { + call mw_swtype (mw, axno, 1, "linear", empty) + + } else if (strncmp (input, "ra--", 4) == 0) { + axes[1] = axno + if (axno == 1) + axes[2] = 2 + else + axes[2] = 1 + i = strldx ("-", input) + 1 + call mw_swtype (mw, axes, 2, input[i], + "axis 1: axtype = ra axis 2: axtype=dec") + + # This is dealt with in the ra case. + } else if (strncmp (input, "dec-", 4) == 0) { + ; + + } else { + # Since we have to be able to read any FITS header, we have + # no control over the value of CTYPEi. If the value is + # something we don't know about, assume a LINEAR axis, using + # the given value of CTYPEi as the default axis label. + call mw_swtype (mw, axno, 1, "linear", empty) + call mw_swattrs (mw, axno, "label", input) + } + +end + + +# WL_GET_SYSTEM_TYPE -- Determine type of transformation the MWCS represents. +# +# Note +# For some systems, the axis mapping reverses the order to make +# the rest of the code tractable. The only problem is that when graphing, +# the graph routines need to "fix" this reversal. Also note that this +# occurs only for systems that have distinct axis types, such as RA and +# DEC. +# +# Bugs +# A potential problem: For a WCS that has more axes than necessary +# for the sky projections, those axis are set such that during +# transformations, the first index position is used. For the one +# example I have seen, the "third" axis is time and this interpretation +# works. But, I am sure something will fall apart because of this. + +procedure wl_get_system_type (mw, system_type, logical_center, world_center, + flip) + +pointer mw # I: the MWCS descriptor. +int system_type # O: the transformation type: + # RA_DEC -> tan, sin, or arc projection + # in right ascension and + # declination + # LINEAR -> any regular linear system + # INDEFI -> could not be determined +double logical_center[N_DIM] # O: the center point in the logical system. +double world_center[N_DIM] # O: the center point in the world system. +int flip # O: true if the order of the axes have been + # changed by axis mappins + +double tmp_logical[MAX_DIM], tmp_world[MAX_DIM] +int wcs_dim, axis, index_sys1, index_sys2, found_axis +int axno[MAX_DIM], axval[MAX_DIM], found_axis_list[N_DIM] +pointer sp, axtype, cd, cur_type +int mw_stati(), strncmp(), strdic() +errchk mw_gwattrs + +begin + # Get some memory. + call smark (sp) + call salloc (axtype, SZ_LINE, TY_CHAR) + call salloc (cur_type, SZ_LINE, TY_CHAR) + call salloc (cd, MAX_DIM, TY_DOUBLE) + + # Get the dimensionality of the WCS. + call mw_seti (mw, MW_USEAXMAP, NO) + wcs_dim = mw_stati (mw, MW_NDIM) + + # Initialize the two dimensions. + index_sys1 = INDEFI + index_sys2 = INDEFI + + # Look through the possible supported axis types. When a type has + # exactly N_DIM axes defined, that will be the one used. + + for (system_type = 1; system_type <= NUMBER_OF_SUPPORTED_TYPES; + system_type = system_type + 1) { + + # Determine the string that should be looked for. + switch (system_type) { + case RA_DEC: + call strcpy (RA_DEC_DICTIONARY, Memc[cur_type], SZ_LINE) + case LINEAR: + call strcpy (LINEAR_DICTIONARY, Memc[cur_type], SZ_LINE) + } + + # Initialize the number of found axis. + found_axis = 0 + + # Examine each axis to determine whether the current axis type is + # the one to use. + for (axis = 1; axis <= wcs_dim; axis = axis + 1) { + + # If the current physical axis is not mapped, ignore it. + # This statement is causing a problem in 2.10.3, not sure + # why but am removing it for now. + #if (axno[axis] == 0) + #next + + ifnoerr (call mw_gwattrs( mw, axis, "wtype", Memc[axtype], + SZ_LINE)) { + call strlwr (Memc[axtype]) + + # If this axis type matches the one being looked for, add + # it to the axis list. If there are too many axis of the + # current type found, don't add to the found axis list. + + if (strdic (Memc[axtype], Memc[axtype], SZ_LINE, + Memc[cur_type]) > 0) { + found_axis = found_axis + 1 + if (found_axis <= N_DIM) + found_axis_list[found_axis] = axis + } + } + } + + # Check to see whether we have the right number axes. + if (found_axis == N_DIM) + break + + } + + # If any axes were found, then further check axis types. + # Depending on the axis type, there may be need to distinguish + # between the two possible axis further. + + if (found_axis == N_DIM) + switch (system_type) { + case RA_DEC: + for (axis = 1; axis <= N_DIM; axis = axis + 1) + ifnoerr (call mw_gwattrs (mw, found_axis_list[axis], + "axtype", Memc[axtype], SZ_LINE)) { + call strlwr( Memc[axtype] ) + if (strncmp (Memc[axtype], "ra", 2) == 0) + index_sys1 = found_axis_list[axis] + else if (strncmp (Memc[axtype], "dec", 3) == 0) + index_sys2 = found_axis_list[axis] + } + + # The "default" seems to be the LINEAR case for MWCS. + # Since no other information is provided, this is all we know. + default: + index_sys1 = found_axis_list[1] + index_sys2 = found_axis_list[2] + } + + # If either axis is unknown, something is wrong. If the WCS has two + # axes defined, then make some grand assumptions. If not, then there + # is nothing more to be done. + + if (IS_INDEFI (index_sys1) || IS_INDEFI (index_sys2)) { + if (wcs_dim >= N_DIM) { + index_sys1 = 1 + index_sys2 = 2 + } else + call error (0, "Wcslab: Fewer than two defined axes") + } + + # Zero the axis values and set any "unknown" axis to always use the + # "first" position in that axis direction. This will more than likely + # be a problem, but no general solution comes to mind this second. + + call amovki (0, axno, wcs_dim) + call amovki (0, axval, wcs_dim) + + # Setup so that the desired axes are set as the X and Y axis. + axno[index_sys1] = X_DIM + axno[index_sys2] = Y_DIM + call mw_saxmap (mw, axno, axval, wcs_dim) + + # Recover the center points of the Logical and World systems. + call mw_gwtermd (mw, tmp_logical, tmp_world, Memd[cd], wcs_dim) + + logical_center[X_DIM] = tmp_logical[index_sys1] + logical_center[Y_DIM] = tmp_logical[index_sys2] + world_center[X_DIM] = tmp_world[index_sys1] + world_center[Y_DIM] = tmp_world[index_sys2] + + # Check for reversal of axes + if (index_sys1 > index_sys2) + flip = YES + else + flip = NO + + # Release the memory. + call sfree (sp) +end + + +# WL_GR_INPARAMS -- Read in the graphics parameters for wcslab. +# +# Description +# Read all the parameters in and make some decisions about what +# will be done. + +procedure wl_gr_inparams (wd) + +pointer wd # I: the WCSLAB descriptor + +pointer sp, aline, pp +bool clgpsetb(), streq() +double wl_string_to_internal() +int btoi(), strdic(), wl_line_type(), clgpseti() +pointer clopset() +real clgpsetr() + +begin + # Get some memory. + call smark (sp) + call salloc (aline, SZ_LINE, TY_CHAR) + + # Open the pset. + pp = clopset ("wlpars") + + # Get the title if other than the default. + call clgpset (pp, "title", Memc[aline], SZ_LINE) + if (! streq (Memc[aline], "imtitle")) + call strcpy (Memc[aline], WL_TITLE(wd), SZ_LINE) + + # Get the axis titles. + call clgpset (pp, "axis1_title", WL_AXIS_TITLE(wd,AXIS1), SZ_LINE) + call clgpset (pp, "axis2_title", WL_AXIS_TITLE(wd,AXIS2), SZ_LINE) + + # Get the parameters. + WL_ALWAYS_FULL_LABEL(wd) = btoi (clgpsetb (pp,"full_label")) + WL_AXIS_TITLE_SIZE(wd) = clgpsetr (pp, "axis_title_size") + WL_LABEL_ROTATE(wd) = btoi (clgpsetb (pp, "rotate")) + WL_LABEL_SIZE(wd) = clgpsetr (pp, "label_size") + WL_LABON(wd) = btoi (clgpsetb (pp, "dolabel")) + WL_LABOUT(wd) = btoi (clgpsetb (pp, "labout")) + WL_MAJ_GRIDON(wd) = btoi (clgpsetb (pp, "major_grid")) + WL_MAJ_TICK_SIZE(wd) = clgpsetr (pp, "major_tick") + WL_MIN_GRIDON(wd) = btoi (clgpsetb (pp, "minor_grid")) + WL_MINOR_INTERVAL(wd,AXIS1) = clgpseti (pp, "axis1_minor") + WL_MINOR_INTERVAL(wd,AXIS2) = clgpseti (pp, "axis2_minor") + WL_MIN_TICK_SIZE(wd) = clgpsetr (pp, "minor_tick") + WL_REMEMBER(wd) = btoi (clgpsetb (pp, "remember")) + WL_TICK_IN(wd) = btoi (clgpsetb (pp, "tick_in")) + WL_TITLE_SIZE(wd) = clgpsetr (pp, "title_size") + + # Set what type of graph will be plotted. + call clgpset (pp, "graph_type", Memc[aline], SZ_LINE) + call strlwr (Memc[aline]) + WL_GRAPH_TYPE(wd) = strdic (Memc[aline], Memc[aline], SZ_LINE, + GRAPHTYPES) + if (WL_GRAPH_TYPE(wd) <= 0) + WL_GRAPH_TYPE(wd) = INDEFI + + # Get which sides labels will appear on. + call clgpset (pp, "axis1_side", Memc[aline], SZ_LINE) + call strlwr (Memc[aline]) + call wl_label_side (Memc[aline], WL_LABEL_SIDE(wd,1,AXIS1)) + + call clgpset (pp, "axis2_side", Memc[aline], SZ_LINE) + call strlwr (Memc[aline]) + call wl_label_side (Memc[aline], WL_LABEL_SIDE(wd,1,AXIS2)) + + # Get the polar justification direction. + call clgpset (pp, "justify", Memc[aline], SZ_LINE) + call strlwr (Memc[aline]) + WL_POLAR_LABEL_DIRECTION(wd) = strdic (Memc[aline], Memc[aline], + SZ_LINE, GRAPHSIDES) + if (WL_POLAR_LABEL_DIRECTION(wd) <= 0) + WL_POLAR_LABEL_DIRECTION(wd) = INDEFI + + # Decode the graphing parameters. + call clgpset (pp, "axis1_int", Memc[aline], SZ_LINE) + WL_MAJOR_INTERVAL(wd,AXIS1) = wl_string_to_internal (Memc[aline], + WL_SYSTEM_TYPE(wd), AXIS1) + call clgpset (pp, "axis1_beg", Memc[aline], SZ_LINE) + WL_BEGIN(wd,AXIS1) = wl_string_to_internal (Memc[aline], + WL_SYSTEM_TYPE(wd), AXIS1) + call clgpset (pp, "axis1_end", Memc[aline], SZ_LINE) + WL_END(wd,AXIS1) = wl_string_to_internal (Memc[aline], + WL_SYSTEM_TYPE(wd), AXIS1) + + call clgpset (pp, "axis2_int", Memc[aline], SZ_LINE) + WL_MAJOR_INTERVAL(wd,AXIS2) = wl_string_to_internal (Memc[aline], + WL_SYSTEM_TYPE(wd), AXIS2) + call clgpset (pp, "axis2_beg", Memc[aline], SZ_LINE) + WL_BEGIN(wd,AXIS2) = wl_string_to_internal(Memc[aline], + WL_SYSTEM_TYPE(wd), AXIS2 ) + call clgpset (pp, "axis2_end", Memc[aline], SZ_LINE) + WL_END(wd,AXIS2) = wl_string_to_internal (Memc[aline], + WL_SYSTEM_TYPE(wd), AXIS2) + + # Get the polar label position. + call clgpset (pp, "axis2_dir", Memc[aline], SZ_LINE) + WL_POLAR_LABEL_POSITION(wd) = wl_string_to_internal( Memc[aline], + WL_SYSTEM_TYPE(wd), AXIS1) + + # Get the axis titles. + call clgpset (pp, "axis1_title_side", Memc[aline], SZ_LINE) + call strlwr (Memc[aline]) + WL_AXIS_TITLE_SIDE(wd,AXIS1) = strdic (Memc[aline], Memc[aline], + SZ_LINE, GRAPHSIDES) + if (WL_AXIS_TITLE_SIDE(wd,AXIS1) <= 0) + WL_AXIS_TITLE_SIDE(wd,AXIS1) = INDEFI + + call clgpset (pp, "axis2_title_side", Memc[aline], SZ_LINE) + call strlwr (Memc[aline]) + WL_AXIS_TITLE_SIDE(wd,AXIS2) = strdic (Memc[aline], Memc[aline], + SZ_LINE, GRAPHSIDES) + if (WL_AXIS_TITLE_SIDE(wd,AXIS2) <= 0) + WL_AXIS_TITLE_SIDE(wd,AXIS2) = INDEFI + + # Decode the grid line types. + call clgpset (pp, "major_line", Memc[aline], SZ_LINE) + WL_MAJ_LINE_TYPE(wd) = wl_line_type (Memc[aline]) + call clgpset (pp, "minor_line", Memc[aline], SZ_LINE) + WL_MIN_LINE_TYPE(wd) = wl_line_type (Memc[aline]) + + # Get the title side. + call clgpset (pp, "title_side", Memc[aline], SZ_LINE) + call strlwr (Memc[ aline]) + WL_TITLE_SIDE(wd) = strdic (Memc[aline], Memc[aline], SZ_LINE, + GRAPHSIDES) + + # Close the pset. + call clcpset (pp) + + # Free memory. + call sfree (sp) +end + + +# WL_GR_REMPARAMS -- Write out the graphing parameters. + +procedure wl_gr_remparams (wd) + +pointer wd # I: the WCSLAB descriptor. + +pointer sp, output, pp +pointer clopset() + +begin + # Get some memory. + call smark (sp) + call salloc (output, SZ_LINE, TY_CHAR) + + # Open the pset. + pp = clopset ("wlpars") + + # Set the graph type. + switch (WL_GRAPH_TYPE(wd)) { + case NORMAL: + call clppset (pp, "graph_type", "normal") + case POLAR: + call clppset (pp, "graph_type", "polar") + case NEAR_POLAR: + call clppset (pp, "graph_type", "near_polar") + default: + call clppset (pp, "graph_type", "default") + } + + # Write back the labelling parameters. + call wl_internal_to_string (WL_MAJOR_INTERVAL(wd,AXIS1), + WL_SYSTEM_TYPE(wd), AXIS1, Memc[output]) + call clppset (pp, "axis1_int", Memc[output]) + call wl_internal_to_string (WL_BEGIN(wd,AXIS1), WL_SYSTEM_TYPE(wd), + AXIS1, Memc[output]) + call clppset (pp, "axis1_beg", Memc[output]) + call wl_internal_to_string (WL_END(WD,AXIS1), WL_SYSTEM_TYPE(wd), + AXIS1, Memc[output]) + call clppset (pp, "axis1_end", Memc[output]) + call wl_internal_to_string (WL_MAJOR_INTERVAL(wd,AXIS2), + WL_SYSTEM_TYPE(wd), AXIS2, Memc[output]) + call clppset (pp, "axis2_int", Memc[output]) + call wl_internal_to_string (WL_BEGIN(wd,AXIS2), WL_SYSTEM_TYPE(wd), + AXIS2, Memc[output]) + call clppset (pp, "axis2_beg", Memc[output]) + call wl_internal_to_string (WL_END(wd,AXIS2), WL_SYSTEM_TYPE(wd), + AXIS2, Memc[output]) + call clppset (pp, "axis2_end", Memc[output]) + call wl_internal_to_string (WL_POLAR_LABEL_POSITION(wd), + WL_SYSTEM_TYPE(wd), AXIS1, Memc[output]) + call clppset (pp, "axis2_dir", Memc[output]) + + # Write back labelling justification. + call wl_side_to_string (WL_POLAR_LABEL_DIRECTION(wd), Memc[output], + SZ_LINE) + call clppset (pp, "justify", Memc[output]) + + # Put the axis title sides out. + call wl_side_to_string (WL_AXIS_TITLE_SIDE(wd,AXIS1), Memc[output], + SZ_LINE) + call clppset (pp, "axis1_title_side", Memc[output]) + call wl_side_to_string (WL_AXIS_TITLE_SIDE(wd,AXIS2), Memc[output], + SZ_LINE ) + call clppset (pp, "axis2_title_side", Memc[output]) + + # Put the label sides out. + call wl_put_label_sides (WL_LABEL_SIDE(wd,1,AXIS1), Memc[output], + SZ_LINE ) + call clppset (pp, "axis1_side", Memc[output]) + call wl_put_label_sides (WL_LABEL_SIDE(wd,1,AXIS2), Memc[output], + SZ_LINE) + call clppset (pp, "axis2_side", Memc[output]) + + # Close the pset. + call clcpset (pp) + + # Free memory. + call sfree (sp) +end + + +# WL_DESTROY -- Deallocate the WCSLAB descriptor. + +procedure wl_destroy (wd) + +pointer wd # I: the WCSLAB descriptor to be destroyed + +begin + # Deallocate all the subarrays. + call mfree (WL_WORLD_CENTER_PTR(wd), TY_DOUBLE) + call mfree (WL_TITLE_PTR(wd), TY_CHAR) + call mfree (WL_SCREEN_BOUNDARY_PTR(wd), TY_DOUBLE) + call mfree (WL_NV_PTR(wd), TY_REAL) + call mfree (WL_MIN_I_PTR(wd), TY_INT) + call mfree (WL_MAJ_I_PTR(wd), TY_DOUBLE) + call mfree (WL_LOGICAL_CENTER_PTR(wd), TY_DOUBLE) + call mfree (WL_LABEL_VALUE_PTR(wd), TY_DOUBLE) + call mfree (WL_LABEL_SIDE_PTR(wd), TY_BOOL) + call mfree (WL_LABEL_POSITION_PTR(wd), TY_DOUBLE) + call mfree (WL_LABEL_AXIS_PTR(wd), TY_INT) + call mfree (WL_LABEL_ANGLE_PTR(wd), TY_DOUBLE) + call mfree (WL_END_PTR(wd), TY_DOUBLE) + call mfree (WL_BEGIN_PTR(wd), TY_DOUBLE) + call mfree (WL_AXIS_TITLE_SIDE_PTR(wd), TY_BOOL) + call mfree (WL_AXIS_TITLE_PTR(wd), TY_CHAR) + + # Now deallocate the structure. + call mfree (wd, TY_STRUCT) +end + + +# WL_LABEL_SIDE -- Decode string into set of booleans sides. + +procedure wl_label_side (input, flag) + +char input[ARB] # I: string listing the sides to be labeled +bool flag[N_SIDES] # O: the flags indicating which sides wll be labeled + +int i +int strmatch() + +begin + # Initialize all the flags to false. + do i = 1, N_SIDES + flag[i] = false + + # Now set each side that is in the list. + if (strmatch (input, "right") != 0) + flag[RIGHT] = true + if (strmatch (input, "left") != 0) + flag[LEFT] = true + if (strmatch (input, "top") != 0) + flag[TOP] = true + if (strmatch (input, "bottom") != 0) + flag[BOTTOM] = true +end + + +# WL_STRING_TO_INTERVAL -- Convert from a string to a number. +# +# Description +# Since (ideally) the wcslab task should be able to handle any sky +# map transformation, there are a number of potential units that can be +# transformed from. The specification of coordinates in these systems +# are also quite varied. Thus, for input purposes, coordinates are entered +# as strings. This routine decodes the strings to a common unit (degrees) +# based on the type of system being graphed. +# +# Function Returns +# This returns the single coordinate value converted to a base system +# (degrees). + +double procedure wl_string_to_internal (input, axis_type, which_axis) + +char input[ARB] # I; the string containing the numerical value +int axis_type # I: the type of wcs +int which_axis # I: the axis number + +double value +int strlen(), nscan() + +begin + # It is possible that the value was not defined. + if (strlen (input) <= 0) + value = INDEFD + + # Decode based on the system. + else + switch (axis_type) { + + # The RA and DEC systems. + case RA_DEC: + + # Since SPP FMTIO can handle the HH:MM:SS format, just let it + # read in the value. However, there is no way to distinquish + # H:M:S from D:M:S. If the axis being read is RA, assume that + # it was H:M:S. + + call sscan (input) + call gargd (value) + + # If the axis is Longitude == RA, then convert the hours to + # degrees. + if (nscan() < 1) { + value = INDEFD + } else { + if (which_axis == AXIS1) + value = HRSTODEG (value) + } + + # Default- unknown system, just read the string as a double + # precision and return it. + default: + call sscan (input) + call gargd (value) + if (nscan() < 1) + value = INDEFD + } + + return (value) +end + + +# WL_LINE_TYPE -- Decode a string into an IRAF GIO polyline type. + +int procedure wl_line_type (line_type_string) + +char line_type_string[ARB] # I: the string specifying the line type + # "solid" -> GL_SOLID + # "dotted" -> GL_DOTTED + # "dashed" -> GL_DASHED + # "dotdash" -> GL_DOTDASH +int type +bool streq() + +begin + if (streq (line_type_string, "solid")) + type = GL_SOLID + else if (streq (line_type_string, "dotted")) + type = GL_DOTTED + else if (streq( line_type_string, "dashed")) + type = GL_DASHED + else if (streq (line_type_string, "dotdash")) + type = GL_DOTDASH + else { + call eprintf ("Pattern unknown, using 'solid'.\n") + type = GL_SOLID + } + + return (type) +end + + +# WL_INTERNAL_TO_STRING - Convert internal representation to a string. + +procedure wl_internal_to_string (value, system_type, which_axis, output) + +double value # I: the value to convert +int system_type # I: the wcs type +int which_axis # I: the axis +char output[ARB] # O: the output string + +begin + # If the value is undefined, write an empty string. + if (IS_INDEFD (value)) + output[1] = EOS + + # Else, convert the value depending on the axis types. + else + switch (system_type) { + + # Handle the RA, DEC + case RA_DEC: + + # If this is Axis1 == Right Ascension, then convert to hours. + if (which_axis == AXIS1) + value = value / 15.0D0 + + call sprintf (output, SZ_LINE, "%.6h") + call pargd (value) + + # Else, just write a value. + default: + call sprintf (output, SZ_LINE, "%.7g") + call pargd (value) + } + +end + + +# WL_SIDE_TO_STRING -- Convert a side to its string representation. + +procedure wl_side_to_string (side, output, max_len) + +int side # I: the side to convert +char output[max_len] # O: the string representation of the side +int max_len # I: the maximum length of the output string + +begin + switch (side) { + case RIGHT: + call strcpy ("right", output, max_len) + case LEFT: + call strcpy ("left", output, max_len) + case TOP: + call strcpy ("top", output, max_len) + case BOTTOM: + call strcpy ("bottom", output, max_len) + default: + call strcpy ("default", output, max_len) + } +end + + +# WL_PUT_LABEL_SIDES -- Create a string containing the sides specified. + +procedure wl_put_label_sides (side_flags, output, max_len) + +bool side_flags[N_SIDES] # I: the boolean array of sides +char output[ARB] # O: the output comma separated list of sides +int max_len # I: maximum length of the output string + +int i +pointer sp, side +int strlen() + +begin + # Get memory. + call smark (sp) + call salloc (side, max_len, TY_CHAR) + + # Build the list. + output[1] = EOS + do i = 1, N_SIDES + if (side_flags[i]) { + if (strlen (output) != 0) + call strcat (",", output, max_len) + call wl_side_to_string (i, Memc[side], max_len) + call strcat (Memc[side], output, max_len) + } + + if (strlen (output) == 0) + call strcat ("default", output, max_len) + + # Free memory. + call sfree (sp) +end diff --git a/pkg/images/tv/wcslab/wlgrid.x b/pkg/images/tv/wcslab/wlgrid.x new file mode 100644 index 00000000..4f457af4 --- /dev/null +++ b/pkg/images/tv/wcslab/wlgrid.x @@ -0,0 +1,448 @@ +include <gset.h> +include <math.h> +include "wcslab.h" +include "wcs_desc.h" + + +# WL_GRID -- Put the grid lines/tick marks on the plot. +# +# Description +# Based on previously determined parameters., draw the grid lines and/or +# tick marks onto the graph. While in the process of doing this, create +# a list of possible label points for use by the label_grid routine. + +procedure wl_grid (wd) + +pointer wd # I: the WCSLAB descriptor + +double current, tmp_begin, tmp_end, tmp_minor_interval +int old_type, old_n_labels, min_counter +int gstati() + +begin + # Initialize the label counter. + WL_N_LABELS(wd) = 0 + + # Remember what line type is currently active. + old_type = gstati (WL_GP(wd), G_PLTYPE) + + # Determine integer range for axis 1. + tmp_minor_interval = WL_MAJOR_INTERVAL(wd,AXIS1) / + double (WL_MINOR_INTERVAL(wd,AXIS1)) + + # If near-polar, the lines should go all the way to the poles. + if (WL_GRAPH_TYPE(wd) == NEAR_POLAR) + if (abs (WL_BEGIN(wd,AXIS2)) < abs (WL_END(wd,AXIS2))) { + tmp_begin = WL_BEGIN(wd,AXIS2) + tmp_end = NORTH_POLE_LATITUDE + } else { + tmp_begin = SOUTH_POLE_LATITUDE + tmp_end = WL_END(wd,AXIS2) + } + else { + tmp_begin = WL_BEGIN(wd,AXIS2) + tmp_end = WL_END(wd,AXIS2) + } + + # Plot lines of constant value in axis 1. + current = WL_BEGIN(wd,AXIS1) + min_counter = 0 + repeat { + + if (mod (min_counter, WL_MINOR_INTERVAL(wd,AXIS1)) == 0) { + call gseti (WL_GP(wd), G_PLTYPE, WL_MAJ_LINE_TYPE(wd)) + call wl_graph_constant_axis1 (wd, current, tmp_begin, tmp_end, + WL_MAJ_GRIDON(wd), WL_LABON(wd), WL_MAJ_TICK_SIZE(wd)) + } else { + call gseti (WL_GP(wd), G_PLTYPE, WL_MIN_LINE_TYPE(wd)) + call wl_graph_constant_axis1 (wd, current, tmp_begin, tmp_end, + WL_MIN_GRIDON(wd), NO, WL_MIN_TICK_SIZE(wd)) + } + + min_counter = min_counter + 1 + current = WL_BEGIN(wd,AXIS1) + tmp_minor_interval * min_counter + + } until (real (current) > real (WL_END(wd,AXIS1))) + + # Determine the interval range for the second axis. + tmp_minor_interval = WL_MAJOR_INTERVAL(wd,AXIS2) / + double (WL_MINOR_INTERVAL(wd,AXIS2)) + + # Plot lines of constant value in axis 2. + if (WL_END(wd,AXIS2) < WL_BEGIN(wd,AXIS2)) { + current = WL_END(wd,AXIS2) + tmp_minor_interval = -tmp_minor_interval + tmp_end = WL_BEGIN(wd,AXIS2) + } else { + current = WL_BEGIN(wd,AXIS2) + tmp_end = WL_END(wd,AXIS2) + } + + min_counter = 0 + tmp_begin = current + repeat { + if (mod (min_counter, WL_MINOR_INTERVAL(wd,AXIS2)) == 0) { + + call gseti (WL_GP(wd), G_PLTYPE, WL_MAJ_LINE_TYPE(wd)) + old_n_labels = WL_N_LABELS(wd) + call wl_graph_constant_axis2 (wd, current, WL_BEGIN(wd,AXIS1), + WL_END(wd,AXIS1), WL_MAJ_GRIDON(wd), WL_LABON(wd), + WL_MAJ_TICK_SIZE(wd)) + + # If this is a polar or near_polar plot, the latitudes + # should be placed near the line, not where it crosses the + # window boundary. + + if (WL_GRAPH_TYPE(wd) == POLAR && + (WL_MAJ_GRIDON(wd) == YES) && (WL_LABON(wd) == YES)) { + WL_N_LABELS(wd) = old_n_labels + 1 + call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), + WL_POLAR_LABEL_POSITION(wd), current, + WL_LABEL_POSITION(wd,WL_N_LABELS(wd),X_DIM), + WL_LABEL_POSITION(wd,WL_N_LABELS(wd),Y_DIM), 1) + WL_LABEL_VALUE(wd,WL_N_LABELS(wd)) = current + WL_LABEL_AXIS(wd,WL_N_LABELS(wd)) = AXIS2 + } + + } else { + call gseti (WL_GP(wd), G_PLTYPE, WL_MIN_LINE_TYPE(wd)) + call wl_graph_constant_axis2 (wd, current, WL_BEGIN(wd,AXIS1), + WL_END(wd,AXIS1), WL_MIN_GRIDON(wd), NO, + WL_MIN_TICK_SIZE(wd)) + } + + # Increment and continue + min_counter = min_counter + 1 + current = tmp_begin + tmp_minor_interval * min_counter + + } until (real (current) > real (tmp_end)) + + # Set the line type back to the way it was. + call gseti (WL_GP(wd), G_PLTYPE, old_type) +end + + +# WL_GRAPH_CONSTANT_AXIS1 - Graph lines of constant X-axis values. +# +# Description +# Because projections are rarely linear, the basic GIO interface to draw +# lines cannot be used. Instead, this routine handles the line drawing. +# Also, possible label points are found and added to a label list array. +# +# CLUDGE! Finding labels here is WRONG. Ideally, crossing points (where the +# line crosses a screen boundary) should be determined analytically. However, +# the MWCS interface lacks the required "cross-transformations". It can +# still be done, but requires a total bypassing of MWCS. Instead, this +# simplistic approach is used. + +procedure wl_graph_constant_axis1 (wd, x, ymin, ymax, gridon, label, tick_size) + +pointer wd # I: the WCSLAB descriptor +double x # I: X value to hold constant +double ymin, ymax # I: Y values to vary between +int gridon # I: true if gridding is on +int label # I: true if the points should be labelled +real tick_size # I: size of tick marks + +bool done +double lastx, lasty, lx, ly, y, yinc +real rlx, rly + +begin + # Determine the scale at which Y should be incremented. + yinc = (ymax - ymin) / WL_LINE_SEGMENTS(wd) + + # Now graph the line segments. + y = ymin + call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), x, y, lastx, lasty, 1) + + rlx = lastx + rly = lasty + call gamove (WL_GP(wd), rlx, rly) + + repeat { + call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), x, y, lx, ly, 1) + call wl_point_to_label (wd, lastx, lasty, lx, ly, AXIS1, x, gridon, + label, tick_size) + if (gridon == YES) { + rlx = lx + rly = ly + call gadraw (WL_GP(wd), rlx, rly) + } + if (yinc < 0.) + done = y < ymax + else + done = y > ymax + y = y + yinc + lastx = lx + lasty = ly + } until (done) +end + + +# WL_GRAPH_CONSTANT_AXIS2 -- Graph lines of constant Y-axis values. +# +# Description +# Because projections are rarely linear, the basic GIO interface to draw +# lines cannot be used. Instead, this routine handles the line drawing. +# Also, possible label points are found and added to an label list array. +# +# CLUDGE! Finding labels here is WRONG. Ideally, crossing points (where the +# line crosses a screen boundary) should be determined analytically. However, +# the MWCS interface lacks the required "cross-transformations". It can +# still be done, but requires a total bypassing of MWCS. Instead, this +# simplistic approach is used. + +procedure wl_graph_constant_axis2 (wd, y, xmin, xmax, gridon, label, tick_size) + +pointer wd # I: the WCSLAB descriptor +double y # I: Y value to hold constant +double xmin, xmax # I: X values to vary between +int gridon # I: true if gridding is on +int label # I: true if points should be labelled +real tick_size # I: tick mark size + +bool done +double lx, ly, lastx, lasty, x, xinc +real rlx, rly + +begin + # Determine the scale at which X should be incremented. + xinc = (xmax - xmin) / WL_LINE_SEGMENTS(wd) + + # Now graph the line segments. + x = xmin + call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), x, y, lastx, lasty, 1) + + rlx = lastx + rly = lasty + call gamove (WL_GP(wd), rlx, rly) + + repeat { + call wl_w2ld (WL_WLCT(wd), WL_AXIS_FLIP(wd), x, y, lx, ly, 1) + call wl_point_to_label (wd, lastx, lasty, lx, ly, AXIS2, y, gridon, + label, tick_size) + if (gridon == YES) { + rlx = lx + rly = ly + call gadraw (WL_GP(wd), rlx, rly) + } + if (xinc < 0.) + done = x < xmax + else + done = x > xmax + lastx = lx + lasty = ly + x = x + xinc + } until (done) +end + + +# Define the inside and outside of the window. + +define OUT (($1<=WL_SCREEN_BOUNDARY(wd,LEFT))||($1>=WL_SCREEN_BOUNDARY(wd,RIGHT))||($2<=WL_SCREEN_BOUNDARY(wd,BOTTOM))||($2>=WL_SCREEN_BOUNDARY(wd,TOP))) + +define IN (($1>WL_SCREEN_BOUNDARY(wd,LEFT))&&($1<WL_SCREEN_BOUNDARY(wd,RIGHT))&&($2>WL_SCREEN_BOUNDARY(wd,BOTTOM))&&($2<WL_SCREEN_BOUNDARY(wd,TOP))) + + +# WL_POINT_TO_LABEL - Record a points position along a window boundary. +# +# Description +# Since the MWCS interface lacks "cross-transformations", i.e. If given +# RA and and X axis location, find DEC and Y axis, we need a different +# method of determining when lines of constant Axis 1/Axis 2 cross +# the window boundary. Since each line is drawn by small increments, each +# increment is watched to see if a window boundary has been crossed. This +# is what this routine does: Confirms that a boundary has been crossed, +# records this position and label value. Tick marks are also drawn here +# because all the necessary information is known at this point. +# +# NOTE: THIS WAY IS A CLUDGE ! A more formal method of finding +# cross-transformations is needed- most likely an iterative method. This +# way was just "convenient at the time". + +procedure wl_point_to_label (wd, x1, y1, x2, y2, axis, axis_value, gridon, + label, tick_size) + +pointer wd # I: the WCSLAB descriptor +double x1, y1, x2, y2 # I: the two possible points to label +int axis # I: which axis are we dealing with ? +double axis_value # I: the value of the axis at this point +int gridon # I: true if gridding is on +int label # I: true if this point should have a label +real tick_size # I: size of the tick mark + +double nx, ny, tick_x, tick_y +double wl_vector_angle() + +begin + # Determine whether the two points straddle a window boundary. If they + # do, then this is the point to label. + if (OUT (x1, y1) && IN (x2, y2)) { + + call wl_axis_on_line (x1, y1, x2, y2, WL_SCREEN_BOUNDARY(wd,1), + nx, ny) + + if (gridon == NO) { + call wl_mark_tick (WL_GP(wd), WL_NDC_WCS(wd), tick_size, + WL_TICK_IN(wd), x1, y1, x2, y2, nx, ny, tick_x, tick_y) + if (WL_TICK_IN(wd) != WL_LABOUT(wd)) { + nx = tick_x + ny = tick_y + } + } + + if ((label == YES) && WL_N_LABELS(wd) < MAX_LABEL_POINTS) { + WL_N_LABELS(wd) = WL_N_LABELS(wd) + 1 + WL_LABEL_POSITION(wd,WL_N_LABELS(wd),AXIS1) = nx + WL_LABEL_POSITION(wd,WL_N_LABELS(wd),AXIS2) = ny + WL_LABEL_VALUE(wd,WL_N_LABELS(wd)) = axis_value + WL_LABEL_AXIS(wd,WL_N_LABELS(wd)) = axis + WL_LABEL_ANGLE(wd,WL_N_LABELS(wd)) = + wl_vector_angle (WL_GP(wd), x1, y1, x2, y2) + } + } + + if (IN (x1, y1) && OUT (x2, y2)) { + + call wl_axis_on_line (x2, y2, x1, y1, WL_SCREEN_BOUNDARY(wd,1), + nx, ny) + + if (gridon == NO) { + call wl_mark_tick (WL_GP(wd), WL_NDC_WCS(wd), tick_size, + WL_TICK_IN(wd), x2, y2, x1, y1, nx, ny, tick_x, tick_y) + if (WL_TICK_IN(wd) != WL_LABOUT(wd)) { + nx = tick_x + ny = tick_y + } + } + + if ((label == YES) && WL_N_LABELS(wd) < MAX_LABEL_POINTS) { + WL_N_LABELS(wd) = WL_N_LABELS(wd) + 1 + WL_LABEL_POSITION(wd,WL_N_LABELS(wd),AXIS1) = nx + WL_LABEL_POSITION(wd,WL_N_LABELS(wd),AXIS2) = ny + WL_LABEL_VALUE(wd,WL_N_LABELS(wd)) = axis_value + WL_LABEL_AXIS(wd,WL_N_LABELS(wd)) = axis + WL_LABEL_ANGLE(wd,WL_N_LABELS(wd)) = + wl_vector_angle (WL_GP(wd), x1, y1, x2, y2) + } + } + +end + + +# WL_MARK_TICK - Draw the tick mark at the point. +# +# Description +# Draw a tick mark rooted at (sx,sy), whose direction is defined by +# the vector (x0,y0) to (x1,y1). The other end of the tick mark is +# returned in (tick_x,tick_y). + +procedure wl_mark_tick (gp, wcs, tick_size, in, x0, y0, x1, y1, sx, sy, + tick_x, tick_y) + +pointer gp # I: the graphics pointer +int wcs # I: the WCS to use to draw the tick marks +real tick_size # I: size of the tick mark +int in # I: true if ticks should be into the graph +double x0, y0, x1, y1 # I: the points defining the tick direction +double sx, sy # I: the root point of the tick mark +double tick_x, tick_y # O: the end point of the tick mark + +int old_line, old_wcs +real dx, dy, t, ndc_x0, ndc_y0, ndc_x1, ndc_y1, ndc_x2, ndc_y2 +real ndc_sx, ndc_sy +int gstati() +real wl_distancer() + +begin + # Change graphics coordinates to NDC. + old_wcs = gstati (gp, G_WCS) + old_line = gstati (gp, G_PLTYPE) + call gseti (gp, G_WCS, wcs) + call gseti (gp, G_PLTYPE, GL_SOLID) + + # Convert the points to NDC coordinates. + ndc_x2 = real (sx) + ndc_y2 = real (sy) + call gctran (gp, ndc_x2, ndc_y2, ndc_sx, ndc_sy, old_wcs, wcs) + ndc_x2 = real (x0) + ndc_y2 = real (y0) + call gctran (gp, ndc_x2, ndc_y2, ndc_x0, ndc_y0, old_wcs, wcs) + ndc_x2 = real (x1) + ndc_y2 = real (y1) + call gctran (gp, ndc_x2, ndc_y2, ndc_x1, ndc_y1, old_wcs, wcs) + + # Determine the parameterized line parameters. + dx = ndc_x1 - ndc_x0 + dy = ndc_y1 - ndc_y0 + + # Determine how large in "time" the tick mark is. + t = tick_size / wl_distancer (ndc_x0, ndc_y0, ndc_x1, ndc_y1) + + # If tick marks are to point out of the graph, reverse the sign of t. + # Also need to turn clipping off for the ticks appear. + if (in == NO) { + t = -t + call gseti (gp, G_CLIP, NO) + } + + # Determine the end point of the tick mark. + ndc_x2 = t * dx + ndc_sx + ndc_y2 = t * dy + ndc_sy + + # Now draw the tick mark. + call gamove (gp, ndc_sx, ndc_sy) + call gadraw (gp, ndc_x2, ndc_y2) + + # Restore clipping if necessary. + if (in == NO) + call gseti (gp, G_CLIP, YES) + + # Restore previous settings. + call gseti (gp, G_WCS, old_wcs) + call gseti (gp, G_PLTYPE, old_line) + + # Transform the end of the tick mark. + call gctran (gp, ndc_x2, ndc_y2, dx, dy, wcs, old_wcs) + tick_x = double (dx) + tick_y = double (dy) +end + + +# WL_VECTOR_ANGLE -- Return the angle represented by the given vector. +# +# Returns +# The angle of the given vector. + +double procedure wl_vector_angle (gp, x1, y1, x2, y2) + +pointer gp # I: the graphics descriptor +double x1, y1, x2, y2 # I: the end points of the vector + +double dangle +real angle, delx, dely, ndc_x1, ndc_x2, ndc_y1, ndc_y2 +bool fp_equalr() +int gstati() + +begin + # Translate the input points to NDC coordinates. + ndc_x1 = real (x1) + ndc_x2 = real (x2) + ndc_y1 = real (y1) + ndc_y2 = real (y2) + call gctran (gp, ndc_x1, ndc_y1, ndc_x1, ndc_y1, gstati (gp, G_WCS), + NDC_WCS) + call gctran (gp, ndc_x2, ndc_y2, ndc_x2, ndc_y2, gstati (gp, G_WCS), + NDC_WCS) + + dely = ndc_y2 - ndc_y1 + delx = ndc_x2 - ndc_x1 + if (fp_equalr (delx, 0.) && fp_equalr (dely, 0.)) + angle = 0.0 + else + angle = RADTODEG (atan2 (dely, delx)) + dangle = angle + + return (dangle) +end diff --git a/pkg/images/tv/wcslab/wllabel.x b/pkg/images/tv/wcslab/wllabel.x new file mode 100644 index 00000000..33e86878 --- /dev/null +++ b/pkg/images/tv/wcslab/wllabel.x @@ -0,0 +1,1077 @@ +include <gset.h> +include <math.h> +include "wcslab.h" +include "wcs_desc.h" + + +# Define the offset array. +define OFFSET Memr[$1+$2-1] + +# WL_LABEL -- Place the labels on the grids. +# +# Description +# Format and write the labels for the grid/tick marks. Much of this +# is wading through conditions to decide whether a label should be +# written or not. + +procedure wl_label (wd) + +pointer wd # I: the WCSLAB descriptor + +bool no_side_axis1, no_side_axis2 +int i, axis1_side, axis2_side +pointer sp, offset_ptr +real offset + +begin + # Get some memory. + call smark (sp) + call salloc (offset_ptr, N_SIDES, TY_REAL) + do i = 1, N_SIDES + OFFSET(offset_ptr,i) = 0. + + # Decide whether any sides were specified for either axis. + no_side_axis1 = true + no_side_axis2 = true + do i = 1, N_SIDES { + if (WL_LABEL_SIDE(wd,i,AXIS1)) + no_side_axis1 = false + if (WL_LABEL_SIDE(wd,i,AXIS2)) + no_side_axis2 = false + } + + # If polar, then label the axis 2's next to their circles on the + # graph and allow the Axis 1s to be labeled on all sides of the graph. + + if (WL_GRAPH_TYPE(wd) == POLAR) { + + call wl_polar_label (wd) + + if (no_side_axis1) { + do i = 1, N_SIDES { + WL_LABEL_SIDE(wd,i,AXIS1) = true + } + if (IS_INDEFI (WL_AXIS_TITLE_SIDE(WD,AXIS1))) + WL_AXIS_TITLE_SIDE(WD,AXIS1) = BOTTOM + } + + # If we are near-polar, label the Axis 2 as if polar, and label + # Axis1 on all sides except the side closest to the pole. + + } else if (WL_GRAPH_TYPE(wd) == NEAR_POLAR) { + + if (no_side_axis1) { + WL_LABEL_SIDE(wd,WL_BAD_LABEL_SIDE(wd),AXIS1) = true + if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS1))) + WL_AXIS_TITLE_SIDE(wd,AXIS1) = WL_BAD_LABEL_SIDE(wd) + } + + if (no_side_axis2) { + WL_LABEL_SIDE(wd,WL_POLAR_LABEL_DIRECTION(wd),AXIS2) = true + if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS2))) + WL_AXIS_TITLE_SIDE(wd,AXIS2) = WL_POLAR_LABEL_DIRECTION(wd) + } + + # Final case- adjacent sides should be labelled. + + } else { + + # Determine the best sides for labelling. + if (INVERT (WL_ROTA(wd))) { + axis1_side = LEFT + axis2_side = BOTTOM + } else { + axis1_side = BOTTOM + axis2_side = LEFT + } + + # If no sides were specified, use the calculated ones above. + if (no_side_axis1) + WL_LABEL_SIDE(wd,axis1_side,AXIS1) = true + if (no_side_axis2) + WL_LABEL_SIDE(wd,axis2_side,AXIS2) = true + } + + # Now draw the labels for axis 1. + do i = 1, N_SIDES { + + if (WL_LABEL_SIDE(wd,i,AXIS1)) { + call wl_lab_edges (wd, AXIS1, i, offset) + if (IS_INDEFI (WL_AXIS_TITLE_SIDE(WD,AXIS1))) + WL_AXIS_TITLE_SIDE(WD,AXIS1) = i + } else + offset = 0. + + # Modify the bounding box for the new viewport. + if (abs (offset) > abs (OFFSET(offset_ptr,i))) + OFFSET(offset_ptr,i) = offset + } + + # Draw the labels for axis 2. + if (WL_GRAPH_TYPE(wd) != POLAR) + do i = 1, N_SIDES { + + if (WL_LABEL_SIDE(wd,i,AXIS2)) { + call wl_lab_edges (wd, AXIS2, i, offset) + if (IS_INDEFI (WL_AXIS_TITLE_SIDE(wd,AXIS2))) + WL_AXIS_TITLE_SIDE(wd,AXIS2) = i + } else + offset = 0. + + # Modify the bounding box for the new viewport. + if (abs (offset) > abs (OFFSET(offset_ptr,i))) + OFFSET(offset_ptr,i) = offset + } + + # Set the bounding box. + do i = 1, N_SIDES + WL_NEW_VIEW(wd,i) = WL_NEW_VIEW(wd,i) + OFFSET(offset_ptr,i) + + # Now write the graph title. + call wl_title (WL_GP(wd), WL_AXIS_TITLE(wd,AXIS1), + WL_AXIS_TITLE_SIDE(wd,AXIS1), WL_AXIS_TITLE_SIZE(wd), + WL_NEW_VIEW(wd,1)) + if (WL_GRAPH_TYPE(wd) != POLAR) + call wl_title (WL_GP(wd), WL_AXIS_TITLE(wd,AXIS2), + WL_AXIS_TITLE_SIDE(wd,AXIS2), WL_AXIS_TITLE_SIZE(WD), + WL_NEW_VIEW(wd,1)) + if (! IS_INDEFI (WL_TITLE_SIDE(wd))) + call wl_title (WL_GP(wd), WL_TITLE(wd), WL_TITLE_SIDE(wd), + WL_TITLE_SIZE(wd), WL_NEW_VIEW(wd,1)) + + # Release memory. + call sfree (sp) +end + + +# Define what is in the screen. + +define IN (($1>WL_SCREEN_BOUNDARY(wd,LEFT))&&($1<WL_SCREEN_BOUNDARY(wd,RIGHT))&&($2>WL_SCREEN_BOUNDARY(wd,BOTTOM))&&($2<WL_SCREEN_BOUNDARY(wd,TOP))) + +# WL_POLAR_LABEL -- Place Latitude labels next to Latitude circles. +# +# Description +# Since Lines of constant Latitude on a polar graph are usually circles +# around the pole, the lines may never cross edges. Instead, the labels +# are placed next to circles. The grid-drawing routines should setup +# the label position array such that each line has only one label point. + +procedure wl_polar_label (wd) + +pointer wd # I: the WCSLAB descriptor + +int i, prec +pointer sp, label, units, label_format, units_format +real char_height, char_width, ndc_textx, ndc_texty, old_text_size +real textx, texty +int wl_precision() +real gstatr(), ggetr() + +begin + # Get some memory. + call smark (sp) + call salloc (label, SZ_LINE, TY_CHAR) + call salloc (units, SZ_LINE, TY_CHAR) + call salloc (label_format, SZ_LINE, TY_CHAR) + call salloc (units_format, SZ_LINE, TY_CHAR) + + # Get the character height and width. This is used to ensure that we + # have moved the label strings off the border. + + char_height = ggetr (WL_GP(wd), "ch") * gstatr (WL_GP(wd), G_TXSIZE) / + 2. + char_width = ggetr (WL_GP(wd), "cw") * gstatr (WL_GP(wd), G_TXSIZE) / + 2. + + # Get the text size and cut it in half for on the plot labelling. + old_text_size = gstatr (WL_GP(wd), G_TXSIZE) + call gsetr (WL_GP(wd), G_TXSIZE, old_text_size) + call gsetr (WL_GP(wd), G_TXSIZE, old_text_size * 0.80) + + # Determine the precision of the output. + prec = wl_precision (wd, AXIS2) + + # Place the labels. + for (i = 1; i <= WL_N_LABELS(wd); i = i + 1) + if (WL_LABEL_AXIS(wd,i) == AXIS2) { + + # Decode the coordinate into a text string. + call wl_dms (WL_LABEL_VALUE(wd,i), Memc[label], Memc[units], + SZ_LINE, prec, true) + + # Convert text position from "unknown" coordinates to NDC. + call gctran (WL_GP(wd), real (WL_LABEL_POSITION(wd,i,AXIS1)), + real (WL_LABEL_POSITION(wd,i,AXIS2)), ndc_textx, ndc_texty, + WL_PLOT_WCS(wd), WL_NDC_WCS(wd)) + + # Determine the text justification. + switch (WL_POLAR_LABEL_DIRECTION(wd)) { + case BOTTOM: + call strcpy ("h=c;v=t", Memc[label_format], SZ_LINE) + call strcpy ("h=c;v=c", Memc[units_format], SZ_LINE) + ndc_texty = ndc_texty - char_height + case TOP: + call strcpy ("h=c;v=c", Memc[label_format], SZ_LINE) + call strcpy ("h=c;v=b", Memc[units_format], SZ_LINE) + ndc_texty = ndc_texty + char_height + case LEFT: + call strcpy ("h=r;v=c", Memc[label_format], SZ_LINE) + call strcpy ("h=r;v=b", Memc[units_format], SZ_LINE) + ndc_textx = ndc_textx - char_width + case RIGHT: + call strcpy ("h=l;v=c", Memc[label_format], SZ_LINE) + call strcpy ("h=l;v=b", Memc[units_format], SZ_LINE) + ndc_textx = ndc_textx + char_width + } + + # Convert the text position from NDC back to the "unknown" + # system. + call gctran (WL_GP(wd), ndc_textx, ndc_texty, textx, texty, + WL_NDC_WCS(wd), WL_PLOT_WCS(wd)) + + # Print the label. + if (IN (textx, texty)) { + call gtext (WL_GP(wd), textx, texty, Memc[label], + Memc[label_format]) + call gtext (WL_GP(wd), textx, texty, Memc[units], + Memc[units_format]) + } + + } + + # Set the text size back. + call gsetr (WL_GP(wd), G_TXSIZE, old_text_size) + + # Release memory. + call sfree (sp) + +end + + +# Memory management for labels + +define LABEL_LIST Memi[labels+$1-1] + +# WL_LAB_EDGES -- Place labels along the edges of the window. +# +# Description +# Place labels on the specified side of the graph. + +procedure wl_lab_edges (wd, axis, side, offset) + +pointer wd # I: the WCSLAB descriptor +int axis # I: the type of axis being labeled +int side # I: the side to place the labels +real offset # O: offset in NDC units for titles + +bool do_full +double angle, tangle +int i, full_label, nlabels, old_wcs, prec +pointer sp, labels +real ndc_textx, ndc_texty, old_text_size, textx, texty + +int wl_full_label_position(), wl_find_side() +double wl_string_angle(), wl_angle() +int gstati(), wl_precision() +real gstatr() + +begin + call smark (sp) + + # All label placement is done in NDC coordinates. + old_wcs = gstati (WL_GP(wd), G_WCS) + call gseti (WL_GP(wd), G_WCS, WL_NDC_WCS(wd)) + + # Set text labelling size. + old_text_size = gstatr (WL_GP(wd), G_TXSIZE) + call gsetr (WL_GP(wd), G_TXSIZE, WL_LABEL_SIZE(wd)) + + # Get the precision of the axis interval. + prec = wl_precision (wd, axis) + + # Initialize string size. + offset = 0. + + # Build a list of possible labels for this side. The conditions are + # that the label should be for the current axis and that it lies on + # the current side. + + call salloc (labels, WL_N_LABELS(wd), TY_INT) + nlabels = 0 + for (i = 1; i <= WL_N_LABELS(wd); i = i + 1) + if (WL_LABEL_AXIS(wd,i) == axis && + wl_find_side (WL_LABEL_POSITION(wd,i,AXIS1), + WL_LABEL_POSITION(wd,i,AXIS2), + WL_SCREEN_BOUNDARY(wd,1)) == side) { + nlabels = nlabels + 1 + LABEL_LIST(nlabels) = i + } + + # If no labels found, then just forget it. If labels found, well + # write them out. + + if (nlabels != 0) { + + # Determine which label should be written out in full. + full_label = wl_full_label_position (wd, Memi[labels], nlabels, + axis, side, prec) + + # Determine the angle that all the labels will be written at. + if ((WL_LABOUT(wd) == NO) && (WL_GRAPH_TYPE(wd) != NORMAL) && + (WL_LABEL_ROTATE(wd) == YES)) + angle = INDEFR + else if ((WL_GRAPH_TYPE(wd) == NORMAL) && ((WL_LABEL_ROTATE(wd) == + YES) || ((WL_LABOUT(wd) == NO) && (WL_MAJ_GRIDON(wd) == YES)))) + angle = wl_angle (wd, Memi[labels], nlabels) + else + angle = 0.0 + + # Place the labels. + for (i = 1; i <= nlabels; i = i + 1) { + + # Save some pertinent information. + textx = real (WL_LABEL_POSITION(wd,LABEL_LIST(i),AXIS1)) + texty = real (WL_LABEL_POSITION(wd,LABEL_LIST(i),AXIS2)) + do_full = ((LABEL_LIST(i) == full_label) || + (WL_ALWAYS_FULL_LABEL(wd) == YES)) + + # Transform the "unknown" coordinate system to a known + # coordinate system, NDC, for text placement. + call gctran (WL_GP(wd), textx, texty, ndc_textx, ndc_texty, + old_wcs, WL_NDC_WCS(wd)) + + # If angle is undefined, determine the angle for each label. + if (IS_INDEFR(angle)) + tangle = wl_string_angle (WL_LABEL_ANGLE(wd, + LABEL_LIST(i)), WL_LABOUT(wd)) + else + tangle = angle + + # Format and write the label. + call wl_write_label (wd, WL_LABEL_VALUE(wd,LABEL_LIST(i)), + side, ndc_textx, ndc_texty, tangle, axis, prec, do_full, + offset) + } + } + + # Reset the graphics WCS. + call gsetr (WL_GP(wd), G_TXSIZE, old_text_size) + call gseti (WL_GP(wd), G_WCS, old_wcs) + + call sfree (sp) +end + + +# WL_TITLE - Write the title of the graph. + +procedure wl_title (gp, title, side, size, viewport) + +pointer gp # I: the graphics descriptor +char title[ARB] # I: the title to write +int side # I: which side the title will go +real size # I: the character size to write the title +real viewport[N_SIDES] # I: the viewport in NDC to keep the title out of + +int old_wcs +real char_height, char_width, left, right, top, bottom, old_rotation +real old_text_size, x, y +int gstati(), strlen() +real ggetr(), gstatr() + +begin + # Make sure there is a title to write. If not, then punt. + if (strlen (title) <= 0) + return + + # Get/Set pertinent graphics info. + call ggview (gp, left, right, bottom, top) + + old_text_size = gstatr (gp, G_TXSIZE) + call gsetr (gp, G_TXSIZE, size) + old_rotation = gstatr (gp, G_TXUP) + + char_height = ggetr (gp, "ch") * size + char_width = ggetr (gp, "cw") * size + + old_wcs = gstati (gp, G_WCS) + call gseti (gp, G_WCS, NDC_WCS) + + # Depending on side, set text position and rotation. + switch (side) { + case TOP: + call gsetr (gp, G_TXUP, 90.) + x = (right + left) / 2. + y = viewport[TOP] + (2 * char_height) + viewport[TOP] = y + (char_height / 2.) + case BOTTOM: + call gsetr (gp, G_TXUP, 90.) + x = (right + left) / 2. + y = viewport[BOTTOM] - (2 * char_height) + viewport[BOTTOM] = y - (char_height / 2.) + case RIGHT: + call gsetr (gp, G_TXUP, 180.) + x = viewport[RIGHT] + (2 * char_width) + y = (top + bottom) / 2. + viewport[RIGHT] = x + (char_width / 2.) + case LEFT: + call gsetr (gp, G_TXUP, 180.) + x = viewport[LEFT] - (2 * char_width) + y = (top + bottom) / 2. + viewport[LEFT] = x - (char_width / 2.) + } + + # Write the puppy out. + call gtext (gp, x, y, title, "h=c;v=c") + + # Set the graphics state back. + call gseti (gp, G_WCS, old_wcs) + call gsetr (gp, G_TXSIZE, old_text_size) + call gsetr (gp, G_TXUP, old_rotation) +end + + +# WL_PRECISION -- Determine the precision of the interval. + +int procedure wl_precision (wd, axis) + +pointer wd # I: the WCSLAB descriptor +int axis # I: which axis is being examined ? + +int prec + +begin + # Handle the sky coordinates. + if (WL_SYSTEM_TYPE(wd) == RA_DEC) + + if (axis == AXIS1) { + if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (3600.0D0)) + prec = HOUR + else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (60.0D0)) + prec = MINUTE + else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (1.0D0)) + prec = SECOND + else if (WL_MAJOR_INTERVAL(wd,AXIS1) >= STTODEG (.01D0)) + prec = SUBSEC_LOW + else + prec = SUBSEC_HIGH + } else { + if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (3600.0D0)) + prec = DEGREE + else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (60.0D0)) + prec = MINUTE + else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (1.0D0)) + prec = SECOND + else if (WL_MAJOR_INTERVAL(wd,AXIS2) >= SATODEG (.01D0)) + prec = SUBSEC_LOW + else + prec = SUBSEC_HIGH + } + + # Handle other coordinate types. + else + prec = INDEFI + + return (prec) + +end + + +# Define some value constraints. + +define LOW_ACCURACY .01 +define HIGH_ACCURACY .0001 + +# WL_HMS -- Convert value to number in hours, minutes, and seconds. + +procedure wl_hms (rarad, hms, units, maxch, precision, all) + +double rarad # I: the value to format into a string (degrees) +char hms[ARB] # O: string containing formatted value +char units[ARB] # O: string containing formatted units +int maxch # I: the maximum number of characters allowed +int precision # I: how precise the output should be +bool all # I: true if all relevent fields should be formatted + +double accuracy, fraction +int sec, h, m, s +pointer sp, temp_hms, temp_units + +begin + # Get some memory. + call smark (sp) + call salloc (temp_hms, maxch, TY_CHAR) + call salloc (temp_units, maxch, TY_CHAR) + + units[1] = EOS + hms[1] = EOS + + # Define how close to zero is needed. + accuracy = LOW_ACCURACY + if (precision == SUBSEC_HIGH) + accuracy = HIGH_ACCURACY + + # Seconds of time. + fraction = double (abs(DEGTOST (rarad))) + if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) { + sec = int (fraction) + fraction = fraction - double (sec) + } else { + sec = int (fraction + 0.5) + fraction = 0. + } + + # Range: 0 to 24 hours. + if (sec < 0) + sec = sec + STPERDAY + else if (sec >= STPERDAY) + sec = mod (sec, STPERDAY) + + # Separater fields. + s = mod (sec, 60) + m = mod (sec / 60, 60) + h = sec / 3600 + + # Format fields. + + # Subseconds. + if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) { + fraction = s + fraction + if (precision == SUBSEC_LOW) { + call sprintf (hms, 6, "%05.2f") + call pargd (fraction) + call strcpy (" s ", units, maxch) + } else { + call sprintf (hms, 8, "%07.4f") + call pargd (fraction) + call strcpy (" s ", units, maxch) + } + if (!all) + all = (fraction < accuracy) + + # Seconds + } else if (precision == SECOND) { + + # NOTE: The all is not part of the if statement because if + # SUBSEC's have been printed, then seconds have already been + # dealt with. If SUBSEC's have not been dealt with, then this + # is the first field to be checked anyways. + + call sprintf (hms, 3, "%02d ") + call pargi (s) + call strcpy (" s", units, maxch) + if (! all) + all = (s == 0) + } + + # Minutes. + if (precision == MINUTE || (precision > MINUTE && all)) { + if (all) { + call strcpy (hms, Memc[temp_hms], maxch) + call strcpy (units, Memc[temp_units], maxch) + } + call sprintf (hms, 3, "%02d ") + call pargi (m) + call strcpy (" m", units, maxch) + if (all) { + call strcat (Memc[temp_hms], hms, maxch) + call strcat (Memc[temp_units], units, maxch) + } else + all = (m == 0) + } + + # Non-zero hours. + if (precision == HOUR || all) { + if (all) { + call strcpy (hms, Memc[temp_hms], maxch) + call strcpy (units, Memc[temp_units], maxch) + } + call sprintf (hms, 3, "%2.2d ") + call pargi (h) + call strcpy(" h", units, maxch) + if (all) { + call strcat (Memc[temp_hms], hms, maxch) + call strcat (Memc[temp_units], units, maxch) + } + } + + # Release memory + call sfree (sp) +end + + +# WL_DMS - Convert value to number in degrees, minutes, and seconds. + +procedure wl_dms (arcrad, dms, units, maxch, precision, all) + +double arcrad # I: the value to format into a string (degrees) +char dms[ARB] # O: string containing formatted value +char units[ARB] # O: string containing formatted units +int maxch # I: the maximum number of characters allowed +int precision # I: how precise the output should be ? +bool all # I: true if all relavent fields should be formatted + +double accuracy, fraction +int sec, h, m, s +pointer sp, temp_dms, temp_units +int strlen() + +begin + # Get some memory. + call smark (sp) + call salloc (temp_dms, maxch, TY_CHAR) + call salloc (temp_units, maxch, TY_CHAR) + + units[1] = EOS + dms[1] = EOS + + # Define how close to zero is needed. + accuracy = LOW_ACCURACY + if (precision == SUBSEC_HIGH) + accuracy = HIGH_ACCURACY + + # Seconds of time. + fraction = double (abs (DEGTOSA (arcrad))) + if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) { + sec = int (fraction) + fraction = fraction - double (sec) + } else { + sec = nint (fraction) + fraction = 0. + } + + # Separater fields. + s = mod (abs(sec), 60) + m = mod (abs(sec) / 60, 60) + h = abs(sec) / 3600 + + # Format fields + # + # Subseconds. + if (precision == SUBSEC_LOW || precision == SUBSEC_HIGH) { + + fraction = s + fraction + call strcpy (dms, Memc[temp_dms], maxch) + call strcpy (units, Memc[temp_units], maxch) + if (precision == SUBSEC_LOW) { + call sprintf (dms, 6, "%05.2f\"") + call pargd (fraction) + call strcpy (" ", units, maxch) + } else { + call sprintf (dms, 8, "%07.4f\"") + call pargd (fraction) + call strcpy (" ", units, maxch) + } + if (! all) + all = (fraction < accuracy) + call strcat (Memc[temp_dms], dms, maxch) + call strcat (Memc[temp_units], units, maxch) + + # Seconds + } else if (precision == SECOND) { + + # NOTE: The all is not part of the if statement because if + # SUBSEC's have been printed, then seconds have already been + # dealt with. If SUBSEC's have not been dealt with, then this + # is the first field to be checked anyways. + + call strcpy (dms, Memc[temp_dms], maxch) + call strcpy (units, Memc[temp_units], maxch) + call sprintf (dms, 3, "%02d\"") + call pargi (s) + call strcpy (" ", units, maxch) + if (! all) + all = (s == 0) + call strcat (Memc[temp_dms], dms, maxch) + call strcat (Memc[temp_units], units, maxch) + } + + # Minutes. + if (precision == MINUTE || (precision > MINUTE && all)) { + call strcpy (dms, Memc[temp_dms], maxch) + call strcpy (units, Memc[temp_units], maxch) + call sprintf (dms, 3, "%02d'") + call pargi (m) + call strcpy (" ", units, maxch) + call strcat (Memc[temp_dms], dms, maxch) + call strcat (Memc[temp_units], units, maxch) + if (! all) + all = (m == 0) + } + + # Hours. + if (precision == DEGREE || all) { + call strcpy (dms, Memc[temp_dms], maxch) + call strcpy (units, Memc[temp_units], maxch) + if (sec + fraction < accuracy) + call strcpy (" 0 ", dms, maxch) + else if (arcrad < 0.) { + call sprintf (dms, 4, "-%d ") + call pargi (h) + } else { + call sprintf (dms, 4, "+%d ") + call pargi (h) + } + call sprintf(units, 4, "%*wo") + call pargi (strlen (dms) - 1) + call strcat (Memc[temp_dms], dms, maxch) + call strcat (Memc[temp_units], units, maxch) + } + + # Release memory. + call sfree (sp) +end + + +# WL_FULL_LABEL_POSTION -- Find the position where the full label should be. +# +# Description +# This routine returns the index to the label that should be printed +# in its full form, regardless of its value. This is so there is always +# at least one labelled point with the full information. This point is +# choosen by examining which label is the closest to the passed point +# (usually one of the four corners of the display). +# +# Returns +# Index into the labell arrays of the label to be fully printed. +# If the return index is 0, then there are no labels for the given +# side. + +int procedure wl_full_label_position (wd, labels, nlabels, axis, side, + precision) + +pointer wd # I: the WCSLAB descriptor +int labels[nlabels] # I: array of indexes of labels to be printed +int nlabels # I: the number of labels in labels +int axis # I: the axis being dealt with +int side # I: the side being dealt with +int precision # I: precision of the label + +bool all +double cur_dist, dist +int i, cur_label, xside, yside +pointer sp, temp1 +double wl_distanced() + +begin + # Allocate some working space. + call smark (sp) + call salloc (temp1, SZ_LINE, TY_CHAR) + + # Initialize. + xside = INDEFI + yside = INDEFI + + # Determine which corner will have the full label. + if (side == TOP || side == BOTTOM) { + yside = side + if (axis == AXIS1) { + if (WL_LABEL_SIDE(wd,RIGHT,AXIS2)) + xside = RIGHT + if (WL_LABEL_SIDE(wd,LEFT,AXIS2)) + xside = LEFT + } else { + if (WL_LABEL_SIDE(wd,RIGHT,AXIS1)) + xside = RIGHT + if (WL_LABEL_SIDE(wd,LEFT,AXIS1)) + xside = LEFT + } + if (IS_INDEFI (xside)) + xside = LEFT + } else { + xside = side + if (axis == AXIS1) { + if (WL_LABEL_SIDE(wd,TOP,AXIS2)) + yside = TOP + if (WL_LABEL_SIDE(wd,BOTTOM,AXIS2)) + yside = BOTTOM + } else { + if (WL_LABEL_SIDE(wd,TOP,AXIS1)) + yside = TOP + if (WL_LABEL_SIDE(wd,BOTTOM,AXIS1)) + yside = BOTTOM + } + if (IS_INDEFI (yside)) + yside = BOTTOM + } + + # Find the full label. + cur_label = labels[1] + cur_dist = wl_distanced (WL_SCREEN_BOUNDARY(wd,xside), + WL_SCREEN_BOUNDARY(wd,yside), + WL_LABEL_POSITION(wd,cur_label,AXIS1), + WL_LABEL_POSITION(wd,cur_label,AXIS2)) + + # Now go through the rest of the labels to find a closer label. + for (i = 2; i <= nlabels; i = i + 1) { + + # Check to see if the label would be written in full anyways. + all = false + if (WL_SYSTEM_TYPE(wd) == RA_DEC) { + if (WL_LABEL_AXIS(wd, labels[i]) == LONGITUDE) + call wl_hms (WL_LABEL_VALUE(wd, labels[i]), + Memc[temp1], Memc[temp1], SZ_LINE, precision, all) + else + call wl_dms (WL_LABEL_VALUE(wd, labels[i]), + Memc[temp1], Memc[temp1], SZ_LINE, precision, all) + } + + # If so, don't figure out which label should be full, there + # will be one someplace. + if (all) { + cur_label = INDEFI + break + } + + dist = wl_distanced (WL_SCREEN_BOUNDARY(wd,xside), + WL_SCREEN_BOUNDARY(wd,yside), + WL_LABEL_POSITION(wd,labels[i],AXIS1), + WL_LABEL_POSITION(wd,labels[i],AXIS2)) + if (dist < cur_dist) { + cur_dist = dist + cur_label = labels[i] + } + } + + # Release memory. + call sfree (sp) + + # Return the label index. + return (cur_label) +end + + +# WL_WRITE_LABEL - Write the label in the format specified by the WCS type. + +procedure wl_write_label (wd, value, side, x, y, angle, axis, precision, + do_full, offset) + +pointer wd # I: the WCSLAB descriptor +double value # I: the value to use as the label +int side # I: the side the label is going on +real x, y # I: position of the label in NDC coordinates +double angle # I: the angle the text should be written at +int axis # I: which axis is being labelled +int precision # I: level of precision for labels +bool do_full # I: true if the full label should be printed +real offset # I/O: offset for titles in NDC units + +int tside +pointer sp, label, label_format, units, units_format +real char_height, char_width, in_off_x, in_off_y, length +real lx, ly, new_offset, rx, ry, text_angle +real unit_off_x, unit_off_y, ux, uy + +bool fp_equalr() +double wl_string_angle() +int wl_opposite_side(), strlen() +real ggetr(), gstatr() + +begin + # Get some memory. + call smark (sp) + call salloc (label, SZ_LINE, TY_CHAR) + call salloc (units, SZ_LINE, TY_CHAR) + call salloc (label_format, SZ_LINE, TY_CHAR) + call salloc (units_format, SZ_LINE, TY_CHAR) + + # Get character size. This info is used to move the character string + # by the appropriate amounts. + + char_height = ggetr (WL_GP(wd), "ch") * gstatr (WL_GP(wd), G_TXSIZE) + char_width = ggetr (WL_GP(wd), "cw") * gstatr (WL_GP(wd), G_TXSIZE) + + # Determine the "corrected" angle to write text in. + text_angle = wl_string_angle (angle, WL_LABOUT(wd)) + + # Determine the units offset. + call wl_rotate (0., char_height / 2., 1, text_angle - 90., unit_off_x, + unit_off_y) + + # If the labels are to appear inside the graph and the major grid lines + # have been drawn, then determine the necessary offset to get the label + # off the line. + + if ((WL_LABOUT(wd) == NO) && (WL_MAJ_GRIDON(wd) == YES)) + call wl_rotate (0., 0.75 * char_height, 1, text_angle - 90., + in_off_x, in_off_y) + else { + in_off_x = 0. + in_off_y = 0. + } + + # Decode the coordinate into a text string. + switch (WL_SYSTEM_TYPE(wd)) { + case RA_DEC: + if (axis == LONGITUDE) + call wl_hms (value, Memc[label], Memc[units], SZ_LINE, + precision, do_full) + else + call wl_dms (value, Memc[label], Memc[units], SZ_LINE, + precision, do_full) + default: + call sprintf (Memc[label], SZ_LINE, "%.2g") + call pargd (value) + } + + # Set the text justification. + call sprintf (Memc[label_format], SZ_LINE, "h=c;v=c;u=%f") + call pargr (text_angle) + call sprintf (Memc[units_format], SZ_LINE, "h=c;v=c;u=%f") + call pargr (text_angle) + + # Determine offset needed to rotate text about the point of placement. + # NOTE: The STDGRAPH kernel messes up rotate text placement. Try to + # accomodate with extra offset. + + length = .5 * char_width * (2 + strlen (Memc[label])) + call wl_rotate (length, 0., 1, text_angle - 90., rx, ry) + rx = abs (rx) + ry = abs (ry) + + # If labels are to appear inside the graph, then justification should + # appear as if it were done for the opposite side. + if (WL_LABOUT(wd) == YES) + tside = side + else + tside = wl_opposite_side (side) + + # Now add the offsets appropriately. + switch (tside) { + case TOP: + ly = y + ry + in_off_y + unit_off_y + if (fp_equalr (text_angle, 90.)) { + lx = x + ly = ly + unit_off_y + } else if (text_angle < 90.) + lx = x - rx + else + lx = x + rx + lx = lx + in_off_x + new_offset = ry + ry + + case BOTTOM: + ly = y - ry - in_off_y - unit_off_y + if (fp_equalr (text_angle, 90.)) { + lx = x + ly = ly - unit_off_y + } else if (text_angle < 90.) + lx = x + rx + else + lx = x - rx + lx = lx - in_off_x + new_offset = ry + ry + + case LEFT: + lx = x - rx - abs (unit_off_x) + if (text_angle < 90.) { + ly = y + ry - in_off_y + lx = lx - in_off_x + } else { + ly = y - ry + in_off_y + lx = lx + in_off_x + } + new_offset = rx + rx + abs (unit_off_x) + + case RIGHT: + lx = x + rx + abs (unit_off_x) + if (text_angle < 90.) { + ly = y - ry + in_off_y + lx = lx + in_off_x + } else { + ly = y + ry - in_off_y + lx = lx - in_off_x + } + new_offset = rx + rx + abs (unit_off_x) + } + + lx = lx - (unit_off_x / 2.) + ly = ly - (unit_off_y / 2.) + ux = lx + unit_off_x + uy = ly + unit_off_y + + # Print the label. + call gtext (WL_GP(wd), lx, ly, Memc[label], Memc[label_format]) + + # Print the units (if appropriate). + if (WL_SYSTEM_TYPE(wd) == RA_DEC) + call gtext (WL_GP(wd), ux, uy, Memc[units], Memc[units_format]) + + # Determine new maximum string size. + if ((WL_LABOUT(wd) == YES) && (abs (offset) < new_offset)) + if (side == LEFT || side == BOTTOM) + offset = -new_offset + else + offset = new_offset + + # Release memory. + call sfree (sp) +end + + +# WL_STRING_ANGLE -- Produce the angle that a label string should be written to. +# +# Description +# Fixes the input angle so that the output angle is in the range 0 to 180. +# +# Returns +# the angle that the label should be written as. + +double procedure wl_string_angle (angle, right_to_up) + +double angle # I: the input angle in degrees +int right_to_up # I: true if angle near horizontal/vertical are fixed + +double output_angle + +begin + # Try to ensure that the angle is "upright", i.e. the string will not + # be printed upside-down. + + output_angle = angle + if (output_angle > QUARTER_CIRCLE) + output_angle = output_angle - HALF_CIRCLE + if (output_angle < -QUARTER_CIRCLE) + output_angle = output_angle + HALF_CIRCLE + + # If the angle is close to parallel with one of the axis, then just + # print it normally. + + if ((right_to_up == YES) && ((mod (abs (output_angle), + QUARTER_CIRCLE) < MIN_ANGLE) || (QUARTER_CIRCLE - + mod (abs (output_angle), QUARTER_CIRCLE) < MIN_ANGLE))) + output_angle = 0. + + # Return the angle modified for the idiocincracy of GIO text angle + # specification. + + return (output_angle + QUARTER_CIRCLE) +end + + +# WL_ANGLE -- Return the average angle of the labels in the list. +# +# Returns +# Average angle +# +# Description +# So that labels on a side are uniform (in some sense), the average angle +# of all the labels is taken and is defined as the angle that all the labels +# will be printed at. + +double procedure wl_angle (wd, labels, nlabels) + +pointer wd # I: the WCSLAB descriptor +int labels[nlabels] # I: the indexes of the labels to be printed out +int nlabels # I: the number of indexes in the list + +double total, average +int i + +begin + total = 0.0 + for (i = 1; i <= nlabels; i = i + 1) + total = total + WL_LABEL_ANGLE(wd,labels[i]) + average = real (total / nlabels) + + return (average) +end diff --git a/pkg/images/tv/wcslab/wlsetup.x b/pkg/images/tv/wcslab/wlsetup.x new file mode 100644 index 00000000..c37e24ca --- /dev/null +++ b/pkg/images/tv/wcslab/wlsetup.x @@ -0,0 +1,1000 @@ +include <gset.h> +include <mach.h> +include <math.h> +include <math/curfit.h> +include "wcslab.h" +include "wcs_desc.h" + +# WL_SETUP -- Determine all the basic characteristics of the plot. +# +# Description +# Determine basic characteristics of the plot at hand. This involved +# "discovering" what part of the world system covers the screen, the +# orientation of the world to logical systems, what type of graph will +# be produced, etc. Many of the parameters determined here can be +# over-ridden by user-specified values. + +procedure wl_setup (wd) + +pointer wd # I: the WCSLAB descriptor + +bool north +double array[N_EDGES,N_DIM], max_value[N_DIM], min_value[N_DIM] +double range[N_DIM], pole_position[N_DIM], view_edge[N_EDGES,N_DIM] +double wl_coord_rotation() +pointer mw_sctran() +string logtran "logical" +string wrldtran "world" + +begin + # Calculate the transformations from the Logical (pixel space) system + # to the World (possibly anything) system and back. + WL_LWCT(wd) = mw_sctran (WL_MW(wd), logtran, wrldtran, AXIS) + WL_WLCT(wd) = mw_sctran (WL_MW(wd), wrldtran, logtran, AXIS) + + # Indicate whether the center of the transformation is north. + if (WL_SYSTEM_TYPE(wd) == RA_DEC) + north = (WL_WORLD_CENTER(wd,LATITUDE) > 0.0D0) + + # Determine the poles position. + if (WL_SYSTEM_TYPE(wd) == RA_DEC) + call wl_pole_position (WL_WLCT(wd), WL_AXIS_FLIP(wd), + WL_WORLD_CENTER(wd,LONGITUDE), north, WL_SYSTEM_TYPE(wd), + pole_position) + + # Determine graph type based on the system type. + call wl_determine_graph_type (WL_SYSTEM_TYPE(wd), pole_position, + WL_SCREEN_BOUNDARY(wd,1), WL_GRAPH_TYPE(wd)) + + # Now find the extent of the WCS the window views, by constructing + # x,y vectors containing evenly spaced points around the edges of + # the viewing window. + + call wl_construct_edge_vectors (WL_SCREEN_BOUNDARY(wd,1), + view_edge[1,X_DIM], view_edge[1,Y_DIM], N_EDGES) + + # Find the range of the axes over the graphics viewport. + call wl_l2wd (WL_LWCT(wd), WL_AXIS_FLIP(wd), view_edge[1,X_DIM], + view_edge[1,Y_DIM], array[1,AXIS1], array[1,AXIS2], N_EDGES) + call alimd (array[1,AXIS1], N_EDGES, min_value[AXIS1], max_value[AXIS1]) + call alimd (array[1,AXIS2], N_EDGES, min_value[AXIS2], max_value[AXIS2]) + range[AXIS1] = abs (max_value[AXIS1] - min_value[AXIS1]) + range[AXIS2] = abs (max_value[AXIS2] - min_value[AXIS2]) + + # The above isn't good enough for the sky projections. Deal with those. + if (WL_SYSTEM_TYPE(wd) == RA_DEC) + call wl_sky_extrema (wd, array[1,AXIS1], N_EDGES, pole_position, + north, min_value[AXIS1], max_value[AXIS1], range[AXIS1], + min_value[AXIS2], max_value[AXIS2], range[AXIS2]) + + # Determine the rotation between the systems. + WL_ROTA(wd) = wl_coord_rotation (WL_WLCT(wd), WL_AXIS_FLIP(wd), + WL_WORLD_CENTER(wd,AXIS1), max_value[AXIS2], + WL_WORLD_CENTER(wd,AXIS1), min_value[AXIS2]) + + # Round the intervals. This is done to make the labelling "nice" and + # to smooth edge effects. + if (IS_INDEFD (WL_MAJOR_INTERVAL(wd,AXIS1)) || + IS_INDEFD (WL_BEGIN(wd,AXIS1)) || IS_INDEFD (WL_END(wd,AXIS1))) + call wl_round_axis (wd, AXIS1, min_value[AXIS1], max_value[AXIS1], + range[AXIS1]) + + if (IS_INDEFD (WL_MAJOR_INTERVAL(wd,AXIS2)) || + IS_INDEFD (WL_BEGIN(wd,AXIS2)) || IS_INDEFD (WL_END(wd,AXIS2))) + call wl_round_axis (wd, AXIS2, min_value[AXIS2], max_value[AXIS2], + range[AXIS2]) +end + + +# WL_POLE_POSITION -- Determine logical coordinates of a pole. +# +# Description +# Calculate the pole's position in the Logical system. +# +# Bugs +# Can only deal with Right Ascension/Declination. + +procedure wl_pole_position (wlct, flip, longitude, north, system_type, + pole_position) + +pointer wlct # I: the world-to-logical transformation +int flip # I: true if the axes are transposed +double longitude # I: the longitude to determine latitude +bool north # I: true if the pole is in the north +int system_type # I: type of system being examined +double pole_position[N_DIM] # O: the pole's logical coordinates + +double sgn + +begin + switch (system_type) { + + # For Right Ascension/Declination, the pole is at any longitude but + # at only 90 degrees (north) or -90 degrees (south) latitude. + case RA_DEC: + if (north) + sgn = NORTH_POLE_LATITUDE + else + sgn = SOUTH_POLE_LATITUDE + call wl_w2ld (wlct, flip, longitude, sgn, pole_position[X_DIM], + pole_position[Y_DIM], 1) + } + + # Sanity check on the pole position. It is very likely that there is + # no valid position in pixel space for the pole. This is checked for + # by looking for extremely large numbers. + if (abs (pole_position[X_DIM]) > abs (double (MAX_INT))) + pole_position[X_DIM] = real (MAX_INT) + if (abs (pole_position[Y_DIM]) > abs (double (MAX_INT))) + pole_position[Y_DIM] = real (MAX_INT) +end + + +# How close can the pole be to the center of the screen to be near-polar. +define HOW_CLOSE 3. + +# WL_DETERMINE_GRAPH_TYPE -- Determine the actual graph type. + +procedure wl_determine_graph_type (system_type, pole_position, + screen_boundary, graph_type) + +int system_type # I: the type of WCS being dealt with +double pole_position[N_DIM] # I: the location of the pole +double screen_boundary[N_SIDES] # I: the edges of the display +int graph_type # O: the graph type + +double max_dist, pole_dist, xcen, ycen + +begin + # Determine graph type based on axis type. + switch (system_type) { + + # If the pole is on the graph then force a graph_type of polar. + case RA_DEC: + + xcen = (screen_boundary[LEFT] + screen_boundary[RIGHT]) / 2. + ycen = (screen_boundary[BOTTOM] + screen_boundary[TOP]) / 2. + max_dist = min ((screen_boundary[LEFT] - xcen) ** 2, + (screen_boundary[TOP] - ycen)**2) + pole_dist = (pole_position[X_DIM] - xcen) ** 2 + + (pole_position[Y_DIM] - ycen) ** 2 + + # Check to see whether the graph is "polar", "near_polar" + # or "normal". If the pole lies within middle part of the + # viewport, then the graph is "polar". If the pole is within + # a certain maximum distance then it is "near_polar". + # Otherwise it is normal. + + switch (graph_type) { + case NORMAL: + # do nothing + case POLAR: + # do nothing + case NEAR_POLAR: + # do nothing + default: + if (pole_dist < max_dist) + graph_type = POLAR + else if (pole_dist < HOW_CLOSE * max_dist) + graph_type = NEAR_POLAR + else + graph_type = NORMAL + } + + # For all other cases, explicitely set this to normal. + default: + graph_type = NORMAL + } +end + + +# WL_CONSTRUCT_EDGE_VECTORS -- Construct vectors of values along window's edge. +# +# Description +# This routines filles two arrays, with the x-values and y-values of +# evenly spaced points along the edges of the screen. This is used to +# make transformation of the logical edges into the world system +# more convenient. + +procedure wl_construct_edge_vectors (screen_boundary, x, y, vector_size) + +double screen_boundary[N_SIDES] # I: the side values +double x[vector_size], y[vector_size] # O: the edge vector points +int vector_size # I: the number of edge vector points + +double current, interval +int i, left_over, offset1, offset2, side_length + +begin + # Divide the vectors into equal amounts for each side. + side_length = vector_size / N_SIDES + left_over = mod (vector_size, N_SIDES) + + # Calculate the horizontal components. + interval = (screen_boundary[RIGHT] - screen_boundary[LEFT]) / + side_length + current = screen_boundary[LEFT] + offset1 = side_length + for (i = 1; i <= side_length; i = i + 1) { + x[i] = current + interval + y[i] = screen_boundary[BOTTOM] + x[i+offset1] = current + y[i+offset1] = screen_boundary[TOP] + current = current + interval + } + + # Calculate the verticle components. + interval = (screen_boundary[TOP] - screen_boundary[BOTTOM]) / + side_length + current = screen_boundary[BOTTOM] + offset1 = 2 * side_length + offset2 = 3 * side_length + for (i = 1; i <= side_length; i = i + 1) { + x[i+offset1] = screen_boundary[LEFT] + y[i+offset1] = current + x[i+offset2] = screen_boundary[RIGHT] + y[i+offset2] = current + interval + current = current + interval + } + + # Fill in the left over with a single point. + offset1 = 4 * side_length + for (i = 1; i <= left_over; i = i + 1) { + x[i+offset1] = screen_boundary[LEFT] + y[i+offset1] = screen_boundary[BOTTOM] + } + +end + + +# WL_SKY_EXTREMA -- Determine what range the view window covers in the sky. +# This routine is only called if the WCS RA,DEC. +# +# Description +# Because of the different graph types and the fact that axis 1 usually +# wraps, more work needs to be done to determine what part of the sky +# is covered by the viewing window. + +procedure wl_sky_extrema (wd, ax1_array, n_points, pole_position, north, + ax1min, ax1max, ax1ran, ax2min, ax2max, ax2ran) + +pointer wd # I: the WCSLAB descriptor +double ax1_array[n_points] # I: the axis 1 edge vector +int n_points # I: the length of the edge vector +double pole_position[N_DIM] # I: the pole position +bool north # I: is the pole in the north ? +double ax1min, ax1max, ax1ran # I/O: the minimum, maximum, range in axis 1 +double ax2min, ax2max, ax2ran # I/O: the minimum, maximum, range in axis 2 + +bool is_pole +double nx, ny, xcen, ycen +int wl_direction_from_axis1(), wl_find_side(), wl_opposite_side() + +begin + # Is the pole on the graph ? + if ((pole_position[X_DIM] < WL_SCREEN_BOUNDARY(wd,LEFT)) || + (pole_position[X_DIM] > WL_SCREEN_BOUNDARY(wd,RIGHT)) || + (pole_position[Y_DIM] < WL_SCREEN_BOUNDARY(wd,BOTTOM)) || + (pole_position[Y_DIM] > WL_SCREEN_BOUNDARY(wd,TOP))) + is_pole = false + else + is_pole = true + + # If so adjust the RA and DEC ranges appropriately. + if (is_pole) { + + # Set the RA range. + ax1min = 0.0D0 + ax1max = 359.9D0 + ax1ran = 360.0D0 + + # Set the dec range. + if (north) + ax2max = NORTH_POLE_LATITUDE - ((NORTH_POLE_LATITUDE - + ax2min) * DISTANCE_TO_POLE ) + else + ax2min = SOUTH_POLE_LATITUDE + ((NORTH_POLE_LATITUDE + + ax2max) * DISTANCE_TO_POLE) + ax2ran = abs (ax2max - ax2min) + + # Mark the pole. + call gmark (WL_GP(wd), real (pole_position[X_DIM]), + real (pole_position[Y_DIM]), POLE_MARK_SHAPE, POLE_MARK_SIZE, + POLE_MARK_SIZE) + + } else { + # Only the RA range needs adjusting. + call wl_ra_range (ax1_array, n_points, ax1min, ax1max, ax1ran) + } + + # Adjust the labelling characteristics appropritatley for various + # types of graphs. + + if (WL_GRAPH_TYPE(wd) == POLAR) { + + # Determine which direction the axis 2's will be labeled on polar + # graphs. + if (IS_INDEFD (WL_POLAR_LABEL_POSITION(wd))) { + call wl_get_axis2_label_direction (WL_LWCT(wd), + WL_AXIS_FLIP(wd), pole_position, WL_SCREEN_BOUNDARY(wd,1), + WL_POLAR_LABEL_POSITION(wd), WL_BAD_LABEL_SIDE(wd)) + } else { + WL_BAD_LABEL_SIDE(wd) = wl_direction_from_axis1 (WL_WLCT(wd), + WL_AXIS_FLIP(wd), pole_position, north, + WL_POLAR_LABEL_POSITION(wd), WL_BEGIN(wd,AXIS2), + WL_END(wd,AXIS2), WL_SCREEN_BOUNDARY(wd,1)) + if (IS_INDEFI (WL_BAD_LABEL_SIDE(wd))) + WL_BAD_LABEL_SIDE(wd) = BOTTOM + } + + # If the graph type is polar, then determine how to justify + # the labels. + + if (IS_INDEFI (WL_POLAR_LABEL_DIRECTION(wd))) + WL_POLAR_LABEL_DIRECTION(wd) = + wl_opposite_side (WL_BAD_LABEL_SIDE(wd)) + + # If the graph_type is near-polar, then handle the directions a bit + # differently. + } else if (WL_GRAPH_TYPE(wd) == NEAR_POLAR) { + + # Find the side that the pole is on. + xcen = (WL_SCREEN_BOUNDARY(wd,LEFT) + + WL_SCREEN_BOUNDARY(wd,RIGHT)) / 2. + ycen = (WL_SCREEN_BOUNDARY(wd,BOTTOM) + + WL_SCREEN_BOUNDARY(wd,TOP)) / 2. + call wl_axis_on_line (xcen, ycen, pole_position[X_DIM], + pole_position[Y_DIM], WL_SCREEN_BOUNDARY(wd,1), nx, ny) + + if (IS_INDEFD(nx) || IS_INDEFD(ny)) { + WL_BAD_LABEL_SIDE(wd) = BOTTOM + WL_POLAR_LABEL_DIRECTION(wd) = LEFT + } else { + WL_BAD_LABEL_SIDE(wd) = wl_find_side (nx, ny, + WL_SCREEN_BOUNDARY(wd,1)) + if (WL_BAD_LABEL_SIDE(wd) == LEFT || WL_BAD_LABEL_SIDE(wd) == + RIGHT) + if (abs (ny - WL_SCREEN_BOUNDARY(wd,BOTTOM)) < + abs (ny - WL_SCREEN_BOUNDARY(wd,TOP))) + WL_POLAR_LABEL_DIRECTION(wd) = BOTTOM + else + WL_POLAR_LABEL_DIRECTION(wd) = TOP + else + if (abs (nx - WL_SCREEN_BOUNDARY(wd,LEFT)) < + abs (nx - WL_SCREEN_BOUNDARY(wd,RIGHT))) + WL_POLAR_LABEL_DIRECTION(wd) = LEFT + else + WL_POLAR_LABEL_DIRECTION(wd) = RIGHT + } + + } +end + + +# WL_COORD_ROTATION -- Determine "rotation" between the coordinate systems. +# +# Description +# This routine takes the world-to-logical coordinate transformation and +# two points in the world system which should define the positive verticle +# axis in the world system. These points are translated into the logical +# system and the angle between the logical vector and its positive verticle +# vector is calculated and returned. The rotation angle is returned +# in degrees and is always positive. + +double procedure wl_coord_rotation (wlct, flip, wx1, wy1, wx2, wy2) + +pointer wlct # I: the world-to-logical transformation +int flip # I: true if the coordinates are transposed +double wx1, wy1, wx2, wy2 # I: points in world space to figure rotation from + +double delx, dely, rota, x1, y1, x2, y2 +bool fp_equald() + +begin + # Transform the points to the logical system. + call wl_w2ld (wlct, flip, wx1, wy1, x1, y1, 1) + call wl_w2ld (wlct, flip, wx2, wy2, x2, y2, 1) + + # Determine the rotation. + delx = x2 - x1 + dely = y2 - y1 + if (fp_equald (delx, 0.0D0) && fp_equald (dely, 0.0D0)) + rota = 0. + else + rota = RADTODEG (atan2 (dely, delx)) + + if (rota < 0.0D0) + rota = rota + FULL_CIRCLE + + return (rota) +end + + +# Define how many axis one should go for. + +define RA_NUM_TRY 6 +define DEC_NUM_TRY 6 +define DEC_POLAR_NUM_TRY 4 + +# WL_ROUND_AXIS - Round values for the axis. + +procedure wl_round_axis (wd, axis, minimum, maximum, range) + +pointer wd # I: the WCSLAB descriptor +int axis # I: the axis being worked on +double minimum, maximum, range # I: raw values to be rounded + +int num_try + +begin + # Depending on axis type, round the values. + switch (WL_SYSTEM_TYPE(wd)) { + case RA_DEC: + if (axis == LONGITUDE) + call wl_round_ra (minimum, maximum, range, RA_NUM_TRY, + WL_BEGIN(wd,LONGITUDE), WL_END(wd,LONGITUDE), + WL_MAJOR_INTERVAL(wd,LONGITUDE)) + else { + if (WL_GRAPH_TYPE(wd) == POLAR) + num_try = DEC_POLAR_NUM_TRY + else + num_try = DEC_NUM_TRY + call wl_round_dec (minimum, maximum, range, num_try, + WL_BEGIN(wd,LATITUDE), WL_END(wd,LATITUDE), + WL_MAJOR_INTERVAL(wd,LATITUDE)) + } + + default: + call wl_generic_round (minimum, maximum, range, WL_BEGIN(wd,axis), + WL_END(wd,axis), WL_MAJOR_INTERVAL(wd,axis)) + } + +end + + +# WL_GET_AXIS2_LABEL_DIRECTION -- Dertermine label direction for latitides. +# +# Description +# Determine from which edge of the graph the axis 2 labels are to +# appear. This (in general) is the opposite edge from which the pole +# is nearest to. Move the pole to the closest edges, determine which +# side it is, then chose the direction as the opposite. Also determines +# the Axis 1 at which the Axis 2 labels will appear. + +procedure wl_get_axis2_label_direction (lwct, flip, pole_position, + screen_boundary, pole_label_position, bad_label_side) + +pointer lwct # I: logical-to-world transformation +int flip # I: true if the axis are transposed +double pole_position[N_DIM] # I: the position of the pole +double screen_boundary[N_SIDES] # I: the edges of the screen +double pole_label_position # O: the axis 1 that axis 2 labels should + # appear for polar|near-polar graphs +int bad_label_side # O: side not to place axis 1 labels + +double dif, tdif, dummy + +begin + # Determine which direction, up or down, the axis 2's will be labelled. + dif = abs (screen_boundary[TOP] - pole_position[AXIS2]) + bad_label_side= TOP + tdif = abs (screen_boundary[BOTTOM] - pole_position[AXIS2]) + if (tdif < dif) { + dif = tdif + bad_label_side = BOTTOM + } + + # Determine at what value of Axis 1 the Axis 2 labels should appear. + switch (bad_label_side) { + case TOP: + call wl_l2wd (lwct, flip, pole_position[AXIS1], + screen_boundary[BOTTOM], pole_label_position, dummy, 1) + case BOTTOM: + call wl_l2wd (lwct, flip, pole_position[AXIS1], + screen_boundary[TOP], pole_label_position, dummy, 1) + case LEFT: + call wl_l2wd (lwct, flip, screen_boundary[RIGHT], + pole_position[AXIS2], pole_label_position, dummy, 1) + case RIGHT: + call wl_l2wd (lwct, flip, screen_boundary[LEFT], + pole_position[AXIS2], pole_label_position, dummy, 1) + } + +end + + +# WL_DIRECTION_FROM_AXIS1 -- Determine axis 2 label direction from axis 1. +# +# Function Returns +# This returns the side where Axis 1 should not be labelled. + +int procedure wl_direction_from_axis1 (wlct, flip, pole_position, north, + polar_label_position, lbegin, lend, screen_boundary) + +pointer wlct # I: world-to-logical transformation +int flip # I: true if the axes are transposed +double pole_position[N_DIM] # I: the pole position +bool north # I: true if the pole is the north pole +double polar_label_position # I: the axis 1 where axis 2 will be + # marked +double lbegin # I: low end of axis 2 +double lend # I: high end of axis 2 +double screen_boundary[N_SIDES] # I: the window boundary + +double nx, ny, cx, cy +int wl_find_side() + +begin + # Determine the point in logical space where the axis 1 and the + # minimum axis 2 meet. + + if (north) + call wl_w2ld (wlct, flip, polar_label_position, lbegin, nx, ny, 1) + else + call wl_w2ld (wlct, flip, polar_label_position, lend, nx, ny, 1) + + # This line should cross a window boundary. Find that point. + + call wl_axis_on_line (pole_position[X_DIM], pole_position[Y_DIM], + screen_boundary, nx, ny, cx, cy) + + # Get the side that the crossing point is. This is the axis 2 labelling + # direction. + + if (IS_INDEFD(cx) || IS_INDEFD(cy)) + return (INDEFI) + else + return (wl_find_side (cx, cy, screen_boundary)) +end + + +# WL_OPPOSITE_SIDE - Return the opposite of the given side. +# +# Returns +# The opposite side of the specified side as follows: +# RIGHT -> LEFT +# LEFT -> RIGHT +# TOP -> BOTTOM +# BOTTOM -> TOP + +int procedure wl_opposite_side (side) + +int side # I: the side to find the opposite of + +int new_side + +begin + switch (side) { + case LEFT: + new_side = RIGHT + case RIGHT: + new_side = LEFT + case TOP: + new_side = BOTTOM + case BOTTOM: + new_side = TOP + } + + return (new_side) +end + + +# Define whether things are on the screen boundary or on them. + +define IN (($1>=screen_boundary[LEFT])&&($1<=screen_boundary[RIGHT])&&($2>=screen_boundary[BOTTOM])&&($2<=screen_boundary[TOP])) + + +# WL_AXIS_ON_LINE - Determine intersection of line and a screen boundary. +# +# Description +# Return the point where the line defined by the two input points +# crosses a screen boundary. The boundary is choosen by determining +# which one is between the two points. + +procedure wl_axis_on_line (x0, y0, x1, y1, screen_boundary, nx, ny) + +double x0, y0, x1, y1 # I: random points in space +double screen_boundary[N_SIDES] # I: sides of the window +double nx, ny # O: the closest point on a window boundary + +double x_val[N_SIDES], y_val[N_SIDES], tx0, ty0, tx1, ty1, w[2] +int i +pointer cvx, cvy +double dcveval() + +begin + # Get the line parameters. + x_val[1] = x0 + x_val[2] = x1 + y_val[1] = y0 + y_val[2] = y1 + + iferr (call dcvinit (cvx, CHEBYSHEV, 2, min (x0, x1), max (x0, x1))) + cvx = NULL + else { + call dcvfit (cvx, x_val, y_val, w, 2, WTS_UNIFORM, i) + if (i != OK) + call error (i, "wlaxie: Error solving on X") + } + + iferr (call dcvinit (cvy, CHEBYSHEV, 2, min (y0, y1), max (y0, y1))) + cvy = NULL + else { + call dcvfit (cvy, y_val, x_val, w, 2, WTS_UNIFORM, i) + if (i != OK) + call error (i, "wlaxie: Error solving on Y") + } + + # Solve for each side. + x_val[LEFT] = screen_boundary[LEFT] + if (cvx == NULL) + y_val[LEFT] = screen_boundary[LEFT] + else + y_val[LEFT] = dcveval (cvx, x_val[LEFT]) + + x_val[RIGHT] = screen_boundary[RIGHT] + if (cvx == NULL ) + y_val[RIGHT] = screen_boundary[RIGHT] + else + y_val[RIGHT] = dcveval (cvx, x_val[RIGHT]) + + y_val[TOP] = screen_boundary[TOP] + if (cvy == NULL) + x_val[TOP] = screen_boundary[TOP] + else + x_val[TOP] = dcveval (cvy, y_val[TOP]) + + y_val[BOTTOM] = screen_boundary[BOTTOM] + if (cvy == NULL) + x_val[BOTTOM] = screen_boundary[BOTTOM] + else + x_val[BOTTOM] = dcveval (cvy, y_val[BOTTOM]) + + # Rearrange the input points to be in ascending order. + if (x0 < x1) { + tx0 = x0 + tx1 = x1 + } else { + tx0 = x1 + tx1 = x0 + } + + if (y0 < y1) { + ty0 = y0 + ty1 = y1 + } else { + ty0 = y1 + ty1 = y0 + } + + # Now find which point is between the two given points and is within + # the viewing area. + # NOTE: Conversion to real for the check- if two points are so close + # for double, any of them would serve as the correct answer. + + nx = INDEFD + ny = INDEFD + for (i = 1; i <= N_SIDES; i = i + 1) + if (real (tx0) <= real (x_val[i]) && + real (x_val[i]) <= real (tx1) && + real (ty0) <= real (y_val[i]) && + real (y_val[i]) <= real (ty1) && + IN (x_val[i], y_val[i]) ) { + nx = x_val[i] + ny = y_val[i] + } + + # Release the curve fit descriptors. + if (cvx != NULL) + call dcvfree (cvx) + if (cvy != NULL) + call dcvfree (cvy) +end + + +# WL_FIND_SIDE -- Return the side that the given point is lying on. +# +# Function Returns +# Return the side, TOP, BOTTOM, LEFT, or RIGHT, that the specified +# point is lying on. One of the coordinates must be VERY CLOSE to one of +# the sides or INDEFI will be returned. + +int procedure wl_find_side (x, y, screen_boundary) + +double x, y # I: the point to inquire about +double screen_boundary[N_SIDES] # I: the edges of the screen + +double dif, ndif +int side + +begin + dif = abs (x - screen_boundary[LEFT]) + side = LEFT + + ndif = abs (x - screen_boundary[RIGHT]) + if (ndif < dif) { + side = RIGHT + dif = ndif + } + + ndif = abs (y - screen_boundary[BOTTOM]) + if (ndif < dif) { + side = BOTTOM + dif = ndif + } + + ndif = abs (y - screen_boundary[TOP]) + if (ndif < dif) + side = TOP + + return (side) +end + + +# WL_RA_RANGE -- Determine the range in RA given a list of possible values. +# +# Description +# Determine the largest range in RA from the provided list of values. +# The problem here is that it is unknown which way the graph is oriented. +# To simplify the problem, it is assume that the graph range does not extend +# beyond a hemisphere and that all distances in RA is less than a hemisphere. +# This assumption is needed to decide when the 0 hour is on the graph. + +procedure wl_ra_range (ra, n_values, min, max, diff) + +double ra[ARB] # I: the possible RA values +int n_values # I: the number of possible RA values +double min # I/O: the minimum RA +double max # I/O: the maximum RA +double diff # I/O: the difference between minimum and maximum + +bool wrap +int i, j, n_diffs +pointer sp, max_array, min_array, ran_array +int wl_max_element_array() + +begin + call smark (sp) + call salloc (max_array, n_values * n_values, TY_DOUBLE) + call salloc (min_array, n_values * n_values, TY_DOUBLE) + call salloc (ran_array, n_values * n_values, TY_DOUBLE) + + # Check whether the RA is wrapped or not. + n_diffs = 0 + do i = 1, n_values { + if (ra[i] >= min && ra[i] <= max) + next + n_diffs = n_diffs + 1 + } + if (n_diffs > 0) + wrap = true + else + wrap = false + + n_diffs = 0 + for (i = 1; i <= n_values; i = i + 1) { + for (j = i + 1; j <= n_values; j = j + 1) { + n_diffs = n_diffs + 1 + call wl_getradif (ra[i], ra[j], Memd[min_array+n_diffs-1], + Memd[max_array+n_diffs-1], Memd[ran_array+n_diffs-1], + wrap) + } + } + + i = wl_max_element_array (Memd[ran_array], n_diffs) + min = Memd[min_array+i-1] + max = Memd[max_array+i-1] + diff = Memd[ran_array+i-1] + + call sfree (sp) +end + + +# WL_GETRADIFF -- Get differences in RA based on degrees. +# +# Description +# This procedure determines, given two values in degrees, the minimum, +# maximum, and difference of those values. The assumption is that no +# difference should be greater than half a circle. Based on this assumption, +# a difference is found and the minimum and maximum are determined. The +# maximum can be greater than 360 degrees. + +procedure wl_getradif (val1, val2, min, max, diff, wrap) + +double val1, val2 # I: the RA values +double min, max # O: the min RA and max RA (possibly > 360.0) +double diff # O: the min, max difference +bool wrap # I: is the ra wrapped ? + +begin + if (! wrap && (abs (val1 - val2) > HALF_CIRCLE)) + if (val1 < val2) { + min = val2 + max = val1 + FULL_CIRCLE + } else { + min = val1 + max = val2 + FULL_CIRCLE + } + else + if (val1 < val2) { + min = val1 + max = val2 + } else { + min = val2 + max = val1 + } + diff = max - min +end + + +define NRAGAP 26 + +# WL_ROUND_RA -- Modify the RA limits and calculate an interval to label. +# +# Description +# The RA limits determine by just the extremes of the window ususally do +# not fall on "reasonable" boundaries; i.e. essentially they are random +# numbers. However, for labelling purposes, it is nice to have grids and +# tick marks for "rounded" numbers- For RA, this means values close to +# whole hours, minutes, or seconds. For example, if the span across the +# plot is a few hours, the marks and labels should represent simply whole +# hours. This routine determines new RA limits based on this and some +# interval to produce marks between the newly revised limits. + +procedure wl_round_ra (longmin, longmax, longran, num_try, minimum, maximum, + major_interval) + +double longmin # I: longitude minimum +double longmax # I: longitude maximum +double longran # I: longitude range +int num_try # I: the number of intervals to try for +double minimum # O: the minimum RA value (in degrees) +double maximum # O: the maximum RA value (in degrees) +double major_interval # O: the appropriate interval (in degrees) for the + # major line marks. + +double ragap[NRAGAP] +double wl_check_arrayd(), wl_round_upd() +data ragap / 1.0D-4, 2.0D-4, 5.0D-4, 1.0D-3, 2.0D-3, 5.0D-3, + 0.01D0, 0.02D0, 0.05D0, 0.1D0, 0.2D0, 0.5D0, 1.0D0, + 2.0D0, 5.0D0, 10.0D0, 20.0D0, 30.0D0, 60.0D0, 120.0D0, + 300.0D0, 600.0D0, 1.2D3, 1.8D3, 3.6D3, 7.2D3 / + + +begin + major_interval = wl_check_arrayd (DEGTOST (longran) / num_try, + ragap, NRAGAP) + minimum = STTODEG (wl_round_upd (DEGTOST (longmin), major_interval) - + major_interval) + maximum = STTODEG (wl_round_upd (DEGTOST (longmax), major_interval)) + major_interval = STTODEG (major_interval) +end + + +define NDECGAP 28 + +# WL_ROUND_DEC -- Modify the DEC limits and calculate an interval to label. +# +# Description +# The DEC limits determine by just the extremes of the window ususally do +# not fall on "reasonable" boundaries; i.e. essentially they are random +# numbers. However, for labelling purposes, it is nice to have grids and +# tick marks for "rounded" numbers- For DEC, this means values close to +# whole degrees, minutes, or seconds. For example, if the span across the +# plot is a few degrees, the marks and labels should represent simply whole +# degrees. This routine determines new DEC limits based on this and some +# interval to produce marks between the newly revised limits. + +procedure wl_round_dec (latmin, latmax, latran, num_try, minimum, maximum, + major_interval) + +double latmin # I: the latitude minimum +double latmax # I: the latitude maximum +double latran # I: the latitude range +int num_try # I: number of intervals to try for +double minimum # O: the DEC minimum +double maximum # O: the DEC maximum +double major_interval # O: the labelling interval to use for major lines + +double decgap[NDECGAP] +double wl_check_arrayd(), wl_round_upd() +data decgap / 1.0D-4, 2.0D-4, 5.0D-4, 1.0D-3, 2.0D-3, 5.0D-3, + 0.01D0, 0.02D0, 0.05D0, 0.1D0, 0.2D0, 0.5D0, 1.0D0, + 2.0D0, 5.0D0, 10.0D0,20.0D0, 30.0D0, 60.0D0, 120.0d0, + 300.0D0, 600.0D0, 1.2D3, 1.8D3, 3.6D3, 7.2D3, 1.8D4, 3.6D4 / + +begin + major_interval = wl_check_arrayd (DEGTOSA (latran) / num_try, + decgap, NDECGAP) + minimum = SATODEG (wl_round_upd (DEGTOSA (latmin), major_interval) - + major_interval) + maximum = SATODEG (wl_round_upd (DEGTOSA (latmax), major_interval)) + major_interval = SATODEG (major_interval) + + # Make sure that the grid marking does not include the pole. + maximum = min (maximum, NORTH_POLE_LATITUDE - major_interval) + minimum = max (minimum, SOUTH_POLE_LATITUDE + major_interval) +end + + +# WL_GENERIC_ROUND -- Round the values (if possible). +# +# History +# 7Feb91 - Created by Jonathan D. Eisenhamer, STScI. + +procedure wl_generic_round (minimum, maximum, range, lbegin, lend, interval) + +double minimum, maximum, range # I: the raw input values +double lbegin, lend # O: the begin and end label points +double interval # O: the major label interval + +double amant, diff +int iexp, num +double wl_round_upd() + +begin + diff = log10 (abs (range) / 4.D0) + iexp = int (diff) + if (diff < 0) + iexp = iexp - 1 + + amant = diff - double (iexp) + if (amant < 0.15D0) + num = 1 + else if (amant < 0.50D0) + num = 2 + else if (amant < 0.85D0) + num = 5 + else + num = 10 + + interval = double (num) * 10.0D0 ** iexp + lbegin = wl_round_upd (minimum, interval) - interval + lend = wl_round_upd (maximum, interval) +end + + +# WL_ROUND_UPD -- Round X up to nearest whole multiple of Y. + +double procedure wl_round_upd (x, y) + +double x # I: value to be rounded +double y # I: multiple of X is to be rounded up in + +double z, r + +begin + if (x < 0.0D0) + z = 0.0D0 + else + z = y + r = y * double (int ((x + z) / y)) + + return (r) +end + + + +# WL_CHECK_ARRAYD -- Check proximity of array elements to each other. +# +# Description +# Returns the element of the array arr(n) which is closest to an exact +# value EX. + +double procedure wl_check_arrayd (ex, arr, n) + +double ex # I: the exact value +double arr[ARB] # I: the array of rounded values +int n # I: dimension of array of rounded values + +int j + +begin + for (j = 1; j < n && (ex - arr[j]) > 0.0D0; j = j + 1) + ; + if (j > 1 && j < n) + if (abs (ex - arr[j-1]) < abs (ex - arr[j])) + j = j - 1 + + return (arr[j]) +end diff --git a/pkg/images/tv/wcslab/wlutil.x b/pkg/images/tv/wcslab/wlutil.x new file mode 100644 index 00000000..c79b8f5e --- /dev/null +++ b/pkg/images/tv/wcslab/wlutil.x @@ -0,0 +1,390 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imio.h> +include <imhdr.h> +include <gset.h> +include <math.h> + +# WL_IMD_VIEWPORT -- Map the viewport and window of the image display. + +procedure wl_imd_viewport (frame, im, c1, c2, l1, l2, vl, vr, vb, vt) + +int frame # I: display frame to be overlayed +pointer im # I: pointer to the input image +real c1, c2, l1, l2 # I/O: input/output window +real vl, vr, vb, vt # I/O: input/output viewport + +int wcs_status, dim1, dim2, step1, step2 +pointer sp, frimage, frim, iw +real x1, x2, y1, y2, fx1, fx2, fy1, fy2, junkx, junky +real vx1, vx2, vy1, vy2, nx1, nx2, ny1, ny2 +pointer imd_mapframe(), iw_open() + + +begin + # If all of the viewport parameters were defined by the user + # use the default viewport and window. + if (! IS_INDEFR(vl) && ! IS_INDEFR(vr) && ! IS_INDEFR(vb) && + ! IS_INDEFR(vt)) + return + + # Allocate some memory. + call smark (sp) + call salloc (frimage, SZ_FNAME, TY_CHAR) + + # Open the requested display frame and get the loaded image name. + # If this name is blank, use the default viewport and window. + + frim = imd_mapframe (frame, READ_ONLY, YES) + iw = iw_open (frim, frame, Memc[frimage], SZ_FNAME, wcs_status) + if (Memc[frimage] == EOS || wcs_status == ERR) { + call iw_close (iw) + call imunmap (frim) + call sfree (sp) + return + } + + # Find the beginning and end points of the requested image section. + # We already know at this point that the input logical image is + # 2-dimensional. However this 2-dimensional section may be part of + # n-dimensional image. + + # X dimension. + dim1 = IM_VMAP(im,1) + step1 = IM_VSTEP(im,1) + if (step1 >= 0) { + x1 = IM_VOFF(im,dim1) + 1 + x2 = x1 + IM_LEN(im,1) - 1 + } else { + x1 = IM_VOFF(im,dim1) - 1 + x2 = x1 - IM_LEN(im,1) + 1 + } + + # Y dimension. + dim2 = IM_VMAP(im,2) + step2 = IM_VSTEP(im,2) + if (step2 >= 0) { + y1 = IM_VOFF(im,dim2) + 1 + y2 = y1 + IM_LEN(im,2) - 1 + } else { + y1 = IM_VOFF(im,dim2) - 1 + y2 = y1 - IM_LEN(im,2) + 1 + } + + # Get the frame buffer coordinates corresponding to the lower left + # and upper right corners of the image section. + + call iw_im2fb (iw, x1, y1, fx1, fy1) + call iw_im2fb (iw, x2, y2, fx2, fy2) + if (fx1 > fx2) { + junkx = fx1 + fx1 = fx2 + fx2 = junkx + } + if (fy1 > fy2) { + junky = fy1 + fy1 = fy2 + fy2 = junky + } + + # Check that some portion of the input image is in the display. + # If not select the default viewport and window coordinates. + if (fx1 > IM_LEN(frim,1) || fx2 < 1.0 || fy1 > IM_LEN(frim,2) || + fy2 < 1.0) { + call iw_close (iw) + call imunmap (frim) + call sfree (sp) + return + } + + # Compute a new viewport and window for X. + if (fx1 >= 1.0) { + vx1 = max (0.0, min (1.0, (fx1 - 0.5) / IM_LEN(frim,1))) + nx1 = 1.0 + } else { + vx1 = 0.0 + call iw_fb2im (iw, 1.0, 1.0, junkx, junky) + if (step1 >= 0) + nx1 = max (1.0, junkx - x1 + 1.0) + else + nx2 = max (1.0, junkx - x2 + 1.0) + } + if (fx2 <= IM_LEN(frim,1)) { + vx2 = max (0.0, min (1.0, (fx2 + 0.5) / IM_LEN(frim,1))) + nx2 = IM_LEN(im,1) + } else { + vx2 = 1.0 + call iw_fb2im (iw, real(IM_LEN(frim,1)), real (IM_LEN(frim,2)), + junkx, junky) + if (step1 >= 0) + nx2 = min (real (IM_LEN(im,1)), junkx - x1 + 1.0) + else + nx1 = min (real (IM_LEN(im,1)), junkx - x2 + 1.0) + } + + # Compute a new viewport and window for Y. + if (fy1 >= 1.0) { + vy1 = max (0.0, min (1.0, (fy1 - 0.5) / IM_LEN(frim,2))) + ny1 = 1.0 + } else { + vy1 = 0.0 + call iw_fb2im (iw, 1.0, 1.0, junkx, junky) + if (step2 >= 0) + ny1 = max (1.0, junky - y1 + 1) + else + ny2 = max (1.0, junky - y2 + 1) + } + if (fy2 <= IM_LEN(frim,2)) { + vy2 = max (0.0, min (1.0, (fy2 + 0.5) / IM_LEN(frim,2))) + ny2 = IM_LEN(im,2) + } else { + vy2 = 1.0 + call iw_fb2im (iw, real (IM_LEN(frim,1)), real (IM_LEN(frim,2)), + junkx, junky) + if (step2 >= 0) + ny2 = min (real (IM_LEN(im,2)), junky - y1 + 1.0) + else + ny1 = min (real (IM_LEN(im,2)), junky - y2 + 1.0) + } + + # Define a the new viewport and window. + if (IS_INDEFR(vl)) { + vl = vx1 + c1 = nx1 + } + if (IS_INDEFR(vr)) { + vr = vx2 + c2 = nx2 + } + if (IS_INDEFR(vb)) { + vb = vy1 + l1 = ny1 + } + if (IS_INDEFR(vt)) { + vt = vy2 + l2 = ny2 + } + + # Clean up. + call iw_close (iw) + call imunmap (frim) + call sfree (sp) +end + + +define EDGE1 0.1 +define EDGE2 0.9 +define EDGE3 0.12 +define EDGE4 0.92 + +# WL_MAP_VIEWPORT -- Set device viewport wcslab plots. If not specified by +# user, a default viewport centered on the device is used. + +procedure wl_map_viewport (gp, c1, c2, l1, l2, ux1, ux2, uy1, uy2, fill) + +pointer gp # I: pointer to graphics descriptor +real c1, c2, l1, l2 # I: the column and line limits +real ux1, ux2, uy1, uy2 # I/O: NDC coordinates of requested viewort +bool fill # I: fill viewport (vs preserve aspect ratio) + +int ncols, nlines +real xcen, ycen, ncolsr, nlinesr, ratio, aspect_ratio +real x1, x2, y1, y2, ext, xdis, ydis +bool fp_equalr() +real ggetr() +data ext /0.0625/ + +begin + ncols = nint (c2 - c1) + 1 + ncolsr = real (ncols) + nlines = nint (l2 - l1) + 1 + nlinesr = real (nlines) + + # Determine the standard window sizes. + if (fill) { + x1 = 0.0; x2 = 1.0 + y1 = 0.0; y2 = 1.0 + } else { + x1 = EDGE1; x2 = EDGE2 + y1 = EDGE3; y2 = EDGE4 + } + + # If any values were specified, then replace them here. + if (! IS_INDEFR(ux1)) + x1 = ux1 + if (! IS_INDEFR(ux2)) + x2 = ux2 + if (! IS_INDEFR(uy1)) + y1 = uy1 + if (! IS_INDEFR(uy2)) + y2 = uy2 + + # Calculate optimum viewport, as in NCAR's conrec, hafton. + if (! fill) { + ratio = min (ncolsr, nlinesr) / max (ncolsr, nlinesr) + if (ratio >= ext) { + if (ncols > nlines) + y2 = (y2 - y1) * nlinesr / ncolsr + y1 + else + x2 = (x2 - x1) * ncolsr / nlinesr + x1 + } + } + + xdis = x2 - x1 + ydis = y2 - y1 + xcen = (x2 + x1) / 2. + ycen = (y2 + y1) / 2. + + # So far, the viewport has been calculated so that equal numbers of + # image pixels map to equal distances in NDC space, regardless of + # the aspect ratio of the device. If the parameter "fill" has been + # set to no, the user wants to compensate for a non-unity aspect + # ratio and make equal numbers of image pixels map to into the same + # physical distance on the device, not the same NDC distance. + + if (! fill) { + aspect_ratio = ggetr (gp, "ar") + if (fp_equalr (aspect_ratio, 0.0)) + aspect_ratio = 1.0 + + if (aspect_ratio < 1.0) + # Landscape + xdis = xdis * aspect_ratio + else if (aspect_ratio > 1.0) + # Portrait + ydis = ydis / aspect_ratio + } + + ux1 = xcen - (xdis / 2.0) + ux2 = xcen + (xdis / 2.0) + uy1 = ycen - (ydis / 2.0) + uy2 = ycen + (ydis / 2.0) + + call gsview (gp, ux1, ux2, uy1, uy2) + call gswind (gp, c1, c2, l1, l2) +end + + +# WL_W2LD -- Transform world coordinates to logical coordinates. + +procedure wl_w2ld (wlct, flip, wx, wy, lx, ly, npts) + +pointer wlct # I: the MWCS coordinate transformation descriptor +int flip # I: true if the axes are transposed +double wx[npts], wy[npts] # I: the world coordinates +double lx[npts], ly[npts] # O: the logical coordinates +int npts # I: the number of points to translate + +begin + if (flip == YES) + call mw_v2trand (wlct, wx, wy, ly, lx, npts) + else + call mw_v2trand (wlct, wx, wy, lx, ly, npts) +end + + +# WL_L2WD -- Transform logical coordinates to world coordinates. + +procedure wl_l2wd (lwct, flip, lx, ly, wx, wy, npts) + +pointer lwct # I: the MWCS coordinate transformation descriptor +int flip # I: true if the axes are transposed +double lx[npts], ly[npts] # I: the logical coordinates +double wx[npts], wy[npts] # O: the world coordinates +int npts # I: the number of points to translate + +begin + if (flip == YES) + call mw_v2trand (lwct, ly, lx, wx, wy, npts) + else + call mw_v2trand (lwct, lx, ly, wx, wy, npts) +end + + +# WL_MAX_ELEMENT_ARRAY -- Return the index of the maximum array element. +# +# Description +# This function returns the index of the maximum value of the input array. + +int procedure wl_max_element_array (array, npts) + +double array[ARB] # I: the array to look through for the maximum +int npts # I: the number of points in the array + +int i, maximum + +begin + maximum = 1 + for (i = 2; i <= npts; i = i + 1) + if (array[i] > array[maximum]) + maximum = i + + return (maximum) +end + + +# WL_DISTANCED - Determine the distance between two points. + +double procedure wl_distanced (x1, y1, x2, y2) + +double x1, y1 # I: coordinates of point 1 +double x2, y2 # I: coordinates of point 2 + +double a, b + +begin + a = x1 - x2 + b = y1 - y2 + return (sqrt ((a * a) + (b * b))) +end + + +# WL_DISTANCER -- Determine the distance between two points. + +real procedure wl_distancer (x1, y1, x2, y2) + +real x1, y1 # I: coordinates of point 1 +real x2, y2 # I: coordinates of point 2 + +real a, b + +begin + a = x1 - x2 + b = y1 - y2 + return (sqrt ((a * a) + (b * b))) +end + + +# The dimensionality. +define N_DIM 2 + +# Define some memory management. +define ONER Memr[$1+$2-1] + +# WL_ROTATE -- Rotate a vector. + +procedure wl_rotate (x, y, npts, angle, nx, ny) + +real x[npts], y[npts] # I: the vectors to rotate +int npts # I: the number of points in the vectors +real angle # I: the angle to rotate (radians) +real nx[npts], ny[npts] # O: the transformed vectors + +pointer sp, center, mw +pointer mw_open(), mw_sctran() + +begin + # Get some memory. + call smark (sp) + call salloc (center, N_DIM, TY_REAL) + + mw = mw_open (NULL, N_DIM) + ONER(center,1) = 0. + ONER(center,2) = 0. + call mw_rotate (mw, -DEGTORAD( angle ), ONER(center,1), 3b) + call mw_v2tranr (mw_sctran (mw, "physical", "logical", 3b), + x, y, nx, ny, npts) + + call mw_close (mw) + call sfree (sp) +end diff --git a/pkg/images/tv/wcslab/wlwcslab.x b/pkg/images/tv/wcslab/wlwcslab.x new file mode 100644 index 00000000..1547f568 --- /dev/null +++ b/pkg/images/tv/wcslab/wlwcslab.x @@ -0,0 +1,181 @@ +include <gio.h> +include <gset.h> +include "wcslab.h" +include "wcs_desc.h" + +# Define the memory structure for saving the graphics wcs. +define SAVE_BLOCK_SIZE 16 +define OLD_NDC_VIEW Memr[P2R(wcs_save_block-1+$1)] +define OLD_NDC_WIND Memr[P2R(wcs_save_block+3+$1)] +define OLD_PLT_VIEW Memr[P2R(wcs_save_block+7+$1)] +define OLD_PLT_WIND Memr[P2R(wcs_save_block+11+$1)] + +# WL_WCSLAB -- Label using a defined wcs. +# +# Description +# This routine uses the information in the WCSLAB descriptor to perform +# labelling. +# +# Before this routine can be called, several things must have already +# occured. They are as follows: +# 1 A call to wl_create must be made to create the WCSLAB descriptor. +# 2 The WCS_MW component must be set to the MWCS object of the +# desired transformations. +# 3 A call to wl_get_system_type must be made. +# 4 The graphics device must have been opened and the window defined. +# The WCS_GP component of the WCSLAB descriptor must be set to the +# graphics window descriptor. +# +# When done with this routine, the WL_GP and WL_MW components must be +# deallocated seperately. Then only wlab_destroy need be called to +# remove the WCSLAB descriptor. +# +#--------------------------------------------------------------------------- + +procedure wl_wcslab (wd) + +pointer wd # I: the WCSLAB descriptor + +int old_clip, old_pltype, old_txquality, old_wcs +pointer sp, wcs_save_block +real old_plwidth, old_txsize, old_txup +int gstati() +real gstatr() + +begin + # Allocate working space. + call smark(sp) + call salloc(wcs_save_block, SAVE_BLOCK_SIZE, TY_STRUCT) + + # Store certain graphics parameters. + old_plwidth = gstatr (WL_GP(wd), G_PLWIDTH) + old_txsize = gstatr (WL_GP(wd), G_TXSIZE) + old_txup = gstatr (WL_GP(wd), G_TXUP) + old_clip = gstati (WL_GP(wd), G_CLIP) + old_pltype = gstati (WL_GP(wd), G_PLTYPE) + old_txquality= gstati (WL_GP(wd), G_TXQUALITY) + old_wcs = gstati (WL_GP(wd), G_WCS) + + # Choose two other graphics wcs' for internal use. Save the wcs for + # later restoration. + if( old_wcs < MAX_WCS - 2 ) { + WL_NDC_WCS(wd) = old_wcs + 1 + WL_PLOT_WCS(wd) = WL_NDC_WCS(wd) + 1 + } else { + WL_NDC_WCS(wd) = old_wcs - 1 + WL_PLOT_WCS(wd) = WL_NDC_WCS(wd) - 1 + } + call gseti(WL_GP(wd), G_WCS, WL_NDC_WCS(wd)) + call ggview(WL_GP(wd), OLD_NDC_VIEW(LEFT), OLD_NDC_VIEW(RIGHT), + OLD_NDC_VIEW(BOTTOM), OLD_NDC_VIEW(TOP)) + call ggwind(WL_GP(wd), OLD_NDC_WIND(LEFT), OLD_NDC_WIND(RIGHT), + OLD_NDC_WIND(BOTTOM), OLD_NDC_WIND(TOP)) + call gseti(WL_GP(wd), G_WCS, WL_PLOT_WCS(wd)) + call ggview(WL_GP(wd), OLD_PLT_VIEW(LEFT), OLD_PLT_VIEW(RIGHT), + OLD_PLT_VIEW(BOTTOM), OLD_PLT_VIEW(TOP)) + call ggwind(WL_GP(wd), OLD_PLT_WIND(LEFT), OLD_PLT_WIND(RIGHT), + OLD_PLT_WIND(BOTTOM), OLD_PLT_WIND(TOP)) + + # Set the graphics device the way wcslab requires it. + call gseti (WL_GP(wd), G_WCS, old_wcs) + call wl_graphics (wd) + + # Determine basic characteristics of the plot. + call wl_setup (wd) + + # Plot the grid lines. + call wl_grid (wd) + + # Put the grid labels on the lines. + if (WL_LABON(wd) == YES) + call wl_label (wd) + + # Restore the original graphics wcs. + call gseti(WL_GP(wd), G_WCS, WL_NDC_WCS(wd)) + call gsview(WL_GP(wd), OLD_NDC_VIEW(LEFT), OLD_NDC_VIEW(RIGHT), + OLD_NDC_VIEW(BOTTOM), OLD_NDC_VIEW(TOP)) + call gswind(WL_GP(wd), OLD_NDC_WIND(LEFT), OLD_NDC_WIND(RIGHT), + OLD_NDC_WIND(BOTTOM), OLD_NDC_WIND(TOP)) + call gseti(WL_GP(wd), G_WCS, WL_PLOT_WCS(wd)) + call gsview(WL_GP(wd), OLD_PLT_VIEW(LEFT), OLD_PLT_VIEW(RIGHT), + OLD_PLT_VIEW(BOTTOM), OLD_PLT_VIEW(TOP)) + call gswind(WL_GP(wd), OLD_PLT_WIND(LEFT), OLD_PLT_WIND(RIGHT), + OLD_PLT_WIND(BOTTOM), OLD_PLT_WIND(TOP)) + + # Restore original graphics state. + call gsetr (WL_GP(wd), G_PLWIDTH, old_plwidth) + call gsetr (WL_GP(wd), G_TXSIZE, old_txsize) + call gsetr (WL_GP(wd), G_TXUP, old_txup) + call gseti (WL_GP(wd), G_CLIP, old_clip) + call gseti (WL_GP(wd), G_PLTYPE, old_pltype) + call gseti (WL_GP(wd), G_TXQUALITY, old_txquality) + call gseti (WL_GP(wd), G_WCS, old_wcs) + + call sfree (sp) +end + + +# WL_GRAPHICS -- Setup the graphics device appropriate for the occasion. + +procedure wl_graphics (wd) + +pointer wd # I: the WCSLAB descriptor + +real relative_size, vl, vr, vb, vt +real ggetr() + +begin + # Setup a graphics WCS that mimics the NDC coordinate WCS, + # but with clipping. + call ggview (WL_GP(wd), vl, vr, vb, vt) + call gseti (WL_GP(wd), G_WCS, WL_NDC_WCS(wd)) + call gsview (WL_GP(wd), vl, vr, vb, vt) + call gswind (WL_GP(wd), vl, vr, vb, vt) + call gseti (WL_GP(wd), G_CLIP, YES) + + # Setup the initial viewport. + WL_NEW_VIEW(wd,LEFT) = vl + WL_NEW_VIEW(wd,RIGHT) = vr + WL_NEW_VIEW(wd,BOTTOM) = vb + WL_NEW_VIEW(wd,TOP) = vt + + # Setup some parameters. + call gseti (WL_GP(wd), G_PLTYPE, GL_SOLID) + call gsetr (WL_GP(wd), G_PLWIDTH, LINE_SIZE) + + # Draw the edges of the viewport. + call gamove (WL_GP(wd), vl, vb) + call gadraw (WL_GP(wd), vr, vb) + call gadraw (WL_GP(wd), vr, vt) + call gadraw (WL_GP(wd), vl, vt) + call gadraw (WL_GP(wd), vl, vb) + + # Determine the tick mark size. + relative_size = max (abs (vr - vl), abs (vt - vb )) + WL_MAJ_TICK_SIZE(wd) = relative_size * WL_MAJ_TICK_SIZE(wd) + WL_MIN_TICK_SIZE(wd) = relative_size * WL_MIN_TICK_SIZE(wd) + + # Determine various character sizes. + WL_TITLE_SIZE(wd) = WL_TITLE_SIZE(wd) * relative_size + WL_AXIS_TITLE_SIZE(wd) = WL_AXIS_TITLE_SIZE(wd) * relative_size + WL_LABEL_SIZE(wd) = WL_LABEL_SIZE(wd) * relative_size + + # Now setup the general plotting WCS. + call gseti (WL_GP(wd), G_WCS, WL_PLOT_WCS(WD)) + call gsview (WL_GP(wd), vl, vr, vb, vt) + vl = real (WL_SCREEN_BOUNDARY(wd,LEFT)) + vr = real (WL_SCREEN_BOUNDARY(wd,RIGHT)) + vb = real (WL_SCREEN_BOUNDARY(wd,BOTTOM)) + vt = real (WL_SCREEN_BOUNDARY(wd,TOP)) + call gswind (WL_GP(wd), vl, vr, vb, vt) + call gseti (WL_GP(wd), G_CLIP, YES) + + # Set some characteristics of the graphics device. + call gseti (WL_GP(wd), G_TXQUALITY, GT_HIGH) + call gseti (WL_GP(wd), G_CLIP, YES) + call gsetr (WL_GP(wd), G_PLWIDTH, LINE_SIZE) + + # Determine the number of segments a "line" should consist of. + WL_LINE_SEGMENTS(wd) = int (min (ggetr (WL_GP(wd), "xr"), + ggetr (WL_GP(wd), "yr")) / 5) +end diff --git a/pkg/images/tv/wcslab/zz.x b/pkg/images/tv/wcslab/zz.x new file mode 100644 index 00000000..e6d0224f --- /dev/null +++ b/pkg/images/tv/wcslab/zz.x @@ -0,0 +1,23 @@ +include <gset.h> +include <math.h> + + +# Define the offset array. +define OFFSET Memr[$1+$2-1] + +procedure wl_label (wd) + +pointer wd # I: the WCSLAB descriptor + +int i +pointer sp, offset_ptr + +begin + # Get some memory. + call smark (sp) + call salloc (offset_ptr, N_SIDES, TY_REAL) + do i = 1, N_SIDES + OFFSET(offset_ptr,i) = 0. + + call sfree (sp) +end diff --git a/pkg/images/tv/wcspars.par b/pkg/images/tv/wcspars.par new file mode 100644 index 00000000..c4ed61d3 --- /dev/null +++ b/pkg/images/tv/wcspars.par @@ -0,0 +1,19 @@ +# WCSPARS pset for WCSLAB containing user WCS + +ctype1,s,h,"linear",,,"X axis type" +ctype2,s,h,"linear",,,"Y axis type" + +crpix1,r,h,0.,,,"X reference coordinate in the logical system" +crpix2,r,h,0.,,,"Y reference coordinate in the logical system" +crval1,r,h,0.,,,"X reference coordinate in the world system" +crval2,r,h,0.,,,"Y reference coordinate in the world system" + +cd1_1,r,h,1.,,,"CD matrix" +cd1_2,r,h,0.,,,"CD matrix" +cd2_1,r,h,0.,,,"CD matrix" +cd2_2,r,h,1.,,,"CD matrix" + +log_x1,r,h,0.,,,"The lower X-extent of the logical space" +log_x2,r,h,1.,,,"The upper X-extent of the logical space" +log_y1,r,h,0.,,,"The lower Y-extent of the logical space" +log_y2,r,h,1.,,,"The upper Y-extent of the logical space" diff --git a/pkg/images/tv/wlpars.par b/pkg/images/tv/wlpars.par new file mode 100644 index 00000000..35bf757b --- /dev/null +++ b/pkg/images/tv/wlpars.par @@ -0,0 +1,45 @@ +# WLPARS pset containing plotting parameters for WCSLAB + +major_grid,b,h,yes,,,"Plot major grid lines instead of tick marks ?" +minor_grid,b,h,no,,,"Plot minor grid lines instead of tick marks ?" +dolabel,b,h,yes,,,"Label major grid lines / tick marks?" +remember,b,h,no,,,"Update wlpars after the plot ?" + +axis1_beg,s,h,"",,,"First major axis 1 value to plot" +axis1_end,s,h,"",,,"Final major axis 1 value to plot" +axis1_int,s,h,"",,,"Axis 1 interval to plot" +axis2_beg,s,h,"",,,"First major axis 2 value to plot" +axis2_end,s,h,"",,,"Final major axis 2 value to plot" +axis2_int,s,h,"",,,"Axis 2 interval to plot" +major_line,s,h,"solid","solid|dotted|dashed|dotdash",,"Major grid line type" +major_tick,r,h,.03,0.,1.,"Major tick size in percent of screen" + +axis1_minor,i,h,5,,,"Number of minor ticks for axis 1" +axis2_minor,i,h,5,,,"Number of minor ticks for axis 2" +minor_line,s,h,"dotted","solid|dotted|dashed|dotdash",,\ + "Line type (solid|dotted|dashed|dotdash)" +minor_tick,r,h,.01,0.,1.,"Minor tick size (percent of screen)" +tick_in,b,h,yes,,,"Should tick marks point into the graph ?" + +axis1_side,s,h,"default",,,"Axis 1 label side" +axis2_side,s,h,"default",,,"Axis 2 label side" +axis2_dir,s,h,"",,,"Axis 1 value at which to label axis 2 (polar)" +justify,s,h,"default","top|bottom|left|right|default",,\ + "Axis 2 side at which to label axis 2 (polar)" +labout,b,h,yes,,,"Draw labels outside axes ?" +rotate,b,h,yes,,,"Allow labels to rotate ?" +full_label,b,h,no,,,"Draw full format labels ?" +label_size,r,h,1.,0.,,"Axis label size" + +title,s,h,"imtitle",,,"Graph title" +axis1_title,s,h,"",,,"Axis 1 title" +axis2_title,s,h,"",,,"Axis 2 title" +title_side,s,h,"top","top|bottom|left|right",,"Title side" +axis1_title_side,s,h,"default","top|bottom|left|right|default",,\ + "Axis 1 title side" +axis2_title_side,s,h,"default","top|bottom|left|right|default",,\ + "Axis 2 title side" +title_size,r,h,1.,0.,,"Title size" +axis_title_size,r,h,1.0,0.,,"Size of the axes titles" + +graph_type,s,h,"default","normal|polar|near_polar|default",,"Graph type" diff --git a/pkg/images/tv/x_tv.x b/pkg/images/tv/x_tv.x new file mode 100644 index 00000000..e4ae5ead --- /dev/null +++ b/pkg/images/tv/x_tv.x @@ -0,0 +1,10 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# Display process. + +task display = t_display, + dcontrol = t_dcontrol, + imedit = t_imedit, + imexamine = t_imexamine, + tvmark = t_tvmark, + wcslab = t_wcslab |