diff options
Diffstat (limited to 'pkg/plot')
108 files changed, 16406 insertions, 0 deletions
diff --git a/pkg/plot/README b/pkg/plot/README new file mode 100644 index 00000000..b3d783a3 --- /dev/null +++ b/pkg/plot/README @@ -0,0 +1,3 @@ +The PLOT package contains all general purpose routines used for vector +graphics. All routines will eventually be able to take input in either +list or image form. diff --git a/pkg/plot/Revisions b/pkg/plot/Revisions new file mode 100644 index 00000000..c3177348 --- /dev/null +++ b/pkg/plot/Revisions @@ -0,0 +1,726 @@ +.help revisions Aug90 pkg.plot +.nf +pkg/plot/crtpict/calchgms.x + The 'ibuf pointer was being used with Memr (5/4/13, MJF) + +pkg/plot/hgpline.x + +pkg/plot/t_prows.x +pkg/plot/t_pcols.x +pkg/plot/t_graph.x +pkg/plot/t_pvector.x +pkg/plot/initmarker.x +pkg/plot/mkpkg +pkg/plot/graph.par +pkg/plot/pcol.par +pkg/plot/pcols.par +pkg/plot/prow.par +pkg/plot/prows.par +pkg/plot/pvector.par +pkg/plot/doc/graph.hlp +pkg/plot/doc/prow.hlp +pkg/plot/doc/prows.hlp +pkg/plot/doc/pcol.hlp +pkg/plot/doc/pcols.hlp +pkg/plot/doc/pvector.hlp + Added a feature where marker types of "lhist" or "bhist" draw line + or box histograms when not in point mode. In point mode these + values default to box and when not in point mode any other value + defaults to connected lines. (8/13/08, Valdes) + +======= +V2.13 +======= + +pkg/plot/t_implot.x + Added a check that the image exists to avoid a bus error caused by + using a null pointer otherwise (8/15/06, MJF) + +======= +V2.12.2 +======= + +pkg/plot/t_implot.x +pkg/doc/implot.hlp +lib/scr/implot.key + The "image" parameter may now be a list and the 'm' and 'n' keys + are used to move through the image. This is an alternate, and + more convenient, version of the 'i' key. + (10/29/04, Valdes) + +======= +V2.12.2 +======= + +pkg/plot/t_pradprof.x +pkg/plot/doc/pradprof.hlp + Added parameters "az1" and "az2" to select a range of azimuths for + the profile. (9/13/02, Valdes) + +======= +V2.12.1 +======= + +===== +V2.12 +===== + +pkg/plot/crtpic/t_crtpict.x +pkg/plot/crtpic/plotimage.x +pkg/plot/t_graph.x +pkg/plot/t_implot.x + Fixed various missing/extra argument and function/subroutine mismatch + problems found by running spplint on the code. (9/19/01, Davis) + +pkg/plot/doc/contour.hlp + Clarified the use of the 'fill' parameter in the example when overlaying + contours to an image display. (08/10/01, MJF) + +pkg/plot/mkpkg + Added some missing file dependencies to the mkpkg file. (21/9/99, Davis) + +======= +V2.11.2 +======= + +pkg/plot/doc/implot.hlp +pkg/plot/doc/surface.hlp + Fixed minor formating problem. (4/22/99, Valdes) + +pkg/plot/t_implot.x + If glabax is called with log axis scaling then it will reset the + graph limits which invalidates the previously saved limits from + ggwind. Therefore ggwind was moved to follow the glabax call. + (1/26/98, Valdes) + +======= +V2.11.1 +======= + +pkg/plot/phistogram.x + Phistogram was producing a segmentation violation error for text file input + due to an error in the bug fix described below. (4/10/97, Davis) + +pkg/plot/phistogram.x + Fixed a bug in the phistogram tasks which could produce invalid floating + point operation errors if the input image contained pixel values outside + the legal integer range. (7/31/97, Davis) + +pkg/plot/t_implot.x + The coordinate to be evaluated for dimensions greater than 2 was not + being defined causing an FPE (Dec Alpha) or possible errors on other + platforms. The initialization was added. (4/3/97, Valdes) + +pkg$plot/t_graph.x +pkg$plot/graph.par +pkg$plot/doc/graph.hlp + Added parameters "ltypes" and "colors" to specify a list of line types + and colors when doing multiple data sets. (5/13/96 & 8/21/96, Valdes) + +pkg$plot/t_implot.x + When the vector being plotted was constant the 'l' and 'c' keys selecting + lines/columns from the right plot axis did not work. The code was + fixed for this case. (3/27/96, Valdes) + +======= +V2.10.4 +======= + +pkg$plot/t_gkixt.x + Increased the size of the index array from 2048 to 8192 to accomodate + very large metacode files. (3/22/95 MJF) + +pkg$plot/t_implot.x +pkg$plot/pltwcs.x + When trying to plot a column of a 1D image the physical axis was + being set to zero and then used inapproprriately as a pointer offset + causing an error on the Dec Alpha port. The axis now defaults to + 1 and also the task now beeps when attempting a column plot rather + than plotting. (2/16/95, Valdes) + +pkg$plot/t_surface.x + The surface task no longer calls error when the input array is unsuitable + for plotting (constant valued, entirely below floor or above ceiling). + The surf_limits procedure was modified to call eprintf and then return an + error value to the calling program, which terminates the task quietly. + This less drastic error exit will allow [e.g., IRAF test] scripts to + continue after calling SURFACE with an invalid input image. (ShJ 6/23/94) + +pkg$plot/implot.hlp - + This junk copy was deleted. The actual file is doc/implot.hlp. + (2/2/94, Valdes) + +pkg$plot/t_implot.x +pkg$plot/implot.par +pkg$plot/doc/implot.hlp + The step for the j/k keys may now be set by a task parameter. + (2/2/94, Valdes) + +pkg$plot/t_graph.x + The marker sizes were given the wrong sign when inputing the size from + a list. The size must be negative. (8/21/93, Valdes) + +pkg$plot/phistogram.x + Fixed a bug in the way phistogram was binning real data read in from + a list or image that was causing to create one less bin than required + to hold the data. (26/6/93, Davis) + +pkg$plot/phistogram.x + Fixed a bug in the way the the phistogram task was handling input + redirected from the standard input STDIN. (5/20/93, Davis) + +pkg$plot/t_implot.x +pkg$plot/pltwcs.x +pkg$plot/impprofile.x + +pkg$plot/impstatus.x + +pkg$plot/doc/implot.hlp +lib$scr/implot.key + Add a profile analysis command, 'p', with a scrolling status line. + (8/31/92, Valdes) + +pkg$plot/t_implot.x + Changed an incorrect real array index to an int. (7/21/92, Valdes) + +======= +V2.10.0 +======= + +======= +V2.10 +======= + +pkg$plot/t_pradprof.x + The new pradprof task was using the file name template expansion routines + instead of the image name template expansion routines producing an error + if the input image name was an image section. (6/23/92, Davis) + +pkg$plot/t_implot.x + There was some ambiguity with the averaging option. This has been defined + that if an averaging size is set then selecting a single line or + column with 'l', 'c', :l, :c will make the selected line be the center + of the averaging region instead of the lower limit. (4/23/92, Valdes) + +pkg$plot/t_pcol.x +pkg$plot/t_implot.x +pkg$plot/t_graph.x +pkg$plot/t_pcols.x +pkg$plot/t_prows.x +pkg$plot/pltwcs.x +pkg$plot/graph.par +pkg$plot/prow.par +pkg$plot/prows.par +pkg$plot/pcol.par +pkg$plot/pcols.par +pkg$plot/doc/graph.hlp +pkg$plot/doc/implot.hlp +pkg$plot/doc/prow.hlp +pkg$plot/doc/prows.hlp +pkg$plot/doc/pcol.hlp +pkg$plot/doc/pcols.hlp + 1. Modified GRAPH, IMPLOT, PROW(S), and PCOL(S) to define and set + a coordinate format in plots. This allows graphs to be + made in DD:MM:SS and related formats. + 2. Modified GRAPH, IMPLOT, PROW(S), and PCOL(S) to use any WCS attribute + coordinate format found in the images. + 3. Added xformat and yformat parameters to GRAPH, PROW(S), and PCOL(S) to + define coordinate plot formats. This allows having a format when a + format attribute in not found in the images, to override a format + attribute, and to allow setting the format in simple text input. + For example, GRAPH can plot formated RA and DEC from a list of + input RA and DEC coordinates. + 4. Added a ":f format" to IMPLOT to allow specifying/overriding the + WCS attribute format. + 5. Added <space> as a key in IMPLOT to print coordinate and pixel + value information: + line=256, column=142, coordinate=13:27:55.6, value=222. + (4/9/92, Valdes) + +pkg$plot/pltwcs.x +pkg$plot/t_prows.x +pkg$plot/t_pcols.x +pkg$plot/t_graph.x + The logical coordinates used for coordinate evaluations when + using an image section were incorrectly set. (3/9/92, Valdes) + +pkg$plot/pltwcs.x +pkg$plot/t_graph.x + Modified plt_wcs to take as input the wcs name in order to + set an appropriate wcs label for the wcs instead of using + the world wcs in all cases. + (3/4/92, Valdes) + +pkg$plot/t_pvector.x + In image pixel buffer column limits were being incorrectly computed + in some cases result in glitches in the output vector. + (12/11/91 Davis) + +pkg/plot/t_graph.x +pkg/plot/graph.par +pkg/plot/doc/graph.hlp + An overplot parameter has been added to allow multiple plots with + different axes and viewports. (10/23/91, Valdes) + +pkg/plot/doc/pvector.hlp + Corrected the examples showing usage the center/theta. Also + added a note to the theta parameter notes explaining that is + set the center must be specified with a certain syntax as shown + in the examples. Reported by Tom Duvall (10/8/91 MJF) + +pkg/plot/crtpict/calchgms.x + Changed the declarations for the variables min_val and max_val in + the procedure crt_user_hgram from int to short. (10/5/91, Davis) + +pkg/plot/phistogram.x + Corrected some type mismatch problems in calls to gset. + (10/3/91 Davis) + +pkg/plot/t_implot.x + The use of overlapping multiple graphics WCS, one for the user and + one for the image columns and rows, would result in erroneous + coordinates using the C key and later =gcur. The task was modified + to have the same functional behaviour but work only with one + graphics WCS. (9/12/91, Valdes) + +pkg/plot/t_prow.x +pkg/plot/t_prows.x +pkg/plot/t_pcol.x +pkg/plot/t_pcols.x +pkg/plot/prow.par +pkg/plot/prows.par +pkg/plot/pcol.par +pkg/plot/pcols.par +pkg/plot/doc/prow.hlp +pkg/plot/doc/prows.hlp +pkg/plot/doc/pcol.hlp +pkg/plot/doc/pcols.hlp + Modified to have a wcs parameter and plot using the specified + wcs. The xlabel parameter includes a special word to select + the WCS label in the image. (9/12/91, Valdes) + +pkg/plot/pradprof.par +pkg/plot/t_pradprof.x +pkg/plot/doc/pradprof.hlp + Pradprof was orignally installed on 8/16/91, but had to be + reinstalled on 8/26/91 after a major disk crash. (8/26/91 LED) + + +pkg/plot/phistogram.par +pkg/plot/phistogram.x +pkg/plot/phminmax.x +pkg/plot/doc/phistogram.hlp + Phistogram was originally installed on 8/14/91, but had to be + reinstalled on 8/26/91 after a major disk crash. (8/26/91 LED) + +pkg/plot/pradprof.par +pkg/plot/t_pradprof.x +pkg/plot/doc/pradprof.hlp + Added a new task pradprof to the plot package. (8/16/91 LED) + +pkg/plot/phistogram.par +pkg/plot/phistogram.x +pkg/plot/phminmax.x +pkg/plot/doc/phistogram.hlp + Added a new task phistogram to the plot package. Phistogram takes + input from either an image or a list and permits full control over + the plotting parameters. The histogram computation is done in + and identical manner to the imhistogram task. (8/14/91 LED) + +pkg/plot/t_implot.x +pkg/plot/t_graph.x +pkg/plot/implot.par +pkg/plot/graph.par +pkg/plot/doc/implot.hlp +pkg/plot/doc/graph.hlp + Added a "wcs" parameter to select using image WCS information for + coordinates and labels. (FV 8/12/91) + +pkg/plot/t_implot.x + Corrected the comment on line 892 (ShJ 8/12/91): + +# IMP_SETPIXELCOORDS -- Set wcs 2 to the pixel coordinate system of the image. +should read +# IMP_SETPIXELCOORDS -- Set wcs 1 to the pixel coordinate system of the image. + ^ +pkg/plot/t_surface.x + Default values for floor and ceiling were changed from 0.0 to INDEF. + The default task behavior is the same, plotting from i_datamin to + i_datamax, but the value of 0.0 is now interpreted as a valid data + value rather than a flag to trigger CONREC's automatic limit algorithm. + At the same time, a coding error that forced you to set both floor + and ceiling (you couldn't set just one or the other) was removed. + (ShJ 8/5/91) + +pkg/plot/t_contour.x + Default values for floor and ceiling were changed from 0.0 to INDEF. + A test was added to detect a constant valued field. A call to + gamove was added before the final gclose, to fix the WCS to the + device. All plotting in the NCAR code is done in NDC space (with + conrec parameter nset = 1). Without the additional call to + gamove, plots drawn with perim- would not report cursor positions + in WCS units, since all plotting had been done in NDC space. (ShJ 8/5) + +pkg/plot/surface.par +pkg/plot/contour.par +pkg/plot/doc/surface.hlp +pkg/plot/doc/contour.hlp + These help and manual pages were modified to reflect the new default + values of floor and ceiling. (ShJ 8/5/91) + +pkg/plot/t_prow[s].x +pkg/plot/t_pcol[s].x + Removed the call to clputi for defining upper limits for the input + row/col number. This was done for two reasons: [1] it duplicated + other code in the task that checks that the input limits are valid + and [2] these tasks could be used with epar when a larger image + is plotted after a smaller image; the smaller image limits remain + in the par file and prevent the user from setting a parameter outside + the range of the smaller image. (ShJ 8/5/91) + +pkg$plot/t_pvector.x + Corrected line #45 which had the wrong number of arguments in a call + to error, resulting in a segmentation violation instead of the intended + error message if the condition being detected occurred. (ShJ 1/25/91) + +pkg$plot/doc/pvector.hlp + Clarified documentation regarding the resampling spacing. (SRo 8/31/90) + +pkg$plot/t_pvector.x + Added checks for wx1/wx2 and wy1/wy2 parameters allow plotting on + an inverse scale when not autoscaling. Suggested by Tetsuo Aoki + at CRL. (MJF 8/9/90) + +pkg$plot/t_surface.x + procedure surf_limits was modified to avoid an arithmetic exception + for images with values entirely above ceiling or below floor. This + modification was coded by Phil Hodge at ST. (ShJ 4/4/90) + +pkg$plot/getdata.x + procedure plt_getdata was completely rewritten to remove the call + to imparse and any built-in dependency on knowledge of image + section notation. (ShJ 4/4/90) + +pkg$plot/t_contour.x, t_surface.x, t_hafton.x + were modified to call plt_getdata with its new calling sequence. + (ShJ 4/4/90) +pkg$plot/t_pcol.x, t_pcols.x +pkg$plot/t_prow.x, t_prows.x + The dependency of these routines on knowledge of image section + notation has been removed. Previously an image section name would + be built using the column limits input by the user. The data are + now extracted from the image with procedure plt_gcols and plt_grows. + Code was also cleaned up to make use of single graphics procedure. + (MJF 4/3/90) + +pkg$plot/doc/pvector.hlp +pkg$plot/t_pvector.x, pvector.par + Implemented output options to PVECTOR task allowing computed + vector to be output as an image or text file (MJF 4/3/90) + +pkg$plot/doc/surface.hlp + Clarified floor and ceiling parmeters in surface manual page. + (ShJ 3/1/90) +pkg$plot/t_gkimos.x + Added a call to flush the gki metacode stream before closing it + when interactive=no. Without this, the stdgraph terminal would + remain in graphics mode when gkimosaic terminated. (ShJ 3/8/89) + +pkg$plot/t_pvector.x + Fixed bug causing vectors near theta=0 to fail. (FV 15/6/89) + +pkg$plot/t_gkimos.x + Duplicate definition of MAX_FRAMES removed. A new option was + added to cursor mode, 'r', to redraw the current screen with any + new parameters that may have been set. Functionally equivalent + to skip -NX*NY and hitting the space bar. + + Error handling is improved. GKIMOSAIC was failing when the + WCSDIR information couldn't be decoded. (ShJ 24/5/89) + +pkg$plot/t_gkixt.x + Added dynamic reallocation of index buffer for metacode files + with more then MAX_FRAMES. (ShJ 24/5/89) + +pkg$plot/t_graph.x + Fixed up setting the marker size when the marker type is either + vertical or horizontal eror bars. Previously, both xsize and + ysize were being set equal to the user indicated size. Now only + the dimension that represents the error gets set; the other + dimension is drawn at NDC size 1.0. (ShJ 24/5/89) + +pkg$plot/t_contour.x + Axes were not being drawn properly when parameter 'perimeter' was + set to no. This was due to a missing nset=-1 statement which has + now been added (line 171). Variable nset is passed in a common + block to the NCAR conrec code. (ShJ 24/5/89) + +pkg$plot/getdata.x, t_contour.x, t_surface.x, t_hafton.x + Added support for subsampling or block averaging of image sections. + The contour, surface and hafton tasks were not doing this correctly. + The mod was coded by Zolt Levay of STScI. (ShJ 18/7/88) + +pkg$plot/vport.x + Changed the value of 'ext' from 0.25 to 0.0625 This is the ratio + of axes lengths beyond which contour will make the output viewport + square. The limit of 1:4 was too restrictive; the limit of 1:16 is + also arbitrary but not as restrictive. This change was also made in + gio$ncarutil/conbd.f; this code is used instead of vport.x when + parameter 'perimeter' = no (which is not the default). (ShJ 10/6/88) + +pkg$plot/initmarker.x + Marker types 'hline', 'vline' and 'diamond' were added to the list + of possible marker types in point mode. (ShJ 24/3/88) + +pkg$plot/initmarker.x +pkg$plot/graph.x + Marker types 'hebar' and 'vebar' were added to the list of possible + marker types in point mode. Parameter 'szmarker' should be set + to 0.0 for the third column of an input list to be interpreted + as marker sizes in WCS units. A duplicate copy of procedure + init_marker existed in graph.x and it has been deleted. (ShJ 23/3/88) + +pkg$plot/vport.x + Modified the viewport setting code to accomodate both landscape + and portrait mode devices when compensating for non-unity aspect + ratios. (e.g., fill=no in contour). Previously, only landscape + mode was considered. This mod suggested by Zolt Levay at STScI. + (ShJ 16/12/87) + + if (aspect_ratio < 1.0) + # Landscape + xdis = xdis * aspect_ratio + else if (aspect_ratio > 1.0) + # Portrait + ydis = ydis / aspect_ratio +------ + +pkg$plot/crtpict/t_crtpict.x +pkg$plot/crtpict/tform_image.x +pkg$plot/crtpict/crtpict.h + Whether or not an annotated perimeter is drawn around the image + portion of a crtpict is now controlled by the cl parameter + 'perimeter'. Default value is yes. (ShJ 20/8/87) + +pkg$plot/crtpict/drawgraph.x +pkg$plot/crtpict/plot_hgrams.x + The crtpict task now prints z1 and z2 (the range of input + intensities mapped to output values) on the final print as + well as to STDOUT. The z1, z2, zmin and zmax values are + now output in `%g' format, not `%.2f' format, which will + prevent truncation to 0.0 of very small values. (SeH 23/4/87) + +pkg$plot/graph.x S. Hammond April 23, 1987 + A bug in the graph task, which prevented users from setting the + window when the values being plotted were very small (1E-7 or so), + has been fixed. The task previously would insist on autoscaling + the y axis in this case. + +pkg$plot/contour.x S. Hammond March 9, 1987 + The NCAR contour task was relinked with libncar to pick up a revision + in procedure STLINE which increased the size of a work array. The + error about "work array overflow in STLINE, picture incomplete" + should be seen much less frequently now, as the buffer which + stores starting points of contours at a given level was increased + in size from 500 to 5000. + +pkg$plot/crtpict/map_image.x S. Hammond March 6, l987 + + This procedure was using an incorrect test for finding images + with no range in the data. It was comparing the difference + between z1 and z2 to EPSILONR; it should have been testing z1 and z2 + for equality. The result of this error was that images containing + only small valued pixels (<= e-8 or so) would be mapped entirely + to a single grey level. The error has been fixed. + +pkg$plot/gkimosaic.x S. Hammond Feb 25, 1987 + + The interactive help facility for task gkimosaic (keystroke '?') + was modified to work properly with the newly installed gio mods for + activating and deactivating workstations. + +pkg$plot/graph.x S. Hammond Feb 25, 1987 + + Task graph would hang when the input file was STDIN, a byproduct of the + recent gio mods for activating and deactivating workstations. This + has been fixed. Another bug was also fixed: the marker size read + from the third column of an input list now controls the marker size + on the plot as described in the graph manual page. + +---------------------------------------------------------------------------- + +From: Hammond Dec 23, 1986 +Task: contour (gio$ncarutil/conrec.f) + + The ncar executable was relinked to pick up a mod to conrec.f + in libncar.a. The polyline width was not being set until after + the first contour line had been drawn, and so the first major + contour line would not be drawn in bold font. + +-------------------------------------------------------------------------- + +From: Hammond Oct 28, 1986 +Task: graph (pkg$plot/graph.x) + + A bug that prevented axes from being drawn properly when the + lower window limit exceeded the upper limit has been fixed. + That is, setting wy1 > wy2 now works. + +_________________________________________________________________________ + +From: Hammond Oct 24, 1986 +Task: crtpict, contour (pkg$plot/perim.x) + + The perimeter drawing procedure has been modified to + calculate the label increments and perimeter spacing + independently in x and y. This was not being done + previously, and images which differ greatly in x and y + dimension would produce unpleasing plots. + +_______________________________________________________________________ + +From: Hammond Jul 21, 1986 +Task: gkimosaic + + An additional interactive command was added to gkimosaic. A + command summary is printed with the keystroke '?'. + +_______________________________________________________________________ + +From: Hammond Jun 25, 1986 +Task: gkimosaic + + Task gkimosaic has been modified to allow interactive browsing + through a metacode file. Keystrokes are available to skip + forward or backward through a file, and to interactively + change the number of plots per page and the rotate and fill + options after each page of plots. See the revised manual page + for a complete description. The WCS information for the individual + plots is preserved for cursor readback. + +________________________________________________________________________ + +From: Hammond Jun 18, 1986 +Task: gkidir, gkiextract + + 1. Long strings in GKI_MFTITLE instructions were causing + memory overwrite errors in tasks gkidir and gkiextract; + the problem has been fixed. + + 2. Tasks gkidir and gkiextract have been modified to filter + out blank frames. +____________________________________________________________________________ + +From: Hammond Jun 12, 1986 +Task: prow, prows, pcol, pcols + + These four tasks have been modified to use the standard parameter + names for window and viewport coordinates within the plot package. + Window (user) coordinates are referred to as wx1, wx2, wy1, and wy1; + viewport (NDC) coordinates are referred to as vx1, vx2, vy1 and + vy2. Default values for these parameters have changed - see + the revised manual pages. A 0 range in window coordinates implies + autoscaling; a 0 range in viewport coordinates indicates automatic + viewport placement by "glabax". + + An additional parameter ("fill") has been added. By default, + the plot drawn will fill the specified device viewport. Setting the + value of fill to "no" means equal numbers of data values in x + and y will occupy equal physical lengths when plotted. That is, + a unity aspect ratio is enforced when fill = no. + +_____________________________________________________________________________ + +From: Hammond Jun 12, 1986 +Task: graph + + Several changes have been made to task graph. + + 1. First, to standardize parameter names within the plot package, + the viewport coordinates are referred to as vx1, vx2, vy1 + and vy2; window coordinates are referred to as wx1, wx2, wy1, + and wy2. Default values for these parameters have changed - see + the revised manual page. A 0 range in window coordinates implies + autoscaling; a 0 range in viewport coordinates indicates automatic + viewport placement by glabax. + + 2. Image templates are now understood in the input list. + + 3. An additional parameter ("fill") has been added. By default, + the plot drawn will fill the specified device viewport. Setting + the value of fill to "no" means equal numbers of data values in x + and y will occupy equal physical lengths when plotted. That is, + a unity aspect ratio is enforced when fill = no. + +________________________________________________________________________ + +From: Hammond Jun 12, 1986 +Task: contour, hafton + +1. To standardize parameter names within the plot package, both these + tasks now refer to the device viewport plotting coordinates + as vx1, vx2, vy1 and vy2. + +__________________________________________________________________________ + +From: Hammond Apr 17, 1986 +Task: gkiextrct + +1. A (boolean == false) construct in source file t_gkiextract.x has been + changed to (! boolean). + +___________________________________________________________________________ + +From: Hammond Mar31, 1986 +Task: crtpict + +1. Crtpict now checks the values returned by the automatic windowing + algorithm (ztrans=auto) to make sure they are not equal. The window + limits, z1 and z2, are equal to each other when there is no range + of intensity in the input image. This was not being checked previously, + and could result in floating divide by zero down the line. + +_________________________________________________________________________ + +From: Rooke Mar27, 1986 +Task: calcomp + +1. Changed default value for parameter LWOVER from "no" to "yes"; users + feel it is more important to get plots out quickly than to have bold + text, axes, and axis labels and ticks. Calcomp line width simulation + in lwtype=ntracing draws each line 5 times for medium quality and 9 + times for high quality. Now must explicitly run CALCOMP standalone + on spooled metacode to get bold text etc. +_________________________________________________________________________ + +From: Hammond Mar19, 1986 +Task: Contour, Surface, Hafton + +1. The string "subsampled image ... being contoured" has been replaced + with "subsampled image ... being plotted". This message is printed + when an image is subsampled rather than block averaged on input. + (The source file changed is plot$get_data.x) +__________________________________________________________________________ + +From: Hammond Mar19, 1986 +Task: gkidir, gkiextract + +1. These tasks no longer truncate the GKI_MFTITLE string when printing + output metacode titles. It used to do this to insure that the + output string would fit on one line, but a unique title string was + not always being printed. +__________________________________________________________________________ + +From: Hammond Jan. 9, 1986 +Task: Hafton + +1. Hafton now allows for user control of the plotting viewport. + +--------------------------------------------------------------------------- + +From: Hammond December 5, 1985 +Task: Graph, Contour + +1. Graph was ignoring a request for log scaling in y, this has been fixed. + +2. Under some conditions, Contour will automatically scale the values it + chooses for contour labels. When this happens, the label under the + plot now says so and reports the scaling factor. +.endhelp diff --git a/pkg/plot/calcomp.par b/pkg/plot/calcomp.par new file mode 100644 index 00000000..20b9823a --- /dev/null +++ b/pkg/plot/calcomp.par @@ -0,0 +1,17 @@ +input,s,a,,,,"input metacode file" +device,s,h,"calcomp",,,"output device" +generic,b,h,no,,,"ignore remaining kernel dependent parameters" +debug,b,h,no,,,"print decoded graphics instr's during processing" +verbose,b,h,no,,,"print elements of polylines, etc. in debug mode" +gkiunits,b,h,no,,,"print coordinates in GKI rather than NDC units" +xscale,r,h,INDEF,0.0,,"plotter x = GKI_NDC_X * xscale" +yscale,r,h,INDEF,0.0,,"plotter y = GKI_NDC_Y * yscale" +txquality,s,h,"normal","normal|low|medium|high",,"character quality" +lwtype,s,h,"ntracing","ntracing|penchange",,"bold line implementation" +ltover,b,h,no,,,"override line type simulation" +lwover,b,h,yes,,,"override line width simulation" +lcover,b,h,no,,,"override line color implementation by penchange" +dashlen,r,h,INDEF,0.0,,"dashed line dash length; 0.1 reasonable" +gaplen,r,h,INDEF,0.0,,"dashed line gap length; 0.05 reasonable" +plwsep,r,hl,INDEF,0.,,"polyline separation in ntracing; .005 reasonable" + diff --git a/pkg/plot/contour.par b/pkg/plot/contour.par new file mode 100644 index 00000000..d0644072 --- /dev/null +++ b/pkg/plot/contour.par @@ -0,0 +1,22 @@ +image,s,a,,,,image or image section to be plotted +floor,r,h,INDEF,,,minimum value to be contoured (INDEF for min) +ceiling,r,h,INDEF,,,maximum value to be contoured (INDEF for max) +zero,r,h,0,,,greyscale value of zero contour +ncontours,i,h,0,,,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 +device,s,h,stdgraph,,,output device +title,s,h,"imtitle",,,optional title +preserve,b,h,yes,,,preserve aspect ratio of image? +label,b,h,yes,,,label major contours with their values? +fill,b,h,no,,,fill viewport regardless of device aspect ratio? +xres,i,h,64,,,resolution in x +yres,i,h,64,,,resolution in y +perimeter,b,h,yes,,,draw labelled perimeter around plot? +vx1,r,h,0.,,,NDC viewport x1 +vx2,r,h,0.,,,NDC viewport x2 +vy1,r,h,0.,,,NDC viewport y1 +vy2,r,h,0.,,,NDC viewport y2 +subsample,b,h,no,,,Subsample (vs blockaverage) to decrease resolution? +append,b,h,no,,,append to an old plot diff --git a/pkg/plot/crtpict.par b/pkg/plot/crtpict.par new file mode 100644 index 00000000..6cf3999a --- /dev/null +++ b/pkg/plot/crtpict.par @@ -0,0 +1,20 @@ +# Parameter file for the CRTPICT task +input,f,a,,,,input images +output,f,h,"",,,output metacode file name +device,s,h,"film_recorder",,,output device +auto_fill,b,h,yes,,,fill output area? +replicate,b,h,yes,,,block replicate to fill device area? +xmag,r,h,1.0,,,x magnification factor +ymag,r,h,1.0,,,y magnification factor +ztrans,s,h,"auto",,,type of transfer function +lutfile,f,h,"",,,input file containing user transfer function +contrast,r,h,0.25,,,contrast factor +nsample_lines,i,h,25,,,number of lines to sample +z1,r,h,0.0,,,intensity mapped to minimum greyscale value +z2,r,h,0.0,,,intensity mapped to maximum greyscale value +perimeter,b,h,yes,,,draw annotated perimeter? +graphics_fraction,r,h,0.20,,, +image_fraction,r,h,0.72,,, +greyscale_fraction,r,h,0.04,,, +x_blk_average,r,h,1.0,,,block average output device in x by this amount +y_blk_average,r,h,1.0,,,block average output device in y by this amount diff --git a/pkg/plot/crtpict/calchgms.x b/pkg/plot/crtpict/calchgms.x new file mode 100644 index 00000000..15c5aa5a --- /dev/null +++ b/pkg/plot/crtpict/calchgms.x @@ -0,0 +1,192 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "wdes.h" +include "crtpict.h" + +# CRT_LINEAR_HGRAM -- Calculate two histograms of an image. One histogram +# shows the distribution of intensities in the untransformed image; the other +# shows the distribution of greyscale values in the transformed image. This +# procedure assumes a linear transformation. + +procedure crt_linear_hgram (im, gp, z1, z2, ztrans, inten_hgram,greys_hgram) + +pointer im # Pointer to image +pointer gp # Graphics descriptor +real z1, z2 # Range of intensities mapped +int ztrans # Type of transfer function - linear or unitary +int inten_hgram[NBINS] # Output array of intensity hgram values +int greys_hgram[NBINS] # Output array of greyscale hgram values + +pointer buf +int npix, nsig_bits, zrange, mask, min_val, max_val +long v[IM_MAXDIM] +int dz1, dz2, high_zi, low_zi +real high_z, low_z +bool ggetb() +pointer imgnlr(), imgnli() +int ggeti() +errchk im_minmax, ggeti, imgnli, imgnlr + +begin + # If z1 and z2 not in graphcap, set to some reasonable numbers for + # plots to be generated. + if (ggetb (gp, "z1") && ggetb (gp, "z2")) { + dz1 = ggeti (gp, "z1") + dz2 = ggeti (gp, "z2") + } else { + dz1 = 0 + dz2 = 255 + } + + # Calculate number of bits of depth in output device + zrange = ggeti (gp, "zr") + for (nsig_bits = 0; ; nsig_bits = nsig_bits + 1) { + zrange = zrange / 2 + if (zrange == 0) + break + } + mask = (2 ** (nsig_bits)) - 1 + + call aclri (inten_hgram, NBINS) + call aclri (greys_hgram, NBINS) + call amovkl (long(1), v, IM_MAXDIM) + + # Read lines into buffer and accumulate histograms. + npix = IM_LEN(im,1) + + if (ztrans == W_UNITARY) { + min_val = int (IM_MIN(im)) + max_val = int (IM_MAX(im)) + while (imgnli (im, buf, v) != EOF) { + call ahgmi (Memi[buf], npix, inten_hgram, NBINS, min_val, + max_val) + call aandki (Memi[buf], mask, Memi[buf], npix) + call ahgmi (Memi[buf], npix, greys_hgram, NBINS, dz1, dz2) + } + } else if (IM_PIXTYPE(im) == TY_SHORT) { + min_val = int (IM_MIN(im)) + max_val = int (IM_MAX(im)) + if (z2 > z1) { + # Positive contrast + high_zi = int (z2) + low_zi = int (z1) + } else { + # Negative contrast + high_zi = int (z1) + low_zi = int (z2) + } + while (imgnli (im, buf, v) != EOF) { + call ahgmi (Memi[buf], npix, inten_hgram, NBINS, min_val, + max_val) + call ahgmi (Memi[buf], npix, greys_hgram, NBINS, low_zi, + high_zi) + } + } else { + if (z2 > z1) { + # Positive contrast + high_z = z2 + low_z = z1 + } else { + # Negative contrast + high_z = z1 + low_z = z2 + } + while (imgnlr (im, buf, v) != EOF) { + call ahgmr (Memr[buf], npix, inten_hgram, NBINS, IM_MIN(im), + IM_MAX(im)) + call ahgmr (Memr[buf], npix, greys_hgram, NBINS, low_z, high_z) + } + } +end + + +# CRT_USER_HGRAM -- Calculate two histograms of an image. One histogram +# shows the distribution of intensities in the untransformed image; the other +# shows the distribution of greyscale values in the transformed image. This +# procedure does not assume a linear transformation, but rather uses a user +# specified look up table. + +procedure crt_user_hgram (im, gp, z1, z2, lut, inten_hgram, greys_hgram) + +pointer im # Pointer to image +pointer gp # Graphics descriptor +real z1, z2 # Range of intensities mapped +short lut[ARB] # Look up table previously calculated +int inten_hgram[NBINS] # Output array of intensity hgram values +int greys_hgram[NBINS] # Output array of greyscale hgram values + +pointer buf, ibuf, sp, rlut +short min_val, max_val, short_min, short_max, dz1, dz2 +int npix +long v[IM_MAXDIM] +short high_zi, low_zi +real high_z, low_z +pointer imgnlr(), imgnls() +errchk im_minmax, imgnls, imgnlr + +begin + # Get max and min in look up table + call alims (lut, SZ_BUF, dz1, dz2) + + call aclri (inten_hgram, NBINS) + call aclri (greys_hgram, NBINS) + call amovkl (long(1), v, IM_MAXDIM) + + # Read lines into buffer and accumulate histograms. + npix = IM_LEN(im,1) + + if (IM_PIXTYPE(im) == TY_SHORT) { + min_val = short (IM_MIN(im)) + max_val = short (IM_MAX(im)) + short_min = short (STARTPT) + short_max = short (ENDPT) + + if (z2 > z1) { + # Positive contrast + high_zi = short (z2) + low_zi = short (z1) + } else { + # Negative contrast + high_zi = short (z1) + low_zi = short (z2) + } + + while (imgnls (im, buf, v) != EOF) { + call ahgms (Mems[buf], npix, inten_hgram, NBINS, min_val, + max_val) + call amaps (Mems[buf], Mems[buf], npix, low_zi, high_zi, + short_min, short_max) + call aluts (Mems[buf], Mems[buf], npix, lut) + call ahgms (Mems[buf], npix, greys_hgram, NBINS, dz1, dz2) + } + } else { + if (z2 > z1) { + # Positive contrast + high_z = z2 + low_z = z1 + } else { + # Negative contrast + high_z = z1 + low_z = z2 + } + + call smark (sp) + call salloc (ibuf, npix, TY_INT) + call salloc (rlut, SZ_BUF, TY_REAL) + call achtsr (lut, Memr[rlut], SZ_BUF) + + while (imgnlr (im, buf, v) != EOF) { + call ahgmr (Memr[buf], npix, inten_hgram, NBINS, IM_MIN(im), + IM_MAX(im)) + + call amapr (Memr[buf], Memr[buf], npix, z1, z2, STARTPT, ENDPT) + call achtri (Memr[buf], Memi[ibuf], npix) + call alutr (Memi[ibuf], Memr[buf], npix, Memr[rlut]) + call ahgmr (Memr[buf], npix, greys_hgram, NBINS, real (dz1), + real (dz2)) + } + + call sfree (sp) + } +end diff --git a/pkg/plot/crtpict/crtpict.h b/pkg/plot/crtpict/crtpict.h new file mode 100644 index 00000000..490f45d7 --- /dev/null +++ b/pkg/plot/crtpict/crtpict.h @@ -0,0 +1,43 @@ +define THETA_X 0 # Orientation angle of x axis label +define THETA_Y 90 # Orientation angle of y axis label +define STEP 10 # Tick marks are placed every 10 pixels +define LABEL 100 # Labelled ticks are multiples of 100 +define SZ_LABEL 5 # Max number of characters in label +define TEXT1 0.15 +define HGRAMS 0.50 +define TEXT2 0.10 +define TEXT3 0.10 +define SPACE 0.03 +define NBINS 256 # Number of bins in intensity histogram +define SAMPLE_SIZE 1000 +define STARTPT 0.0E0 +define ENDPT 4095.0E0 +define SZ_BUF 4096 + +define CRT_XS 0.210 +define CRT_XE 0.810 +define CRT_YS 0.076 +define CRT_YE 0.950 + +define LEN_CLPAR (15 + 40 + 40 + 20) +define FILL Memi[$1] +define REPLICATE Memi[$1+1] +define NSAMPLE_LINES Memi[$1+2] +define LUT Memi[$1+3] +define PERIM Memi[$1+4] +define XMAG Memr[P2R($1+5)] +define YMAG Memr[P2R($1+6)] +define CONTRAST Memr[P2R($1+7)] +define Z1 Memr[P2R($1+8)] +define Z2 Memr[P2R($1+9)] +define GREYSCALE_FRACTION Memr[P2R($1+10)] +define IMAGE_FRACTION Memr[P2R($1+11)] +define GRAPHICS_FRACTION Memr[P2R($1+12)] +define X_BA Memr[P2R($1+13)] +define Y_BA Memr[P2R($1+14)] +define UFILE Memc[P2C($1+15)] +define ZTRANS Memc[P2C($1+55)] +define DEVICE Memc[P2C($1+95)] + +define NSTEPS 16 +define SZ_LABEL 5 diff --git a/pkg/plot/crtpict/crtpict.semi b/pkg/plot/crtpict/crtpict.semi new file mode 100644 index 00000000..b2100753 --- /dev/null +++ b/pkg/plot/crtpict/crtpict.semi @@ -0,0 +1,263 @@ +# Semicode for the CRTPICT replacement. Input to the procedure +# is an IRAF image; output is a file of metacode instructions, +# essentially x,y,z for each pixel on the dicomed. The image intensities +# are scaled to the dynamic range of the dicomed. The image +# is also scaled spatially, either expanded or reduced. + +struct dicomed { + + # These constants refer to the full dicomed plotting area and will + # be read from the graphcap entry for "dicomed". + + int di_xr 4096 # x resolution + int di_yr 4096 # y resolution + int di_xs 1 # starting x + int di_xe 4096 # ending x + int di_ys 1 # starting y + int di_ye 4096 # ending y + int di_zmin 1 # minimum grey scale value + int di_zmax 254 # maximum grey scale value + + # These constants refer to the dicomed area accessed by crtpict. + # They will be stored in file crtpict.h. + + int crtpict_xr 2059 # x resolution + int crtpict_yr 2931 # y resolution + int crtpict_xs 886 # starting x + int crtpict_xe 2944 # ending x + int crtpict_ys 875 # starting y + int crtpict_ye 3805 # ending y +} + +# The cl parameters that are read_only will be stored in this structure: + +struct cl_params { + + bool fill + char ztrans + char device + int nsample_lines + real xmag + real ymag + real contrast + real z1 + real z2 + real z1out + real z2out + real greyscale_window + real image_window + real graphics_window +} + +t_crtpict (image_name) + +begin + cl_params = allocate space for read_only cl_parameters + + # First, get the parameters necessary to calculate z1, z2. + if (ztrans = "auto") + get contrast, nsample_lines + if (ztrans = "min_max") { + get z1, z2 + if (z1 == z2) { + get contrast + if (abs (contrast) != 1) + get nsample_lines + } + } + + # Get parameters necessary to compute the spatial transformation. + if (fill) = no { + get xmag, ymag + if (xmag or ymag < 0) + convert them to fractional magnification factors + } + + # If the output has been redirected, input is read from the named + # command file. If not, each image name in the input template is + # assumed to be preceded by the command "plot". + + if (output has been redirected) { + redir = true + cmd = open command file + } + + # Loop over commands until EOF + repeat { + if (redir) { + command = get next command from cmd file + if (command = EOF) + break + if (command != plot) { + reset WCS so gscan coordinates are plotted properly + call gscan (command) + } else + image = image to be plotted + } else { + image = next name from expanded template + if (image = EOF) + break + } + + im = open image file + gp = open new graphics descriptor + + if (user specified output name) { + generate unique output name + call gredir (output name) + } + + call plot_image (gp, im, cl_params) + } + + close image + close gp +end + + +define NSTEPS 16 + +procedure plot_image (gp, im, cl_params) + +begin + wdes = allocate space for window descriptor as in DISPLAY + call establish_transform (gp, im, cl_params, wdes) + + if (cl_params.image_fraction > 0.0) + call transform_image (gp, im, wdes) + + if (cl_params.greyscale_fraction > 0.0) + call draw_greyscale (gp, cl_params, NSTEPS) + + if (cl_params.graphics_fraction > 0.0) + call draw_graphics (gp, im, cl_params) + + free (wdes) + + +procedure establish_transform (gp, im, cl_params, wdes) + +begin + # Procedure xy_scale calculates and stores the spatial + # transformation fields of structure wdes + + call xy_scale (gp, cl_params, im, wdes) + + # Now for the intensity to greyscale mapping. Values z1 and z2, + # the intensities that map to the lowest and highest greyscale + # levels, are also calculated and stored in the wdes structure. + + w1 = W_WC(wdes, 1) + W_ZT(w1) = W_UNITARY + + if (ztrans = "min_max") { + W_ZT(w1) = W_LINEAR + if (cl_param.z1 != cl_param.z2) { + # Use values set by user + z1 = cl_param.z1 + z2 = cl_param.z2 + } else { + # Use image min and max unless the user has set the contrast + # parameter to alter the slope of the transfer function. + if (cl_params.contrast == 1) { + z1 = im.im_min + z2 = im.im_max + } else if (cl_params.contrast == -1) { + z1 = im.im_max + z2 = im.im_min + } else + call zscale (im, z1, z2, contrast, SAMPLE_SIZE, len_stdline) + } + } + + if (ztrans = "auto") { + W_ZT(w1) = W_LINEAR + # Calculate optimum z1 and z2 from image mode + call zscale (im, z1, z2, contrast, SAMPLE_SIZE, len_stdline) + } + + W_ZS(w1) = z1 + W_ZE(w1) = z2 +end + + +procedure xy_scale (gp, cl_params, im, wdes) + +begin + if (fill) { + # Find the number of device pixels per image pixel required to + # scale the image to fit the device window. + xscale = scaling factor in x dimension + yscale = scaling factor in y dimension + + # Preserve the aspect ratio + if (image is longer in x than y) + yscale = xscale + else + xscale = yscale + } else { + # Use the magnification factors specified by the user. + xscale = cl_params.xmag + yscale = cl_params.ymag + } + + # The (NDC) device coordinates of the image viewport are stored + # as world coordinate system 0. + w0 = W_WC(wdes, 0) + W_XS(w0) = NDC coord of left edge of viewport + W_XE(w0) = NDC coord of right edge of viewport + W_YS(w0) = NDC coord of lower edge of viewport + W_YE(w0) = NDC coord of upper edge of viewport + W_XRES(w0) = number of elements in plotting area x dimension + W_YRES(w0) = number of elements in plotting area y dimension + + # The pixel coordinates of the window are stored as world + # coordinate system 1. + w1 = W_WC(wdes, 1) + W_XS(w1) = image column plotted at left edge of window + W_XE(w1) = image column plotted at right edge of window + W_YS(w1) = image row plotted at lower edge of window + W_YE(w1) = image row plotted at upper edge of window +end + + +procedure draw_greyscale (gp, cl_params, NSTEPS) + +begin + # The (NDC) device coordinates of the greyscale_window: + gs_x1 = crtpict_xs / di_xr + gs_x2 = crtpict_x2 / di_xr + gs_y1 = im_y2 / di_yr + gs_y2 = gs_y1 + ((crtpict_yr * cl_params.greyscale_fraction) / di_yr) + + # Set the viewport and window mapping + call gsview (gp, gs_x1, gs_x2, gs_y1, gs_y2) + call gswind (gp, 1, NSTEPS, 1, 1) + + # Fill and output greyscale array + do i = 1, NSTEPS + grey_levels[i] = grey level + + call gcell (gp, grey_levels, NSTEPS, 1, 1, 1, NSTEPS, 1) +end + + +define NVALUES 256 + +procedure draw_graphics (gp, im, cl_params) + +begin + # The (NDC) device coordinates of the graphics viewport: + gr_x1 = crtpict_xs / di_xr + gr_x2 = crtpict_xe / di_xr + gr_y1 = crtpict_ys / di_yr + gr_y2 = gr_y1 + ((crtpict_yr * cl_params.graphics_fraction) / di_yr) + + # Set the viewport and window coordinates + call gsview (gp, gr_x1, gr_x2, gr_y1, gr_y2) + call gswind (gp, 1, crtpict_xr, 1, gr_yr) + + call gtext (for id string, nrows, ncols etc.) + call generate_histograms (im, NVALUES) + call gploto (?) to plot histograms +end diff --git a/pkg/plot/crtpict/crtulut.x b/pkg/plot/crtpict/crtulut.x new file mode 100644 index 00000000..43609c55 --- /dev/null +++ b/pkg/plot/crtpict/crtulut.x @@ -0,0 +1,130 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <ctype.h> +include "crtpict.h" + +# CRT_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 crt_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 crt_rlut, crt_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 crt_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 crt_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 + + +# CRT_RLUT -- Read text file of x, y, values. + +procedure crt_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 + + +# CRT_SORT -- Bubble sort of paired arrays. + +procedure crt_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/plot/crtpict/drawgraph.x b/pkg/plot/crtpict/drawgraph.x new file mode 100644 index 00000000..5ee94045 --- /dev/null +++ b/pkg/plot/crtpict/drawgraph.x @@ -0,0 +1,153 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <imhdr.h> +include <time.h> +include "wdes.h" +include "crtpict.h" + + +# CRT_DRAW_GRAPHICS -- Draw histogram plots and id information at the bottom of +# the output print. + +procedure crt_draw_graphics (gp, im, cl, wdes) + +pointer gp # Pointer to graphics descriptor +pointer im # Pointer to input image +pointer cl # Pointer to cl parameter structure +pointer wdes # Pointer to window descriptor + +pointer w1, w0 +char text[SZ_LINE], system_id[SZ_LINE] +int ndev_rows, ndev_cols +real ndc_xs, ndc_xe, ndc_ys, ndc_ye # Graphics (NDC) viewport +real h_xs, h_xe, h_ys, h_ye # Histogram viewport +real tx1_xc, tx1_ly, tx2_xs, tx2_ly, tx3_xs, tx3_ly, tx4_xs, tx4_ly +real px1, px2, py1, py2, pxcenter, pycenter, yres +real vx1, vx2, vy1, vy2, tx_start, xrf, yrf + +int junk +pointer sp, buf +int envfind(), envputs() + +int strlen(), ggeti() +errchk strlen, ggeti, crt_plot_hgrams, ggwind, ggview +errchk gtext + +begin + ndev_rows = ggeti (gp, "yr") + ndev_cols = ggeti (gp, "xr") + yres = (CRT_YE - CRT_YS) * ndev_rows + + w0 = W_WC (wdes, 0) + w1 = W_WC (wdes, 1) + + # The (NDC) device coordinates of the entire graphics viewport: + ndc_xs = CRT_XS + ndc_xe = CRT_XE + ndc_ys = CRT_YS + ndc_ye = CRT_YS + real (yres * GRAPHICS_FRACTION(cl) / ndev_rows) + + # Working up from the bottom of the print, locations of various + # sections of the graphics are are calculated. String TEXT1 will + # be centered in x at tx1_xc and have lower y coordinate tx1_ly: + + tx1_xc = (ndc_xe + ndc_xs) / 2.0 + tx1_ly = ndc_ys + + # The three histograms occupy the space calculated next. This + # space is broken into individual plots in a separate procedure. + + h_xs = ndc_xs + h_xe = ndc_xe + h_ys = ndc_ys + ((ndc_ye - ndc_ys) * (TEXT1 + SPACE)) + h_ye = h_ys + ((ndc_ye - ndc_ys) * HGRAMS) + + # The left starting position of the text strings is calculated to + # line up with the leftmost histogram window: + tx_start = h_xs + ((h_xe - h_xs) / 6.0) - ((h_xe - h_xs) / 8.0) + + # String TEXT2 has the following starting_x and lower_y coordinates: + tx2_xs = tx_start + tx2_ly = h_ye + ((ndc_ye - ndc_ys) * SPACE) + + # String TEXT3 has these starting_x and lower_y coordinates: + tx3_xs = tx_start + tx3_ly = ndc_ys + ((TEXT1 + HGRAMS + TEXT2 + SPACE) * (ndc_ye - ndc_ys)) + + # String TEXT4 has these starting_x and lower_y coordinates: + tx4_xs = tx_start + tx4_ly = ndc_ys + ((TEXT1+HGRAMS+TEXT2+TEXT3+SPACE) * (ndc_ye - ndc_ys)) + + # Draw 3 plots describing transformation of image + call crt_plot_histograms (gp, cl, im, wdes, h_xs, h_xe, h_ys, h_ye) + + # Set graphics WCS to WCS 0 for text plotting + call gseti (gp, G_WCS, 0) + + # Text line 3 has the image filename and title string. + call sprintf (text, SZ_LINE, "%s: %s") + call pargstr (W_IMSECT(wdes)) + call pargstr (IM_TITLE(im)) + call gtext (gp, tx3_xs, tx3_ly, text, "s=0.5") + + # Text line 2 contains image and transformation information; it + # is necessary to change to WCS_2 to retrieve the information: + + call gseti (gp, G_WCS, 2) + call ggwind (gp, px1, px2, py1, py2) + call ggview (gp, vx1, vx2, vy1, vy2) + call gseti (gp, G_WCS, 0) + + pxcenter = (px1 + px2) / 2.0 + pycenter = (py1 + py2) / 2.0 + xrf = ((vx2 * ndev_cols) - (vx1 * ndev_cols)) / (px2 - px1 + 1.0) + yrf = ((vy2 * ndev_rows) - (vy1 * ndev_rows)) / (py2 - py1 + 1.0) + + call sprintf (text, SZ_LINE, + "ncols=%d nrows=%d zmin=%g zmax=%g xc=%0.2f yc=%0.2f") + call pargi (IM_LEN(im,1)) + call pargi (IM_LEN(im,2)) + call pargr (IM_MIN(im)) + call pargr (IM_MAX(im)) + call pargr (pxcenter) + call pargr (pycenter) + call sprintf (text[strlen(text)+1], SZ_LINE, " x_rep=%.2f y_rep=%.2f") + call pargr (xrf) + call pargr (yrf) + call gtext (gp, tx2_xs, tx2_ly, text, "s=0.35") + + # Text line 1 gives the time and date the output was written + call sysid (system_id, SZ_LINE) + call gtext (gp, tx1_xc, tx1_ly, system_id, "h=c;s=0.45") + + # Also output transformation information to STDOUT + call printf ("ncols=%d nrows=%d zmin=%g zmax=%g xc=%.2f yc=%.2f") + call pargi (IM_LEN(im,1)) + call pargi (IM_LEN(im,2)) + call pargr (IM_MIN(im)) + call pargr (IM_MAX(im)) + call pargr (pxcenter) + call pargr (pycenter) + call printf (" xrf=%.2f yrf=%.2f\n") + call pargr (xrf) + call pargr (yrf) + + call printf ("%s \n") + call pargstr (system_id) + + # The following was added 17Dec85 at the request of the photo lab. + # It allows the negative to be identified easily by user name in + # addition to the sequence number written by the 11/23 program. + + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + if (envfind ("userid", Memc[buf], SZ_LINE) <= 0) { + call getuid (Memc[buf], SZ_LINE) + junk = envputs ("userid", Memc[buf]) + } + call gtext (gp, CRT_XE, 0.001, Memc[buf], "h=r;v=b;s=1.2") + + call sfree (sp) +end diff --git a/pkg/plot/crtpict/drawgrey.x b/pkg/plot/crtpict/drawgrey.x new file mode 100644 index 00000000..6f2807ea --- /dev/null +++ b/pkg/plot/crtpict/drawgrey.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include <gset.h> +include "wdes.h" +include "crtpict.h" + +# CRT_DRAW_GREYSCALE -- Draw steps representing greyscale increments on output. + +procedure crt_draw_greyscale (gp, cl) + +pointer gp +pointer cl + +short grey[NSTEPS] +char label[SZ_LABEL] +int ndev_rows, i, dummy +real ndc_xs, ndc_xe, ndc_ys, ndc_ye, yres, del_y +real delta_grey, delta_x, x_start, x, dz1, dz2 + +bool ggetb() +int ggeti(), itoc() +real ggetr() +errchk ggetb, ggeti, ggetr, gpcell, ggetr, gtext + +begin + if (ggetb (gp, "z1") && ggetb (gp, "z2")) { + dz1 = ggetr (gp, "z1") + dz2 = ggetr (gp, "z2") + } else { + dz1 = 0. + dz2 = 255. + } + + ndev_rows = ggeti (gp, "yr") + yres = (CRT_YE - CRT_YS) * ndev_rows + + # The (NDC) device coordinates of the greyscale_window are calculated. + + ndc_xs = CRT_XS + ndc_xe = CRT_XE + ndc_ys = CRT_YS + ((GRAPHICS_FRACTION(cl) + IMAGE_FRACTION(cl) + SPACE)* + yres) / ndev_rows + ndc_ye = ndc_ys + ((yres * GREYSCALE_FRACTION(cl)) / ndev_rows) + ndc_ye = min (ndc_ye, CRT_YE) + del_y = ndc_ye - ndc_ys + + # Calculate and output grey levels + call gseti (gp, G_WCS, 0) + delta_grey = (dz2 - dz1) / real(NSTEPS - 1) + delta_x = (ndc_xe - ndc_xs) / NSTEPS + x_start = ndc_xs + (delta_x / 2.0) + do i = 1, NSTEPS { + grey[i] = short (dz1 + (i-1) * delta_grey + 0.5) + dummy = itoc (int(grey[i]), label, SZ_LABEL) + x = x_start + (i - 1) * delta_x + call gtext (gp, x, ndc_ys, label, "h=c;s=0.25;v=t") + } + + call gpcell (gp, grey, NSTEPS, 1, ndc_xs, ndc_ys + (0.05 * del_y), + ndc_xe, ndc_ye) +end diff --git a/pkg/plot/crtpict/mapimage.x b/pkg/plot/crtpict/mapimage.x new file mode 100644 index 00000000..9a215278 --- /dev/null +++ b/pkg/plot/crtpict/mapimage.x @@ -0,0 +1,172 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include <gset.h> +include <error.h> +include "wdes.h" +include "crtpict.h" + +# CRT_MAP_IMAGE -- Output a scaled image window to the device viewport. +# Spatial scaling is handled by the "scaled input" package, SIGL2[SR]; it is +# possible to scale the image window to a block averaged device viewport. +# Image intensities are converted to greyscale values and the input NDC +# coordinates are "tweaked" to make sure they represent integer device pixels. +# This tweaking also insures an integer replication factor between image +# pixels and device pixels. Type short pixels are treated as a special +# case to minimize vector operations. + +procedure crt_map_image (im, gp, px1,px2,py1,py2, ndc_xs,ndc_xe,ndc_ys,ndc_ye, + nx_output, ny_output, z1,z2,zt, cl) + +pointer im # input image +pointer gp # graphics descriptor +real px1,px2,py1,py2 # input section +real ndc_xs,ndc_xe,ndc_ys,ndc_ye # NDC of output section +int nx_output, ny_output # Number of output pixels. Image pixels + # are scaled to these dimensions. +real z1,z2 # range of intensities to be mapped. +int zt # specified greyscale transform type +pointer cl # Pointer to crtpict structure + +bool unitary_greyscale_transformation +pointer in, si, sline, rline, llut, sp +short sz1, sz2, sdz1, sdz2, lut1, lut2 +real dz1, dz2, y1, y2, delta_y +int ndev_cols, ndev_rows, nline, ny_device +int xblk, yblk +bool ggetb(), fp_equalr() +int ggeti() +real ggetr() +pointer sigl2s(), sigl2r(), sigl2_setup() +errchk sigl2s, sigl2r, sigl2_setup, ndc_tweak_ndc, ggeti, malloc, ggetr +errchk ggetb, ggetr, gpcell, crt_ulut + +begin + call smark (sp) + call salloc (sline, nx_output, TY_SHORT) + if (IM_PIXTYPE(im) != TY_SHORT) + call salloc (rline, nx_output, TY_REAL) + + # Calculate and allocate heap space needed for an image row. + ndev_cols = ggeti (gp, "xr") + ndev_rows = ggeti (gp, "yr") + ny_device = ((ndc_ye * ndev_rows) - (ndc_ys * ndev_rows)) + 1 + + # This sets up for the scaled image input + xblk = INDEFI + yblk = INDEFI + si = sigl2_setup (im, px1,px2,nx_output,xblk, py1,py2,ny_output,yblk) + + # If user has supplied look up table, it has to be dealt with at + # this point. Greyscale transform is coming up, and the transfer + # function will be plotted at a later step. + + if (zt == W_USER) { + iferr (call crt_ulut (UFILE(cl), z1, z2, llut)) + call erract (EA_FATAL) + LUT(cl) = llut + call alims (Mems[llut], SZ_BUF, lut1, lut2) + } + + # If device can't output greyscale information, return at this point. + if (! ggetb (gp, "zr")) { + call eprintf ("Graphics device doesn't support greyscale output\n") + return + } + + # Determine the device range for the greyscale transformation. + if (ggetb (gp, "z1") && ggetb (gp, "z2")) { + dz1 = ggetr (gp, "z1") + dz2 = ggetr (gp, "z2") + } else { + dz1 = 0. + dz2 = 255. + } + + # And now a quick test to make sure user specified greyscale and + # intensity ranges are reasonable. + if (zt == W_USER) { + sdz1 = short (dz1) + sdz2 = short (dz2) + if (lut2 < sdz1 || lut1 > sdz2) + 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") + } + + if (zt == W_UNITARY) + unitary_greyscale_transformation = true + else + unitary_greyscale_transformation = + (fp_equalr (dz1,z1) && fp_equalr (dz2,z2)) || fp_equalr (z1,z2) + + # Calculate the delta_y, that is, the change in ndc coordinate + # with each output row. It has been assurred by tweak_ndc that + # the ratio of device rows to output pixels is an integer. + + delta_y = (real (ny_device) / ny_output) / real (ndev_rows) + + # For TY_SHORT pixels, pixel intensities are converted to greyscale + # values, then output with gpcell. + if (IM_PIXTYPE(im) == TY_SHORT) { + for (nline=1; nline <= ny_output; nline=nline+1) { + in = sigl2s (si, nline) + if (unitary_greyscale_transformation) + call amovs (Mems[in], Mems[sline], nx_output) + else if (zt == W_LINEAR) { + sz1 = short (z1) + sz2 = short (z2) + sdz1 = short (dz1) + sdz2 = short (dz2) + call amaps (Mems[in], Mems[sline], nx_output, sz1, sz2, + sdz1, sdz2) + } else if (zt == W_USER) { + sz1 = short (z1) + sz2 = short (z2) + sdz1 = short (STARTPT) + sdz2 = short (ENDPT) + call amaps (Mems[in], Mems[sline], nx_output, sz1, sz2, + sdz1, sdz2) + call aluts (Mems[sline], Mems[sline], nx_output, Mems[llut]) + } + + # Now put line out to greyscale device + y1 = ndc_ys + (nline - 1) * delta_y + y2 = ndc_ys + (nline * delta_y) + + call gpcell (gp, Mems[sline], nx_output, 1, ndc_xs, y1, ndc_xe, + y2) + } + } else { + # Pixels are treated as TY_REAL; intensities are converted to + # greyscale values, then converted to TY_SHORT for gpcell output. + for (nline=1; nline <= ny_output; nline=nline+1) { + in = sigl2r (si, nline) + if (unitary_greyscale_transformation) { + call amovr (Memr[in], Memr[rline], nx_output) + call achtrs (Memr[rline], Mems[sline], nx_output) + } else if (zt == W_LINEAR) { + call amapr (Memr[in], Memr[rline], nx_output, z1, z2, dz1, + dz2) + call achtrs (Memr[rline], Mems[sline], nx_output) + } else if (zt == W_USER) { + call amapr (Memr[in], Memr[rline], nx_output, z1, z2, + STARTPT, ENDPT) + call achtrs (Memr[rline], Mems[sline], nx_output) + call aluts (Mems[sline], Mems[sline], nx_output, Mems[llut]) + } + + # Output line to greyscale device + y1 = ndc_ys + (nline - 1) * delta_y + y2 = ndc_ys + (nline * delta_y) + + call gpcell (gp, Mems[sline], nx_output, 1, ndc_xs, y1, + ndc_xe, y2) + } + } + + # Free allocate memory + call sigl2_free (si) + call sfree (sp) +end diff --git a/pkg/plot/crtpict/minmax.x b/pkg/plot/crtpict/minmax.x new file mode 100644 index 00000000..092d3b9e --- /dev/null +++ b/pkg/plot/crtpict/minmax.x @@ -0,0 +1,75 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IM_MINMAX -- Compute the minimum and maximum pixel values of an image. +# Works for images of any dimensionality, size, or datatype, although +# the min and max values can currently only be stored in the image header +# as real values. + +procedure im_minmax (im, min_value, max_value) + +pointer im # image descriptor +real min_value # minimum pixel value in image (out) +real max_value # maximum pixel value in image (out) + +pointer buf +bool first_line +long v[IM_MAXDIM] +short minval_s, maxval_s +long minval_l, maxval_l +real minval_r, maxval_r +int imgnls(), imgnll(), imgnlr() +errchk amovkl, imgnls, imgnll, imgnlr, alims, aliml, alimr + +begin + call amovkl (long(1), v, IM_MAXDIM) # start vector + first_line = true + min_value = INDEF + max_value = INDEF + + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + while (imgnls (im, buf, v) != EOF) { + call alims (Mems[buf], IM_LEN(im,1), minval_s, maxval_s) + if (first_line) { + min_value = minval_s + max_value = maxval_s + first_line = false + } else { + if (minval_s < min_value) + min_value = minval_s + if (maxval_s > max_value) + max_value = maxval_s + } + } + case TY_USHORT, TY_INT, TY_LONG: + while (imgnll (im, buf, v) != EOF) { + call aliml (Meml[buf], IM_LEN(im,1), minval_l, maxval_l) + if (first_line) { + min_value = minval_l + max_value = maxval_l + first_line = false + } else { + if (minval_l < min_value) + min_value = minval_l + if (maxval_l > max_value) + max_value = maxval_l + } + } + default: + while (imgnlr (im, buf, v) != EOF) { + call alimr (Memr[buf], IM_LEN(im,1), minval_r, maxval_r) + if (first_line) { + min_value = minval_r + max_value = maxval_r + first_line = false + } else { + if (minval_r < min_value) + min_value = minval_r + if (maxval_r > max_value) + max_value = maxval_r + } + } + } +end diff --git a/pkg/plot/crtpict/mkpkg b/pkg/plot/crtpict/mkpkg new file mode 100644 index 00000000..9f41a011 --- /dev/null +++ b/pkg/plot/crtpict/mkpkg @@ -0,0 +1,24 @@ +# Makelib file for CRTPICT contributions to the plot package library. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + calchgms.x crtpict.h <imhdr.h> wdes.h + crtulut.x crtpict.h <ctype.h> <error.h> + drawgraph.x crtpict.h <gset.h> <imhdr.h> <time.h> wdes.h + drawgrey.x crtpict.h wdes.h <gset.h> <imhdr.h> <mach.h> + mapimage.x crtpict.h wdes.h <error.h> <gset.h> <imhdr.h> <mach.h> + minmax.x <imhdr.h> + plothgms.x crtpict.h <gset.h> <imhdr.h> <mach.h> wdes.h + plotimage.x crtpict.h wdes.h <mach.h> + setxform.x crtpict.h wdes.h <imhdr.h> <mach.h> + sigl2.x <error.h> <imhdr.h> + t_crtpict.x crtpict.h <fset.h> <gset.h> <imhdr.h> <mach.h> <error.h> + tweakndc.x + xformimage.x crtpict.h wdes.h <gset.h> <imhdr.h> <mach.h> + xyscale.x crtpict.h wdes.h <error.h> <imhdr.h> <mach.h> + zscale.x <imhdr.h> + ; diff --git a/pkg/plot/crtpict/plothgms.x b/pkg/plot/crtpict/plothgms.x new file mode 100644 index 00000000..803c709f --- /dev/null +++ b/pkg/plot/crtpict/plothgms.x @@ -0,0 +1,209 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <imhdr.h> +include <mach.h> +include "wdes.h" +include "crtpict.h" + +# CRT_PLOT_HISTOGRAMS -- Calculate and plot three histograms describing the +# intensity to greyscale mapping. + +procedure crt_plot_histograms (gp, cl, im, wdes, xs, xe, ys, ye) + +pointer gp +pointer cl # Pointer to cl structure. +pointer im +pointer wdes +real xs, xe, ys, ye, z1, z2 + +pointer w1, inten_hgram, greys_hgram, sp, text, syv, greys, hgram +pointer real_greys, xval, yval +int nsig_bits, i, zrange, mask +real plot_ys, plot_ye, plot_width, plot_spacing, x, y, delta_inten, inten +real plot1_xs, plot1_xe, plot2_xs, plot2_xe, plot3_xs, plot3_xe +real dz1, dz2, gio_char_x +real major_length, minor_length, ux1, ux2, uy1, uy2, y_pos, label_y +real wx1, wx2, wy1, wy2 + +bool ggetb() +real ggetr() +int ggeti(), and() +errchk ggetb, ggeti, ggetr, crt_calc_hgrams, ggwind, gswind, gsview, gploto +errchk gsetr, gseti, glabax, amapr, gpline, gvline, achtir, gtext + +begin + call smark (sp) + call salloc (inten_hgram, NBINS, TY_INT) + call salloc (greys_hgram, NBINS, TY_INT) + call salloc (text, SZ_LINE, TY_CHAR) + call salloc (syv, NBINS, TY_SHORT) + call salloc (greys, NBINS, TY_INT) + call salloc (hgram, NBINS, TY_REAL) + call salloc (real_greys, NBINS, TY_REAL) + call salloc (xval, NBINS, TY_REAL) + call salloc (yval, NBINS, TY_REAL) + + # First, get pointer to WCS 1 and some device parameters. + w1 = W_WC(wdes, 1) + z1 = W_ZS(w1) + z2 = W_ZE(w1) + + # If z1 and z2 not in graphcap, set to some reasonable numbers for + # plots to be generated. + + if (ggetb (gp, "z1") && ggetb (gp, "z2")) { + dz1 = ggetr (gp, "z1") + dz2 = ggetr (gp, "z2") + } else { + dz1 = 0. + dz2 = 255. + } + + # To allow room for annotation, the y limits of each plot are + # drawn in by 5%. The y limits are the same for each plot. + + plot_ys = ys + (0.05 * (ye - ys)) + plot_ye = ye - (0.05 * (ye - ys)) + label_y = plot_ys - (plot_ye - plot_ys) * 0.20 + + # Now calculate the x limits. Each plot occupys a fourth of the + # available space in x. The distance between plot centers is a + # third of the available space. + + plot_width = (xe - xs) / 4.0 + plot_spacing = (xe - xs) / 3.0 + + plot1_xs = xs + (plot_spacing / 2.0) - (plot_width / 2.0) + plot1_xe = plot1_xs + plot_width + plot2_xs = plot1_xs + plot_spacing + plot2_xe = plot2_xs + plot_width + plot3_xs = plot2_xs + plot_spacing + plot3_xe = plot3_xs + plot_width + + # Calculate the histograms for both the untransformed (intensity) and + # transformed (greyscale) image in a single procedure. A separate + # path is taken for linear or user transformations: + + if (W_ZT(w1) == W_USER) + call crt_user_hgram (im, gp, z1, z2, Mems[LUT(cl)], + Memi[inten_hgram], Memi[greys_hgram]) + else + call crt_linear_hgram (im, gp, z1, z2, W_ZT(w1), Memi[inten_hgram], + Memi[greys_hgram]) + + # Each histogram plot is a separate mapping in WCS 3 + call gseti (gp, G_WCS, 3) + + # The first histogram shows the number of pixels at a given + # intensity versus intensity for the original image. + + call gsview (gp, plot1_xs, plot1_xe, plot_ys, plot_ye) + gio_char_x = ((plot1_xe - plot1_xs) / 50.) / ggetr (gp, "cw") + major_length = gio_char_x * (ggetr (gp, "cw")) + minor_length = gio_char_x * (0.5 * (ggetr (gp, "cw"))) + + call gseti (gp, G_YTRAN, GW_LOG) + call gseti (gp, G_ROUND, YES) + call gsetr (gp, G_MAJORLENGTH, major_length) + call gsetr (gp, G_MINORLENGTH, minor_length) + call gseti (gp, G_LABELAXIS, NO) + call gsetr (gp, G_TICKLABELSIZE, 0.25) + call achtir (Memi[inten_hgram], Memr[hgram], NBINS) + call gploto (gp, Memr[hgram], NBINS, IM_MIN(im), IM_MAX(im), "") + + # Now to label the plot: + call ggwind (gp, ux1, ux2, uy1, uy2) + y_pos = uy1 - ((uy2 - uy1) * 0.20) #y_pos below yaxis by 20% of height + call gseti (gp, G_YTRAN, GW_LINEAR) + call gtext (gp, (ux1+ux2)/2.0, y_pos, "LOG10(N(DN)) VS DN", + "v=t;h=c;s=.25") + + # The third plot shows the number of pixels at a given greyscale + # level versus greyscale level for the range of intensities + # transformed. + + call gsview (gp, plot3_xs, plot3_xe, plot_ys, plot_ye) + call achtir (Memi[greys_hgram], Memr[hgram], NBINS) + + if (z2 > z1) + call gploto (gp, Memr[hgram], NBINS, dz1, dz2, "") + else + call gploto (gp, Memr[hgram], NBINS, dz2, dz1, "") + + # Now to label the plot: + call ggwind (gp, ux1, ux2, uy1, uy2) + call gseti (gp, G_YTRAN, GW_LINEAR) + y_pos = uy1 - ((uy2 - uy1) * 0.20) # y_pos below yaxis by 20% of height + call gtext (gp, (ux1+ux2)/2.0, y_pos, "TRANSFORMED HISTOGRAM", + "v=t;h=c;s=.25") + + # The second plot shows how the dynamic range of the transformed + # image maps to the dynamic range of the output device. + + call gsview (gp, plot2_xs, plot2_xe, plot_ys, plot_ye) + call gswind (gp, IM_MIN(im), IM_MAX(im), real (dz1), real (dz2)) + call gseti (gp, G_YTRAN, GW_LINEAR) + call glabax (gp, "", "", "") + + if (W_ZT(w1) != W_UNITARY) { + do i = 1, NBINS + Memr[xval+i-1] = IM_MIN(im) + (i-1) * (IM_MAX(im) - + IM_MIN(im))/ (NBINS-1) + + if (W_ZT(w1) == W_USER) { + call sprintf (Memc[text], SZ_LINE, + "USER DEFINED FUNCTION: FROM %g TO %g") + call pargr (z1) + call pargr (z2) + call amapr (Memr[xval], Memr[yval], NBINS, z1, z2, STARTPT, + ENDPT) + call achtrs (Memr[yval], Mems[syv], NBINS) + call aluts (Mems[syv], Mems[syv], NBINS, Mems[LUT[cl]]) + call achtsr (Mems[syv], Memr[yval], NBINS) + } else { + call sprintf (Memc[text], SZ_LINE, + "TRANSFER FUNCTION: LINEAR FROM %g TO %g") + call pargr (z1) + call pargr (z2) + call amapr (Memr[xval], Memr[yval], NBINS, z1, z2, real (dz1), + real (dz2)) + } + + call gpline (gp, Memr[xval], Memr[yval], NBINS) + call ggwind (gp, wx1, wx2, wy1, wy2) + x = (wx2 + wx1) / 2.0 + y = wy1 - (wy2 - wy1) * 0.20 + call gtext (gp, x, y, Memc[text], "h=c;v=t;s=0.25") + call printf ("%s\n") + call pargstr (Memc[text]) + + } else { + # Calculate number of bits depth in output device + zrange = ggeti (gp, "zr") + for (nsig_bits = 0; ; nsig_bits = nsig_bits + 1) { + zrange = zrange / 2 + if (zrange == 0) + break + } + + # Truncate intensities to dynamic range of output device. + delta_inten = (IM_MAX(im) - IM_MIN(im)) / (NBINS - 1) + mask = 2**(nsig_bits) - 1 + do i = 1, NBINS { + inten = IM_MIN(im) + ((i-1) * delta_inten) + Memi[greys+i-1] = and (int (inten), mask) + } + + call achtir (Memi[greys], Memr[real_greys], NBINS) + call gvline (gp, Memr[real_greys], NBINS, IM_MIN(im), IM_MAX(im)) + call ggwind (gp, wx1, wx2, wy1, wy2) + x = (wx2 + wx1) / 2.0 + y = wy1 - (wy2 - wy1) * 0.20 + call gtext (gp, x, y, "TRANSFER FUNCTION: UNITARY","h=c;v=t;s=0.25") + call printf ("Unitary Transfer Function; Lowest %d bits output.\n") + call pargi (nsig_bits) + } + + call sfree (sp) +end diff --git a/pkg/plot/crtpict/plotimage.x b/pkg/plot/crtpict/plotimage.x new file mode 100644 index 00000000..add1ed8a --- /dev/null +++ b/pkg/plot/crtpict/plotimage.x @@ -0,0 +1,40 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "wdes.h" +include "crtpict.h" + +# CRT_PLOT_IMAGE - Plot the image, graphics and greyscale portion of +# each image to be transformed. + +procedure crt_plot_image (gp, im, image, cl) + +pointer gp # Graphics descriptor +pointer im # Pointer to image +char image[SZ_FNAME] # Image filename +pointer cl # Pointer to structure of cl parameters + +pointer sp, wdes +errchk crt_establish_transform, crt_transform_image +errchk crt_draw_graphics, crt_draw_greyscale + +begin + call smark (sp) + call salloc (wdes, LEN_WDES, TY_STRUCT) + call strcpy (image, W_IMSECT(wdes), W_SZIMSECT) + + if (IMAGE_FRACTION(cl) > EPSILON) { + call crt_establish_transform (gp, im, cl, wdes) + call crt_transform_image (gp, im, wdes, cl) + } + + if (GRAPHICS_FRACTION(cl) > EPSILON) { + call crt_draw_graphics (gp, im, cl, wdes) + } + + if (GREYSCALE_FRACTION(cl) > EPSILON) { + call crt_draw_greyscale (gp, cl) + } + + call sfree (sp) +end diff --git a/pkg/plot/crtpict/setxform.x b/pkg/plot/crtpict/setxform.x new file mode 100644 index 00000000..a6c50dfb --- /dev/null +++ b/pkg/plot/crtpict/setxform.x @@ -0,0 +1,96 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "wdes.h" +include "crtpict.h" + + +# CRT_ESTABLISH_TRANSFORM -- Set up both the spatial and greyscale mapping. +# The window descriptor "wdes" is filled. + +procedure crt_establish_transform (gp, im, cl, wdes) + +pointer gp +pointer im +pointer cl +pointer wdes + +int w1, len_stdline +real z1, z2 + +bool fp_equalr() +int strncmp() +errchk crt_xy_scale, strcmp, im_minmax, zscale + +begin + # Procedure xy_scale calculates and stores the spatial + # transformation fields of structure wdes. + + call crt_xy_scale (gp, cl, im, wdes) + + w1 = W_WC(wdes, 1) + + # Now for the intensity to greyscale mapping. Values z1 and z2, + # the intensities that map to the lowest and highest greyscale + # levels, are calculated and stored in the wdes structure. First, + # set up the default values. These will not be changed if + # ztrans = "user". + + W_ZT(w1) = W_USER + z1 = INDEFR + z2 = INDEFR + + # Put up to date min, max values in the header structure, if necessary + if (IM_LIMTIME(im) < IM_MTIME(im)) + call im_minmax (im, IM_MIN(im), IM_MAX(im)) + + if (strncmp (ZTRANS(cl), "min_max", 1) == 0) { + W_ZT(w1) = W_LINEAR + if (Z1(cl) != Z2(cl)) { + # Use values set by user + z1 = Z1(cl) + z2 = Z2(cl) + } else { + # Use image min and max unless the user has set the contrast + # parameter to alter the slope of the transfer function. + if (abs (CONTRAST(cl) - 1.0) > EPSILON) { + # CONTRAST = 1.0 + z1 = IM_MIN(im) + z2 = IM_MAX(im) + } else if (abs (CONTRAST(cl) + 1.0) > EPSILON) { + # CONTRAST = -1.0 + z1 = IM_MAX(im) + z2 = IM_MIN(im) + } else { + len_stdline = SAMPLE_SIZE / NSAMPLE_LINES(cl) + call zscale (im, z1, z2, CONTRAST(cl), SAMPLE_SIZE, + len_stdline) + } + } + } + + if (strncmp (ZTRANS(cl), "auto", 1) == 0) { + W_ZT(w1) = W_LINEAR + # Calculate optimum z1 and z2 from image mode + len_stdline = SAMPLE_SIZE / NSAMPLE_LINES(cl) + call zscale (im, z1, z2, CONTRAST(cl), SAMPLE_SIZE, len_stdline) + if (IM_PIXTYPE(im) == TY_SHORT) { + if (short (z1) == short (z2)) + call error (0, + "No range in data, ztrans=auto failed: z1 = z2") + } + else if (fp_equalr (z1, z2)) + call error (0, "No range in data, ztrans=auto failed: z1=z2") + } + + # Set the intensity extremes of the window descriptor + if (strncmp (ZTRANS(cl), "none", 1) == 0) { + W_ZT(w1) = W_UNITARY + W_ZS(w1) = IM_MIN(im) + W_ZE(w1) = IM_MAX(im) + } else { + W_ZS(w1) = z1 + W_ZE(w1) = z2 + } +end diff --git a/pkg/plot/crtpict/sigl2.x b/pkg/plot/crtpict/sigl2.x new file mode 100644 index 00000000..c1e1c9fc --- /dev/null +++ b/pkg/plot/crtpict/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 snlines +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) { + snlines = short (nlines_in_sum) + call adivks (Mems[b], snlines, 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/plot/crtpict/t_crtpict.x b/pkg/plot/crtpict/t_crtpict.x new file mode 100644 index 00000000..bd1887f9 --- /dev/null +++ b/pkg/plot/crtpict/t_crtpict.x @@ -0,0 +1,162 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <error.h> +include <gset.h> +include <fset.h> +include <imhdr.h> +include "crtpict.h" + +# T_CRTPICT -- Code for the CRTPICT replacement. Input to the procedure +# is an IRAF image; output is a file of GKI metacode instructions, +# essentially x,y,z for each pixel on the dicomed. The image intensities +# are scaled to the dynamic range of the output device. The image +# is also scaled spatially, either expanded or reduced. + +procedure t_crtpict () + +bool redir +pointer sp, cl, gp, im, command, image, word, title, output, ofile, dev +int cmd, stat, fd + +pointer immap(), gopen() +bool clgetb(), streq() +int strncmp(), clgeti(), btoi(), fstati(), open(), getline() +int imtopenp(), list, imtgetim() +real clgetr() + +begin + call smark (sp) + call salloc (cl, LEN_CLPAR, TY_STRUCT) + call salloc (command, SZ_LINE, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (word, SZ_LINE, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (ofile, SZ_FNAME, TY_CHAR) + call salloc (dev, SZ_FNAME, TY_CHAR) + + # 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. + + call fseti (STDOUT, F_FLUSHNL, YES) + if (fstati (STDIN, F_REDIR) == YES) { + call printf ("Input has been redirected\n") + redir = true + cmd = open ("STDIN", READ_ONLY, TEXT_FILE) + } else + list = imtopenp ("input") + + # The user can "trap" the output metacode and intercept the + # spooling process if an output file is specified. + call clgstr ("output", Memc[output], SZ_FNAME) + if (!streq (Memc[output], "")) { + call strcpy (Memc[output], Memc[ofile], SZ_FNAME) + fd = open (Memc[ofile], NEW_FILE, BINARY_FILE) + } else + fd = STDGRAPH + + # Now get the parameters necessary to calculate z1, z2. + call clgstr ("ztrans", ZTRANS(cl), SZ_LINE) + if (strncmp (ZTRANS(cl), "auto", 1) == 0) { + CONTRAST(cl) = clgetr ("contrast") + NSAMPLE_LINES(cl) = clgeti ("nsample_lines") + } else if (strncmp (ZTRANS(cl), "min_max", 1) == 0) { + Z1(cl) = clgetr ("z1") + Z2(cl) = clgetr ("z2") + if (abs (Z1(cl) - Z2(cl)) < EPSILON) { + CONTRAST(cl) = clgetr ("contrast") + if (abs (CONTRAST(cl)) - 1.0 > EPSILON) + NSAMPLE_LINES(cl) = clgeti ("nsample_lines") + } + } else if (strncmp (ZTRANS(cl), "user", 1) == 0) + call clgstr ("lutfile", UFILE(cl), SZ_FNAME) + + # Get parameters necessary to compute the spatial transformation. + FILL(cl) = btoi (clgetb ("auto_fill")) + if (FILL(cl) == NO) { + XMAG(cl) = clgetr ("xmag") + YMAG(cl) = clgetr ("ymag") + if (XMAG(cl) < 0) + XMAG(cl) = 1 / abs (XMAG(cl)) + if (YMAG(cl) < 0) + YMAG(cl) = 1 / abs (YMAG(cl)) + } + + if (FILL(cl) == YES || XMAG(cl) - 1.0 > EPSILON || + YMAG(cl) - 1.0 > EPSILON) { + # Find out how spatial scaling is to be done + REPLICATE(cl) = btoi (clgetb ("replicate")) + if (REPLICATE(cl) == NO) { + # Get block averaging factors + X_BA(cl) = clgetr ("x_blk_average") + Y_BA(cl) = clgetr ("y_blk_average") + } + } else + REPLICATE(cl) = YES + + # And for the plotting fractions: + PERIM(cl) = btoi (clgetb ("perimeter")) + GRAPHICS_FRACTION(cl) = clgetr ("graphics_fraction") + IMAGE_FRACTION(cl) = clgetr ("image_fraction") + GREYSCALE_FRACTION(cl) = clgetr ("greyscale_fraction") + + # Get the output device name and determine the graphics pointer. + call clgstr ("device", Memc[dev], SZ_FNAME) + gp = gopen (Memc[dev], NEW_FILE, fd) + + # Loop over commands until EOF + repeat { + if (redir) { + if (getline (STDIN, Memc[command]) == EOF) + break + call sscan (Memc[command]) + call gargwrd (Memc[word], SZ_LINE) + if (!streq (Memc[word], "plot")) { + # Pixel window has been stored as WCS 2 + call gseti (gp, G_WCS, 2) + call gscan (gp, Memc[command]) + next + } else + call gargwrd (Memc[image], SZ_FNAME) + } else { + stat = imtgetim (list, Memc[image], SZ_FNAME) + if (stat == EOF) + break + } + + # Open the input image; if an error occurs, go to next image in list + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + + iferr (call crt_plot_image (gp, im, Memc[image], cl)) + call erract (EA_WARN) + + # Add title to metacode file + call sprintf (Memc[title], SZ_LINE, "CRTPICT: %s") + call pargstr (IM_TITLE(im)) + call gmftitle (gp, Memc[title]) + call imunmap (im) + + # Clear frame for next picture (unless plotting to terminal) + if (strncmp (Memc[dev], "stdgraph", 4) == 0) + call gflush (gp) + else + call gclear (gp) + } + + # Clean up and close files + call gclose (gp) + call close (fd) + + if (redir) + call close (cmd) + else + call imtclose (list) + + call sfree (sp) + call flush (STDOUT) +end diff --git a/pkg/plot/crtpict/tweakndc.x b/pkg/plot/crtpict/tweakndc.x new file mode 100644 index 00000000..1a8f674b --- /dev/null +++ b/pkg/plot/crtpict/tweakndc.x @@ -0,0 +1,66 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CRT_TWEAK_NDC -- Alter the input ndc endpoints so that the ratio +# of device_pixels to image_pixels is an integer. This procedure insures +# an integer replication (or decimation) factor. For replication, +# ndevice_pixels_spanned / nimage_values_output = an_integer. For +# decimation, ndevice_pixels_spanned / nimage_values_output = 1 / an_integer. +# The NDC coordinates returned also represent integer device pixels. + +procedure crt_tweak_ndc (nvalues, ndc_start, ndc_end, device_res) + +int nvalues # Number of image values to output +real ndc_start, ndc_end # NDC endpoints - changed on output +int device_res # Full device resolution + +int ndevice_elements, first_device_element, last_device_element, int_extra +int dev_pixel_1, dev_pixel_2, desired_dev_elements, desired_inverse +real ndc_extra, extra, real_extra +double gki_tweak + +begin + gki_tweak = double (32767) / double (32768) + if (int (ndc_end) == 1) + ndc_end = gki_tweak + first_device_element = ndc_start * device_res + last_device_element = ndc_end * device_res + ndevice_elements = (last_device_element - first_device_element) + 1 + + if (mod (ndevice_elements, nvalues) != 0) { + # Calculate amount to be altered + real_extra = real (ndevice_elements) / real (nvalues) + if (real_extra > 1.0) { + # Tweak to get an integer replication factor + int_extra = ndevice_elements / nvalues + extra = real ((real_extra - int_extra) * nvalues) + ndc_extra = extra / device_res + ndc_start = ndc_start + (ndc_extra / 2.0) + ndc_end = ndc_end - (ndc_extra / 2.0) + } else { + # Tweak to get an integer decimation factor + real_extra = real (nvalues) / real (ndevice_elements) + desired_inverse = int (real_extra) + 1 + desired_dev_elements = nvalues / desired_inverse + extra = desired_dev_elements - ndevice_elements + ndc_extra = real (extra) / real (device_res) + ndc_start = ndc_start - (ndc_extra / 2.0) + ndc_end = ndc_end + (ndc_extra / 2.0) + } + } + + # Now have ndc coordinates of starting and ending pixel such + # that the replication or decimation factor is + # an integer. Now insure that the ndc coordinates refer to + # integer device pixels so that truncation later in the + # processing doesn't alter this replication factor. In what + # follows, note that dev_pixel_1 and dev_pixel_2 + # are 0-based; dev_pixel_1 is the first pixel to be filled, and + # dev_pixel_2 is the first pixel NOT to be filled, in accordance + # with Richard's notes. + + dev_pixel_1 = ndc_start * device_res + dev_pixel_2 = (ndc_end * device_res) + 1 + + ndc_start = real (dev_pixel_1) / real (device_res) / gki_tweak + ndc_end = real (dev_pixel_2) / real (device_res) / gki_tweak +end diff --git a/pkg/plot/crtpict/wdes.h b/pkg/plot/crtpict/wdes.h new file mode 100644 index 00000000..60d89f21 --- /dev/null +++ b/pkg/plot/crtpict/wdes.h @@ -0,0 +1,33 @@ +# Window descriptor structure. + +define LEN_WDES (5+(W_MAXWC+1)*LEN_WC+40) +define LEN_WC 9 # 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[P2C($1+50)] + +# 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 + +# 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 supplied lut values diff --git a/pkg/plot/crtpict/xformimage.x b/pkg/plot/crtpict/xformimage.x new file mode 100644 index 00000000..0400cc91 --- /dev/null +++ b/pkg/plot/crtpict/xformimage.x @@ -0,0 +1,117 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include <gset.h> +include "wdes.h" +include "crtpict.h" + +# CRT_TRANSFORM_IMAGE -- Map an image into the output device. 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. The input image is accessed via IMIO; the +# transformed image is output to a greyscale device via GIO. + +procedure crt_transform_image (gp, im, wdes, cl) + +pointer gp # graphics descriptor for output +pointer im # input image +pointer wdes # graphics window descriptor +pointer cl + +real ndc_xs,ndc_xe,ndc_ys,ndc_ye # NDC of output device window +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) +int ndev_cols, ndev_rows, nx_output, ny_output +int ggeti() +errchk ggeti, gseti, gsview, gswind, draw_perimeter +errchk crt_map_image, crt_replicate_image + +begin + # Compute pointers to WCS 0 and 1. + w0 = W_WC(wdes,0) + w1 = W_WC(wdes,1) + + call printf ("%s: %s\n") + call pargstr (W_IMSECT(wdes)) + call pargstr (IM_TITLE(im)) + + ndev_cols = ggeti (gp, "xr") + ndev_rows = ggeti (gp, "yr") + + # Compute X and Y magnification ratios required to map image into + # the device window. + + xmag = ((W_XE(w0) - W_XS(w0)) * ndev_cols) / (W_XE(w1) - W_XS(w1)) + ymag = ((W_YE(w0) - W_YS(w0)) * ndev_rows) / (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, but they are integral pixels. + + px1 = max (1.0, real (int (W_XS(w1) + 0.5))) + px2 = min (real (IM_LEN(im,1)), real (int (W_XE(w1) + 0.5))) + py1 = max (1.0, real (int (W_YS(w1) + 0.5))) + py2 = min (real (IM_LEN(im,2)), real (int (W_YE(w1) + 0.5))) + + # The extent of the output image in NDC coords + pxsize = ((px2 - px1) + 1.0) / ndev_cols + pysize = ((py2 - py1) + 1.0) / ndev_rows + + # The NDC coordinates that map to the central image pixel output + wxcenter = (W_XE(w0) + W_XS(w0)) / 2.0 + wycenter = (W_YE(w0) + W_YS(w0)) / 2.0 + + # Now compute the NDC coordinates of the output device that the + # image will occupy. + ndc_xs = max (W_XS(w0), wxcenter - (pxsize / 2.0 * xmag)) + ndc_xe = max (ndc_xs, min (W_XE(w0), ndc_xs + (pxsize * xmag))) + ndc_ys = max (W_YS(w0), wycenter - (pysize / 2.0 * ymag)) + ndc_ye = max (ndc_ys, min (W_YE(w0), ndc_ys + (pysize * ymag))) + + # To avoid possible truncation errors down the line, make sure + # the ndc coordinates passed to the output procedures represent + # integer pixels. + ndc_xs = real (int (ndc_xs * ndev_cols)) / ndev_cols + ndc_xe = real (int (ndc_xe * ndev_cols)) / ndev_cols + ndc_ys = real (int (ndc_ys * ndev_rows)) / ndev_rows + ndc_ye = real (int (ndc_ye * ndev_rows)) / ndev_rows + + # Output the image data in WCS 0. The number of image pixels that + # will be put out across the device is calculated first. + + call gseti (gp, G_WCS, 0) + if (REPLICATE(cl) == YES) { + nx_output = (int(px2) - int(px1)) + 1 + ny_output = (int(py2) - int(py1)) + 1 + } else { + # Image pixels will be scaled to number of device pixels + nx_output = ((ndc_xe * ndev_cols) - (ndc_xs * ndev_cols)) + 1 + ny_output = ((ndc_ye * ndev_rows) - (ndc_ys * ndev_rows)) + 1 + nx_output = nx_output / X_BA(cl) + ny_output = ny_output / Y_BA(cl) + } + + # Tweak the ndc coordinates to insure integer replication factors. + # This may change the ndc coordinates. + call crt_tweak_ndc (nx_output, ndc_xs, ndc_xe, ndev_cols) + call crt_tweak_ndc (ny_output, ndc_ys, ndc_ye, ndev_rows) + + # Call routine that actually puts out the pixels row by row + call crt_map_image (im, gp, px1,px2,py1,py2, ndc_xs,ndc_xe, + ndc_ys,ndc_ye, nx_output, ny_output, W_ZS(w1),W_ZE(w1),W_ZT(w1), + cl) + + # Change to pixel coordinates and draw perimeter axes if requested + call gseti (gp, G_WCS, 2) + call gsview (gp, ndc_xs, ndc_xe, ndc_ys, ndc_ye) + call gswind (gp, px1, px2, py1, py2) + + if (PERIM(cl) == YES) + call draw_perimeter (gp) +end diff --git a/pkg/plot/crtpict/xyscale.x b/pkg/plot/crtpict/xyscale.x new file mode 100644 index 00000000..094b78ee --- /dev/null +++ b/pkg/plot/crtpict/xyscale.x @@ -0,0 +1,90 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imhdr.h> +include <error.h> +include "wdes.h" +include "crtpict.h" + +# CRT_XY_SCALE -- Calculate the spatial transformation parameters and store +# them in the "wdes" window descriptor. These are used to map the image +# to the graphics device. + +procedure crt_xy_scale (gp, cl, im, wdes) + +pointer gp +pointer cl +pointer im +pointer wdes + +int w1, w0, ndev_rows, ndev_cols +real xcenter, ycenter, xsize, ysize, pxsize, pysize, xscale, yscale +real ystart, yend +int ggeti() +errchk ggeti + +begin + ndev_rows = ggeti (gp, "yr") + ndev_cols = ggeti (gp, "xr") + + # Determine the maximum display window available for mapping the + # image. This is a function of the user specified "fractions"; + # the outer 6% of the user specified image area is used for annotation. + + xcenter = (CRT_XE + CRT_XS) / 2.0 + xsize = CRT_XE - CRT_XS + ystart = CRT_YS + (CRT_YE - CRT_YS) * GRAPHICS_FRACTION(cl) + yend = ystart + (CRT_YE - CRT_YS) * IMAGE_FRACTION(cl) + ycenter = (yend + ystart) / 2.0 + ysize = yend - ystart + + # Set device window limits in normalized device coordinates. + # World coord system 0 is used for the device window. + + w0 = W_WC(wdes,0) + W_XS(w0) = xcenter - (xsize / 2.0) + W_XE(w0) = xcenter + (xsize / 2.0) + W_YS(w0) = ycenter - (ysize / 2.0) + W_YE(w0) = ycenter + (ysize / 2.0) + + # Determine X and Y scaling ratios required to map the image into the + # normalized display window. + + if (FILL(cl) == YES) { + # Compute scale in units of NDC viewport coords per image pixel. + xscale = xsize / max (1, (IM_LEN(im,1) - 1)) + yscale = ysize / max (1, (IM_LEN(im,2) - 1)) + + # Image scaled by same factor in x and y with FILL = YES. + if (xscale < yscale) + yscale = xscale + else + xscale = yscale + + } else { + # From the user specified magnification factors, compute the scale + # in units of NDC coords per "effective" display pixels. + + xscale = 1.0 / ((ndev_cols - 1) / XMAG(cl)) + yscale = 1.0 / ((ndev_rows - 1) / YMAG(cl)) + } + + # Determine the image pixels that map to the available device + # viewport. The starting and ending pixels calculated from + # xscale and yscale may be in the image interior or reference + # beyond the bounds of the image. These endpoints are tuned + # further in procedure transform_image. + + w1 = W_WC(wdes,1) + pxsize = xsize / xscale + pysize = ysize / yscale + + W_XS(w1) = (IM_LEN(im,1) - 1) / 2.0 + 1 - (pxsize / 2.0) + W_XE(w1) = W_XS(w1) + pxsize + W_YS(w1) = (IM_LEN(im,2) - 1) / 2.0 + 1 - (pysize / 2.0) + W_YE(w1) = W_YS(w1) + pysize + + # All spatial transformations are linear. + W_XT(w1) = W_LINEAR + W_YT(w1) = W_LINEAR +end diff --git a/pkg/plot/crtpict/zscale.x b/pkg/plot/crtpict/zscale.x new file mode 100644 index 00000000..aa0b925d --- /dev/null +++ b/pkg/plot/crtpict/zscale.x @@ -0,0 +1,441 @@ +# 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, temp +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 { + zslope = zslope / abs (contrast) + z1 = max (zmin, median - (center_pixel - 1) * zslope) + z2 = min (zmax, median + (npix - center_pixel) * zslope) + if (contrast < 0) { + # Negative contrast desired, flip z1 and z2 + temp = z1 + z1 = z2 + z2 = temp + } + } + + 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) + + # 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 + } + # 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/plot/doc/calcomp.hlp b/pkg/plot/doc/calcomp.hlp new file mode 100644 index 00000000..4595b614 --- /dev/null +++ b/pkg/plot/doc/calcomp.hlp @@ -0,0 +1,173 @@ +.help calcomp Mar86 plot +.ih +NAME +calcomp -- plot a GKI metacode file on a Calcomp pen plotter +.ih +USAGE +calcomp input +.ih +PARAMETERS +.ls input +Name of input GKI metacode file, file template, or list of files. +.le +.ls device = "calcomp" +Name of the destination plotter (as referenced in graphcap). +.le +.ls generic = no +Ignore remaining kernel dependent parameters -- if yes, then none of the +following parameters will be used; this is automatically the case, for +instance, when using ":.snap calcomp" from cursor mode. +.le +.ls debug = no +Print decoded graphics instructions during processing -- print each GKI +metacode instruction on standard output. +.le +.ls verbose = no +Print elements of polylines, etc. in debug mode -- if yes, this is essentially +all of the information present in the input metacode file. +.le +.ls gkiunits = no +Print coordinates in GKI rather than NDC units if in debug mode. +.le +.ls xscale = INDEF +X scale in device units per GKI unit; e.g. 0.0003 is 3 ten-thousandths of an +inch per GKI unit on a plotter calibrated in inches; normally a plot is 32767 +GKI units wide. If the plotting task that generated the metacode file generated +a scale, this will be used if xscale is INDEF. Specify xscale only if you wish +to override the scale in the metacode. +.le +.ls yscale = INDEF +Y scale in device units per GKI unit -- see xscale. +.le +.ls txquality = "normal" +Text quality; "normal" means use the text quality specified in the metacode +file. "Low" means override the metacode font with the Calcomp symbol font, +while "medium" and "high" use IRAF fonts. There is little difference in speed +with the different fonts, except if the text is bold, in which case "high" +takes twice as long as "low" or "medium". +.le +.ls lwtype = "ntracing" +Type of line and text width implementation. "Ntracing" causes the pen plotter +to draw each line or character several times with slight offsets to simulate +boldness. "Penchange", if implemented in the local Calcomp library, would +cause the plotter to pause for an operator to change the pen when bold lines +or text are requested. +.le +.ls ltover = no +Line type override, if yes, causes the pen plotter to draw all lines solidly, +rather than as dashed or dotted lines if these are specified in the metacode. +This may be desired for previewing a plot quickly. +.le +.ls lwover = yes +Line width override; causes all lines and text to come out with single width +in order to speed up plotting. If bold text, axes, etc. are desired and +present in the parent plot, then set lwover = no. +.le +.ls lcover = no +Line color override, if yes, causes the pen plotter to ignore any requests in +the metacode for a colored pen change. Pen change is not implemented at all +sites with Calcomp plotters. +.le +.ls dashlen = INDEF +Length of the dash in dashed lines in device units, usually inches. Shorter +dashes usually take longer to plot but may look nicer. If left INDEF, a +local default from dev$graphcap will be used; a good range is 0.1 to 0.5 inches. +.le +.ls gaplen = INDEF +Length of the gap in dashed or dotted lines, in device units. Longer gaps +result in faster plotting at the expense of clarity. If left INDEF, a local +default from dev$graphcap will be used. A good range is 0.05 to 0.2 inches. +.le +.ls plwsep = INDEF +Parallel line width separation -- if bold lines are implemented with "lwtype += ntracing", this is the right-angle distance between adjacent traces. If +INDEF, a local default is used from the device table dev$graphcap. +.le +.ih +DESCRIPTION +Task \fBcalcomp\fR is an IRAF graphics kernel. It may be run standalone to +plot a GKI metacode file, or from cursor mode via ":.snap calcomp". + +\fBCalcomp\fR may be used to draw any IRAF plot on a Calcomp pen plotter. It is +only available if the local site has a Calcomp library. Task \fBcalcomp\fR +is an exact-scaling graphics kernel, unlike the NSPP, or STDPLOT kernel. +This means that if the task that generated the metacode input file passed an +exact scale into the metacode, data can be plotted to a desired precise scale. + +The metacode scale may be overridden, or metacode files generated by tasks that +do not implement exact scales may be plotted to a precise scale, by specifying +xscale or yscale. Note, however, that the only coordinates in a metacode file +are GKI coordinates, usually running from 1 - 32767. This means that to use +xscale and yscale, the user must calculate the number of inches per GKI unit, +not the number of world or data units per inch. + +\fBCalcomp\fR also implements dashed and dotted lines and bold lines and text. +Thus high-quality plots may be produced, at the expense of requiring more time. +If "lwtype=ntracing" and "lwover=no", any bold text or lines in the metacode +file, such as are produced for axes, tickmarks, titles and axis labels by many +IRAF plotting tasks, will appear bold on the Calcomp. If txquality="low" or +"medium", and bold text is requested, each character will be drawn 5 times -- +once in the center position and once to the right, top, left, and bottom of +the original position. Each of the side positions is drawn "plwsep" inches +from the center. If txquality="high", bold text is implemented with the same +five tracings plus the four corners upper right, upper left, etc. For most +applications txquality="normal" or "medium" is adequate for nice-looking +plots. + +When drawing data lines bold (only possible if the task originating the +metacode specifically requested it, not the case for most IRAF plotting +tasks), the bounding parallel line traces are constructed to meet at sharp +points. This looks fine for line intersections that are not too acute. If +the intersection angle between two lines is very acute, say less than 5 +degrees, the vertex of the parallel lines bounding to the outside may lie +quite a distance away from the actual vertex. In the limit, if the +intersection angle is zero, the outer vertex will lie at infinity. For +this reason, all intersection angles less than 5 degrees are treated as +though they were exactly 5 degrees. +.ih +EXAMPLES +1. Plot a metacode file exactly as is: + + cl> calcomp metacodefile + +2. Get the fastest plot you can -- no bold lines or text, no dashed or dotted +lines: + + cl> calcomp metacodefile lwover+ ltover+ txquality=low + +3. Get a plot half the size of the original; suppose the original plot had +metacode scales = 0.0003 inches / GKI unit: + + cl> calcomp metacodefile xscale=0.00015 yscale=0.00015 + +4. Get the highest quality plot you can without having to change pens: + + cl> calcomp metacodefile txqual=high + +5. Get a high-quality plot where you have to change the pen each time the +metacode switches from bold to single-width lines or text: + + cl> calcomp metacodefile txqual=high lwtype=penchange + +.ih +TIME REQUIREMENTS +Pen plotters vary considerably in their plotting rates. At NOAO, plotting a +metacode file from a 1024-pixel image generated by \fBlongplot\fR, overriding +bold lines and text, takes a couple of minutes. The same plot with txquality += "medium" can take over twice as long due to bold text, axes, and tick labels. +With txquality = "high", it may take 4 or 5 times as long to plot. + +Plots with dashed and dotted, or both, lines may take 2-5 times as long to +plot as single-width lines. The slowest of all is to produce plots with +a lot of bold text, or with dashed and dotted AND bold data lines. +.ih +BUGS +When using multiple tracing to simulate bold lines that intersect at very +acute angles, i.e. less than 5 degrees, each bold line will thin slightly +as it approaches the obtuse vertex. +.ih +SEE ALSO +See task \fBlongplot\fR, also in the plot package, for a task designed to +use the \fBcalcomp\fR graphics kernel for exact scaling and/or long, e.g. +spectral, plots. +.endhelp diff --git a/pkg/plot/doc/contour.hlp b/pkg/plot/doc/contour.hlp new file mode 100644 index 00000000..86ce342b --- /dev/null +++ b/pkg/plot/doc/contour.hlp @@ -0,0 +1,166 @@ +.help contour Aug91 plot +.ih +NAME +contour -- draw a contour plot of an image +.ih +USAGE +contour image +.ih +PARAMETERS +.ls image +Two dimensional image or image section to be contoured. +.le +.ls floor = INDEF +Minimum value to be contoured. If \fBfloor = INDEF\fR, the data minimum is +used for the floor. +.le +.ls ceiling = INDEF +Maximum value to be contoured. If \fBceiling = INDEF\fR, the data maximum +is used for the ceiling. +.le +.ls zero = 0 +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 ncontours = 0 +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 interval = 0 +Contour interval. If 0, a contour interval is chosen which places 20 to 30 +contours spanning the intensity range of the image. +.le +.ls nhi = -1 +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 dashpat = 528 +Dash pattern for negative contours. +.le +.ls device = "stdgraph" +Output device (\fBstdgraph\fR, \fBstdplot\fR, or the name of a physical +device). +.le +.ls xres = 64, yres = 64 +The input image is block averaged or subsampled to this resolution. +.le +.ls preserve = yes +If \fBpreserve\fR = yes, the aspect ratio of the image is preserved when +achieving the resolution specified by \fBxres\fR and \fByres\fR. +.le +.ls subsample = no +The resolution specified by \fBxres\fR, \fByres\fR is achieved by block +averaging unless \fBsubsample = yes\fR. +.le +.ls perimeter = yes +A \fIcrtpict\fR perimeter is drawn around the contour plot with labeled +tickmarks. +.le +.ls label= yes +By default, the value of each major contour is embedded in the contour +line. This can be disabled by setting \fBlabel=no\fR. +.le +.ls vx1 = 0.0, vx2 = 0.0, vy1 = 0.0, vy2 = 0.0 +The device viewport, in normalized device coordinates (from 0.0 to 1.0 +inclusive). If not specified by the user, +\fBcontour\fR automatically centers the plot on the device viewport. +.le +.ls fill = no +Fill the output viewport regardless of the device aspect ratio? +.le +.ls title = "imtitle" +A title to be centered above the plot. The user can specify a title string; +the default string is the image title. +.le +.ls append = no +Append to an existing plot? +.le +.ih +DESCRIPTION +Contours are traced, smoothed with splines under tension, and optionally printed +with embedded intensity labels. Positive contours are printed as solid +lines and negative contours as dashed lines. The plot is generated +by the NCAR \fBconrec\fR utility, using \fBdashsmth\fR to smooth the +contours and draw dashed lines. + +To speed up the contouring, the resolution of the image to be plotted can +be decreased to \fBxres\fR by \fByres\fR. +When \fBpreserve\fR = yes, \fBcontour\fR +automatically reduces the image in both directions by the same factor, which +is the larger of [ncolumns / xres or nlines / yres]. If the +aspect ratio is not being preserved, the x and y dimensions are independently +reduced to the specified resolution. +No reduction is done if \fBxres\fR and \fByres\fR = 0, if the input image is +an image section, or if the image is smaller than \fBxres\fR by \fByres\fR. + +If the device viewport (plotting area) is not set by the user, +\fIcontour\fR automatically +sets a viewport centered on the output device. The default value of +\fBfill=no\fR means the viewport will be adjusted so that equal +numbers of image pixels in x and y will occupy equal lengths when plotted. +That is, when \fBfill = no\fR, a unity aspect ratio is enforced, and square +images are represented as square plots regardless of the device aspect ratio. +On devices with non square full device viewports (e.g., the vt640), a +square image will appear extended when \fBfill\fR = yes. To completely +fill the device viewport with contour lines, disable perimeter drawing +and enable fill, and nothing but the contour map will be drawn. + +Contour plots may be overlaid on a displayed image by setting the output +\fBdevice\fR to "imd" for image display and the contouring parameters +\fBfill\fR and \fBperimeter\fR to "yes" and "no" respectively. By default +green contours will be drawn on the image display. Other choices for +\fBdevice\fR are "imdr", "imb", "imdy", "imdw" and "imdg" for red, blue, +yellow, white and green output contours respectively. + +.ih +EXAMPLES +1. Draw a contour plot of a 512 square image on the graphics terminal. +With the default values for \fBxres\fR and \fByres\fR, the image +would automatically be block averaged by a factor of 8 in x and y. + + cl> contour crab.5009 + +2. The plot could be output to the plotter as a background job: + + cl> contour crab.5009 device=stdplot & + +3. Place a ceiling at an intensity value of 500 to cut out a noise spike. +The plot has been moved to the lower left corner of the display. + + cl> cont crab.5009 ceil=500 vx1=.1 vx2=.6 vy1=.1 vy2=.6 + +4. Overlay a contour plot of an image on the same image displayed on the +display device. Note that the CONTOUR parameters \fBfill\fR and \fBperimeter\fR +must be on and off respectively, the \fBfill\fR parameter should be specified +for the DISPLAY task to ensure the image fills the frame buffer in the +same way. + +.nf + cl> display m51 1 fill+ + cl> cont m51 fill+ per- device=imd +.fi +.ih +TIME REQUIREMENTS +The time required for \fIcontour\fR depends on the number of contours +being drawn - that is, the size and smoothness of the intensity array. +A 512 square image of "average" smoothness, with x and y resolution equal to +64, requires about 22 cpu seconds with block averaging. Using subsampling +rather than block averaging, \fIcontour\fR takes 16 seconds. A noisy +picture will be plotted more quickly if block averaged rather than +subsampled. +.ih +BUGS +If block averaging is used the precision with which a contour is drawn +will be no better than the blocking factor. For example, if a contour +map drawn with a block averaging factor of 8 is overlaid on an image of +a starfield, contours drawn around stars in the field may not appear to +be centered. If this is a problem the solution is to increase the plotting +resolution using the \fIxres\fR and \fIyres\fR parameters. + +It should be possible to have list input as well as image section input. +.ih +SEE ALSO +surface, display, imdkern, imexamine +.endhelp diff --git a/pkg/plot/doc/crtpict.hlp b/pkg/plot/doc/crtpict.hlp new file mode 100644 index 00000000..9ecb3b4e --- /dev/null +++ b/pkg/plot/doc/crtpict.hlp @@ -0,0 +1,171 @@ +.help crtpict Aug87 plot +.ih +NAME +crtpict -- make a hardcopy of an IRAF image +.ih +USAGE +crtpict input +.ih +PARAMETERS +.ls input +Input images to be processed. +.le +.ls device = "dicomed" +The output device. +.le +.ls auto_fill = yes +If set to yes, the image will be scaled to fit the device viewport. +The aspect ratio is always preserved when \fIauto_fill\fR = yes. +.le +.ls xmag = 1.0, ymag = 1.0 +When \fIauto_fill\fR = no, the x and y magnification ratios are specified +by these parameters. +.le +.ls replicate = yes +The image pixels are block replicated to fit the device viewport when +\fIreplicate\fR = yes. Otherwise, the pixels are linearly interpolated +to match the device pixels. +.le +.ls x_block_avg = 1, y_block_avg = 1 +These parameters are used when \fIreplicate\fR = no to decrease the +effective output device resolution, and speed up the interpolation. The +pixels are interpolated to the block averaged output device, then +block replicated to fill the device viewport. +.le +.ls ztrans = "auto" +This parameter specifies how the image intensities are mapped into the +greyscale values of the output device. Intensity z1 maps to black, z2 to white. +The 4 choices for \fIztrans\fR are: +.nf + + "auto" - z1 and z2 centered on median of image + "min_max" - set z1 and z2 to specified intensities + "none" - truncate intensities to fit output range + "user" - user supplies look up table of values +.fi +.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 +.ls contrast = 0.25 +Used when automatically determining z1 and z2. The slope of the transfer +function is divided by \fIcontrast\fR, so negative values of \fIcontrast\fR +result in a negative transfer function. +.le +.ls nsample_lines = 25 +Used when automatically determining z1 and z2, this parameter sets the number +of image lines to be sampled when determining the median. +.le +.ls z1 = 0.0, z2 = 0.0 +These parameters are used when \fIztrans\fR = "min_max", to specify which +pixel values map to black and white. +.le +.ls perimeter = yes +Draw annotated axes around the plot perimeter? +.le +.ls image_fraction = 0.70 +The fraction of the vertical device viewport reserved for the image. +.le +.ls graphics_fraction = 0.20 +The fraction of the vertical device viewport reserved for histogram +plots and id information. +.le +.ls greyscale_fraction = 0.05 +The fraction of the vertical device viewport reserved for the greyscale +step wedge. +.le +.ls output = "" +Output metacode is appended to this file. +By naming an output file, the metacode can be "trapped", and the normal +spooling process intercepted. +.le +.ih +DESCRIPTION +Procedure \fBcrtpict\fR makes a photographic hardcopy plot of IRAF images. + +The image can be automatically scaled to fill the output plotting window, with +the aspect ratio preserved, by setting \fBauto_fill\fR = yes. When +\fBauto_fill\fR = no, magnification factors for the axes are entered as +\fBxmag\fR and \fBymag\fR, where negative values (as well as fractional +values < 1.0), indicate that the image is to be reduced. By default, the +imaged is enlarged by block replication. By setting \fBreplicate\fR = no, +the image will be linearly interpolated to fit the device area. (In this +case, to speed things up, the \fBblock_avg\fR parameters can be set to +reduce the effective output resolution.) In either case, if an image needs +to be reduced in size, it will be decimated. + +Four methods of determining the greyscale transformation are available. +When \fIztrans\fR = "none", no transformation between intensity and +greyscale level occurs, the intensities are simply copied, which will most +likely result in truncation. With this method, the lowest bits of each pixel, +the lowest level variations, are always shown, regardless of the dynamic +range of the image. + +When \fIztrans\fR = "auto", +the greyscale levels are automatically centered on the median of the image +pixels. The window of intensities spanned by the greyscale is controlled +by parameter \fIcontrast\fR, which is divided into the calculated slope of +the transfer function. The larger the absolute value of \fIcontrast\fR, the +higher the contrast in the output image. A subset of the image pixels are +used to determine the median; the number of lines sampled is +\fInsample_lines\fR. + +When \fBztrans\fR = "min_max", intensity \fBz1\fR maps to the minimum +greyscale level (black), \fBz2\fR maps to the maximum greyscale level +(white) and the transfer function is linear in between these two endpoints. +If \fIz1\fR = \fIz2\fR, the image min and max map to black and white, modified +by \fBcontrast\fR. (NOTE: When running \fIcrtpict\fR on an image created with +\fIsnap\fR, \fBztrans\fR should be set to "min_max", with \fBz1\fR = 0 and +\fBz2\fR = 1023, the maximum output value possible from the IIS.) + +When \fBztrans\fR = "user", a look up table of intensity values and their +corresponding greyscale levels is read from the file specified by the +\fBlutfile\fR parameter. From this information, +\fIcrtpict\fR constructs a piecewise linear look up table containing +4096 discrete values. +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 \fBshowcap\fR can be used to determine the range +of acceptable greyscale levels. +.ih +EXAMPLES +1. To subsample every 4th pixel of a large image, fill the output area and use +previously determined values of z1 and z2 for the greyscale transformation +the command would be: + + cl> crtpict sunpic[*:4,*:4] ztrans=min z1=0 z2=800 + +2. To process every image with the root name ccdpic, using default values of +all parameters, the command would be: + + cl> crtpict ccdpic* + +3. To process images created with \fBsnap\fR, ztrans and z2 must be changed +from their default values: + + cl> crtpict iis.snap ztrans=min z2=1023 + +4. Image `mypic' is processed using the look up table in file `mylut', + + cl> crtpict mypic ztrans=user lutfile=mylut + +Where file `mylut' contains this information: +.nf + 10 40 + 1500 100 + 2500 100 + 3500 200 + 7500 255 +.fi +.ih +TIMING +For a 512 x 512 real image, \fBcrtpict\fR takes about 40 cpu seconds with +\fBauto_fill\fR and \fBreplicate\fR = yes. When \fBauto_fill\fR = yes +but \fBreplicate\fR = no, \fBcrtpict\fR requires almost 400 cpu seconds. +.ih +SEE ALSO +display, showcap +.endhelp diff --git a/pkg/plot/doc/gdevices.hlp b/pkg/plot/doc/gdevices.hlp new file mode 100644 index 00000000..526a55bb --- /dev/null +++ b/pkg/plot/doc/gdevices.hlp @@ -0,0 +1,75 @@ +.help gdevices Apr92 plot +.ih +NAME +gdevices -- list available imaging or other graphics devices +.ih +USAGE +gdevices +.ih +PARAMETERS +.ls devices = "^imt" +A list of patterns identifying the class of devices for which information +is to be output. If multiple patterns are given they should be separated +by commas. The default pattern matches all stdimage (e.g. IMTOOL) devices. +.le +.ls graphcap = "graphcap" +The graphcap file to be scanned (any termcap format file will do). By default +the graphcap file specified by the graphcap environment variable, usually +"dev$graphcap", is scanned. +.le +.ih +DESCRIPTION +\fBgdevices\fR prints a table of the available devices in a given class of +devices, giving for each device a list of the aliases by which the device +is known, the imaging resolution in X and Y, and a short description of the +device (if present in the graphcap file entry). + +By default \fIgdevices\fR lists the available stdimage devices as defined in +the active graphcap file, however, by manipulating the \fIdevices\fR and +\fIgraphcap\fR parameters any class of devices in any file can be listed. +.ih +EXAMPLES +1. List the available stdimage (e.g. IMTOOL or SAOIMAGE) devices. + +.nf + cl> gdev +# ALIASES NX NY DESCRIPTION + imtx 512 512 Imtool display server + imt1 imt512 imtool 512 512 Imtool display server + imt2 imt800 800 800 + imt3 imt1024 1024 1024 + imt4 imt1600 1600 1600 + imt5 imt2048 2048 2048 + imt6 imt4096 4096 4096 + (etc.) +.fi + +2. List the available IMDKERN devices. + +.nf + cl> gdev dev=imd +# ALIASES NX NY DESCRIPTION + imdblack imdbla imdB imdbl 2048 2048 + imdwhite imdwhi imdW imdw 2048 2048 + (etc.) +.fi + +3. List the VMS graphics devices. + +.nf + cl> gdev dev=VMS +# ALIASES NX NY DESCRIPTION + iism70v 512 512 NOAO Vela hosted IIS model + iism75 512 512 IIS model 75 image display + ui300 3130 2370 UNIX interface to the NOAO + vver 2112 1636 VMS generic interface to th + (etc.) +.fi +.ih +BUGS +The method used to extract device entries involves multiple scans of the +graphcap file hence is not very efficient. +.ih +SEE ALSO +system.devices, dev$graphcap +.endhelp diff --git a/pkg/plot/doc/gkidecode.hlp b/pkg/plot/doc/gkidecode.hlp new file mode 100644 index 00000000..6582b1a3 --- /dev/null +++ b/pkg/plot/doc/gkidecode.hlp @@ -0,0 +1,51 @@ +.help gkidecode Jan85 plot +.ih +NAME +gkidecode -- decode one or more GKI metacode files +.ih +USAGE +gkidecode input +.ih +PARAMETERS +.ls input +The input metacode, which can be read from a list of files or +redirected from the standard input. +.le +.ls generic = no +The remaining parameters are ignored when \fBgeneric\fR = yes. +.le +.ls verbose = no +If \fBverbose\fR = yes, the elements of polylines, cell arrays, etc. will +be printed. +.le +.ls gkiunits = no +By default, coordinates are printed in NDC rather than GKI units. +.le +.ih +DESCRIPTION +Task \fBgkidecode\fR is a debugging tool used to decode GKI metacode +files. The plotting instructions are decoded and printed in readable +form on the standard output. The input metacode can be read from one +or more files or redirected from the standard input. + +If \fBverbose\fR = yes, elements of polyline and cell array calls are +printed in addition to the default output. +Coordinates can be printed in either GKI (0 - 32767) or NDC (0.0 - 1.0) +units. +.ih +EXAMPLES +1. Decode the metacode instructions in file crtpict.mc in verbose mode. + + cl> gkidecode crtpict.mc verbose+ + +2. Print a shorter listing of the same file on the versatec. + + cl> gkidecode crtpict.mc | lprint dev=ver + +3. Decode the third frame in metacode file "oned.mc". + + cl> gkiextract oned.mc 3 | gkidecode +.ih +SEE ALSO +stdgraph stdplot +.endhelp diff --git a/pkg/plot/doc/gkidir.hlp b/pkg/plot/doc/gkidir.hlp new file mode 100644 index 00000000..fef0ca0a --- /dev/null +++ b/pkg/plot/doc/gkidir.hlp @@ -0,0 +1,42 @@ +.help gkidir Jan86 plot +.ih +NAME +gkidir -- print directory of plots within the named metacode file +.ih +USAGE +gkidir input +.ih +PARAMETERS +.ls input +The metacode file or files to be examined. +.le +.ih +DESCRIPTION +Task \fBgkidir\fR examines GKI metacode files, and prints a directory of +the plots contained in each input file. Each plot is listed with its +size and an identifying title string. The title string is the MFTITLE +string if given, or else the longest GTEXT string found (hopefully the +plot title), or else the string "(no title)". The output format is as +follows: +.nf + + file1: + [1] (1234 words) title_string + [2] (78364 words) title_string + + file2: + [1] (874 words) title_string + . + . + . + +.fi +.ih +EXAMPLES +1. List the plots in the GKI metacode file "file": + + cl> gkidir file +.ih +SEE ALSO +gkiextract +.endhelp diff --git a/pkg/plot/doc/gkiextract.hlp b/pkg/plot/doc/gkiextract.hlp new file mode 100644 index 00000000..22b51318 --- /dev/null +++ b/pkg/plot/doc/gkiextract.hlp @@ -0,0 +1,45 @@ +.help gkiextract Jan86 plot +.ih +NAME +gkiextract -- extract individual frames from a GKI metacode file +.ih +USAGE +gkiextract input frames +.ih +PARAMETERS +.ls input +The metacode source file or files. +.le +.ls frames +List of frames to be extracted from each metacode file. +.le +.ls verify = no +Verify each frame before extraction? +.le +.ih +DESCRIPTION +Task \fBgkiextract\fR will extract individual frames from a metacode file, +writing a binary metacode output stream which can be piped to a kernel +for plotting or redirected to produce a new metacode file. +Parameter \fIframes\fR specifies a list of frames to be +extracted from each input file. If \fIverify\fR = yes, +a \fBgkidir\fR style line will be printed for each specified frame +and the user will be queried whether or not to extract the frame. +.ih +EXAMPLES +1. Extract frames 1, 3 and 5 from metacode file "mc_file" and +plot them on the device "vup": + + cl> gkiextract mc_file 1,3,5 | stdplot dev=vup + +2. Print a directory of the first 99 frames in "mc_file", extract +those files requested by the user and write them to file "new_mc_file". + + cl> gkiextract mc_file 1-99 ver+ > new_mc_file +.ih +BUGS +A maximum of 8192 plots in a single metacode file may be processed. +.ih +SEE ALSO +gkidir +.endhelp diff --git a/pkg/plot/doc/gkimosaic.hlp b/pkg/plot/doc/gkimosaic.hlp new file mode 100644 index 00000000..33d8ada3 --- /dev/null +++ b/pkg/plot/doc/gkimosaic.hlp @@ -0,0 +1,110 @@ +.help gkimosaic Mar87 plot +.ih +NAME +gkimosaic -- condense metacode frames to fit on one page +.ih +USAGE +gkimosaic input +.ih +PARAMETERS +.ls input +The metacode input, which can be redirected from STDIN or read from +one or more binary metacode files. +.le +.ls output = "" +If \fBoutput\fR is specified, the mosaiced metacode is spooled to this +file for later plotting. +.le +.ls device = "stdgraph" +Output plotting device. +.le +.ls nx = 2 +The number of plots to draw in the x direction. +.le +.ls ny = 2 +The number of plots to draw in the y direction. +.le +.ls fill = no +The plots are reduced by equal factors in x and y when \fBfill\fR = no. +.le +.ls rotate = no +Output the mosaiced plots rotated by 90 degrees. +.le +.ls interactive = yes +If plotting to \fBstdgraph\fR, interactively examine each page of plots. +.le +.ls cursor = "stdgcur" +Source of cursor input. +.le +.ih +DESCRIPTION +Task \fBgkimosaic\fR condenses the plots in a metacode file to fit +on a single page. The plots can be examined interactively after +each pageful. The number of plots in x and y can be specified. This +task is useful for browsing through a large metacode file, and for +compactly plotting a large number of metacode frames. + +When \fBfill\fR = no, the plots will be +reduced by equal factors in x and y; the aspect ratio of the original +plot is preserved. When \fBfill\fR = yes, the transformations in x and +y are handled separately, meaning that the reduction factors will not +be equal unless \fBnx\fR = \fBny\fR. + +The mosaiced plots are drawn on the page rotated by 90 degrees +when \fBrotate\fR = yes. This means the x axis of the plots can be +placed along either the page width or length. +The plots can be output to a plotting \fBdevice\fR, +or spooled in file \fBoutput\fR for later plotting. + +If plotting to \fBstdgraph\fR, the plot can be interactively +examined after each page of output by setting \fBinteractive\fR = yes. +The world coordinate system information of the individual plots has +been retained for cursor readback. +Standard cursor mode keystroke commands are available as well as the +\fIgkimosaic\fR specific commands listed below. Colon commands :nx, :ny, +:fill and :rotate take effect on the next page of output. Command :skip +allows you to browse through a metacode file, skipping either forward or +backward by N input plots. +.nf + + q quit + return quit + spacebar continue + ? print help information + + :nx N change value of nx to N + :ny N change value of ny to N + :fill yes, :fill+, :fill sets fill = yes + :fill no, :fill- sets fill = no + :rotate yes, :rotate+, :rotate sets rotate = yes + :rotate no, :rotate- sets rotate = no + :skip +/-N skip forward/backward N plots + +.fi +.ih +EXAMPLES +1. Plot every frame in the metacode file "oned.plots". There will be 4 plots +to the page originally, but this can be overridden interactively. + + cl> gkimosaic oned.plots + +2. Extract every third plot from the metacode file "oned.plots" with task +\fIgkiextract\fR and plot them four to a page. + + cl> gkiextract oned.plots 1-99x3 | gkimosaic + +3. Plot all frames in every metacode file beginning with "mcode." and +condense them so 16 fit on a page. The metacode is being spooled; +it will be plotted, perhaps, when the computer isn't so busy. Interactive +mode is automatically disabled when not plotting to a graphics terminal. + + cl> gkimosaic mcode.* nx=4 ny=4 output=plt.spool +.ih +BUGS +Setting \fBdevice\fR to "stdvdm" does not work. To produce an output file +of mosaiced metacode, use the \fIoutput\fR parameter or the ">G" graphics +stream redirection feature of the cl. +.ih +SEE ALSO +gkidir, gkiextract +.endhelp diff --git a/pkg/plot/doc/graph.hlp b/pkg/plot/doc/graph.hlp new file mode 100644 index 00000000..6c18f3e1 --- /dev/null +++ b/pkg/plot/doc/graph.hlp @@ -0,0 +1,247 @@ +.help graph Aug91 plot +.ih +NAME +graph -- graph one or more lists or image sections +.ih +USAGE +graph input +.ih +PARAMETERS +.ls input +List of operands to be graphed. May be STDIN, or one or more image sections +or lists. +.le +.ls wx1=0., wx2=0., wy1=0., wy2=0. +The range of user coordinates spanned by the plot. If the range of values +in x or y = 0, the plot is automatically scaled from the minimum to +maximum data value along the degenerate dimension. +.le +.ls wcs = "logical" +The world coordinate system (\fIwcs\fR) to be used for axis labeling when +input is f rom 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 + +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 vx1=0., vx2=0., vy1=0., vy2=0. +NDC coordinates (0-1) of the device plotting viewport. If not set by +the user, a suitable viewport which allows sufficient room for all labels +is used. +.le +.ls pointmode = no +If \fBpointmode\fR = yes, plot points or markers at data values, rather than +connected lines. +.le +.ls marker = "box" +Marker or line type to be drawn. If \fBpointmode\fR = yes the markers are +"point", "box", "cross", "plus", "circle", "hebar", "vebar", "hline", +"vline" or "diamond". Any other value defaults to "box". If drawing lines, +\fBpointmode\fR = no, the values are "line", "lhist", "bhist". Any other +value defaults to "line". "bhist" (box histogram) draws lines to the +bottom of the graph while "lhist" does not. In both cases the +horizontal histogram lines run between the half way points (reflected +at the ends). +.le +.ls szmarker = 0.005 +The size of a marker in NDC coordinates (0 to 1 spans the screen). +If zero and the input operand is a list, marker sizes are taken individually +from the third column of each list element. If positive, all markers are +of size \fBszmarker\fR. If negative and the input operand is a list, +the size of a marker is the third column of each list element times the +absolute value of \fBszmarker\fR. +.le +.ls ltypes = "", colors = "" +List of line types and colors to use when graphing multiple data sets. +The lists are comma or space separate integer numbers. If no list is +given the line types and colors will cycle through the range of +values. If a list is given then the values are used in order and if +the list is exhausted before the data the last value is used for all +remaining data sets. + +The line types have values between 1 and 4: + +.nf + 1 - solid line + 2 - dashed line + 3 - dotted line + 4 - dot-dash line +.fi + +The colors have values between 1 and 9. The colors associated with each +number depend on the graphics device. For example "xgterm" colors are +assigned by X resources. +.le +.ls xlabel = "wcslabel", ylabel = "" +Label for the X-axis or Y-axis. if \fBxlabel\fR = "wcslabel" and the first +operand in the \fBinput\fR is an image, the world coordinate system label +if defined is used. +.le +.ls title = "imtitle" +Plot title. If \fBtitle\fR = "imtitle" +and the first operand in \fBinput\fR is an image, the image title is used +as the plot title. +.le +.ls xformat = "wcsformat", yformat = "" +The numerical format for the coordinate labels. 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. For images a recommended x coordinate format may be defined as +a WCS attribute. If the xformat value is "wcsformat" the WCS attribute +format will be used. Any other value will override the image attribute. +.le +.ls box = yes +Draw axes at the perimeter of the plotting window. +.le +.ls fill = yes +Fill the output viewport regardless of the device aspect ratio? +.le +.ls axis = 1 +Axis along which the projection is to be computed, if an input operand is +an image section of dimension 2 or higher. Axis 1 is X (line average), +2 is Y (column average), and so on. +.le +.ls transpose = no +Swap the X and Y axes of the plot. If enabled, the axes are transposed +after the optional linear transformation of the X-axis. +.le +.ls logx = no, logy = no +Log scale the X or Y axis. Zero or negative values are indefinite and +will not be plotted, but are tolerated. +.le +.ls ticklabels = yes +Label the tick marks. +.le +.ls majrx=5, minrx=5, majry=5, minry=5 +Number of major tick marks on each axis; number of minor tick marks between +major tick marks. Ignored if log scaling is in effect for an axis. +.le +.ls lintran = no +Perform a linear transformation of the X-axis upon input. Used to assign +logical coordinates to the indices of pixel data arrays (image sections). +.le +.ls p1=0, p2=0, q1=0, q2=1 +If \fBlintran\fR is enabled, pixel index P1 is mapped to Q1, and P2 to Q2. +If P1 and P2 are zero, P1 is set to 1 and P2 to the number of pixels in +the input array. +.le +.ls round = no +Extend the axes up to "nice" values. +.le +.ls overplot = no +Overplot on an existing plot. All axis scaling and labeling parameters +apply. +.le +.ls append = no +Append to an existing plot. The previous axis is used and the axis +scaling and labeling parameters are ignored. +.le +.ls device = "stdgraph" +The output device. +.le +.ih +DESCRIPTION +\fBGraph\fR graphs one or more lists or image sections; lists and image +sections may be mixed in the input list at will. If the curves are not +all the same length the plot will be scaled to the longest curve and all +curves will be plotted left justified. If an image section operand has +more than one dimension the projection (average) along a designated axis +will be computed and plotted. By default, a unique dash pattern is used +for each curve, up to a maximum of 4. + +List input may be taken from the standard input or from a file, +and consists of a sequence of Y values, X and Y values, or X, Y, +and marker size values, one pair of coordinates per line in the list. +If the third column of a list contains positive numbers, they are +interpreted as NDC marker sizes, optionally scaled by the absolute +value of \fIszmarker\fR. If you want the third column of a list to +be interpreted as WCS coordinates, indicating errors for example, the +marker sizes should be entered as negative numbers. +Blank lines, comment lines, and extra columns are ignored. +The first element in the list determines whether the list is a Y list +or and X,Y list; it is an error if an X,Y list has fewer than two +coordinates in any element. INDEF valued elements appear as gaps +in the plot. + +If \fBappend\fR is enabled, previous values for \fBbox\fR, +\fBfill\fR, \fBround\fR, the plotting viewport (\fBvx1\fR, \fBvx2\fR, +\fBvy1\fR, \fBvy2\fR), and the plotting window (\fBwx1\fR, \fBwx2\fR, +\fBwy1\fR, \fBwy2\fR) are used. The \fBoverplot\fR parameter overplots +a new plot including any new axis scaling and labeling. + +By default, the plot drawn will fill the device viewport, if the viewport +was either specified by the user or automatically calculated by +\fIgraph\fR. Setting +the value of \fBfill\fR to "no" means the viewport will be adjusted so +that equal numbers of data values in x and y will occupy equal lengths +when plotted. That is, when \fBfill = no\fR, a unity aspect ratio is +enforced, and plots +appear square regardless of the device aspect ratio. On devices with non +square full device viewports (e.g., the vt640), a plot drawn by \fIgraph\fR +appears extended in the x direction unless \fBfill\fR = no. + +.ih +EXAMPLES +1. Plot the output of a list processing filter: + + cl> ... list_filter | graph + +2. Plot a graph entered interactively from the terminal: + + cl> graph STDIN + +3. Overplot two lists: + + cl> graph list1,list2 + +4. Graph line 128 of image "pix": + + cl> graph pix[*,128] + +5. Graph the average of columns 50 through 100: + + cl> graph pix[50:100,*] axis=2 + +6. Graph a list in point plot mode: + + cl> graph list po+ + +7. Annotate a graph: + +.nf + cl> graph pix[*,10],pix[*,20] xlabel=column\ + >>> ylabel=intensity title="lines 10 and 20 of pix" +.fi + +8. Direct the graph to the standard plotter device: + + cl> graph list device=stdplot +.ih +BUGS +Indefinites are not recognized when computing image projections. +.ih +SEE ALSO +pcol, pcols, prow, prows +.endhelp diff --git a/pkg/plot/doc/hafton.hlp b/pkg/plot/doc/hafton.hlp new file mode 100644 index 00000000..63845968 --- /dev/null +++ b/pkg/plot/doc/hafton.hlp @@ -0,0 +1,123 @@ +.help hafton Jun86 plot +.ih +NAME +hafton -- draw a half tone picture of an image +.ih +USAGE +hafton image +.ih +PARAMETERS +.ls image +Two dimensional image or image section to be plotted. +.le +.ls z1 = 0.0, z2 = 0.0 +The minimum (z1) and maximum (z2) intensities to be mapped. If left at the +default values of 0.0, the full intensity range will be mapped. +.le +.ls nlevels = 0 +The number of intensities levels to be shown. If \fBnlevels = 0\fR or \fB1\fR, +the maximum of 16 levels is used. +.le +.ls mapping_function = "linear" +A string specifying the image intensity to half tone mapping function. +The default is linear mapping between \fBz1\fR and \fBz2\fR. For other +choices, see the description section below. +.le +.ls contrast = 0.25 +Positive or negative contrast. Negative contrast is indicated by setting +\fBcontrast\fR to a negative number. The magnitude of \fBcontrast\fR is +not important unless \fBmapping_function = crtpict\fR. +.le +.ls perimeter = yes +Should a \fBcrtpict\fR perimeter with labeled tickmarks be drawn around +the plot? +.le +.ls device="stdgraph" +Output device for plot. +.le +.ls title = "imtitle" +The title to be centered above the plot. By default, the title string from +the image header is used. +.le +.ls xres = 64, yres = 64 +The input image is block averaged or subsampled to this resolution. +.le +.ls preserve = yes +If \fBpreserve\fR = yes, the aspect ratio of the image is preserved when +achieving the resolution specified by \fBxres\fR and \fByres\fR. +.le +.ls subsample = no +Should the image be subsampled (as opposed to block averaged) to achieve the +specified resolution? +.le +.ls vx1 = 0.0, vx2 = 0.0, vy1 = 0.0, vy2 = 0.0 +The device viewport, in normalized device coordinates (from 0.0 to 1.0 +inclusive). If not specified by the user, the plot is centered on the viewport. +.le +.ls fill = no +Should the plot fill the viewport regardless of the device aspect ratio? +.le +.ls append = no +Append to an existing plot? +.le +.ih +DESCRIPTION +Task \fIhafton\fR draws a half tone picture of an IRAF image, where varying +intensities in the image are represented by areas of varying darkness on +the plot. Six different mapping functions are available; the desired +mapping function is selected with the \fBmapping_function\fR string. +The types of mapping are: +.nf + + linear + exponential - emphasizes high intensity values. + logarithmic - emphasizes low intensity values. + sinusoidal - emphasizes mid-range values. + arcsine - extreme values emphasized at the expense of mid-range. + crtpict - linear mapping centered on median intensity. The slope of + the function is modified by \fBcontrast\fR. +.fi +To speed up the plotting, the resolution of the input image can be +decreased to \fBxres\fR by \fByres\fR. +When \fBpreserve\fR = yes, \fBhafton\fR automatically reduces the +image in both directions by the same factor, which +is the larger of [ncolumns / xres or nlines / yres]. If the +aspect ratio is not being preserved, the x and y dimensions are independently +reduced to the specified resolution. +No reduction is done if +\fBxres\fR and \fByres\fR = 0, if the input image is an image section, or +if the image is smaller than \fBxres\fR by \fByres\fR. + +If the device viewport is not set by the user, \fIhafton\fR automatically +sets a viewport centered on the output device. The default value of +\fBfill=no\fR means the viewport will be adjusted so that equal +numbers of image pixels in x and y will occupy equal lengths when plotted. +That is, when \fBfill=no\fR, a unity aspect +ratio is enforced, and square images are represented as square plots +regardless of the device aspect ratio. +On devices with non square full device +viewports (e.g., the vt640), a square image will appear extended when +\fBfill=yes\fR. +.ih +EXAMPLES +1. Image "crab.6563" is plotted in negative contrast, with linear mapping +between the minimum and maximum image pixel. + + cl> hafton crab.6563 contrast=-1 + +2. The image is plotted in negative contrast using the same mapping +function as used by the \fIcrtpict\fR task. The resulting plot is +in negative contrast. + + cl> hafton crab.6563 mapping_fun=crt contrast =-0.25 + +.ih +TIME REQUIREMENTS +To produce a \fIhafton\fR plot on the terminal takes just under 9 cpu +minutes. If the output device is the imagen or versatec (or another +nspp device) the total cpu time is about an hour. +.ih +BUGS +A large number of plotter instructions ( > 100,000 polylines) is generated +per frame for square images. +.endhelp diff --git a/pkg/plot/doc/imdkern.hlp b/pkg/plot/doc/imdkern.hlp new file mode 100644 index 00000000..170cb3fd --- /dev/null +++ b/pkg/plot/doc/imdkern.hlp @@ -0,0 +1,105 @@ +.help imdkern Mar90 plot +.ih +NAME +imdkern -- image display device graphics kernel +.ih +USAGE +imdkern input +.ih +PARAMETERS +.ls input +The list of input metacode files. +.le +.ls device = "stdimage" +The output device. +.le +.ls generic = no +The remaining parameters are ignored when \fBgeneric\fR = yes (as when +the kernel is called automatically by the system during plotting). +.le +.ls frame = 0 +The display frame to be drawn into. If the value given is less than or +equal to zero, the plot is drawn into the frame currently being displayed. +.le +.ls color = 205 +The pixel value to be used for graphics. The value required to generate +a given color is device dependent. For IMTOOL and compatible display servers +(such as SAOIMAGE) black=202, white=203, red=204, green=205, blue=206, +yellow=207, and so on through 217. (The \fItvmark\fR help page contains +a full listing of the available colors). +.le +.ls debug = no +If \fBdebug\fR = yes, the graphics instructions are decoded and printed +during processing. +.le +.ls verbose = no +If \fBverbose\fR = yes, the elements of polylines, cell arrays, etc. will +be printed in debug mode. +.le +.ls gkiunits = no +By default, coordinates are printed in NDC rather than GKI units. +.le +.ih +DESCRIPTION +The \fIimdkern\fR graphics kernel is used to draw graphics into the image +display. To overlay a plot on a displayed image, one first displays the +image, then runs \fIimdkern\fR to overlay the graphics on the displayed image. +\fIimdkern\fR always overlays a plot on whatever is currently in the display +frame buffer. To erase the graphics drawn by \fIimdkern\fR, one must +redisplay the frame using \fIdisplay\fR or a similar program, or erase the +frame entirely using \fItv.erase\fR. + +Like all IRAF graphics kernels, \fIimdkern\fR may be called either explicitly +as a task, to plot a graphics metacode file, or implicitly when the output +of a graphics task is directed to a device which uses the IMD kernel. +The standard IRAF \fIgraphcap\fR file defines the following logical IMD +graphics devices: + +.nf + imd|imdkern same as imdg + imdw output to stdimage, frame=0, color=white + imdr output to stdimage, frame=0, color=red + imdg output to stdimage, frame=0, color=green + imdb output to stdimage, frame=0, color=blue + imdy output to stdimage, frame=0, color=yellow +.fi + +As noted earlier, \fIframe=0\fR causes the graph to be plotted in the +currently displayed image display frame. +.ih +EXAMPLES +1. Capture the output of the \fIprow\fR task in a metacode file and +plot in image display frame 2. + +.nf + cl> prow dev$pix 101 >G mc + cl> imdkern mc frame=2 +.fi + +2. Display dev$pix in image display frame 1 and overlay a contour plot, +drawing the contour plot overlaid on the image in green. + +.nf + cl> display dev$pix 1 + cl> contour dev$pix \ + >>> xres=256 yres=256 perim- fill+ label- ceil=500 dev=imdg +.fi + +Note that a higher than normal resolution contour plot is generated to +avoid the contour placement errors that occur when a large block averaging +factor is used to generate the contour map (this can make contours drawn +around objects such as stars appear to not be centered on the object). +.ih +BUGS +The IMD interface, used by this task to draw the graphics, requires that the +display frame buffer be read and edited in the client address space, hence +drawing is slow compared to having the display server draw the graphics. +This effect is especially noticeable when the display is accessed remotely +over the network. Also, because the graph is drawn in the client +(i.e., in \fIimdkern\fR) the GIO fonts must be used for character drawing, +so characters will not be as well formed as when display server character +generation is used. +.ih +SEE ALSO +tvmark, display +.endhelp diff --git a/pkg/plot/doc/implot.hlp b/pkg/plot/doc/implot.hlp new file mode 100644 index 00000000..4d97e0e7 --- /dev/null +++ b/pkg/plot/doc/implot.hlp @@ -0,0 +1,231 @@ +.help implot Feb94 plot +.ih +NAME +implot -- plot lines and columns of images +.ih +USAGE +implot image [line] +.ih +PARAMETERS +.ls image +List of images to be plotted. If more than one image is in the list then +the 'm' and 'n' keys are used proceed to the previous and next image. +.le +.ls line +If given, the number of the image line to be plotted, otherwise the central +line is plotted. +.le +.ls wcs = "logical" +The world coordinate system (\fIwcs\fR) to be used for axis labeling. +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 + +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 step = 0 +Step size for stepping through lines or columns in an image with the +'j' and 'k' keys. If zero or INDEF the step defaults to ~10% of the +image axis length. This parameter may be changed interactively with +a colon command. +.le +.ih +DESCRIPTION +Implot is an interactive, cursor driven task for examining images by plotting +the lines and columns or the averages of lines and columns. An image +line is plotted when the task is first run, then cursor mode is entered and +keystrokes may be used to generate additional line and column plots. 'q' +is typed to exit cursor mode and implot and 'n' is typed to proceed to +the next image in the input image list. + +The following single character keystrokes are recognized by Implot. Note that +numerous additional keystrokes are provided by "cursor mode" itself, i.e., +by the graphics system. These additional keystrokes provide such standard +facilities as stepwise cursor motion, plot expansion, movies, disposal to a +batch plotter or metafile, and plot annotation facilities. Cursor mode is +documented elsewhere. + + +.ks +.nf + ? print help and other info + a plot the average of a range of lines or columns + c plot a column + e expand plot by marking corners of viewport + j move down within image (moving section) + k move up within image (moving section) + l plot a line + m proceed to the previous image in the list + n proceed to the next image in the list + o overplot next vector + p measure profile (mark region and bkg with 2 pos) + q quit + s print statistics on a region + w change world coordinate system + / scroll status line + <space> print coordinates and pixel value +.fi +.ke + + +The single character keystroke commands use the position to the cursor to +determine what region of the image to plot. If the plot is examined carefully +one will note an extra scale on the right hand edge. This scale gives the +"other" axis of the image in units of pixels. For example, if the current +plot is a line plot (rather than a column plot), the X axis of the plot +will correspond to the X axis of the image, and the right Y axis of the plot +will correspond to the Y axis of the image. Both axes will be scaled +linearly in units of pixels. The left Y axis is scaled in either linear or +logarithmic pixel intensity units. In the case of a column plot the bottom +axis will correspond to image Y and the right axis to image X. + +The 'l' and 'c' keystrokes, used to plot lines and columns, take image +coordinates from the bottom and right axes of the plot. In the case of a +lineplot, the cursor would be positioned in Y and the key 'l' typed to +plot a new line. Extrapolation of this convention to the other cases and +keystrokes is self evident. The 'a' keystroke is used to mark an X or Y +region to be averaged and plotted. This mode of averaging is independent +of the ':a' command discussed below. + +Successive vectors may be overplotted by typing an 'o' and then any other +command. A range of linetypes are used if the device supports them to +make the curves easier to distinguish. The position of each line is marked +on the right axis with a small tick to document the coordinates of the +curves. + +The 'j' and 'k' commands are used to step through an image in either the +upward (k) or downward (j) directions, relative to the current line or +column plot. Each new vector is plotted in place of the previous one +without clearing the screen, making it easy to compare successive vectors. +The step between vectors may be defined by a task parameter and +changed by a colon command. + +The 'm' and 'n' commands are used to step through the input image list. +This is the same as using the 'i' key to switch images and the 'l' key +to plot the same line or column as the previous image. + +There are three keys which print various quantities of interest. +The space bar key will read the cursor position, find the nearest pixel, +and report the image line and column, the coordinate along the current +axis, and the pixel value. The line and column are in logical pixels +(that is the coordinates in the current image section) and the +coordinates are in the selected world coordinate system and printed +in the current coordinate format. If the selected world coordinate +system is "logical" then the coordinate will be the same as the line +or column. + +The 's' key requires two cursor positions and then computes statistics of +the region. The values are the median, mean, sigma, sum, and number of +pixels. The 'p' key also requires two cursor positions with the x +positions defining a region and the y positions defining a linear +background. Within the defined region the peak departure from the +background (either above or below the background) is found and the full +width at half maximum of this peak is measured. The linear background, the +peak position and distance from the background and the widths at half the +peak value are overplotted on the data. In addition to the profile +quantities the moments of the background subtracted data are measured. The +moments computed are the centroid, the integral (or flux), the width, and +the normalized asymmetry. The width reported is the square root of the +second central moment multiplied by 2.35482. For a gaussian profile this +corresponds to the full width at half maximum which can be compared with +the direct measure of the profile width. The normalized asymmetry is the +third central moment divided by the 3/2 power of the second central +moment. The various measurements are printed on the status line. There +are multiple lines of results which are scrolled using the '/' key. + +In addition to the single keystroke commands, the following : escape +commands are provided: + + +.ks +.nf + :a N set number of lines or columns to average + :c N [M] plot column N [average of columns N to M] + :f format set the x coordinate numerical format + :i imagename open a new image for input + :l N [M] plot line N [average of lines N to M] + :o overplot + :log+ log scale in Y + :log- turn off log scale in Y + :step N set step size for j,k + :solid overplot with solid, not dashed, lines + :w wcsname change world coordinate systems + :x x1 x2 fix range in X (call with no args to unfix) + :y y1 y2 fix range in Y (call with no args to unfix) +.fi +.ke + + +The 'c' and 'l' commands are identical to the keystroke commands except +that the column or line position is explicitly entered rather than taken +from the cursor. An averaging factor entered with 'a' will apply to all +subsequent line and column plots, as well as plots generated by 'j' and 'k'. +The input image may be changed at any time using the 'i' command; only one +image may be open at a time. Log scaling on the Y axis may be turned on +and off with the 'log' commands. The default step size of 1/10 the height +of the image may be changed with the 'step' command. Finally, the 'solid' +command may be used to draw all overplotted curves using solid, rather than +dashed, line segments. + +The 'x' and 'y' commands may be used to fix the plotting scale in either +X or Y, i.e., to disable autoscaling. Once the scale is fixed on an axis +it remains fixed until either the fix scale command is repeated without +any arguments, or the 'e' option is used to expand the plot (this causes +the fixed scale to be lost). Plotting different lines or columns or even +changing images does not cause loss of fixed scaling. If the X scale is +fixed to a range less than an entire line or column Y autoscaling, if enabled, +will only pertain to the displayed range in X. + +The numerical format for the coordinate labels are set with the 'f' +command. 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. Some images have a recommended x +coordinate format defined as a WCS attribute. If the format value is "" +(the default) the WCS attribute format will be used. Any other value will +override the image attribute. +.ih +EXAMPLES +1. Enter cursor mode, plotting line 240 of the 300x480 image 'crab': + +.nf + cl> implot crab + (plot appears) +.fi + +Type '?' to get the list of recognized keystrokes. Move the cursor and +type 'l' to plot the line at the Y position of the cursor. Try typing 'c' +to plot a column (note that a column plot will take longer than a line +plot since the entire image must be read). Go back to a line plot and +try several 'k' keystrokes to step up through the image. Try a cursor +mode 'E' to playback a movie of a small region, then type 0 (zero) to +restore the original plot. +.ih +BUGS +It should be possible to use the image display cursor to mark the lines or +columns to be plotted. This capability will be added when the image display +is interfaced to GIO (the IRAF graphics subsystem). +.ih +SEE ALSO +imexamine, cursor +.endhelp diff --git a/pkg/plot/doc/nsppkern.hlp b/pkg/plot/doc/nsppkern.hlp new file mode 100644 index 00000000..93677dc4 --- /dev/null +++ b/pkg/plot/doc/nsppkern.hlp @@ -0,0 +1,56 @@ +.help nsppkern Apr89 plot +.ih +NAME +nsppkern -- draw metacode on an NSPP interfaced plotter device +.ih +USAGE +nsppkern input +.ih +PARAMETERS +.ls input +The list of input metacode files. +.le +.ls device = "nsppdefault" +The NSPP interfaced plotting device output is to be directed to. +.le +.ls generic = no +The remaining parameters are ignored when \fBgeneric\fR = yes. +.le +.ls debug = no +If \fBdebug\fR = yes, the graphics instructions are decoded and printed +during processing. +.le +.ls verbose = no +If \fBverbose\fR = yes, the elements of polylines, cell arrays, etc. will +be printed in debug mode. +.le +.ls gkiunits = no +By default, coordinates are printed in NDC rather than GKI units. +.le +.ih +DESCRIPTION +Task \fInsppkern\fR translates metacode and draws it on a plotting +device. +Input is GKI metacode, which can be read from one or more binary +files or redirected from the standard input. + +If \fBdebug\fR is set to yes, the plotting instructions are printed in +readable form during processing. +If \fBverbose\fR = yes, elements of polyline and cell array calls are +printed in addition to the default debug output. +Coordinates can be printed in either GKI (0 - 32767) or NDC (0.0 - 1.0) +units. +.ih +EXAMPLES +1. Extract the fourth frame from metacode file "oned.mc" and plot it. + + cl> gkiextract oned.mc 4 | nsppkern + +2. Plot metacode frame "contour.demo" in debug mode, so the plotting +instructions can be read as they are processed. + + cl> nsppkern contour.demo debug+ +.ih +SEE ALSO +stdgraph, sgikern, calcomp +.endhelp diff --git a/pkg/plot/doc/pcol.hlp b/pkg/plot/doc/pcol.hlp new file mode 100644 index 00000000..c7ac6e98 --- /dev/null +++ b/pkg/plot/doc/pcol.hlp @@ -0,0 +1,147 @@ +.help pcol Sep91 plot +.ih +NAME +pcol -- plot an image column +.ih +USAGE +pcol image col +.ih +PARAMETERS +.ls image +Input image containing column to be plotted. +.le +.ls col +The column to be plotted. +.le +.ls wcs = "logical" +The world coordinate system (\fIwcs\fR) to be used for axis labeling when +input is f rom 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 +.le +.ls wx1=0., wx2=0., wy1=0., wy2=0. +The range of window (user) coordinates to be included in the plot. If +the range of values in x or y = 0, the plot is automatically scaled +from the minimum to maximum data values along the degenerate axis. +.le +.ls vx1=0., vx2=0., vy1=0., vy2=0. +NDC coordinates (0-1) of the device plotting viewport. If not set by +user, a suitable viewport which allows sufficient room for all labels +is used. +.le +.ls pointmode = no +Plot individual points instead of a line? +.le +.ls marker = "box" +Marker or line type to be drawn. If \fBpointmode\fR = yes the markers are +"point", "box", "cross", "plus", "circle", "hebar", "vebar", "hline", +"vline" or "diamond". Any other value defaults to "box". If drawing lines, +\fBpointmode\fR = no, the values are "line", "lhist", "bhist". Any other +value defaults to "line". "bhist" (box histogram) draws lines to the +bottom of the graph while "lhist" does not. In both cases the +horizontal histogram lines run between the half way points (reflected +at the ends). +.le +.ls szmarker = 0.005 +The size of the marker drawn when \fBpointmode\fR = yes. +.le +.ls logx = no, logy = no +Draw the x or y axis in log units, versus linear? +.le +.ls xlabel = "wcslabel", ylabel = "" +Label for the X-axis or Y-axis. if \fBxlabel\fR = "wcslabel" +the world coordinate system label in the image, if defined, is used. +.le +.ls xformat = "wcsformat" +The numerical format for the coordinate labels. 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. Some images have a recommended x coordinate format defined as +a WCS attribute. If the xformat value is "wcsformat" the WCS attribute +format will be used. Any other value will override the image attribute. +.le +.ls title = "imtitle" +Title for plot. If not changed from the default, the title string from the +image header, appended with the columns being plotted, is used. +.le +.ls majrx=5, minrx=5, majry=5, minry=5 +The number of major and minor divisions along the x or y axis. +.le +.ls round = no +Round axes up to nice values? +.le +.ls fill = yes +Fill plotting viewport regardless of device aspect ratio? +.le +.ls append = no +Append to an existing plot? +.le +.ls device="stdgraph" +Output device. +.le +.ih +DESCRIPTION +Plot a specified column of an image. The user can control the +plot size and placement, the scaling and labeling of axes. The column can be +plotted as a continuous line or individual points with a specified marker. + +If \fBappend\fR is enabled, previous values for \fBbox\fR, +\fBfill\fR, \fBround\fR, the plotting viewport (\fBvx1\fR, \fBvx2\fR, +\fBvy1\fR, \fBvy2\fR), and the plotting window (\fBwx1\fR, \fBwx2\fR, +\fBwy1\fR, \fBwy2\fR) are used. + +If the plotting viewport was not set by the user, \fBpcol\fR +automatically sets a viewport centered on the device. The default value +of \fBfill\fR = yes means the plot spans equal amounts of NDC space in +x and y. Setting +the value of \fBfill\fR to "no" means the viewport will be adjusted so +that the square plot will span equal physical lengths in x and y +when plotted. That is, when \fBfill = no\fR, a unity aspect ratio is +enforced, and plots +appear square regardless of the device aspect ratio. On devices with non +square full device viewports (e.g., the vt640), a plot drawn by \fIpcol\fR +appears extended in the x direction unless \fBfill\fR = no. +.ih +EXAMPLES +1. Plot column 128 of image crab.5009 with default parameters: + + cl> pcol crab.5009 128 + +2. Overplot column 128 of crab.red using boxes to mark the added points: + + cl> pcol crab.red 128 append+ pointmode+ + +3. Annotate the axes of a column plot: + + cl> pcol crab.5009 64 xlabel="Row Number" ylabel=Intensity + +.ih +TIME REQUIREMENTS +\fBpcol\fR requires about 1.6 cp seconds to plot a column of a 512 square +image. +.ih +BUGS +.ih +SEE ALSO +prow, prows, pcols +.endhelp diff --git a/pkg/plot/doc/pcols.hlp b/pkg/plot/doc/pcols.hlp new file mode 100644 index 00000000..09834641 --- /dev/null +++ b/pkg/plot/doc/pcols.hlp @@ -0,0 +1,150 @@ +.help pcols Sep91 plot +.ih +NAME +pcols -- plot average of image columns +.ih +USAGE +prows image col1 col2 +.ih +PARAMETERS +.ls image +Input image containing columns to be plotted. +.le +.ls col1 +First column to average. +.le +.ls col2 +Last column to average. +.le +.ls wcs = "logical" +The world coordinate system (\fIwcs\fR) to be used for axis labeling when +input is f rom 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 +.le +.ls wx1=0., wx2=0., wy1=0., wy2=0. +The range of window (user) coordinates to be included in the plot. If +the range of values in x or y = 0, the plot is automatically scaled from +the minimum to maximum data values along the degenerate axis. +.le +.ls vx1=0., vx2=0., vy1=0., vy2=0. +NDC coordinates (0-1) of the device plotting viewport. If not set by the +user, a suitable viewport which allows sufficient room for all labels +is used. +.le +.ls pointmode = no +Plot individual points instead of a line? +.le +.ls marker = "box" +Marker or line type to be drawn. If \fBpointmode\fR = yes the markers are +"point", "box", "cross", "plus", "circle", "hebar", "vebar", "hline", +"vline" or "diamond". Any other value defaults to "box". If drawing lines, +\fBpointmode\fR = no, the values are "line", "lhist", "bhist". Any other +value defaults to "line". "bhist" (box histogram) draws lines to the +bottom of the graph while "lhist" does not. In both cases the +horizontal histogram lines run between the half way points (reflected +at the ends). +.le +.ls szmarker = 0.005 +The size of the marker drawn when \fBpointmode\fR = yes. +.le +.ls logx = no, logy = no +Draw the x or y axis in log units, versus linear? +.le +.ls xlabel = "wcslabel", ylabel = "" +Label for the X-axis or Y-axis. if \fBxlabel\fR = "wcslabel" +the world coordinate system label in the image, if defined, is used. +.le +.ls xformat = "wcsformat" +The numerical format for the coordinate labels. 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. Some images have a recommended x coordinate format defined as +a WCS attribute. If the xformat value is "wcsformat" the WCS attribute +format will be used. Any other value will override the image attribute. +.le +.ls title = "imtitle" +Title for plot. If not changed from the default, the title string from the +image header, appended with the columns being plotted, is used. +.le +.ls majrx=5, minrx=5, majry=5, minry=5 +The number of major and minor divisions along the x or y axis. +.le +.ls round = no +Round axes up to nice values? +.le +.ls fill = yes +Fill plotting viewport regardless of device aspect ratio? +.le +.ls append = no +Append to an existing plot? +.le +.ls device="stdgraph" +Output device. +.le +.ih +DESCRIPTION +Plot the average of specified columns from an image. The user can control the +plot size and placement, the scaling and labeling of axes. Columns can be +plotted as a continuous line or individual points with a specified marker. + +If \fBappend\fR is enabled, previous values for \fBbox\fR, +\fBfill\fR, \fBround\fR, the plotting viewport (\fBvx1\fR, \fBvx2\fR, +\fBvy1\fR, \fBvy2\fR), and the plotting window (\fBwx1\fR, \fBwx2\fR, +\fBwy1\fR, \fBwy2\fR) are used. + +If the plotting viewport was not set by the user, \fBpcols\fR +automatically sets a viewport centered on the device. The default value +of \fBfill\fR = yes means the plot spans equal amounts of NDC space in +x and y. Setting +the value of \fBfill\fR to "no" means the viewport will be adjusted so +that the square plot will span equal physical lengths in x and y +when plotted. That is, when \fBfill = no\fR, a unity aspect ratio is +enforced, and plots +appear square regardless of the device aspect ratio. On devices with non +square full device viewports (e.g., the vt640), a plot drawn by \fIpcols\fR +appears extended in the x direction unless \fBfill\fR = no. +.ih +EXAMPLES +1. Plot columns 64 through 128 of image crab.5009 with default parameters: + + cl> pcols crab.5009 64 128 + +2. Overplot columns 64 through 128 of crab.red using boxes to mark the +added points: + + cl> pcols crab.red 64 128 append+ pointmode+ + +3. Annotate the axes of the plot: + + cl> pcols crab.5009 64 84 xlabel="Row Number" ylabel=Intensity +.ih +TIME REQUIREMENTS +\fBpcols\fR takes about 3.25 cp seconds to plot the average of 20 columns +from a 512 square image. +.ih +BUGS +.ih +SEE ALSO +prow, prows, pcol +.endhelp diff --git a/pkg/plot/doc/phistogram.hlp b/pkg/plot/doc/phistogram.hlp new file mode 100644 index 00000000..adfe5a1f --- /dev/null +++ b/pkg/plot/doc/phistogram.hlp @@ -0,0 +1,181 @@ +.help phistogram Nov89 plot +.ih +NAME +phistogram -- print or plot the histogram of an image or stream of values +.ih +USAGE +phistogram input +.ih +PARAMETERS +.ls input +The name of the image, image subsection, or the text file containing the +stream of values whose histogram is to be computed. \fIInput\fR may be +the standard input "STDIN". +.le +.ls z1 = INDEF, z2 = INDEF +The minimum and maximum values included in the histogram. The image or data +minimum and maximum values are used by default. +.le +.ls binwidth = INDEF +The resolution of the histogram in data units. If \fIbinwidth\fR is not defined, +the parameters \fInbins\fR, \fIz1\fR, and \fIz2\fR determine the resolution of +the histogram. +.le +.ls nbins = 512 +The number of bins in, or resolution of, the histogram. +The \fInbins\fR parameter is overridden if \fIbinwidth\fR is defined. +.le +.ls autoscale = yes +In the case of integer image data, automatically adjust \fInbins\fR and +\fIz2\fR to avoid aliasing effects. Data in text files is not autoscaled. +.le +.ls top_closed = no +Include z2 in the top bin? Each bin of the histogram is a subinterval +that is half open at the top. \fITop_closed\fR decides whether those +pixels with values equal to z2 are to be counted in the histogram. If +\fBtop_closed\fR is yes, the top bin will be larger than the other bins. +.le +.ls hist_type = "normal" +The type of histogram to plot or list. The choices are "normal", +"cumulative", "difference", or "second_difference". The two +"difference" options are calculated as forward differences, i.e. +diff[n] = hist[n+1] - hist[n]. +.le +.ls listout = no +List instead of plot the histogram? The list is never log scaled. +.le +.ls title = "imtitle" +The plot title. If title = "imtitle", the image name and title or the +text file name, and the +characteristics of the histogram are included in the title. +.le +.ls xlabel = "Data values", ylabel = "Counts" +The labels for the X and Y axes. +.le +.ls wx1 = INDEF, wx2 = INDEF, wy1 = 0.0, wy2 = INDEF +The range of user coordinates spanned by the plot. If either of the x axis +limits is INDEF the histogram minimum or maximum data values +are used. If either of the y axis limits is INDEF, the +minimum or maximum counts in the histogram is used. +.le +.ls logx = no, logy = yes +Use log scaling on the x or y axes of the plot? +.le +.ls round = no +Round the axes minimum and maximum values up to "nice" values? +.le +.ls plot_type = "line" +The style of histogram to plot. The options are "line", "box" and "fullbox". +If \fIplot_type\fR is "line" the histogram data points are connected by +straight lines; if it is "box" a stepped histogram is drawn; if it is "fullbox" +the histogram lines are drawn to the base of the plot. +.le +.ls box = yes +Draw axes at the perimeter of the plotting window? +.le +.ls ticklabels = yes +Label the tick marks? +.le +.ls majrx = 5, minrx = 5, majry = 5, minry = 5 +Number of major tick marks on each axis and number of minor tick marks between +major tick marks. These quantities are ignored if log scaling is in effect +for an axis. +.le +.ls fill = yes +Fill the output viewport regardless of the device aspect ratio? +.le +.ls vx1 = 0.0, vx2 = 1.0, vy1 = 0.0, vy2 = 1.0 +The NDC coordinates (0.0:1.0) of the device plotting viewport. +.le +.ls append = no +Append to an existing plot? +.le +.ls pattern = "solid" +The type of line used to draw the histogram. The options are "solid", +"dashed" "dotted", and "dotdash". \fIPattern\fR can be changed when +appending to an existing plot. +.le +.ls device = "stdgraph" +The output graphics device. +.le +.ih +DESCRIPTION +\fIPhistogram\fR computes the histogram of the IRAF image or stream +of values in the text file specified by +\fIinput\fR, using the parameters \fIbinwidth\fR, \fInbins\fR, +\fIz1\fR and \fIz2\fR. +If either \fIz1\fR or \fIz2\fR is undefined the data minimum or +maximum values define the histogram limits. +If \fIbinwidth\fR is undefined, \fInbins\fR +determines the resolution of the histogram. If \fIlistout\fR = no, +the histogram is plotted on +the graphics device \fIdevice\fR in the style specified by +\fIplot_type\fR. The plot may be log scaled if \fIlogy\fR = yes (the +default) and the input is an IRAF image. If \fIlistout\fR = yes, +the histogram is printed on the standard output. + +In addition to computing the "normal" histogram, PHISTOGRAM can also +calculate the cumulative and the first and second difference histograms +depending on the value of the \fIhist_type\fR parameter. The options are: +"normal", "cumulative", "difference", and "second_difference". + +Each bin of the histogram is defined to be half open at the top. This +results in an ambiguity in deciding whether those pixels with z=z2 are +included in the topmost bin. This decision is left to the user via the +\fItop_closed\fR parameter. This is usually only of concern with integer +image data and histograms with few bins. + +If \fBappend\fR is enabled, previous values for \fBbox\fR, +\fBfill\fR, \fBround\fR, the plotting viewport (\fBvx1\fR, \fBvx2\fR, +\fBvy1\fR, \fBvy2\fR), and the plotting window (\fBwx1\fR, \fBwx2\fR, +\fBwy1\fR, \fBwy2\fR) are used. + +By default, the plot drawn will fill the device viewport. Setting +the value of \fBfill\fR to "no" means the viewport will be adjusted so +that equal numbers of data values in x and y will occupy equal lengths +when plotted. That is, when \fBfill = no\fR, a unity aspect ratio is +enforced, and plots +appear square regardless of the device aspect ratio. On devices with non +square full device viewports (e.g., the vt640), a plot drawn by +PHISTOGRAM appears extended in the x direction unless \fBfill\fR = no. + +.ih +EXAMPLES +1. Output the histogram of an image to a file. + + cl> phist M51.imh li+ nbins=100 > fits1.hst + +2. Plot the histogram of an image using only values from 0 to 2000. + + cl> phist M31.imh nbins=100 z1=0. z2=2000. + +3. Ditto, but set the histogram resolution explicitly to avoid +smoothing the histogram. + + cl> phist M31.imh z1=0 z2=2000 nbins=2001 + +4. Plot the cumulative histogram. This is most useful for images with +fairly flat "normal" histograms. + + cl> phist R50.imh hist=cum + +5. Plot the histogram of a stream of values in the textfile "list". + + cl> phist list +.ih +BUGS +If the resolution of the histogram (number of bins) is a non-integral multiple +of the intensity resolution of the data (number of possible intensity values), +then \fIaliasing\fR can occur. The effect is to cause periodic zero dropouts +(for an oversampled histogram) or excess-valued bins (for a slightly +undersampled histogram). The \fIautoscaling\fR feature, if enabled, will +adjust the histogram parameters to avoid such aliasing effects for integer +data. This is not possible for floating point data, however, in which case +aliasing is certainly possible and can only be avoided by manually adjusting +the histogram parameters. One should also be aware that \fIsmoothing\fR of +the histogram will occur whenever the data range exceeds the histogram +resolution. +.ih +SEE ALSO +listpixels, plot.graph, proto.mkhistogram +.endhelp diff --git a/pkg/plot/doc/pradprof.hlp b/pkg/plot/doc/pradprof.hlp new file mode 100644 index 00000000..4ad76dca --- /dev/null +++ b/pkg/plot/doc/pradprof.hlp @@ -0,0 +1,132 @@ +.help pradprof Aug91 plot +.ih +NAME +pradprof -- plot or list the radial profile of a stellar object +.ih +USAGE +pradprof input xinit yinit +.ih +PARAMETERS +.ls input +The list of images containing the object of interest. +.le +.ls xinit, yinit +The initial guess for the x and y coordinates of the object whose +profile is to be computed. If \fIcenter\fR +is yes, \fIxinit\fR and \fIyinit\fR are the initial input to the centering +algorithm, otherwise \fIxinit\fR and \fIyinit\fR are passed directly to the +radial profiling algorithm. +.le +.ls radius = 11 +The plotting radius in pixels. +.le +.ls az1 = 0., az2 = 360. +Azimuth limits for the profile points in degrees. The azimuth is +measured from the x or first image axis towards the y or second image +axis. Negative azimuths are allowed as are any multiples of 360. +.le +.ls center = yes +Center the initial coordinates before computing the profile? +.le +.ls cboxsize = 5 +The size of the extraction box of pixels to be used by the centering +algorithm. +.le +.ls list = no +Make a list of the radial profile, instead of a plot? +.le +.ls graphics = "stdgraph" +The graphics device for plotting. +.le +.ls append = no +Append to an existing plot? +.le +.ls title = "imtitle" +The plot title. If title = "imtitle", the image name, \fIxinit\fR, and +\fIyinit\fR are +used to construct a default title, otherwise the user specified title is +used. +.le +.ls xlabel = "Radius", ylabel = "Intensity" +The default labels for the X and Y axes. +.le +.ls wx1 = INDEF, wx2 = INDEF, wy1 = INDEF, wy2 = INDEF +The range of user coordinates spanned by the plot. By default the data is +used to determine the range. +.le +.ls logx = no, logy = yes +Use log scaling on the x or y axes of the plot? +.le +.ls round = no +Round the axes minimum and maximum values up to "nice" values? +.le +.ls box = yes +Draw axes at the perimeter of the plotting window? +.le +.ls majrx = 5, minrx = 5, majry = 5, minry = 5 +Number of major tick marks on each axis and number of minor tick marks between +major tick marks. These quantities are ignored if log scaling is in effect +for an axis. +.le +.ls ticklabels = yes +Label the tick marks? +.le +.ls fill = yes +Fill the output viewport regardless of the device aspect ratio ? +.le +.ls vx1 = 0.0, vx2 = 1.0, vy1 = 0.0, vy2 = 1.0 +The NDC coordinates (0.0:1.0) of the device plotting viewport. +.le +.ls pointmode = yes +Plot points instead of lines? +.le +.ls marker = "plus" +Type of marker used in pointmode. +.le +.ls szmarker = 1. +Size of markers used in pointmode. +.le + +.ih +DESCRIPTION + +PRADPROF computes a radial profile of length \fIradius\fR pixels +with a range of azimuths (\fIaz1\fR to \fIaz2\fR), +for the object near (\fIxinit\fR, \fIyinit\fR) in the input image(s) +\fIinput\fR, and plots it on the graphics device \fIgraphics\fR. +If the parameter \fIcenter\fR is +"yes", then pixels in a box \fIcboxwidth\fR wide around the initial +coordinates and a simple centroiding algorithm are used to +compute a more accurate center, before the radial profile is computed. + +The azimuths are measured from the first image axis towards the second +image axis. The limits may be given in any multiple of 360 degrees +including negative azimuths. + +If the parameter +\fIappend\fR is yes then the new plot will be appended to an existing plot, +otherwise the device is cleared and a new plot is made. The +remainder of the parameters control the details of how +the plot is displayed. If the parameter \fBlist\fR is "yes" +the radial profile is listed on the standard output instead of plotted. + +.ih +EXAMPLES +1. Plot the radial profile of a star near (123, 234). + + cl> pradprof m92red 123 234 + +2. Plot the profile around (123, 234) with centering turned off. + + cl> pradprof m92red 123 234 center=no + +3. List the radial profile and redirect it to a file. + + cl> pradprof m92red 123 234 list=yes > profile + +.ih +BUGS +.ih +SEE ALSO +proto.imcntr, imexamine +.endhelp diff --git a/pkg/plot/doc/prow.hlp b/pkg/plot/doc/prow.hlp new file mode 100644 index 00000000..b59550e2 --- /dev/null +++ b/pkg/plot/doc/prow.hlp @@ -0,0 +1,146 @@ +.help prow Sep91 plot +.ih +NAME +prow -- plot an image row +.ih +USAGE +prow image row +.ih +PARAMETERS +.ls image +Input image containing the row to be plotted. +.le +.ls row +The row to be plotted. +.le +.ls wcs = "logical" +The world coordinate system (\fIwcs\fR) to be used for axis labeling when +input is f rom 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 wx1=0., wx2=0., wy1=0., wy2=0. +The range of window (user) coordinates to be included in the plot. If +the range of values in x or y = 0, the plot is automatically scaled +from the minimum to maximum data values along the degenerate direction. +.le +.le +.ls vx1=0., vx2=0., vy1=0., vy2=0. +NDC coordinates (0-1) of the device plotting viewport. If not set by +the user, a suitable viewport which allows sufficient room for all +labels is used. +.le +.ls pointmode = no +Plot individual points instead of a continuous line? +.le +.ls marker = "box" +Marker or line type to be drawn. If \fBpointmode\fR = yes the markers are +"point", "box", "cross", "plus", "circle", "hebar", "vebar", "hline", +"vline" or "diamond". Any other value defaults to "box". If drawing lines, +\fBpointmode\fR = no, the values are "line", "lhist", "bhist". Any other +value defaults to "line". "bhist" (box histogram) draws lines to the +bottom of the graph while "lhist" does not. In both cases the +horizontal histogram lines run between the half way points (reflected +at the ends). +.le +.ls szmarker = 0.005 +The size of the marker drawn when \fBpointmode\fR = yes. +.le +.ls logx = no, logy = no +Draw the x or y axis in log units, versus linear? +.le +.ls xlabel = "wcslabel", ylabel = "" +Label for the X-axis or Y-axis. if \fBxlabel\fR = "wcslabel" +the world coordinate system label in the image, if defined, is used. +.le +.ls xformat = "wcsformat" +The numerical format for the coordinate labels. 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. Some images have a recommended x coordinate format defined as +a WCS attribute. If the xformat value is "wcsformat" the WCS attribute +format will be used. Any other value will override the image attribute. +.le +.ls title = "imtitle" +Title for plot. If not changed from the default, the title string from the +image header, appended with the row being plotted, is used. +.le +.ls majrx=5, minrx=5, majry=5, minry=5 +The number of major and minor divisions along the x or y axis. +.le +.ls round = no +Round axes up to nice values? +.le +.ls fill = yes +Fill plotting viewport regardless of device aspect ratio? +.le +.ls append = no +Append to an existing plot? +.le +.ls device="stdgraph" +Output device. +.le +.ih +DESCRIPTION +Plot a specified row from an image. The user can control the +plot size and placement, the scaling and labeling of axes. Rows can be +plotted as a continuous line or individual points with a specified marker. + +If \fBappend\fR is enabled, previous values for \fBbox\fR, +\fBfill\fR, \fBround\fR, the plotting viewport (\fBvx1\fR, \fBvx2\fR, +\fBvy1\fR, \fBvy2\fR), and the plotting window (\fBwx1\fR, \fBwx2\fR, +\fBwy1\fR, \fBwy2\fR) are used. + +If the plotting viewport was not set by the user, \fBprow\fR +automatically sets a viewport centered on the device. The default value +of \fBfill\fR = yes means the plot spans equal amounts of NDC space in +x and y. Setting +the value of \fBfill\fR to "no" means the viewport will be adjusted so +that the square plot will span equal physical lengths in x and y +when plotted. That is, when \fBfill = no\fR, a unity aspect ratio is +enforced, and plots +appear square regardless of the device aspect ratio. On devices with non +square full device viewports (e.g., the vt640), a plot drawn by \fIprow\fR +appears extended in the x direction unless \fBfill\fR = no. + +.ih +EXAMPLES +1. Plot row 128 of image crab.5009 with default parameters: + + cl> prow crab.5009 128 + +2. Overplot row 128 of crab.red using crosses to mark the added points: + + cl> prow crab.red 128 append+ pointmode+ marker=cross + +3. Annotate the axes of a row plot: + + cl> prow crab.5009 64 xlabel="Column Number" ylabel=Intensity +.ih +TIME REQUIREMENTS +\fIprow\fR takes about 1 cp second to plot a row of a 512 square image. +.ih +BUGS +.ih +SEE ALSO +prows, pcol, pcols +.endhelp diff --git a/pkg/plot/doc/prows.hlp b/pkg/plot/doc/prows.hlp new file mode 100644 index 00000000..893231d7 --- /dev/null +++ b/pkg/plot/doc/prows.hlp @@ -0,0 +1,151 @@ +.help prows Sep91 plot +.ih +NAME +prows -- plot average of image rows +.ih +USAGE +prows image row1 row2 +.ih +PARAMETERS +.ls image +Input image containing rows to be plotted. +.le +.ls row1 +First row to average. +.le +.ls row2 +Last row to average. +.le +.ls wcs = "logical" +The world coordinate system (\fIwcs\fR) to be used for axis labeling when +input is f rom 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 +.le +.ls wx1=0., wx2=0., wy1=0., wy2=0. +The range of window (user) coordinates to be included in the plot. +If the range of values in x or y = 0, the plot is automatically scaled +from the minimum to maximum data values along the degenerate axis. +.le +.ls vx1=0., vx2=0., vy1=0., vy2=0. +NDC coordinates (0-1) of the plotting device viewport. If not set +by the user, a suitable viewport which allows sufficient room for all +labels is used. +.le +.ls pointmode = no +Plot individual points instead of a continuous line? +.le +.ls marker = "box" +Marker or line type to be drawn. If \fBpointmode\fR = yes the markers are +"point", "box", "cross", "plus", "circle", "hebar", "vebar", "hline", +"vline" or "diamond". Any other value defaults to "box". If drawing lines, +\fBpointmode\fR = no, the values are "line", "lhist", "bhist". Any other +value defaults to "line". "bhist" (box histogram) draws lines to the +bottom of the graph while "lhist" does not. In both cases the +horizontal histogram lines run between the half way points (reflected +at the ends). +.le +.ls szmarker = 0.005 +The size of the marker drawn when \fBpointmode\fR = yes. +.le +.ls logx = no, logy = no +Draw the x or y axis in log units, versus linear? +.le +.ls xlabel = "wcslabel", ylabel = "" +Label for the X-axis or Y-axis. if \fBxlabel\fR = "wcslabel" +the world coordinate system label in the image, if defined, is used. +.le +.ls xformat = "wcsformat" +The numerical format for the coordinate labels. 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. Some images have a recommended x coordinate format defined as +a WCS attribute. If the xformat value is "wcsformat" the WCS attribute +format will be used. Any other value will override the image attribute. +.le +.ls title = "imtitle" +Title for plot. If not changed from the default, the title string from the +image header, appended with the rows being plotted, is used. +.le +.ls majrx=5, minrx=5, majry=5, minry=5 +The number of major and minor divisions along the x or y axis. +.le +.ls round = no +Round axes up to nice values? +.le +.ls fill = yes +Fill the plotting viewport regardless of the device aspect ratio? +.le +.ls append = no +Append to an existing plot? +.le +.ls device="stdgraph" +Output device. +.le +.ih +DESCRIPTION +Plot the average of specified rows from an image. The user can control the +plot size and placement, the scaling and labeling of axes. Rows can be +plotted as a continuous line or individual points with a specified marker. + +If \fBappend\fR is enabled, previous values for \fBbox\fR, +\fBfill\fR, \fBround\fR, the plotting viewport (\fBvx1\fR, \fBvx2\fR, +\fBvy1\fR, \fBvy2\fR), and the plotting window (\fBwx1\fR, \fBwx2\fR, +\fBwy1\fR, \fBwy2\fR) are used. + +If the plotting viewport was not set by the user, \fBprows\fR +automatically sets a viewport centered on the device. The default value +of \fBfill\fR = yes means the plot spans equal amounts of NDC space in +x and y. Setting +the value of \fBfill\fR to "no" means the viewport will be adjusted so +that the square plot will span equal physical lengths in x and y +when plotted. That is, when \fBfill = no\fR, a unity aspect ratio is +enforced, and plots +appear square regardless of the device aspect ratio. On devices with non +square full device viewports (e.g., the vt640), a plot drawn by \fIprows\fR +appears extended in the x direction unless \fBfill\fR = no. + +.ih +EXAMPLES +1. Plot rows 128 through 150 of image crab.5009 with default parameters: + + cl> prows crab.5009 128 150 + +2. Overplot rows 128 through 150 of crab.red using circles to mark the +added points: + + cl> prows crab.red 128 150 append+ pointmode+ marker=circle + +3. Annotate the axes of the plot: + + cl> prows crab.5009 64 128 xlabel="Column Number" ylabel=Intensity +.ih +TIME REQUIREMENTS +To plot the average of 20 rows from a 512 square image, \fIprows\fR takes +about 1.5 cp seconds. +.ih +BUGS +.ih +SEE ALSO +prow, pcol, pcols +.endhelp diff --git a/pkg/plot/doc/pvector.hlp b/pkg/plot/doc/pvector.hlp new file mode 100644 index 00000000..34ab1590 --- /dev/null +++ b/pkg/plot/doc/pvector.hlp @@ -0,0 +1,191 @@ +.help pvector Oct91 plot +.ih +NAME +pvector -- plot an arbitrary vector in a 2D image +.ih +USAGE +pvector image x1 y1 x2 y2 +.ih +PARAMETERS +.ls image +Input image containing data to be plotted. +.le +.ls x1, y1 +Starting coordinates of the vector to be plotted. +.le +.ls x2, y2 +Ending coordinates of the vector to be plotted. +.le +.ls xc, yc +The center coordinates of the vector to be plotted if the position +angle \fItheta\fR is defined. +.le +.ls width = 1 +Number of pixels perpendicular to the vector to average. +.le +.ls theta = INDEF +The postion angle of the vector to be plotted measured counter-clockwise +from the positive x axis. Theta must be between 0.0 and 360.0 degrees. +If theta is specified, the \fIxc\fR, and \fIyc\fR parameters +must be specified instead of the starting and ending coordinates +as in examples 3 and 4. +.le +.ls length = INDEF +The length of the vector to be plotted if \fItheta\fR is defined. The +default is to plot the vector from one edge of the frame to another. +.le +.ls boundary = constant +The type of boundary extension. The boundary extension options are: +.ls nearest +Use the value of the nearest boundary pixel. +.le +.ls constant +Use a constant value. +.le +.ls reflect +Generate a value by reflecting around the boundary. +.le +.ls wrap +Generate a value by wrapping around to the opposite side of the image. +.le +.le +.ls constant = 0. +The constant for constant valued boundary extension. +.le +.ls vec_output = "" +File or image name if output vector is desired. If this parameter is +non-null, then the computed vector will be output to the named file of +the type specified by the \fIout_type\fR parameter. If set to STDOUT +or STDERR, a listing of the pixels (i.e. text format) will be output to +either of these streams. Plotting is disabled if vector output is selected. +.le +.ls out_type = "text" +Type of output format (image|text). If an image is created, then a new +header keyword, "VSLICE", will be appended to the new image describing +the endpoints of the vector, the width, and the parent image name. The +parent image header will be copied to the new image. +.le +.ls wx1 = 0., wx2 = 0., wy1 = 0., wy2 = 0. +The range of world coordinates to be included in the plot. If the +range of values in x or y is zero, the plot is automatically scaled from the +minimum to maximum data values along the degenerate axis. +.le +.ls vx1 = 0., vx2 = 0., vy1 = 0., vy2 = 0. +NDC coordinates (0-1) of the device plotting window. If not set by user, +a suitable viewport which allows sufficient room for all labels is used. +.le +.ls pointmode = no +Plot individual points instead of a continuous line? +.le +.ls marker = "box" +Marker or line type to be drawn. If \fBpointmode\fR = yes the markers are +"point", "box", "cross", "plus", "circle", "hebar", "vebar", "hline", +"vline" or "diamond". Any other value defaults to "box". If drawing lines, +\fBpointmode\fR = no, the values are "line", "lhist", "bhist". Any other +value defaults to "line". "bhist" (box histogram) draws lines to the +bottom of the graph while "lhist" does not. In both cases the +horizontal histogram lines run between the half way points (reflected +at the ends). +.le +.ls szmarker = 0.005 +The size of the marker drawn when \fBpointmode\fR = yes. +.le +.ls logx = no, logy = no +Draw the x or y axis in log units, versus linear? +.le +.ls xlabel = "", ylabel = "" +The x-axis and y-axis labels. +.le +.ls title = "imtitle" +Title for plot. If not changed from the default, the title string from the +image header, appended with the vector endpoints, is used. +.le +.ls majrx = 5, minrx = 5, majry = 5, minry = 5 +The number of major and minor divisions along the x or y axis. +.le +.ls round = no +Round axes up to nice values? +.le +.ls fill = yes +Fill the output viewport regardless of the device aspect ratio? +.le +.ls append = no +Append to an existing plot? +.le +.ls device = "stdgraph" +Output device. +.le +.ih +DESCRIPTION +Plot an arbitrary vector of data from an image. The vector can be +specified by either defining the two endpoints of the vector or +by specifying the center position, length and position angle of the vector. +The user can specify +the plot size and placement, the scaling and labeling of axes. Data can be +plotted as a continuous line or individual points with a specified marker. +Optionally, the computed vector may be output to a named image or text file +(as specified by the \fIvec_output\fR and \fIout_type\fR parameters). + +The vector is extracted as a straight line between the given +coordinates, sampled at a spacing along that line equivalent to that +between adjacent pixels in the x or y direction (e.g. the length of a +diagonal endpoint vector from a square image is n*sqrt(2)). +It is possible to specify an averaging width +which determines how many pixels perpendicular to the vector are averaged. +This averaging window is centered +on the vector pixel. When this window is greater than one pixel, it +is possible that the extraction process might try to exceed the +image boundary, in which case the specified type of boundary extension +is employed. The extraction algorithm uses bilinear interpolation to +evaluate points at non-integral pixel positions. + +If \fBappend\fR is enabled, previous values for \fBbox\fR, +\fBfill\fR, \fBround\fR, the plotting viewport (\fBvx1\fR, \fBvx2\fR, +\fBvy1\fR, \fBvy2\fR), and the plotting window (\fBwx1\fR, \fBwx2\fR, +\fBwy1\fR, \fBwy2\fR) are used. + +If the plotting viewport was not set by the user, \fBpvector\fR +automatically sets a viewport centered on the device. The default value +of \fBfill\fR = yes means the plot spans equal amounts of NDC space in +x and y. Setting +the value of \fBfill\fR to "no" means the viewport will be adjusted so +that the square plot will span equal physical lengths in x and y +when plotted. That is, when \fBfill = no\fR, a unity aspect ratio is +enforced, and plots +appear square regardless of the device aspect ratio. On devices with non +square full device viewports (e.g., the vt640), a plot drawn by \fIpvector\fR +appears extended in the x direction unless \fBfill\fR = no. + +.ih +EXAMPLES +1. Plot from the lower left to upper right of 512 square image crab.5009. + + cl> pvector crab.5009 1. 1. 512. 512. + +2. Plot the same vector but with the sampling width = 3. + + cl> pvector crab.5009 1. 1. 512. 512. width=3 + +3. Plot a vector in same image with center position 256, 256, and a position +angle of 45 degrees which extends from one edge of the frame to the other. + + cl> pvector crab.5009 0. 0. 0. 0. 256. 256. theta=45. + or + cl> pvector crab.5009 xc=256. xc=256. theta=45. + + +4. Plot the above vector with a length of 100 pixels. + + cl> pvector crab.5009 0. 0. 0. 0. 256. 256. theta=45. length=100. + or + cl> pvector crab.5009 xc=256. xc=256. theta=45. length=100. +.ih +TIME REQUIREMENTS +It takes approximately 6.7 cpu seconds to compute and plot the twenty +pixel wide diagonal of a 512 square real image. (VAX/VMS 750 with fpa). +.ih +BUGS +.ih +SEE ALSO +prow, pcol, prow, pcols +.endhelp diff --git a/pkg/plot/doc/sgidecode.hlp b/pkg/plot/doc/sgidecode.hlp new file mode 100644 index 00000000..c5cbc007 --- /dev/null +++ b/pkg/plot/doc/sgidecode.hlp @@ -0,0 +1,40 @@ +.help sgidecode Jun86 plot +.ih +NAME +sgidecode -- decode simple graphics interface (SGI) metacode files +.ih +USAGE +sgidecode input +.ih +PARAMETERS +.ls input +The input SGI metacode files. +.le +.ls generic = no +Ignore remaining parameters? +.le +.ls verbose = no +Print metacode in a verbose format? +.le +.ls gkiunits = no +By default, coordinates are printed in NDC rather than GKI units. +.le +.ih +DESCRIPTION +Task \fIsgidecode\fR is a debugging tool used to decode SGI metacode +files. The plotting instructions are decoded and printed in readable +form on the standard output. The input metacode can be read from one +or more files or redirected from the standard input. + +Coordinates are printed in NDC units (0-1) by default. When \fBgkiunits\fR += yes, coordinates are printed in gki units (0-32767). Parameter +\fBverbose\fR is currently not implemented. +.ih +EXAMPLES +1. Decode the metacode in file "home$vdm.sgi". + + cl> sgidecode home$vdm.sgi +.ih +SEE ALSO +gkidecode sgikern +.endhelp diff --git a/pkg/plot/doc/sgikern.hlp b/pkg/plot/doc/sgikern.hlp new file mode 100644 index 00000000..14ce0699 --- /dev/null +++ b/pkg/plot/doc/sgikern.hlp @@ -0,0 +1,178 @@ +.help sgikern Feb87 plot +.ih +NAME +sgikern -- simple graphics interface (SGI) kernel +.ih +USAGE +sgikern input +.ih +PARAMETERS +.ls input +The list of input metacode files. +.le +.ls device = "sgimc" +The name of the logical or physical graphics device for which SGI metacode +is to be generated. +.le +.ls generic = no +The remaining parameters are ignored when \fBgeneric\fR = yes. +.le +.ls debug = no +If \fBdebug\fR = yes, the graphics instructions are decoded and printed +during processing. +.le +.ls verbose = no +If \fBverbose\fR = yes, the elements of polylines, cell arrays, etc. will +be printed in debug mode. +.le +.ls gkiunits = no +By default, coordinates are printed in NDC rather than GKI units. +.le +.ih +DESCRIPTION +Task \fIsgikern\fR translates GKI metacode into a much simpler format and +then calls up a host system task to dispose of the intermediate file to a +plotter device. The SGI kernel can generate as output either an SGI metacode +file, used to drive laser plotters and pen plotters, or a bitmap file, used +to drive raster graphics devices. Both types of files have a very simple +format, making it straightforward to implement interfaces for new devices. + +The SGI/SGK \fBmetacode format\fR is a sequence of 16 bit integer values encoded +in the machine independent MII format (twos complement, most significant byte +first). The SGI kernel reduces all IRAF plotting instructions to only four +SGK metacode instructions, i.e.: + + +.ks +.nf + opcode arguments description + + 1 0 0 start a new frame + 2 X Y move to (x,y) + 3 X Y draw to (x,y) + 4 W 0 set line width (>= 1) +.fi +.ke + + +All coordinates are specified in GKI NDC units in the range 0-32767. Note that +all metacode instructions are the same length. All text generation, line type +emulation, mark drawing, etc., is done in the higher level IRAF software. +The metacode file is a standard IRAF random access (non record structured) +binary file. + +The \fBbitmap format\fR written by the SGK is even simpler than the metacode +format. Output consists either of a single binary raster file containing one +or more bitmaps with no embedded header information, or a set of binary files +with the same root name and the extensions .1, .2, etc., each of which contains +a single bitmap. All bitmaps the same size. The size is specified in the +graphcap entry for the device and may be passed to the host dispose task on +the foreign task command line if desired. Page offsets may also be passed on +the command line, e.g., to position the plot on the plotter page. + +The following graphcap fields apply to both metacode and bitmap devices. + +.ks +.nf + DD host command to dispose of metacode file ($F) + DB have the kernel print debug messages during execution + RM boolean; if present, SGK will delete metacode file + MF multiframe count (max frames per job) + NF store each frame in a new file (one frame/file) + RO rotate plot (swap x and y) + YF y-flip plot (flip y axis) (done after rotate) +.fi +.ke + +The following additional fields are defined for bitmap devices. + +.ks +.nf + BI boolean; presence indicates a bitmapped or raster device + LO width in device pixels of a line of size 1.0 + LS difference in device pixels between line sizes + PX physical x size of bitmap as stored in memory, bits + PY physical y size of bitmap, i.e., number of lines in bitmap + XO,YO origin of plotting window in device pixels + XW,YW width of plotting window in device pixels + NB number of bits to be set in each 8 bit byte output + BF bit-flip each byte in bitmap (easier here than later) + BS byte swap the bitmap when output (swap every two bytes) + WS word swap the bitmap when output (swap every four bytes) +.fi +.ke + +The multiframe count (MF) limits the number of frames per job, where a job +refers to the dispose command submitted to the host to process the frames. +If the new file flag (NF) is absent, all frames will be stored in the same +physical file (this holds for both metacode and bitmap frames). If the new +file flag (NF) is set, each frame will be stored in a separate file, with +the N files having the names $F.1, $F.2, ... $F.N, where $F is the unique +(root) filename generated from the template given in the DD string. The $F +is replaced by the root filename, rather than by a list of all the filenames, +to keep the OS command to a reasonable length and to permit the use of host +file templates to perform operate upon the full set of files (and to avoid +having to choose between spaces and commas to delimit the filenames). +For example, if MF=8 and NF=yes, then "$F.[1-8]" will match the file set +on a UNIX host. The template "$F.*" is less precise but would also work. + +The values of graphcap device capability fields may also be substituted +symbolically when building up the dispose command. If the sequence +$(\fICC\fR) is encountered in the dispose command template, the string +value of the capability \fICC\fR will be substituted. For example, given +the sequence "-w $(xr)" and the graphcap capability entry ":xr#1024:", +the output sequence would be "-w 1024". This feature is particularly +useful when several high level device entries include (via "tc=device") +a generic device entry. The DD string in the generic entry may substitute +the values of device parameters defined differently in the high level +entries; this avoids the need to duplicate an almost identical DD string +in several device entries. + +The output raster will consist of PY lines each of length PX bits. If PX is +chosen to be a multiple of 8, there will be PX/8 bytes per line of the output +raster. Note that the values of PX and PY are arbitrary and should be chosen +to simplify the code of the translator and maximize efficiency. In particular, +PX and PY do not in general define the maximum physical resolution of the +device, although if NB=8 the value of PX will typically approximate the +physical resolution in X. If there are multiple bitmap frames per file, +each frame will occupy an integral number of SPP char units of storage in the +output file, with the values of any extra bits at the end of the bitmap being +undefined (a char is 16 bits on most IRAF host machines). + +The plot will be rasterized in a logical window XW one-bit pixels wide and YW +pixels high. The first YO lines of the output raster will be zero, with the +plotting window beginning at line YO+1. The first XO bits of each output line +will be zeroed, with the plotting window beginning at bit XO+1. The bytes in +each output line may be bit-flipped if desired, and all of the bits in each +output byte need not be used for pixel data. If the bit packing factor NB is +set to 8 the plotting window will map into XW bits of storage of each output +line. If fewer than 8 bits are used in each output byte more than XW physical +bits of storage will be used, e.g., if NB=4, XW*2 bits of storage are required +for a line of the plotting window. The unused bits are set to zero. The +translator can later "or" a mask into the zeroed bits, flip the data bits, +or perform any other bytewise operation using simple lookup table mapping +techniques. + +The DD entry consists of three fields delimited by commas, i.e., the device +name, including node name (not used at present for this kernel), the VOS +root filename to be used to make a temporary file to contain the output (note +that this is NOT a host filename), and lastly the command to be sent to the +host system to dispose of the output metacode file or bitmap file to the +plotter device. +.ih +EXAMPLES +1. Convert the GIO/GKI metacode file "dev$mc" into an SGI format metacode file. + + cl> sgikern dev$mc device=sgimc + +2. The same GIO/GKI metacode file read in the previous example ("dev$mc") can +be plotted on the SGI device "qms_sgi". + + cl> sgikern dev$mc device=qms_sgi +.ih +SEE ALSO +"The IRAF Simple Graphics Interface (SGI)", August 1986 +.br +sgidecode, stdgraph, stdplot +.endhelp + diff --git a/pkg/plot/doc/showcap.hlp b/pkg/plot/doc/showcap.hlp new file mode 100644 index 00000000..21503979 --- /dev/null +++ b/pkg/plot/doc/showcap.hlp @@ -0,0 +1,99 @@ +.help showcap Jan86 plot +.ih +NAME +showcap -- show and decode graphcap entries +.ih +USAGE +showcap +.ih +PARAMETERS +None +.ih +DESCRIPTION +\fBShowcap\fR is an interactive, parameterless task that prints and interprets +entries in the IRAF graphics device capability file dev$graphcap. These +entries contain device dimensions, character sizes etc. plus information for +encoding and decoding the ASCII control sequences sent to or returned by the +device. \fBShowcap\fR is thus mainly used by IRAF programmers for debugging +new graphcap device entries. + +At startup \fBshowcap\fR prints the following instructions to STDOUT, then +prompts with an asterisk. +.nf + + cmd : `set' device + | `*' (to dump full graphcap entry) + | cc [arg1 [arg2 [arg3]]] + ; + + cc : a two character capcode (e.g., 'cm') + | an encoder program (non alpha first char) + ; + * + +.fi +The user must first use `set' to tell \fBshowcap\fR which graphics device to +read from graphcap. After a `set' or `*', the full graphcap entry for the +named device will be printed. To view an individual capability, type the +two-character capability name. + +Some device capability entries take up to three arguments, which may be +listed on the same line after `cc', separated by whitespace. \fBShowcap\fR +is particularly useful for decoding the binary encoder entries used by the +graphics kernels. See the examples below. +.ih +EXAMPLES +1. Examine the graphcap entry for the Retrographics vt640. + +.nf + cl> showcap + * set vt640 (dumps vt640 entry) +.fi + +2. Decode the sequence sent to the terminal for setting text height 2. + +.nf + * TH 2 + program: ^[(1#47+. + encoding: ^[1 +.fi + +3. Decode the sequence sent to the terminal to set line type 3. + +.nf + * LT 3 + program: LT=\E/(1$0)1d\E`($1-5)0d\E(1_+.$D)0d\E`($$:\ + encoding: ^[/0d^[b +.fi + +4. Set environment variable "graphcap" to your local test graphcap file, +set device to vt240 and examine the write-cursor (WC) command for +x-coordinate 150, y-coordinate 350, and cursor 1. + +.nf + cl> set graphcap = "mytest.graphcap" + cl> showcap + * set vt240 (dumps vt240 entry) + * WC 150 350 1 + program: P[(1)%d,(2)%d] + encoding: P[150,350] +.fi + +5. Examine the scan-cursor function returned when the user types key `a' +from coordinate x=150, y=350 after a read-cursor request. + +.nf + * SC a[150,350] + program: (#0!1#0!2,!3,#0!8,#48-!99$0-91#10*9+!1#1!8 + $$8#1=#-39;#0!8,#48-!99$0-92#10*9+!2#1!8 + $$8#1=#-39;); + X(R1)=150 Y(R2)=350, key = a +.fi +.ih +BUGS +Diagnostics are mostly limited to a numeric status return when debugging +binary encoder entries that contain bugs. +.ih +SEE ALSO +Graphics I/O Design Document. +.endhelp diff --git a/pkg/plot/doc/stdgraph.hlp b/pkg/plot/doc/stdgraph.hlp new file mode 100644 index 00000000..d07ee7b2 --- /dev/null +++ b/pkg/plot/doc/stdgraph.hlp @@ -0,0 +1,72 @@ +.help stdgraph Jan86 plot +.ih +NAME +stdgraph -- draws a plot on the terminal +.ih +USAGE +stdgraph input +.ih +PARAMETERS +.ls input +The input metacode, may be a list of files or redirected STDIN. +.le +.ls device = "stdgraph" +The terminal type. +.le +.ls generic = no +The remaining parameters are ignored if \fBgeneric\fR = yes. +.le +.ls debug = no +When \fBdebug\fR = yes, the decoded plotting instructions are printed +during processing. +.le +.ls verbose = no +If \fBverbose\fR = yes, elements of polylines and cell array calls are +printed in debug mode. +.le +.ls gkiunits = no +In debug mode, coordinates can be printed in GKI rather than NDC units. +.le +.ls txquality = "normal" +The character drawing quality. +.le +.ls xres = 0, yres= 0 +The number of resolution elements in x and y +.le +.ih +DESCRIPTION +Task \fIstdgraph\fR translates GKI metacode and draws a plot on a +graphics terminal. Input to +\fIstdgraph\fR is GKI metacode, which can be read from one or more +metacode files or redirected from the standard input. + +Parameters +\fBtxquality\fR, \fBxres\fR, and \fByres\fR are used to override the +values for text quality, and x and y resolution already in the metacode. +Values for \fBtxquality\fR are chosen from normal, low, medium or high. +High quality characters are software generated, and can be of any size. + +If \fBdebug\fR is set to yes, the plotting instructions are printed in +readable form as the metacode is processed. In debug mode, GKI +instructions can be printed in verbose mode, where the elements of +polylines and cell arrays are printed in addition to the default output. +Coordinates can be printed in either GKI (0 - 32767) or NDC (0.0 - 1.0) +units. + +.ih +EXAMPLES +1. Extract the fourth frame from metacode file "plots.mc" and plot it. + + cl> gkiextract plots.mc 4 | stdgraph + +2. Process file "one.mc" in debug mode. + + cl> stdgraph oned.mc debug+ + +3. Plot file "oned.mc" with high quality text generation. + + cl> stdgraph oned.mc txquality=high +.ih +SEE ALSO +gkiextract, stdplot +.endhelp diff --git a/pkg/plot/doc/stdplot.hlp b/pkg/plot/doc/stdplot.hlp new file mode 100644 index 00000000..ddd3017d --- /dev/null +++ b/pkg/plot/doc/stdplot.hlp @@ -0,0 +1,56 @@ +.help stdplot Jan86 plot +.ih +NAME +stdplot -- draw metacode on the standard plotter device +.ih +USAGE +stdplot input +.ih +PARAMETERS +.ls input +The list of input metacode files. +.le +.ls device = "stdplot" +The type of plotting device. +.le +.ls generic = no +The remaining parameters are ignored when \fBgeneric\fR = yes. +.le +.ls debug = no +If \fBdebug\fR = yes, the graphics instructions are decoded and printed +during processing. +.le +.ls verbose = no +If \fBverbose\fR = yes, the elements of polylines, cell arrays, etc. will +be printed in debug mode. +.le +.ls gkiunits = no +By default, coordinates are printed in NDC rather than GKI units. +.le +.ih +DESCRIPTION +Task \fIstdplot\fR translates metacode and draws it on a plotting +device. +Input is GKI metacode, which can be read from one or more binary +files or redirected from the standard input. + +If \fBdebug\fR is set to yes, the plotting instructions are printed in +readable form during processing. +If \fBverbose\fR = yes, elements of polyline and cell array calls are +printed in addition to the default debug output. +Coordinates can be printed in either GKI (0 - 32767) or NDC (0.0 - 1.0) +units. +.ih +EXAMPLES +1. Extract the fourth frame from metacode file "oned.mc" and plot it. + + cl> gkiextract oned.mc 4 | stdplot + +2. Plot metacode frame "contour.demo" in debug mode, so the plotting +instructions can be read as they are processed. + + cl> stdplot contour.demo debug+ +.ih +SEE ALSO +gkiextract stdgraph +.endhelp diff --git a/pkg/plot/doc/surface.hlp b/pkg/plot/doc/surface.hlp new file mode 100644 index 00000000..9331bc76 --- /dev/null +++ b/pkg/plot/doc/surface.hlp @@ -0,0 +1,95 @@ +.help surface Aug91 plot +.ih +NAME +surface -- draw a three dimensional perspective plot of a surface +.ih +USAGE +surface image +.ih +PARAMETERS +.ls image +Image or image section to be plotted. +.le +.ls floor = INDEF +Data values below \fBfloor\fR are clipped. If \fBfloor = INDEF\fR, the data +minimum is used for the floor. +.le +.ls ceiling = INDEF +Data values above \fBceiling\fR are clipped. If \fBceiling = INDEF\fR, the +data maximum is used for the ceiling. +.le +.ls angh = -33.0 +Horizontal viewing angle, degrees. +.le +.ls angv = 25.0 +Vertical viewing angle, degrees. +.le +.ls device = "stdgraph" +Output device (\fBstdgraph\fR, \fBstdplot\fR, or the name of a physical +device). +.le +.ls title = "imtitle" +A title string is centered above the plot. The user can specify a title +string; the default is the image title. +.le +.ls label = no +The axes are drawn and the corner points of the plotting area are labeled +if \fBlabel\fR = yes. +.le +.ls xres = 64, yres = 64 +The input image is block averaged or subsampled to this resolution. +.le +.ls preserve = yes +If \fBpreserve\fR = yes, the aspect ratio of the image is preserved when +achieving the resolution specified by \fBxres\fR and \fByres\fR. +.le +.ls subsample = no +The resolution specified by \fBxres\fR, \fByres\fR is achieved by block +averaging unless \fBsubsample\fR = yes. +.le +.ih +DESCRIPTION +\fBSurface\fR draws a pseudo-three dimensional perspective of an image +section. Hidden lines are removed. The surface may be viewed from any +angle. Subsampling or block averaging is used to achieve the resolution +specified. A labeled perimeter is optionally drawn around the plot. + +To speed up the plot, the resolution of the image can be decreased to +\fBxres\fR by \fByres\fR. When \fBpreserve\fR = yes, \fBsurface\fR +automatically reduces the image in both directions by the same factor, which +is the larger of [ncolumns / xres or nlines / yres]. If the +aspect ratio is not being preserved, the x and y dimensions are independently +reduced to the specified resolution. +No reduction is done if +\fBxres\fR and \fByres\fR = 0, if the input image is an image section, or if +the image is smaller than \fBxres\fR by \fByres\fR. +.ih +EXAMPLES +1. Surface plot of a 512 square image. With the default values of \fBxres\fR +and \fByres\fR, the image would be block averaged by a factor of 8 in x and y. + + cl> surface crab.5009 + +2. Look at the bottom of the surface, but subsample rather that block average +to decrease resolution and speed things up. Also, the output device will +be the plotter, and the job will run in the background: + + cl> surface crab.5009 angv=-30 subsample+ device=stdplot & + +3. Surface plot of band 4 of an image cube. Since the image is specified using +image section notation, no block averaging or subsampling will be done. + + cl> surface cube[*,*,4] +.ih +TIME REQUIREMENTS +The time required by \fIsurface\fR depends on image size and resolution. +A surface plot of a +512 square image block averaged to 64 square requires 30 cpu seconds. The +same image subsampled would take 23 seconds to plot. +.ih +BUGS +It should be possible to input the surface in list form. +.ih +SEE ALSO +contour, graph +.endhelp diff --git a/pkg/plot/doc/velvect.hlp b/pkg/plot/doc/velvect.hlp new file mode 100644 index 00000000..43b73cfb --- /dev/null +++ b/pkg/plot/doc/velvect.hlp @@ -0,0 +1,47 @@ +.help velvect Sep85 plot +.ih +NAME +velvect -- two dimensional velocity field plot +.ih +USAGE +velvect uimage vimage +.ih +PARAMETERS +.ls uimage +Name of image containing u components of the velocity field. +.le +.ls vimage +Name of image containing v components of the velocity field. +.le +.ls device = stdgraph +Output device for plot. +.le +.ls title = "imtitle" +Title to be centered over the plot. By default, it will be the title +from the image header of the \fBuimage\fR. +.le +.ls append = no +Append to an old plot? +.le +.ls verbose = yes +Print warning messages? +.le +.ih +DESCRIPTION +Task \fIvelvect\fR draws a representation of a two-dimensional velocity +field by drawing arrows from each data location. The length of the arrow +is proportional to the strength of the field at that location and the direction +of the arrow indicates the direction of the flow at that location. The +two images \fIuimage\fR and \fIvimage\fR contain the velocity field to be +plotted. The vector at the point (i,j) has: + +.nf + magnitude = sqrt (uimage(i,j)**2 + vimage(i,j)**2) + direction = atan2 (vimage(i,j), uimage(i,j)) +.fi +.ih +EXAMPLES +1. Make a vector plot from the two images "crab.blue" and "crab.red". + + cl> velvect crab.blue crab.red +.endhelp diff --git a/pkg/plot/gdevices.par b/pkg/plot/gdevices.par new file mode 100644 index 00000000..f88058b5 --- /dev/null +++ b/pkg/plot/gdevices.par @@ -0,0 +1,2 @@ +devices,s,h,"^imt",,,List of patterns defining device class +graphcap,s,h,"graphcap",,,Graphcap file to be searched diff --git a/pkg/plot/gdevices.x b/pkg/plot/gdevices.x new file mode 100644 index 00000000..e67091ba --- /dev/null +++ b/pkg/plot/gdevices.x @@ -0,0 +1,116 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define SZ_LBUF 2048 +define SZ_PATSTR 128 +define SZ_PATBUF 1024 + +# GDEVICES -- Print a summary of the graphics devices currently defined in +# graphcap. The devices parameter, a list of pattern strings, defines the +# class of devices to be listed. The devices aliases, X and Y resolution, +# and device description are output for each device. + +procedure t_gdevices() + +pointer fnt, ip, op, gty +int fd, junk, nalias, lnum, xr, yr +pointer sp, devices, fname, patstr, patbuf, lbuf, device, devdes + +bool streq() +pointer fntopn(), gtyopen() +int patmake(), patmatch(), gtygeti() +int open(), getlongline(), envfind(), fntgfn() +string s_graphcap "graphcap" + +begin + call smark (sp) + call salloc (devices, SZ_LINE, TY_CHAR) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (patstr, SZ_PATSTR, TY_CHAR) + call salloc (patbuf, SZ_PATBUF, TY_CHAR) + call salloc (lbuf, SZ_LBUF, TY_CHAR) + call salloc (device, SZ_FNAME, TY_CHAR) + + # Get list of device patterns to be matched against graphcap. + call clgstr ("devices", Memc[devices], SZ_LINE) + + # Get graphcap file name. + call clgstr (s_graphcap, Memc[fname], SZ_PATHNAME) + if (Memc[fname] == EOS) + call strcpy ("dev$graphcap", Memc[fname], SZ_PATHNAME) + else if (streq (Memc[fname], s_graphcap)) + if (envfind (s_graphcap, Memc[fname], SZ_PATHNAME) <= 0) + call strcpy ("dev$graphcap", Memc[fname], SZ_PATHNAME) + + # Print table header. + call printf ("#%39s %4s %4s %s\n") + call pargstr ("ALIASES") + call pargstr ("NX") + call pargstr ("NY") + call pargstr ("DESCRIPTION") + + fnt = fntopn (Memc[devices]) + while (fntgfn (fnt, Memc[patstr], SZ_PATSTR) != EOF) { + junk = patmake (Memc[patstr], Memc[patbuf], SZ_PATBUF) + + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + while (getlongline (fd, Memc[lbuf], SZ_LBUF, lnum) != EOF) { + + if (patmatch (Memc[lbuf], Memc[patbuf]) > 0) { + # Get device alias list and extract first device name + # into "device" string. + + ip = lbuf + op = device + for (nalias=1; Memc[ip] != EOS; nalias=nalias+1) { + devdes = ip + while (Memc[ip] != EOS) { + if (Memc[ip] == '|') { + Memc[ip] = ' ' + ip = ip + 1 + break + } else if (Memc[ip] == ':') { + Memc[devdes-1] = EOS + Memc[ip] = EOS + break + } else { + if (nalias == 1) { + Memc[op] = Memc[ip] + op = op + 1 + } + ip = ip + 1 + } + } + Memc[op] = EOS + } + + # Fetch graphcap entry for device. + iferr (gty = gtyopen (Memc[fname], Memc[device], "")) { + call eprintf ("cannot access entry for %s\n") + call pargstr (Memc[device]) + next + } + + # Print information about graphics device, in the + # form alias ... alias nx ny description. + + iferr (xr = gtygeti (gty, "xr")) + xr = 0 + iferr (yr = gtygeti (gty, "yr")) + yr = 0 + + call printf ("%40s %5d%5d %0.27s\n") + call pargstr (Memc[lbuf]) + call pargi (xr) + call pargi (yr) + call pargstr (Memc[devdes]) + + call flush (STDOUT) + call gtyclose (gty) + } + } + call close (fd) + } + + call fntcls (fnt) + call sfree (sp) +end diff --git a/pkg/plot/getdata.x b/pkg/plot/getdata.x new file mode 100644 index 00000000..2e64b184 --- /dev/null +++ b/pkg/plot/getdata.x @@ -0,0 +1,212 @@ +include <imhdr.h> + +# PLT_GETDATA -- Decrease resolution of image by either subsampling +# or block averaging. A pointer to the data values to be plotted is +# returned, as well as the number of columns and lines in the data matrix. + +pointer procedure plt_getdata (im, sub, pre, xres, yres, nx, ny) + +pointer im # Pointer to image header +bool sub # Subsample versus block average (yes/no)? +bool pre # Preserve aspect ratio (yes/no)? +int xres, yres # desired resolution +int nx, ny # dimensions of output array + +int nxin, nyin +pointer subras, data +pointer plt_blkaverage(), plt_subsample(), imgs2r() +errchk plt_blkaverage, plt_subsample, calloc + +begin + # First, determine if the image resolution is to be decreased or not. + nxin = IM_LEN(im,1) + nyin = IM_LEN(im,2) + + if ((nxin > xres && xres != 0) || (nyin > yres && yres != 0)) { + # Need to decrease resolution; image can be either subsampled + # or block averaged. + + if (sub) { + data = plt_subsample (im, xres, yres, pre, nx, ny) + return (data) + } else { + data = plt_blkaverage (im, xres, yres, pre, nx, ny) + return (data) + } + + } else { + # Return entire image as data matrix. + nx = nxin + ny = nyin + call calloc (data, nx * ny, TY_REAL) + subras = imgs2r (im, 1, nxin, 1, nyin) + call amovr (Memr[subras], Memr[data], nx * ny) + return (data) + } +end + + +# PLT_SUBSAMPLE -- The input data array is subsampled by the specified +# factors. The reduced data array and its dimensions are returned. + +pointer procedure plt_subsample (im, xres, yres, pre, nxout, nyout) + +pointer im # input image +int xres, yres # desired output resolution +bool pre # preserve aspect ratio? +int nxout, nyout # dimensions of output array (returned) + +pointer sp, xvec, data +int x_factor, y_factor, xrf, yrf +int nxin, nyin, yin, ii, jj, index, nop +errchk imgl2r, calloc +pointer imgl2r() + +begin + call smark (sp) + + nxin = IM_LEN(im,1) + nyin = IM_LEN(im,2) + + # User could have disabled subsampling in x or y, but not both. + if (xres == 0) + xres = nxin + if (yres == 0) + yres = nyin + + x_factor = (nxin + xres - 1) / xres + y_factor = (nyin + yres - 1) / yres + if (pre) { + xrf = max (x_factor, y_factor) + yrf = max (x_factor, y_factor) + } else { + xrf = x_factor + yrf = y_factor + } + + nxout = nxin / xrf + nyout = nyin / yrf + + call eprintf ("Image will be subsampled by %d in x and %d in y\n") + call pargi (xrf) + call pargi (yrf) + + call salloc (xvec, nxin, TY_REAL) + call calloc (data, nxout * nyout, TY_REAL) + + yin = 1 + do jj = 1, nyout { + call amovr (Memr[imgl2r (im, yin)], Memr[xvec], nxin) + nop = 1 + do ii = 1, nxin { + index = data + ((jj-1) * nxout) + nop - 1 + if (mod (ii-1, xrf) == 0) { + Memr[index] = Memr[xvec+ii-1] + nop = nop + 1 + } + } + yin = yin + yrf + } + + call sfree (sp) + return (data) +end + + +# PLT_BLKAVERAGE -- Block average the input image by the specified reduction +# factors. The reduced array and its dimensions are returned. + +pointer procedure plt_blkaverage (im, xres, yres, pre, nx, ny) + +pointer im # input image +int xres, yres # blocking factors +bool pre # preserve aspect ratio? +int nx, ny # dimensions of output array (returned) + +real sum +pointer sp, xvec, data +int nxin, nyin, nxout, nyout, nxout_full, nyout_full +int jj, ii, index, nxcols, yin, nxrows, bfx, bfy, x_factor, y_factor +errchk abavr, aclrr, aaddr, salloc, calloc, imgl2r +pointer imgl2r() + +begin + call smark (sp) + + nxin = IM_LEN(im,1) + nyin = IM_LEN(im,2) + + # User could have disabled blockaveraging in x or y, but not both. + if (xres == 0) + xres = nxin + if (yres == 0) + yres = nyin + + bfx = nxin / xres + bfy = nyin / yres + if (pre) { + x_factor = max (bfx, bfy) + y_factor = max (bfx, bfy) + } else{ + x_factor = bfx + y_factor = bfy + } + + call eprintf ("Image will be block averaged by %d in x and %d in y\n") + call pargi (x_factor) + call pargi (y_factor) + + nxout = (nxin + x_factor - 1) / x_factor + nyout = (nyin + y_factor - 1) / y_factor + nxout_full = nxin / x_factor + nyout_full = nyin / y_factor + nxcols = nxin - (nxout_full * x_factor) + nxrows = nyin - (nyout_full * y_factor) + + call salloc (xvec, nxin, TY_REAL) + call calloc (data, nxout * nyout, TY_REAL) + + yin = 1 + do jj = 1, nyout_full { + call aclrr (Memr[xvec], nxin) + do ii = 1, y_factor { + call aaddr (Memr[imgl2r(im,yin)], Memr[xvec], Memr[xvec], nxin) + yin = yin + 1 + } + call adivkr (Memr[xvec], real(y_factor), Memr[xvec], nxin) + + index = data + (jj-1) * nxout + call abavr (Memr[xvec], Memr[index], nxout_full, x_factor) + + if (nxcols != 0) { + sum = 0.0 + # deal with trailing column pixels + do ii = 1, nxcols + sum = sum + Memr[xvec+(nxout_full*x_factor)+ii-1] + Memr[index+nxout_full] = sum / real (nxcols) + } + + } + + if (nxrows != 0) { + call aclrr (Memr[xvec], nxin) + do ii = yin, nyin + call aaddr (Memr[imgl2r(im,ii)], Memr[xvec], Memr[xvec], nxin) + call adivkr (Memr[xvec], real (nxrows), Memr[xvec], nxin) + + index = data + (nyout - 1) * nxout + call abavr (Memr[xvec], Memr[index], nxout_full, x_factor) + + if (nxcols != 0) { + # Deal with trailing column pixels. + do ii = 1, nxcols + sum = sum + Memr[xvec+(nxout_full*x_factor)+ii-1] + Memr[index+nxout_full] = sum / real (nxcols) + } + } + + nx = nxout + ny = nyout + call sfree (sp) + return (data) +end diff --git a/pkg/plot/gkidecode.par b/pkg/plot/gkidecode.par new file mode 100644 index 00000000..12900077 --- /dev/null +++ b/pkg/plot/gkidecode.par @@ -0,0 +1,4 @@ +input,s,a,,,,input metacode file +generic,b,h,no,,,ignore remaining kernel dependent parameters +verbose,b,h,no,,,"print elements of polylines, cell arrays, etc." +gkiunits,b,h,no,,,print coordinates in GKI rather than NDC units diff --git a/pkg/plot/gkidir.par b/pkg/plot/gkidir.par new file mode 100644 index 00000000..f23fb00c --- /dev/null +++ b/pkg/plot/gkidir.par @@ -0,0 +1 @@ +input,f,q,"",,,"Metacode file" diff --git a/pkg/plot/gkiextract.par b/pkg/plot/gkiextract.par new file mode 100644 index 00000000..b3c8b026 --- /dev/null +++ b/pkg/plot/gkiextract.par @@ -0,0 +1,5 @@ +input,f,a,"",,,metacode source file +frames,s,ql,"1-99",,,ranges of frames to extract +verify,b,h,no,,,verify operation before extracting each frame? +go_ahead,b,q,yes,,," ?" +default_action,b,h,yes,,,default extract action for verify query diff --git a/pkg/plot/gkimosaic.par b/pkg/plot/gkimosaic.par new file mode 100644 index 00000000..d45647aa --- /dev/null +++ b/pkg/plot/gkimosaic.par @@ -0,0 +1,9 @@ +input,f,a,,,,metacode input +device,s,h,"stdgraph",,,output device +output,f,h,,,,name of binary output file +nx,i,h,2,,,number of plots in x direction +ny,i,h,2,,,number of plots in y direction +rotate,b,h,no,,,rotate axes? +fill,b,h,no,,,fill viewport vs preserve aspect ratio +interactive,b,h,yes,,, +cursor,*gcur,h,"",,, diff --git a/pkg/plot/graph.par b/pkg/plot/graph.par new file mode 100644 index 00000000..f245b033 --- /dev/null +++ b/pkg/plot/graph.par @@ -0,0 +1,40 @@ +input,s,a,,,,list of images or list files to be graphed +wx1,r,h,0.,,,left world x-coord if not autoscaling +wx2,r,h,0.,,,right world x-coord if not autoscaling +wy1,r,h,0.,,,lower world y-coord if not autoscaling +wy2,r,h,0.,,,upper world y-coord if not autoscaling +wcs,s,h,"logical",,,Coordinate system for images +axis,i,h,1,1,7,axis along which projection is to be taken +transpose,b,h,no,,,transpose the x and y axes of the plot +pointmode,b,h,no,,,plot points instead of lines? +marker,s,h,"box",,,point marker or line mode? +szmarker,r,h,5E-3,,,marker size (0 for list input) +ltypes,s,h,"",,,List of line types (1-4) +colors,s,h,"",,,List of colors (1-9) +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 +xlabel,s,h,"wcslabel",,,x-axis label +ylabel,s,h,"",,,y-axis label +xformat,s,h,"wcsformat",,,x-axis coordinate format +yformat,s,h,"",,,y-axis coordinate format +title,s,h,"imtitle",,,title for plot +lintran,b,h,no,,,perform linear transformation of x axis +p1,r,h,0,,,start input pixel value for lintran +p2,r,h,0,,,end input pixel value for lintran +q1,r,h,0,,,start output pixel value for lintran +q2,r,h,1,,,end output pixel value for lintran +vx1,r,h,0.,,,left limit of device viewport (0.0:1.0) +vx2,r,h,0.,,,right limit of device viewport (0.0:1.0) +vy1,r,h,0.,,,bottom limit of device viewport (0.0:1.0) +vy2,r,h,0.,,,upper limit of device viewport (0.0:1.0) +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 +overplot,b,h,no,,,overplot on existing plot? +append,b,h,no,,,append to existing plot? +device,s,h,"stdgraph",,,output device +round,b,h,no,,,round axes to nice values? +fill,b,h,yes,,,fill viewport vs enforce unity aspect ratio? diff --git a/pkg/plot/hafton.par b/pkg/plot/hafton.par new file mode 100644 index 00000000..ccf14148 --- /dev/null +++ b/pkg/plot/hafton.par @@ -0,0 +1,19 @@ +image,s,a,,,,image or image section to be plotted +z1,r,h,0,,,minimum intensity to be mapped (0 if zmin) +z2,r,h,0,,,maximum intensity to be mapped (0 if zmax) +nlevels,i,h,0,,,number of levels to be drawn (0 for default) +mapping_function,s,h,"linear",,,type of mapping +contrast,r,h,0.25,,,positive or negative contrast [+/-1]? +perimeter,b,h,yes,,,draw perimeter around plot? +device,s,h,stdgraph,,,output device +title,s,h,"imtitle",,,optional title +preserve,b,h,yes,,,preserve aspect ratio when decreasing resolution? +xres,i,h,64,,,x resolution in pixels +yres,i,h,64,,,y resolution in pixels +vx1,r,h,0.,,,NDC viewport x1 +vx2,r,h,0.,,,NDC viewport x2 +vy1,r,h,0.,,,NDC viewport y1 +vy2,r,h,0.,,,NDC viewport y2 +fill,b,h,no,,,fill viewport regardless of device aspect ratio? +subsample,b,h,no,,,subsample (vs block average) to reduce resolution? +append,b,h,no,,,append to an old plot? diff --git a/pkg/plot/hgpline.x b/pkg/plot/hgpline.x new file mode 100644 index 00000000..50b3d9a8 --- /dev/null +++ b/pkg/plot/hgpline.x @@ -0,0 +1,56 @@ +include <gset.h> + + +# Any other type defaults to a connected line. +define PLOT_TYPES "|line|lhist|bhist|" +define LINE 1 # Connected line +define LHIST 2 # Line histogram +define BHIST 3 # Box histogram + +procedure hgpline (gp, x, y, n, type) + +pointer gp #I GIO pointer +real x[ARB] #I X coordinates +real y[ARB] #I Y coordinates +int n #I Number of coordinates +char type[ARB] #I Plot type + +int i +real x1, x2, bottom +char line[5] + +int strdic() + +begin + # Draw lines. + switch (strdic (type, line, 5, PLOT_TYPES)) { + case LHIST: + x1 = (3 * x[1] - x[2]) / 2 + call gamove (gp, x1, y[1]) + do i = 1, n-1 { + x2 = (x[i] + x[i+1]) / 2 + call gadraw (gp, x2, y[i]) + call gadraw (gp, x2, y[i+1]) + x1 = x2 + } + x2 = (3 * x[n] - x[n-1]) / 2 + call gadraw (gp, x2, y[n]) + case BHIST: + call ggwind (gp, x1, x2, bottom, x1) + x1 = (3 * x[1] - x[2]) / 2 + call gamove (gp, x1, bottom) + call gadraw (gp, x1, y[1]) + do i = 1, n-1 { + x2 = (x[i] + x[i+1]) / 2 + call gadraw (gp, x2, y[i]) + call gadraw (gp, x2, bottom) + call gadraw (gp, x2, y[i+1]) + x1 = x2 + } + x2 = (3 * x[n] - x[n-1]) / 2 + call gadraw (gp, x2, y[n]) + call gadraw (gp, x2, bottom) + default: + call gpline (gp, x, y, n) + } +end diff --git a/pkg/plot/imdkern.par b/pkg/plot/imdkern.par new file mode 100644 index 00000000..3d6c8993 --- /dev/null +++ b/pkg/plot/imdkern.par @@ -0,0 +1,8 @@ +input,s,a,,,,input metacode file +device,s,h,"stdimage",,,output device +generic,b,h,no,,,ignore remaining kernel dependent parameters +frame,i,h,0,,,display frame +color,i,h,205,0,255,color index +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 diff --git a/pkg/plot/implot.par b/pkg/plot/implot.par new file mode 100644 index 00000000..7377f50b --- /dev/null +++ b/pkg/plot/implot.par @@ -0,0 +1,6 @@ +image,s,a,,,,image to be plotted +line,i,a,,,,line to be plotted +wcs,s,h,"logical",,,world coordinate system +step,i,h,0,,,Step in pixels for j/k key +coords,*gcur,h,,,,graphics cursor input +device,s,h,"stdgraph",,,graphics device for plots diff --git a/pkg/plot/impprofile.x b/pkg/plot/impprofile.x new file mode 100644 index 00000000..efcca960 --- /dev/null +++ b/pkg/plot/impprofile.x @@ -0,0 +1,221 @@ +include <gset.h> +include <math/iminterp.h> + +define INTERP_TYPE II_SPLINE3 # Interpolation type +define STEP 0.01 # Approximate step size +define NITERATE 10 # Number of iteration to find endpoints +define DX 0.001 # Accuracy + + +# IMP_PROFILE -- IMPLOT profile analysis. + +procedure imp_profile (gp, x, y, n, x1, y1, x2, y2, sl, sline) + +pointer gp #I gio pointer +real x[n] #I x coordinates +real y[n] #I y coordinates +int n #I number of points +real x1, y1 #I first endpoint +real x2, y2 #I second endpoint +pointer sl #U status line pointer +int sline #U line to print + +int i +real p, p1, p2, pc, pl, pr, step +real a, b, c, y0, dy, xc, xl, xr, der[2] +double sumb, sum0, sum1, sum2, sum3 +pointer xasi, yasi, sl_getstr +real asieval() +bool fp_equalr() + +begin + # Fit an interpolator to the input arrays. + call asiinit (xasi, INTERP_TYPE) + call asiinit (yasi, INTERP_TYPE) + call asifit (xasi, x, n) + call asifit (yasi, y, n) + + # Find the pixel endpoints given the x endpoints to an accuracy of DX. + p1 = 1. + n / 2. + b = 1. + do i = 1, NITERATE { + call asider (xasi, p1, der, 2) + if (!fp_equalr (der[2], 0.)) + b = der[2] + a = x1 - der[1] + p1 = max (1., min (real(n), p1 + a / der[2])) + if (abs (a) < DX) + break + } + p2 = p1 + do i = 1, NITERATE { + call asider (xasi, p2, der, 2) + if (!fp_equalr (der[2], 0.)) + b = der[2] + a = x2 - der[1] + p2 = max (1., min (real(n), p2 + a / der[2])) + if (abs (a) < DX) + break + } + + # Set the linear baseline. + if (fp_equalr (p1, p2)) { + y0 = (y1 + y2) / 2. + dy = 1. + step = STEP + } else if (p1 < p2) { + y0 = y1 + dy = (y2 - y0) / (p2 - p1) + step = (p2 - p1) / (nint(p2) - nint(p1) + 1) * STEP + } else { + pc = p1 + p1 = p2 + p2 = pc + y0 = y2 + dy = (y1 - y0) / (p2 - p1) + step = (p2 - p1) / (nint(p2) - nint(p1) + 1) * STEP + } + + # Compute the first 2 moments using trapezoidal integration. + p = p1 + a = asieval (xasi, p) + b = y0 + (p - p1) * dy + c = asieval (yasi, p) - b + sumb = b / 2 + sum0 = c / 2 + sum1 = a * c / 2 + for (p=p+step; p<=p2; p=p+step) { + a = asieval (xasi, p) + b = y0 + (p - p1) * dy + c = asieval (yasi, p) - b + sumb = sumb + b + sum0 = sum0 + c + sum1 = sum1 + a * c + } + sumb = (sumb - b / 2) * step + sum0 = (sum0 - c / 2) * step + sum1 = (sum1 - a * c / 2) * step + + # Compute the higher central moments using trapezoidal integration. + if (sum0 == 0D0) { + sum1 = INDEFD + sum2 = INDEFD + sum3 = INDEFD + } else { + sum1 = sum1 / sum0 + p = p1 + a = asieval (xasi, p) - sum1 + b = y0 + (p - p1) * dy + c = asieval (yasi, p) - b + sum2 = a * a * c / 2 + sum3 = a * a * a * c / 2 + for (p=p+step; p<=p2; p=p+step) { + a = asieval (xasi, p) - sum1 + b = y0 + (p - p1) * dy + c = asieval (yasi, p) - b + sum2 = sum2 + a * a * c + sum3 = sum3 + a * a * a * c + } + sum2 = (sum2 - a * a * c / 2) * step + sum3 = (sum3 - a * a * a * c / 2) * step + sum2 = sqrt (sum2 / sum0) + if (sum2 > 0.) + sum3 = (sum3 / sum0) / (sum2 ** 3) + } + + # Find the maximum value away from the baseline. + pc= p1 + c = 0. + for (p=p1; p<=p2; p=p+step) { + a = abs (asieval (yasi, p) - y0 - (p - p1) * dy) + if (a > c) { + pc = p + c = a + } + } + xc = asieval (xasi, pc) + + # Find the half width points. + c = c / 2 + pl = INDEF + xl = INDEF + for (p=pc; p>=p1; p=p-step) { + a = abs (asieval (yasi, p) - y0 - (p - p1) * dy) + if (a < c) { + pl = p + (c - a) / (b - a) * step + xl = asieval (xasi, pl) + break + } + b = a + } + + pr = INDEF + xr = INDEF + for (p=pc; p<p2; p=p+step) { + a = abs (asieval (yasi, p) - y0 - (p - p1) * dy) + if (a < c) { + pr = p - (c - a) / (b - a) * step + xr = asieval (xasi, pr) + break + } + b = a + } + + b = y0 + (pc - p1) * dy + p = asieval (yasi, pc) + a = (p - b) / 2 + b + if (!IS_INDEF(xl)) { + if (xl > xc) { + c = pl + pl = pr + pr = c + c = xl + xl = xr + xr = c + } + } + if (IS_INDEF(xl) || IS_INDEF(xr)) + c = INDEF + else + c = xr - xl + + # Draw marks to show the baseline, center, and width. + call gseti (gp, G_PLTYPE, 2) + call gline (gp, x1, y1, x2, y2) + call gline (gp, xc, b, xc, p) + if (!IS_INDEF(xl)) + call gline (gp, xc, a, xl, a-b+y0+(pl-p1)*dy) + if (!IS_INDEF(xr)) + call gline (gp, xc, a, xr, a-b+y0+(pr-p1)*dy) + call gseti (gp, G_PLTYPE, 1) + + # Record the results. + call sl_init (sl, 4) + call sprintf (Memc[sl_getstr(sl,1)], SZ_LINE, + "[1/4] Profile: Center=%8g, Width=%8g, Peak=%8g, Bkg=%8g\n") + call pargr (xc) + call pargr (c) + call pargr (p) + call pargr (b) + call sprintf (Memc[sl_getstr(sl,2)], SZ_LINE, + "[2/4] Moments: Centroid=%8g, Width=%8g, Flux=%8g, Asym=%6g\n") + call pargd (sum1) + call pargd (2.35482 * sum2) + call pargd (sum0) + call pargd (sum3) + call sprintf (Memc[sl_getstr(sl,3)], SZ_LINE, + "[3/4] Half Intensity: Lower=%8g, Upper=%8g, Width=%8g\n") + call pargr (xl) + call pargr (xr) + call pargr (c) + call sprintf (Memc[sl_getstr(sl,4)], SZ_LINE, + "[4/4] Background: (%8g, %8g) - (%8g, %8g)\n") + call pargr (x1) + call pargr (y1) + call pargr (x2) + call pargr (y2) + sline = 1 + + call asifree (xasi) + call asifree (yasi) +end diff --git a/pkg/plot/improject.x b/pkg/plot/improject.x new file mode 100644 index 00000000..f0a41abb --- /dev/null +++ b/pkg/plot/improject.x @@ -0,0 +1,73 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# IM_PROJECTION -- Given an image section of arbitrary dimension, compute +# the projection along a single axis by taking the average over the other +# axes. We do not know about bad pixels. + +procedure im_projection (im, pv, npix, axis) + +pointer im +real pv[npix] # receives the projection vector +int npix # length of projection vector +int axis # the axis to be projected to (x=1) + +int i, lastv +long v[IM_MAXDIM], nsum, totpix +pointer pix +real asumr() +pointer imgnlr() +errchk imgnlr + +begin + if (im == NULL) + call error (1, "Image projection operator called with null im") + if (axis < 1 || axis > IM_NDIM(im)) + call error (2, "Attempt to take projection over nonexistent axis") + + call aclrr (pv, npix) + call amovkl (long(1), v, IM_MAXDIM) + + switch (axis) { + case 1: + # Since the image is read line by line, it is easy to compute the + # projection along the x-axis (axis 1). We merely sum all of the + # image lines. + + while (imgnlr (im, pix, v) != EOF) + call aaddr (Memr[pix], pv, pv, npix) + + default: + # Projecting along any other axis when reading the image line + # by line is a bit difficult to understand. Basically, the + # element 'axis' of the V vector (position of the line in the + # image) gives us the index into the appropriate element of + # pv. When computing the projection over multiple dimensions, + # the same output element will be referenced repeatedly. All + # of the elmenents of the input line are summed and added into + # this output element. + + for (lastv=v[axis]; imgnlr (im, pix, v) != EOF; lastv=v[axis]) { + i = lastv + if (i <= npix) + pv[i] = pv[i] + asumr (Memr[pix], IM_LEN(im,1)) + } + } + + # Now compute the number of pixels contributing to each element + # of the output vector. This is the number of pixels in the image + # divided by the length of the projection. + + totpix = 1 + do i = 1, IM_NDIM(im) + if (i == axis) + totpix = totpix * min (npix, IM_LEN(im,i)) + else + totpix = totpix * IM_LEN(im,i) + nsum = totpix / min (npix, IM_LEN(im,axis)) + + # Compute the average by dividing by the number if pixels summed at + # each point. + call adivkr (pv, real(nsum), pv, npix) +end diff --git a/pkg/plot/impstatus.x b/pkg/plot/impstatus.x new file mode 100644 index 00000000..77d56eb4 --- /dev/null +++ b/pkg/plot/impstatus.x @@ -0,0 +1,48 @@ +# IMPSTATUS.X -- Support routines for multiple line, scrolling status line. + + +# SL_INIT -- Initialize the status lines for nlines + +procedure sl_init (sl, nlines) + +pointer sl # Pointer to status lines +int nlines # Number of lines + +int i + +begin + i = nlines * (SZ_LINE + 1) + if (sl == NULL) + call calloc (sl, i, TY_CHAR) + else { + call realloc (sl, i, TY_CHAR) + call aclrc (Memc[sl], i) + } + Memc[sl] = nlines +end + + +# SL_FREE -- Free memory used in the status lines + +procedure sl_free (sl) + +pointer sl # Pointer to status lines + +begin + call mfree (sl, TY_CHAR) +end + + +# SL_GETSTR -- Get a status line string as a char pointer + +pointer procedure sl_getstr (sl, line) + +pointer sl # Pointer to status lines +int line # Line to enter + +int i + +begin + i = mod (line-1, int(Memc[sl])) + return (sl + i * (SZ_LINE+1) + 1) +end diff --git a/pkg/plot/initmarker.x b/pkg/plot/initmarker.x new file mode 100644 index 00000000..a965ebb0 --- /dev/null +++ b/pkg/plot/initmarker.x @@ -0,0 +1,47 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> + +# INIT_MARKER -- Returns integers code for marker type string. + +procedure init_marker (marker, imark) + +char marker[SZ_FNAME] # Marker type as a string +int imark # Integer code for marker - returned + +bool streq() + +begin + if (streq (marker, "point")) + imark = GM_POINT + else if (streq (marker, "box")) + imark = GM_BOX + else if (streq (marker, "plus")) + imark = GM_PLUS + else if (streq (marker, "cross")) + imark = GM_CROSS + else if (streq (marker, "circle")) + imark = GM_CIRCLE + else if (streq (marker, "hebar")) + imark = GM_HEBAR + else if (streq (marker, "vebar")) + imark = GM_VEBAR + else if (streq (marker, "hline")) + imark = GM_HLINE + else if (streq (marker, "vline")) + imark = GM_VLINE + else if (streq (marker, "diamond")) + imark = GM_DIAMOND + else { + if (streq (marker, "line") || + streq (marker, "lhist") || + streq (marker, "bhist")) + imark = GM_BOX + else { + call eprintf ("Unrecognized marker type, using 'box'\n") + imark = GM_BOX + } + } +end + + diff --git a/pkg/plot/mkpkg b/pkg/plot/mkpkg new file mode 100644 index 00000000..f9f897e0 --- /dev/null +++ b/pkg/plot/mkpkg @@ -0,0 +1,80 @@ +# Make the PLOT package. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $update libpkg.a + $call linkplot + $call linkncar + ; + +install: + $move xx_plot.e bin$x_plot.e + $move xx_ncar.e bin$x_ncar.e + ; + +ncar: + $update libpkg.a + $call linkncar + ; +linkncar: + $set LIBS = "-lncar -lgks -lxtools" + $omake x_ncar.x + $link x_ncar.o libpkg.a $(LIBS) -o xx_ncar.e + ; + +plot: + $update libpkg.a + $call linkplot + ; +linkplot: + $set LIBS = "-lncar -lgks -lxtools -liminterp" + $omake x_plot.x + $link x_plot.o libpkg.a $(LIBS) -o xx_plot.e + ; + +libpkg.a: + @crtpict + + gdevices.x + getdata.x <imhdr.h> + hgpline.x <gset.h> + improject.x <imhdr.h> + impprofile.x <gset.h> <math/iminterp.h> + impstatus.x + initmarker.x <gset.h> + perim.x <gset.h> <mach.h> + phistogram.x <mach.h> <imhdr.h> <gset.h> + phminmax.x <imhdr.h> + pltwcs.x <imhdr.h> <mwset.h> + t_contour.x <config.h> <error.h> <fset.h> <gset.h> <imhdr.h>\ + <mach.h> <xwhen.h> + t_gkidir.x <gki.h> + t_gkimos.x <error.h> <fset.h> <gio.h> <gki.h> <gset.h> <mach.h>\ + <math.h> + t_gkixt.x <gki.h> + t_graph.x <config.h> <ctype.h> <error.h> <fset.h> <gset.h>\ + <imhdr.h> <mach.h> <xwhen.h> <mwset.h> + t_hafton.x <config.h> <error.h> <fset.h> <gset.h> <imhdr.h>\ + <mach.h> <xwhen.h> + t_implot.x <ctype.h> <error.h> <gset.h> <imhdr.h> <mach.h>\ + <mwset.h> + t_pcol.x <gset.h> <imhdr.h> <mach.h> <mwset.h> + t_pcols.x <gset.h> <imhdr.h> <mach.h> <mwset.h> + t_pradprof.x <gset.h> <imhdr.h> + t_prow.x <gset.h> <imhdr.h> <mach.h> <mwset.h> + t_prows.x <gset.h> <imhdr.h> <mach.h> <mwset.h> + t_pvector.x <gset.h> <imhdr.h> <mach.h> <imset.h> <math.h>\ + <math/iminterp.h> + t_surface.x <config.h> <error.h> <fset.h> <gset.h> <imhdr.h>\ + <mach.h> <xwhen.h> + t_velvect.x <config.h> <error.h> <fset.h> <gset.h> <imhdr.h>\ + <mach.h> <xwhen.h> + vport.x <gset.h> + ; diff --git a/pkg/plot/nsppkern.par b/pkg/plot/nsppkern.par new file mode 100644 index 00000000..e0ec18b2 --- /dev/null +++ b/pkg/plot/nsppkern.par @@ -0,0 +1,6 @@ +input,s,a,,,,input metacode file +device,s,h,"nsppdefault",,,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 diff --git a/pkg/plot/pcol.par b/pkg/plot/pcol.par new file mode 100644 index 00000000..dc4b629f --- /dev/null +++ b/pkg/plot/pcol.par @@ -0,0 +1,28 @@ +image,s,a,,,,image containing column to be plotted +col,i,a,,1,,column to be plotted +wcs,s,h,"logical",,,world coordinate system +wx1,r,h,0.,,,left user x-coord if not autoscaling +wx2,r,h,0.,,,right user x-coord if not autoscaling +wy1,r,h,0.,,,lower user y-coord if not autoscaling +wy2,r,h,0.,,,upper user y-coord if not autoscaling +pointmode,b,h,no,,,plot points instead of lines +marker,s,h,"box",,,point marker or line mode +szmarker,r,h,5E-3,,,marker size (0 for list input) +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +xlabel,s,h,"wcslabel",,,x-axis label +ylabel,s,h,"",,,y-axis label +title,s,h,"imtitle",,,title for plot +xformat,s,h,"wcsformat",,,x-axis coordinate format +vx1,r,h,0.,,,left limit of device window (ndc coords) +vx2,r,h,0.,,,right limit of device window (ndc coords) +vy1,r,h,0.,,,bottom limit of device window (ndc coords) +vy2,r,h,0.,,,upper limit of device window (ndc coords) +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,yes,,,fill device viewport regardless of aspect ratio? +append,b,h,no,,,append to existing plot +device,s,h,"stdgraph",,,output device diff --git a/pkg/plot/pcols.par b/pkg/plot/pcols.par new file mode 100644 index 00000000..bf97cde9 --- /dev/null +++ b/pkg/plot/pcols.par @@ -0,0 +1,29 @@ +image,s,a,,,,image containing columns to be plotted +col1,i,a,,1,,first column to be plotted +col2,i,a,,1,,last column to be plotted +wcs,s,h,"logical",,,world coordinate system +wx1,r,h,0.,,,left user x-coord if not autoscaling +wx2,r,h,0.,,,right user x-coord if not autoscaling +wy1,r,h,0.,,,lower user y-coord if not autoscaling +wy2,r,h,0.,,,upper user y-coord if not autoscaling +pointmode,b,h,no,,,plot points instead of lines +marker,s,h,"box",,,point marker or line mode +szmarker,r,h,5E-3,,,marker size (0 for list input) +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +xlabel,s,h,"wcslabel",,,x-axis label +ylabel,s,h,"",,,y-axis label +title,s,h,"imtitle",,,title for plot +xformat,s,h,"wcsformat",,,x-axis coordinate format +vx1,r,h,0.,,,left limit of device window (ndc coords) +vx2,r,h,0.,,,right limit of device window (ndc coords) +vy1,r,h,0.,,,bottom limit of device window (ndc coords) +vy2,r,h,0.,,,upper limit of device window (ndc coords) +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,yes,,,fill device viewport regardless of aspect ratio? +append,b,h,no,,,append to existing plot +device,s,h,"stdgraph",,,output device diff --git a/pkg/plot/perim.x b/pkg/plot/perim.x new file mode 100644 index 00000000..0857b303 --- /dev/null +++ b/pkg/plot/perim.x @@ -0,0 +1,176 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <gset.h> + +define SZ_LABEL 10 +define SZ_FMT 20 + +# DRAW_PERIMETER -- draw and annotate the axes drawn around the perimeter +# of the image pixels. The viewport and window have been set by +# the calling procedure. Plotting is done in window coordinates. +# This procedure is called by both crtpict and the ncar plotting routines +# contour and hafton. + +procedure draw_perimeter (gp) + +pointer gp # Graphics descriptor +real xs, xe, ys, ye # WCS coordinates of pixel window + +int i, first_col, last_col, first_tick, last_tick, bias +int nchar, dummy, first_row, last_row, cnt_step, cnt_label +char label[SZ_LABEL], fmt1[SZ_FMT], fmt2[SZ_FMT], fmt3[SZ_FMT], fmt4[SZ_FMT] +real dist, kk, col, row, dx, dy, sz_char, cw, xsz, label_pos +real xdist, ydist, xspace, yspace +bool ggetb() +int itoc() +real ggetr() +real k[3] +data k/1.0,2.0,3.0/ +errchk ggwind, gseti, gctran, gline, gtext, itoc + +begin + # First, get window coordinates and turn off clipping + call ggwind (gp, xs, xe, ys, ye) + call gseti (gp, G_CLIP, NO) + + # A readable character width seems to be about 1.mm. A readable + # perimeter seperation seems to be about .80mm. If the physical + # size of the output device is contained in the graphcap file, the + # NDC sizes of these measurements can be determined. If not, + # the separation between perimeter axes equals one quarter character + # width or one quarter percent of frame, which ever is larger, and + # the character size is set to 0.40. + + cw = max (ggetr (gp, "cw"), 0.01) + if (ggetb (gp, "xs")) { + xsz = ggetr (gp, "xs") + dist = .80 / (xsz * 1000.) + sz_char = dist / cw + } else { + # Get character width and calculate perimeter separation. + dist = cw * 0.25 + sz_char = 0.40 + } + + # Convert distance to user coordinates + call ggscale (gp, xs, ys, dx, dy) + xdist = dist * dx + ydist = dist * dy + + # Generate four possible format strings for gtext + call sprintf (fmt1, SZ_LINE, "h=c;v=t;s=%.2f") + call pargr (sz_char) + call sprintf (fmt2, SZ_LINE, "h=c;v=b;s=%.2f") + call pargr (sz_char) + call sprintf (fmt3, SZ_LINE, "h=r;v=c;s=%.2f") + call pargr (sz_char) + call sprintf (fmt4, SZ_LINE, "h=l;v=c;s=%.2f") + call pargr (sz_char) + + # Draw inner and outer perimeter + kk = k[1] + do i = 1, 2 { + xspace = kk * xdist + yspace = kk * ydist + call gline (gp, xs - xspace, ys - yspace, xe + xspace, ys - yspace) + call gline (gp, xe + xspace, ys - yspace, xe + xspace, ye + yspace) + call gline (gp, xe + xspace, ye + yspace, xs - xspace, ye + yspace) + call gline (gp, xs - xspace, ye + yspace, xs - xspace, ys - yspace) + kk = k[2] + } + + # Now draw x axis tick marks, along both the bottom and top of + # the picture. First find the endpoint integer pixels. + + first_col = int (xs) + last_col = int (xe) + + # Determine increments of ticks and tick labels for x axis + cnt_step = 1 + cnt_label = 10 + if (last_col - first_col > 256) { + cnt_step = 10 + cnt_label = 100 + } else if (last_col - first_col < 26) { + cnt_step = 1 + cnt_label = 1 + } + + first_tick = first_col + bias = mod (first_tick, cnt_step) + last_tick = last_col + bias + + do i = first_tick, last_tick, cnt_step { + col = real (i - bias) + call gline (gp, col, ys - k[1] * ydist, col, ys - k[2] * ydist) + call gline (gp, col, ye + k[1] * ydist, col, ye + k[2] * ydist) + + if (mod ((i - bias), cnt_label) == 0) { + # Label tick mark; calculate number of characters needed + nchar = 3 + if (int (col) == 0) + nchar = 1 + if (int (col) >= 1000) + nchar = 4 + + dummy = itoc (int(col), label, nchar) + + # Position label slightly below outer perimeter. Seperation + # is twenty percent of a character width, in WCS. + label_pos = ys - (k[2] * ydist + (cw * 0.20 * dy)) + call gtext (gp, col, label_pos, label, fmt1) + + # Position label slightly above outer perimeter + label_pos = ye + (k[2] * ydist + (cw * 0.20 * dy)) + call gtext (gp, col, label_pos, label, fmt2) + } + } + + # Label the y axis tick marks along the left and right sides of the + # picture. First find the integer pixel endpoints. + + first_row = int (ys) + last_row = int (ye) + + # Determine increments of ticks and tick labels for y axis + cnt_step = 1 + cnt_label = 10 + if (last_row - first_row > 256) { + cnt_step = 10 + cnt_label = 100 + } else if (last_row - first_row < 26) { + cnt_step = 1 + cnt_label = 1 + } + + first_tick = first_row + bias = mod (first_tick, cnt_step) + last_tick = last_row + bias + + do i = first_tick, last_tick, cnt_step { + row = real (i - bias) + call gline (gp, xs - k[1] * xdist, row, xs - k[2] * xdist, row) + call gline (gp, xe + k[1] * xdist, row, xe + k[2] * xdist, row) + + if (mod ((i - bias), cnt_label) == 0) { + # Label tick mark; calculate number of characters needed + nchar = 3 + if (int (row) == 0) + nchar = 1 + else if (int (row) >= 1000) + nchar = 4 + + dummy = itoc (int(row), label, nchar) + + # Position label slightly to the left of outer perimeter. + # Separation twenty percent of a character width, in WCS. + label_pos = xs - (k[2] * xdist + (cw * 0.20 * dx)) + call gtext (gp, label_pos, row, label, fmt3) + + # Position label slightly to the right of outer perimeter + label_pos = xe + (k[2] * xdist + (cw * 0.20 * dx)) + call gtext (gp, label_pos, row, label, fmt4) + } + } +end diff --git a/pkg/plot/phistogram.par b/pkg/plot/phistogram.par new file mode 100644 index 00000000..1ff9c297 --- /dev/null +++ b/pkg/plot/phistogram.par @@ -0,0 +1,37 @@ +# PARAMETER FILE FOR PHISTOGRAM + +input,s,a,,,,The input data +z1,r,h,INDEF,,,Minimum histogram intensity +z2,r,h,INDEF,,,Maximum histogram intensity +binwidth,r,h,INDEF,,,Resolution of histogram in intensity units +nbins,i,h,512,1,,Number of bins in histogram +autoscale,b,h,yes,,,Adjust nbins and z2 for integer data? +top_closed,b,h,no,,,Include z2 in the top bin? +hist_type,s,h,"normal","normal|cumulative|difference|second_difference",,"Type of histogram" +listout,b,h,no,,,List instead of plot histogram? +title,s,h,"imtitle",,,Title for the plot +xlabel,s,h,"Data values",,,X-axis label +ylabel,s,h,"Counts",,,Y-axis label +wx1,r,h,INDEF,,,Left user x_coord if not autoscaling +wx2,r,h,INDEF,,,Right user x_coord if not autoscaling +wy1,r,h,0.0,,,Lower user y_coord if not autoscaling +wy2,r,h,INDEF,,,Right user y_coord if not autoscaling +logx,b,h,no,,,Log scale x-axis? +logy,b,h,yes,,,Log scale y-axis? +round,b,h,no,,,Round axes to nice values? +plot_type,s,h,"line","line|box|fullbox",,Type of vectors to plot +box,b,h,yes,,,Draw a box around periphery of window? +ticklabels,b,h,yes,,,Label the tick marks? +majrx,i,h,5,,,Number of major divisions along the X axis +minrx,i,h,5,,,Number of minor divisions along the X axis +majry,i,h,5,,,Number of major divisions along the Y axis +minry,i,h,5,,,Number of minor divisions along the Y axis +fill,b,h,yes,,,Fill viewport vs enforce unity aspect ratio +vx1,r,h,0.0,,,Left limit of device viewport (0.0:1.0) +vx2,r,h,1.0,,,Right limit of device viewport (0.0:1.0) +vy1,r,h,0.0,,,Lower limit of device viewport (0.0:1.0) +vy2,r,h,1.0,,,Upper limit of device viewport (0.0:1.0) +append,b,h,no,,,Append to an existing plot? +pattern,s,h,"solid","solid|dashed|dotted|dotdash",,Line pattern +device,s,h,"stdgraph",,,Output graphics device +mode,s,h,ql,,, diff --git a/pkg/plot/phistogram.x b/pkg/plot/phistogram.x new file mode 100644 index 00000000..cb112112 --- /dev/null +++ b/pkg/plot/phistogram.x @@ -0,0 +1,573 @@ +include <mach.h> +include <imhdr.h> +include <gset.h> + +define SZ_HISTBUF 512 +define SZ_CHOICE 18 + +define HIST_TYPES "|normal|cumulative|difference|second_difference|" +define NORMAL 1 +define CUMULATIVE 2 +define DIFFERENCE 3 +define SECOND_DIFF 4 + +define PLOT_TYPES "|line|box|fullbox|" +define LINE 1 +define BOX 2 +define FULLBOX 3 + +define PATTERN_TYPES "|solid|dashed|dotted|dotdash|" +define SOLID 1 +define DASHED 2 +define DOTTED 3 +define DOTDASH 4 + +define DEF_TITLE "imtitle" # define the default title +define SZ_TITLE 512 # plot title buffer + +# T_PHISTOGRAM -- Compute and plot the histogram of an image. + +procedure t_phistogram() + +int isimage, npix, nbins, nbins1, nlevels, nwide, z1i, z2i, i, hist_type +pointer im, tx, sp, hgm, hgmr, buf, input, str, v +real z1, z2, dz, z1temp, z2temp, zstart + +bool streq(), clgetb(), fp_equalr() +int clgeti(), clgwrd(), open(), ph_gdata(), imgnlr(), imgnli() +pointer immap() +real clgetr() +errchk immap() + +begin + call smark (sp) + call salloc (input, SZ_LINE, TY_CHAR) + call salloc (str, SZ_CHOICE, TY_CHAR) + call salloc (v, IM_MAXDIM, TY_LONG) + + # Get the image name. + call clgstr ("input", Memc[input], SZ_LINE) + if (streq (Memc[input], "STDIN")) { + isimage = NO + tx = open (Memc[input], READ_ONLY, TEXT_FILE) + npix = ph_gdata (tx, buf, SZ_HISTBUF) + } else { + iferr { + im = immap (Memc[input], READ_ONLY, 0) + } then { + isimage = NO + tx = open (Memc[input], READ_ONLY, TEXT_FILE) + npix = ph_gdata (tx, buf, SZ_HISTBUF) + } else { + isimage = YES + npix = IM_LEN(im,1) + call amovkl (long(1), Meml[v], IM_MAXDIM) + } + } + + # Get histogram range. + z1 = clgetr ("z1") + z2 = clgetr ("z2") + + if (IS_INDEFR(z1) || IS_INDEFR(z2)) { + if (isimage == NO) { + call alimr (Memr[buf], npix, z1temp, z2temp) + } else if (IM_LIMTIME(im) >= IM_MTIME(im)) { + z1temp = IM_MIN(im) + z2temp = IM_MAX(im) + } else { + call ph_imminmax (im, z1temp, z2temp) + } + if (IS_INDEFR(z1)) + z1 = z1temp + if (IS_INDEFR(z2)) + z2 = z2temp + } + + if (z1 > z2) { + dz = z1; z1 = z2; z2 = dz + } + + # Get the default histogram resolution. + dz = clgetr ("binwidth") + if (IS_INDEFR(dz)) { + nbins = clgeti ("nbins") + } else { + nbins = nint ((z2 - z1) / dz) + if ((z1 + nbins * dz) < z2) + nbins = nbins + 1 + z2 = z1 + nbins * dz + } + + # Set the integer defaults. + if (isimage == YES) { + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_USHORT, TY_INT, TY_LONG: + z1i = nint (z1) + z2i = nint (z2) + z1 = real (z1i) + z2 = real (z2i) + } + } + + + # Adjust the resolution of the histogram and/or the data range + # so that an integral number of data values map into each + # histogram bin (to avoid aliasing effects). + + if (isimage == YES && clgetb ("autoscale")) + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_USHORT, TY_INT, TY_LONG: + nlevels = z2i - z1i + nwide = max (1, nint (real (nlevels) / real (nbins))) + nbins = max (1, nint (real (nlevels) / real (nwide))) + z2i = z1i + nbins * nwide + z2 = real (z2i) + } + + # The extra bin counts the pixels that equal z2 and shifts the + # remaining bins to evenly cover the interval [z1,z2]. + # Real numbers could be handled better - perhaps adjust z2 + # upward by ~ EPSILONR (in ahgm itself). + + nbins1 = nbins + 1 + + # Initialize the histogram buffer and image line vector. + call salloc (hgm, nbins1, TY_INT) + call aclri (Memi[hgm], nbins1) + + # Read successive lines of the image and accumulate the histogram. + + if (isimage == NO) { + + # Test for NULL data range. + if (fp_equalr (z1, z2)) { + call eprintf ("Warning: File `%s' has no data range.\n") + call pargstr (Memc[input]) + call mfree (buf, TY_REAL) + call sfree (sp) + call close (tx) + return + } + + call ahgmr (Memr[buf], npix, Memi[hgm], nbins1, z1, z2) + + } else { + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_USHORT, TY_INT, TY_LONG: + + # Test for constant valued image. + if (z1i == z2i) { + call eprintf ("Warning: Image `%s' has no data range.\n") + call pargstr (Memc[input]) + call sfree (sp) + call imunmap (im) + return + } + + while (imgnli (im, buf, Meml[v]) != EOF) + call ahgmi (Memi[buf], npix, Memi[hgm], nbins1, z1i, z2i) + + default: + + # Test for constant valued image. + if (fp_equalr (z1, z2)) { + call eprintf ("Warning: Image `%s' has no data range.\n") + call pargstr (Memc[input]) + call sfree (sp) + call imunmap (im) + return + } + + while (imgnlr (im, buf, Meml[v]) != EOF) + call ahgmr (Memr[buf], npix, Memi[hgm], nbins1, z1, z2) + } + } + + # "Correct" the topmost bin for pixels that equal z2. Each + # histogram bin really wants to be half open. + + if (clgetb ("top_closed")) + Memi[hgm+nbins-1] = Memi[hgm+nbins-1] + Memi[hgm+nbins1-1] + dz = (z2 - z1) / real (nbins) + + hist_type = clgwrd ("hist_type", Memc[str], SZ_CHOICE, HIST_TYPES) + switch (hist_type) { + case NORMAL: + # do nothing + case CUMULATIVE: + call ph_acumi (Memi[hgm], Memi[hgm], nbins) + case DIFFERENCE: + call ph_amrgi (Memi[hgm], Memi[hgm], nbins) + z1 = z1 + dz / 2. + z2 = z2 - dz / 2. + nbins = nbins - 1 + case SECOND_DIFF: + call ph_amrgi (Memi[hgm], Memi[hgm], nbins) + call ph_amrgi (Memi[hgm], Memi[hgm], nbins-1) + z1 = z1 + dz + z2 = z2 - dz + nbins = nbins - 2 + default: + call error (0, "Unknown histogram type") + } + + # List or plot the histogram. In list format, the bin value is the + # z value of the left side (start) of the bin. + + if (clgetb ("listout")) { + + zstart = z1 + dz / 2.0 + do i = 1, nbins { + call printf ("%g %d\n") + call pargr (zstart) + call pargi (Memi[hgm+i-1]) + zstart = zstart + dz + } + + } else { + + # Convert the histogram to the correct data type for plotting + # and do the plot. + + call salloc (hgmr, nbins, TY_REAL) + call achtir (Memi[hgm], Memr[hgmr], nbins) + if (isimage == YES) + call ph_plot (Memr[hgmr], nbins, z1, z2, dz, hist_type, + Memc[input], IM_TITLE(im)) + else + call ph_plot (Memr[hgmr], nbins, z1, z2, dz, hist_type, + Memc[input], "") + } + + if (isimage == YES) { + call imunmap (im) + } else { + call mfree (buf, TY_REAL) + call close (tx) + } + call sfree (sp) +end + + +# PH_GDATA -- Read the data from a text file. + +int procedure ph_gdata (fd, data, sz_bufincr) + +int fd # input text file descriptor +pointer data # pointer to the ouput data array +int sz_bufincr # increment for data buffer size + +int szbuf, ndata +int fscan(), nscan() + +begin + # Get some buffer space. + call malloc (data, sz_bufincr, TY_REAL) + szbuf = sz_bufincr + + # Read the data. + ndata = 0 + while (fscan (fd) != EOF) { + call gargr (Memr[data+ndata]) + if (nscan() != 1) + next + ndata = ndata + 1 + if (ndata < szbuf) + next + szbuf = szbuf + sz_bufincr + call realloc (data, szbuf, TY_REAL) + } + + # Fit the buffer size to the data. + if (ndata > 0) + call realloc (data, ndata, TY_REAL) + + return (ndata) +end + + +# PH_PLOT -- Plot the histogram. + +procedure ph_plot (hgmr, nbins, z1, z2, dz, hist_type, hsource, hid) + +real hgmr[ARB] # the histogram values +int nbins # the number of bins in the histogram +real z1 # the lower limit of the histogram +real z2 # the upper limit of the histogram +real dz # the bin width of the histogram +int hist_type # the histogram type +char hsource[ARB] # source of the histogram data +char hid[ARB] # the id of the histogram + +pointer sp, title, xlabel, ylabel, device, str, gp +real hmin, hmax, wx1, wx2, wy1, wy2, vx1, vx2, vy1, vy2 +bool clgetb(), streq() +int clgwrd(), btoi(), clgeti() +pointer gopen() +real clgetr() + +begin + # Allocate working space. + call smark (sp) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (str, max (SZ_CHOICE, SZ_TITLE), TY_CHAR) + + call clgstr ("device", Memc[device], SZ_FNAME) + if (! clgetb ("append")) { + + # Open the graphics device. + gp = gopen (Memc[device], NEW_FILE, STDGRAPH) + + # Get the world coordinate system of the plot. + wx1 = clgetr ("wx1") + wx2 = clgetr ("wx2") + wy1 = clgetr ("wy1") + wy2 = clgetr ("wy2") + if (IS_INDEFR(wx1)) + wx1 = z1 + if (IS_INDEFR(wx2)) + wx2 = z2 + if (IS_INDEFR(wy1) || IS_INDEFR(wy2)) { + call alimr (hgmr, nbins, hmin, hmax) + if (IS_INDEFR(wy1)) + wy1 = 0.0 + if (IS_INDEFR(wy2)) + wy2 = hmax + } + call gswind (gp, wx1, wx2, wy1, wy2) + call gseti (gp, G_ROUND, btoi (clgetb ("round"))) + if (clgetb ("fill")) + call gsetr (gp, G_ASPECT, 0.0) + else + call gsetr (gp, G_ASPECT, 1.0) + + if (clgetb ("logx")) + call gseti (gp, G_XTRAN, GW_LOG) + else + call gseti (gp, G_XTRAN, GW_LINEAR) + if (clgetb ("logy")) + call gseti (gp, G_YTRAN, GW_LOG) + else + call gseti (gp, G_YTRAN, GW_LINEAR) + + # Set the view port. + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + call gsview (gp, vx1, vx2, vy1, vy2) + + # Draw the box around the plot and label the tick marks. + if (clgetb ("box")) { + + # Label the tick marks. + call gseti (gp, G_LABELTICKS, btoi (clgetb ("ticklabels"))) + + # Get the number of tick marks. + call gseti (gp, G_XNMAJOR, clgeti ("majrx")) + call gseti (gp, G_XNMINOR, clgeti ("minrx")) + call gseti (gp, G_YNMAJOR, clgeti ("majry")) + call gseti (gp, G_YNMINOR, clgeti ("minry")) + + # Allocate space for the labels and title. + call salloc (title, SZ_TITLE, TY_CHAR) + call salloc (xlabel, SZ_FNAME, TY_CHAR) + call salloc (ylabel, SZ_FNAME, TY_CHAR) + + # Format the x and y axis labels. + call clgstr ("xlabel", Memc[xlabel], SZ_FNAME) + call clgstr ("ylabel", Memc[ylabel], SZ_FNAME) + + # Format the plot title, starting with the system banner. + call clgstr ("title", Memc[title], SZ_TITLE) + if (streq (Memc[title], DEF_TITLE)) { + call sysid (Memc[str], SZ_TITLE) + call sprintf (Memc[title], SZ_TITLE, + "%s\n%s of %s %s\nFrom z1=%g to z2=%g, nbins=%d, width=%g") + call pargstr (Memc[str]) + switch (hist_type) { + case NORMAL: + call pargstr ("Histogram") + case CUMULATIVE: + call pargstr ("Cumulative histogram") + case DIFFERENCE: + call pargstr ("Difference histogram") + case SECOND_DIFF: + call pargstr ("Second difference histogram") + default: + call error (0, "Unknown histogram type") + } + call pargstr (hsource) + call pargstr (hid) + call pargr (z1) + call pargr (z2) + call pargi (nbins) + call pargr (dz) + } + + call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel]) + } + + } else + gp = gopen (Memc[device], APPEND, STDGRAPH) + + + # Set the vector pattern. + switch (clgwrd ("pattern", Memc[str], SZ_LINE, PATTERN_TYPES)) { + case SOLID: + call gseti (gp, G_PLTYPE, GL_SOLID) + case DASHED: + call gseti (gp, G_PLTYPE, GL_DASHED) + case DOTTED: + call gseti (gp, G_PLTYPE, GL_DOTTED) + case DOTDASH: + call gseti (gp, G_PLTYPE, GL_DOTDASH) + } + + # Draw the plot. Center the bins for plot_type=line. + switch (clgwrd ("plot_type", Memc[str], SZ_LINE, PLOT_TYPES)) { + case LINE: + call gvline (gp, hgmr, nbins, z1 + dz/2., z2 - dz/2.) + case BOX: + call ph_hgline (gp, hgmr, nbins, z1, z2) + case FULLBOX: + call ph_fhgline (gp, hgmr, nbins, z1, z2) + default: + call error (0, "Unknown histogram plot type") + } + + call gclose (gp) + call sfree (sp) +end + + +# PH_HGLINE -- Draw a stepped curve of the histogram data. + +procedure ph_hgline (gp, ydata, npts, x1, x2) + +pointer gp # Graphics descriptor +real ydata[ARB] # Y coordinates of the line endpoints +int npts # Number of line endpoints +real x1, x2 + +int pixel +real left, right, top, bottom, x, y, dx + +begin + call ggwind (gp, left, right, bottom, top) + + dx = (x2 - x1) / npts + + # Do the first vertical line. + call gamove (gp, x1, bottom) + call gadraw (gp, x1, ydata[1]) + + # Do the first horizontal line. + call gadraw (gp, x1 + dx, ydata[1]) + + # Draw the remaining horizontal lines. + do pixel = 2, npts { + x = x1 + dx * (pixel - 1) + y = ydata[pixel] + call gadraw (gp, x, y) + call gadraw (gp, x + dx, y) + } + + # Draw the last vertical line. + call gadraw (gp, x + dx, bottom) +end + + +# PH_FHGLINE -- Draw a stepped curve of the histogram data. + +procedure ph_fhgline (gp, ydata, npts, x1, x2) + +pointer gp # Graphics descriptor +real ydata[ARB] # Y coordinates of the line endpoints +int npts # Number of line endpoints +real x1, x2 + +int pixel +real left, right, top, bottom, x, y, dx + +begin + call ggwind (gp, left, right, bottom, top) + + dx = (x2 - x1) / npts + + # Do the first vertical line. + call gamove (gp, x1, bottom) + call gadraw (gp, x1, ydata[1]) + + # Do the first horizontal line. + call gadraw (gp, x1 + dx, ydata[1]) + + # Draw the remaining horizontal lines. + do pixel = 2, npts { + x = x1 + dx * (pixel - 1) + y = ydata[pixel] + call gadraw (gp, x, y) + call gamove (gp, x, bottom) + call gadraw (gp, x, y) + call gadraw (gp, x + dx, y) + } + + # Draw the last vertical line. + call gadraw (gp, x + dx, bottom) +end + + +# These two routines are intended to be generic vops routines. Only +# the integer versions are included since that's all that's used here. + +# <NOT IMPLEMENTED!> The operation is carried out in such a way that +# the result is the same whether or not the output vector overlaps +# (partially) the input vector. The routines WILL work in place! + +# PH_ACUMI -- Compute a cumulative vector (generic). Should b[1] be zero? + +procedure ph_acumi (a, b, npix) + +int a[ARB], b[ARB] +int npix, i + +# int npix, i, a_first, b_first + +begin +# call zlocva (a, a_first) +# call zlocva (b, b_first) +# +# if (b_first <= a_first) { + # Shouldn't use output arguments internally, + # but no reason to use this routine unsafely. + b[1] = a[1] + do i = 2, npix + b[i] = b[i-1] + a[i] +# } else { + # overlapping solution not implemented yet! +# } +end + + +# PH_AMRG -- Compute a marginal (forward difference) vector (generic). + +procedure ph_amrgi (a, b, npix) + +int a[ARB], b[ARB] +int npix, i + +# int npix, i, a_first, b_first + +begin +# call zlocva (a, a_first) +# call zlocva (b, b_first) +# +# if (b_first <= a_first) { + do i = 1, npix-1 + b[i] = a[i+1] - a[i] + b[npix] = 0 +# } else { + # overlapping solution not implemented yet! +# } +end diff --git a/pkg/plot/phminmax.x b/pkg/plot/phminmax.x new file mode 100644 index 00000000..ddfde8fe --- /dev/null +++ b/pkg/plot/phminmax.x @@ -0,0 +1,74 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +# PH_IMMINMAX -- Compute the minimum and maximum pixel values of an image. +# Works for images of any dimensionality, size, or datatype, although +# the min and max values can currently only be stored in the image header +# as real values. + +procedure ph_imminmax (im, min_value, max_value) + +pointer im # image descriptor +real min_value # minimum pixel value in image (out) +real max_value # maximum pixel value in image (out) + +pointer buf +bool first_line +long v[IM_MAXDIM] +short minval_s, maxval_s +long minval_l, maxval_l +real minval_r, maxval_r +int imgnls(), imgnll(), imgnlr() + +begin + call amovkl (long(1), v, IM_MAXDIM) # start vector + first_line = true + min_value = INDEF + max_value = INDEF + + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + while (imgnls (im, buf, v) != EOF) { + call alims (Mems[buf], IM_LEN(im,1), minval_s, maxval_s) + if (first_line) { + min_value = minval_s + max_value = maxval_s + first_line = false + } else { + if (minval_s < min_value) + min_value = minval_s + if (maxval_s > max_value) + max_value = maxval_s + } + } + case TY_USHORT, TY_INT, TY_LONG: + while (imgnll (im, buf, v) != EOF) { + call aliml (Meml[buf], IM_LEN(im,1), minval_l, maxval_l) + if (first_line) { + min_value = minval_l + max_value = maxval_l + first_line = false + } else { + if (minval_l < min_value) + min_value = minval_l + if (maxval_l > max_value) + max_value = maxval_l + } + } + default: + while (imgnlr (im, buf, v) != EOF) { + call alimr (Memr[buf], IM_LEN(im,1), minval_r, maxval_r) + if (first_line) { + min_value = minval_r + max_value = maxval_r + first_line = false + } else { + if (minval_r < min_value) + min_value = minval_r + if (maxval_r > max_value) + max_value = maxval_r + } + } + } +end diff --git a/pkg/plot/plot.cl b/pkg/plot/plot.cl new file mode 100644 index 00000000..13e54011 --- /dev/null +++ b/pkg/plot/plot.cl @@ -0,0 +1,41 @@ +#{ Plot package -- vector graphics utilities. + +package plot + +task implot, + gdevices, + graph, + prow, + prows, + pcol, + pcols, + phistogram, + pradprof, + pvector, + gkidir, + gkimosaic, + gkiextract.tb, + crtpict = "plot$x_plot.e" + +task contour, + surface, + hafton, + velvect = "plot$x_ncar.e" + +# Graphics Kernels. + +task stdgraph, + gkidecode, + $showcap = "plot$x_stdgraph.e" + +task stdplot, + sgikern, + sgidecode = "plot$x_sgikern.e" + +task imdkern = "plot$x_imdkern.e" + +task nsppkern = "plot$x_nsppkern.e" +task calcomp = "plot$x_calcomp.e" + + +clbye() diff --git a/pkg/plot/plot.hd b/pkg/plot/plot.hd new file mode 100644 index 00000000..74404cbd --- /dev/null +++ b/pkg/plot/plot.hd @@ -0,0 +1,33 @@ +# Help directory for the PLOT package. + +$doc = "plot$doc/" +$crtpict = "plot$crtpict/" + +calcomp hlp=doc$calcomp.hlp +contour hlp=doc$contour.hlp, src=t_contour.x +crtpict hlp=doc$crtpict.hlp, src=crtpict$t_crtpict.x +gdevices hlp=doc$gdevices.hlp, src=gdevices.x +gkidecode hlp=doc$gkidecode.hlp +gkidir hlp=doc$gkidir.hlp, src=t_gkidir.x +gkiextract hlp=doc$gkiextract.hlp, src=t_gkixt.x.x +gkimosaic hlp=doc$gkimosaic.hlp, src=t_gkimos.x +graph hlp=doc$graph.hlp, src=t_graph.x +hafton hlp=doc$hafton.hlp, src=t_hafton.x +imdkern hlp=doc$imdkern.hlp, src=gio$imdkern/idk.x +implot hlp=doc$implot.hlp, src=t_implot.x +nsppkern hlp=doc$nsppkern.hlp, src=gio$nsppkern/t_nsppkern.x +pcol hlp=doc$pcol.hlp, src=t_pcol.x +pcols hlp=doc$pcols.hlp, src=t_pcols.x +phistogram hlp=doc$phistogram.hlp, src=phistogram.x +pradprof hlp=doc$pradprof.hlp, src=t_pradprof.x +prow hlp=doc$prow.hlp, src=t_prow.x +prows hlp=doc$prows.hlp, src=t_prows.x +pvector hlp=doc$pvector.hlp, src=t_pvector.x +revisions sys=Revisions +sgidecode hlp=doc$sgidecode.hlp, src=gio$sgikern/t_sgideco.x +sgikern hlp=doc$sgikern.hlp, src=gio$sgikern/sgk.x +showcap hlp=doc$showcap.hlp +stdgraph hlp=doc$stdgraph.hlp +stdplot hlp=doc$stdplot.hlp +surface hlp=doc$surface.hlp, src=t_surface.x +velvect hlp=doc$velvect.hlp, src=t_velvect.x diff --git a/pkg/plot/plot.men b/pkg/plot/plot.men new file mode 100644 index 00000000..690145ee --- /dev/null +++ b/pkg/plot/plot.men @@ -0,0 +1,27 @@ + calcomp - Plot metacode on a Calcomp pen plotter + contour - Make a contour plot of an image + crtpict - Generate greyscale plots of IRAF images + gdevices - List available imaging or other graphics devices + gkidecode - Decode metacode on the standard output + gkidir - Directory listing of metacode file + gkiextract - Extract individual frames from metacode file + gkimosaic - Condense metacode frames to fit on one page + graph - Graph one or more image sections or lists + hafton - Generate half-tone plots of an image + imdkern - Image display device (IMD) graphics kernel + implot - Plot lines and columns of images using cursors + nsppkern - Plot metacode on a NSPP (NCAR) plotter device + pcol - Plot a column of an image + pcols - Plot the average of a range of image columns + phistogram - Plot or print the histogram of an image or list + pradprof - Plot or list the radial profile of a stellar object + prow - Plot a line (row) of an image + prows - Plot the average of a range of image lines + pvector - Plot an arbitrary vector in a 2D image + sgidecode - Decode an SGI format metacode file + sgikern - Simple graphics interface (SGI) graphics kernel + showcap - Show and decode graphcap entries + stdgraph - Plot metacode on the standard graphics device + stdplot - Plot metacode on the standard plotter device + surface - Make a surface plot of an image + velvect - Plot representation of a velocity field diff --git a/pkg/plot/plot.par b/pkg/plot/plot.par new file mode 100644 index 00000000..51960705 --- /dev/null +++ b/pkg/plot/plot.par @@ -0,0 +1 @@ +version,s,h,"25Mar84" diff --git a/pkg/plot/pltwcs.x b/pkg/plot/pltwcs.x new file mode 100644 index 00000000..f4bb4f44 --- /dev/null +++ b/pkg/plot/pltwcs.x @@ -0,0 +1,258 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mwset.h> + +# PLT_WCS -- Return WCS coordinate vector and label for the specified +# logical axis of an image. The transform pointer must be from logical +# coordinates to the desired final coordinates and opened with all +# axes selected. This routine supplies the appropriate image section +# element in the case of dimensional reduction and the specified value +# for the other image axes when evaluating coordinates. The label +# string is input with the system name in order to generate an appropriate +# label. + +procedure plt_wcs (im, mw, ct, axis, axvals, x1, x2, x, npts, label, format, + maxchar) + +pointer im # image descriptor +pointer mw # mwcs descriptor +pointer ct # coordinate descriptor +int axis # logical axis +real axvals[ARB] # axis values for nonselected logical axes +real x1 # starting logical pixel coordinate +real x2 # ending logical pixel coordinate +real x[ARB] # output vector +int npts # number of points +char label[ARB] # input system label, output coordinate label +char format[ARB] # output coordinate format +int maxchar # maximum characters in label and format + +int i, j, wcsdim, paxis, mw_stati() +real dx +pointer sp, axno, axval, xin, xout, str1, str2 +bool streq() +errchk mw_gwattrs + +begin + call smark (sp) + call salloc (axno, IM_MAXDIM, TY_INT) + call salloc (axval, IM_MAXDIM, TY_INT) + call salloc (xin, IM_MAXDIM, TY_REAL) + call salloc (xout, IM_MAXDIM, TY_REAL) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + call mw_seti (mw, MW_USEAXMAP, NO) + wcsdim = mw_stati (mw, MW_NDIM) + call mw_gaxmap (mw, Memi[axno], Memi[axval], wcsdim) + + paxis = 0 + do i = 1, wcsdim { + j = Memi[axno+i-1] + if (j == axis) + paxis = i + else if (j == 0) + Memr[xin+i-1] = 1 + else + Memr[xin+i-1] = axvals[j] + } + if (paxis == 0) { # Bug workaround + paxis = 1 + do i = 1, wcsdim { + j = i + if (j == axis) + paxis = i + else if (j == 0) + Memr[xin+i-1] = 1 + else + Memr[xin+i-1] = axvals[j] + } + } + + if (npts > 1) + dx = (x2 - x1) / (npts - 1) + + do i = 1, npts { + Memr[xin+paxis-1] = x1 + (i - 1) * dx + call mw_ctranr (ct, Memr[xin], Memr[xout], wcsdim) + x[i] = Memr[xout+paxis-1] + } + + # Set coordinate label + format[1] = EOS + if (streq (label, "logical")) { + if (axis == 1) + call strcpy ("Column (pixels)", label, maxchar) + else if (axis == 2) + call strcpy ("Line (pixels)", label, maxchar) + else + call strcpy ("Pixels", label, maxchar) + } else if (streq (label, "physical")) { + if (paxis == 1) + call strcpy ("Column (pixels)", label, maxchar) + else if (paxis == 2) + call strcpy ("Line (pixels)", label, maxchar) + else + call strcpy ("Pixels", label, maxchar) + } else { + label[1] = EOS + ifnoerr (call mw_gwattrs (mw,paxis,"label",Memc[str1],SZ_LINE)) { + ifnoerr (call mw_gwattrs (mw, paxis, "units", Memc[str2], + SZ_LINE)) { + call sprintf (label, maxchar, "%s (%s)") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + } else { + call sprintf (label, maxchar, "%s") + call pargstr (Memc[str1]) + } + } + + ifnoerr (call mw_gwattrs (mw,paxis,"format",Memc[str1],SZ_LINE)) + call strcpy (Memc[str1], format, maxchar) + } + + call sfree (sp) +end + + +# PLT_WCSCOORD -- Return 2D WCS coordinate + +procedure plt_wcscoord (im, mw, ct, wcs, format, col, line, value, str, maxchar) + +pointer im # image descriptor +pointer mw # mwcs descriptor +pointer ct # coordinate descriptor +char wcs[ARB] # WCS type +char format[ARB] # default format +int col # logical column +int line # logical line +real value # pixel value +char str[maxchar] # coordinate string +int maxchar # maximum length of coordinate string + +int i, j, k, wcsdim, mw_stati() +pointer sp, axno, axval, axis, xin, xout, fmt, temp +bool streq() +errchk mw_gwattrs + +begin + if (streq (wcs, "logical")) { + call sprintf (str, maxchar, "pixel=[%d,%d] value=%g\n") + call pargi (col) + call pargi (line) + call pargr (value) + return + } + + call smark (sp) + call salloc (axno, IM_MAXDIM, TY_INT) + call salloc (axval, IM_MAXDIM, TY_INT) + call salloc (axis, IM_MAXDIM, TY_INT) + call salloc (xin, IM_MAXDIM, TY_REAL) + call salloc (xout, IM_MAXDIM, TY_REAL) + call salloc (fmt, SZ_FNAME, TY_CHAR) + call salloc (temp, SZ_FNAME, TY_CHAR) + call aclri (Memi[axis], IM_MAXDIM) + + # Map the logical to physical coordinates + call mw_seti (mw, MW_USEAXMAP, NO) + wcsdim = mw_stati (mw, MW_NDIM) + call mw_gaxmap (mw, Memi[axno], Memi[axval], wcsdim) + + k = 0 + do i = 1, wcsdim { + j = Memi[axno+i-1] + if (j != 0) { + Memi[axis+k] = i + k = k + 1 + } + if (j == 1) + Memr[xin+i-1] = col + else if (j == 2) + Memr[xin+i-1] = line + else + Memr[xin+i-1] = 1 + } + if (k == 0) { # Bug workaround + do i = 1, wcsdim { + Memi[axno+i-1] = i + j = Memi[axno+i-1] + if (j != 0) { + Memi[axis+k] = i + k = k + 1 + } + if (j == 1) + Memr[xin+i-1] = col + else if (j == 2) + Memr[xin+i-1] = line + else + Memr[xin+i-1] = 1 + } + } + + # Do the coordinate transform + call mw_ctranr (ct, Memr[xin], Memr[xout], wcsdim) + + # Print the coordinates and data value using appropriate formats + j = Memi[axis] + k = Memi[axis+1] + if (k == 0) + k = mod (j, 2) + 1 + i = min (j, k) + j = max (j, k) + if (streq (wcs, "physical")) { + call sprintf (str, maxchar, + "pixel=[%d,%d], physical=[%d,%d], value=%g\n") + call pargi (col) + call pargi (line) + call pargi (nint (Memr[xout+i-1])) + call pargi (nint (Memr[xout+j-1])) + call pargr (value) + } else { + call sprintf (str, maxchar, "pixel=[%d,%d], world=[") + call pargi (col) + call pargi (line) + + call strcpy (format, Memc[fmt], SZ_FNAME) + if (Memc[fmt] == EOS) + iferr (call mw_gwattrs (mw,i,"format",Memc[fmt],SZ_FNAME)) + call strcpy ("%g", Memc[fmt], SZ_FNAME) + call sprintf (Memc[temp], SZ_FNAME, Memc[fmt]) + call pargr (Memr[xout+i-1]) + call strcat (Memc[temp], str, maxchar) + call strcat (",", str, maxchar) + call strcpy (format, Memc[fmt], SZ_FNAME) + if (Memc[fmt] == EOS) + iferr (call mw_gwattrs (mw,j,"format",Memc[fmt],SZ_FNAME)) + call strcpy ("%g", Memc[fmt], SZ_FNAME) + call sprintf (Memc[temp], SZ_FNAME, Memc[fmt]) + call pargr (Memr[xout+j-1]) + call strcat (Memc[temp], str, maxchar) + + call sprintf (Memc[temp], SZ_FNAME, "] value=%g\n") + call pargr (value) + call strcat (Memc[temp], str, maxchar) + } + + call sfree (sp) +end + + +# PLT_IFORMATR -- Determine the inverse formatted real value +# This temporary routine is used to account for scaling of the H and M formats. + +real procedure plt_iformatr (value, format) + +real value # Value to be inverse formated +char format[ARB] # Format + +int strldxs() + +begin + if (strldxs ("HM", format) > 0) + return (value * 15.) + else + return (value) +end diff --git a/pkg/plot/pradprof.par b/pkg/plot/pradprof.par new file mode 100644 index 00000000..ef2d533a --- /dev/null +++ b/pkg/plot/pradprof.par @@ -0,0 +1,35 @@ +input,s,a,,,,"Images or list to be profiled" +xinit,r,a,,,,"Initial x position of profile" +yinit,r,a,,,,"Initial y position of profile" +radius,r,h,11.0,1.5,,"The profile radius in pixels" +az1,r,h,0.,,,"Starting azimuth (deg)" +az2,r,h,360.,,,"Ending azimuth (deg)" +center,b,h,yes,,,"Center the profile?" +cboxsize,i,h,5,3,,"The centering box width in pixels" +list,b,h,no,,,"List instead of plot profile?" +graphics,s,h,"stdgraph",,,"The graphics device" +append,b,h,no,,,"Append to an existing graph?" +title,s,h,"imtitle",,,"Plot title" +xlabel,s,h,"Radius",,,"X-axis label" +ylabel,s,h,"Intensity",,,"Y-axis label" +wx1,r,h,INDEF,,,"X-axis window limit" +wx2,r,h,INDEF,,,"X-axis window limit" +wy1,r,h,INDEF,,,"Y-axis window limit" +wy2,r,h,INDEF,,,"Y-axis window limit" +round,b,h,no,,,"Round axes to nice values?" +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?" +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" +ticklabels,b,h,yes,,,"Label tick marks?" +fill,b,h,yes,,,"Fill viewport vs enforce unity aspect ratio?" +vx1,r,h,0.0,,,"Left limit of device viewport (0.0:1.0)" +vx2,r,h,1.0,,,"Right limit of device viewport (0.0:1.0)" +vy1,r,h,0.0,,,"Lower limit of device viewport (0.0:1.0)" +vy2,r,h,1.0,,,"Upper limit of device viewport (0.0:1.0)" +pointmode,b,h,yes,,,"Plot points instead of lines?" +marker,s,h,"plus",,,"Point marker character" +szmarker,r,h,1.,,,"Marker size" diff --git a/pkg/plot/prow.par b/pkg/plot/prow.par new file mode 100644 index 00000000..a83af044 --- /dev/null +++ b/pkg/plot/prow.par @@ -0,0 +1,28 @@ +image,s,a,,,,image containing row to be plotted +row,i,a,,1,,row to be plotted +wcs,s,h,"logical",,,world coordinate system +wx1,r,h,0.,,,left user x-coord +wx2,r,h,0.,,,right user x-coord +wy1,r,h,0.,,,lower user y-coord +wy2,r,h,0.,,,upper user y-coord +pointmode,b,h,no,,,plot points instead of lines +marker,s,h,"box",,,point marker or line mode +szmarker,r,h,5E-3,,,marker size (0 for list input) +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +xlabel,s,h,"wcslabel",,,x-axis label +ylabel,s,h,"",,,y-axis label +title,s,h,"imtitle",,,title for plot +xformat,s,h,"wcsformat",,,x-axis coordinate format +vx1,r,h,0.,,,left limit of device window (ndc coords) +vx2,r,h,0.,,,right limit of device window (ndc coords) +vy1,r,h,0.,,,bottom limit of device window (ndc coords) +vy2,r,h,0.,,,upper limit of device window (ndc coords) +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,yes,,,fill device viewport regardless of aspect ratio? +append,b,h,no,,,append to existing plot +device,s,h,"stdgraph",,,output device diff --git a/pkg/plot/prows.par b/pkg/plot/prows.par new file mode 100644 index 00000000..61b1c6a9 --- /dev/null +++ b/pkg/plot/prows.par @@ -0,0 +1,29 @@ +image,s,a,,,,image containing rows to be plotted +row1,i,a,,1,,first row to average +row2,i,a,,1,,last row to average +wcs,s,h,"logical",,,world coordinate system +wx1,r,h,0.,,,left user x-coord if not autoscaling +wx2,r,h,0.,,,right user x-coord if not autoscaling +wy1,r,h,0.,,,lower user y-coord if not autoscaling +wy2,r,h,0.,,,upper user y-coord if not autoscaling +pointmode,b,h,no,,,plot points instead of lines +marker,s,h,"box",,,point marker or line mode +szmarker,r,h,5E-3,,,marker size (0 for list input) +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +xlabel,s,h,"wcslabel",,,x-axis label +ylabel,s,h,"",,,y-axis label +title,s,h,"imtitle",,,title for plot +xformat,s,h,"wcsformat",,,x-axis coordinate format +vx1,r,h,0.,,,left limit of device window (ndc coords) +vx2,r,h,0.,,,right limit of device window (ndc coords) +vy1,r,h,0.,,,bottom limit of device window (ndc coords) +vy2,r,h,0.,,,upper limit of device window (ndc coords) +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,yes,,,fill device viewport regardless of aspect ratio? +append,b,h,no,,,append to existing plot +device,s,h,"stdgraph",,,output device diff --git a/pkg/plot/pvector.par b/pkg/plot/pvector.par new file mode 100644 index 00000000..99d60817 --- /dev/null +++ b/pkg/plot/pvector.par @@ -0,0 +1,39 @@ +image,s,a,,,,image containing vector to be plotted +x1,r,a,,1.,,x-coord of first point +y1,r,a,,1.,,y-coord of first point +x2,r,a,,1.,,x-coord of second point +y2,r,a,,1.,,y-coord of second point +xc,r,a,,,,x-coord of center point +yc,r,a,,,,y-coord of center point +width,i,h,1,1,,width of strip +theta,r,h,INDEF,0.,360.,angle of vector (ccw from +x axis) +length,r,h,INDEF,,,length of vector in theta mode +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 +vec_output,s,h,"",,,file or image name if output vector is desired +out_type,s,h,"text","text|image",,type of output format (image|text) +wx1,r,h,0.,,,left user x-coord if not autoscaling +wx2,r,h,0.,,,right user x-coord if not autoscaling +wy1,r,h,0.,,,lower user y-coord if not autoscaling +wy2,r,h,0.,,,upper user y-coord if not autoscaling +pointmode,b,h,no,,,plot points instead of lines +marker,s,h,"box",,,point marker or line mode +szmarker,r,h,5E-3,,,marker size (0 for list input) +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +xlabel,s,h,"",,,x-axis label +ylabel,s,h,"",,,y-axis label +title,s,h,"imtitle",,,title for plot +vx1,r,h,0.,,,left limit of device window (ndc coords) +vx2,r,h,0.,,,right limit of device window (ndc coords) +vy1,r,h,0.,,,bottom limit of device window (ndc coords) +vy2,r,h,0.,,,upper limit of device window (ndc coords) +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,yes,,,fill device viewport regardless of aspect ratio? +append,b,h,no,,,append to existing plot +device,s,h,"stdgraph",,,output device +mode,s,h,'ql' diff --git a/pkg/plot/sgidecode.par b/pkg/plot/sgidecode.par new file mode 100644 index 00000000..12900077 --- /dev/null +++ b/pkg/plot/sgidecode.par @@ -0,0 +1,4 @@ +input,s,a,,,,input metacode file +generic,b,h,no,,,ignore remaining kernel dependent parameters +verbose,b,h,no,,,"print elements of polylines, cell arrays, etc." +gkiunits,b,h,no,,,print coordinates in GKI rather than NDC units diff --git a/pkg/plot/sgikern.par b/pkg/plot/sgikern.par new file mode 100644 index 00000000..8f11f7ec --- /dev/null +++ b/pkg/plot/sgikern.par @@ -0,0 +1,6 @@ +input,s,a,,,,input metacode file +device,s,h,"stdplot",,,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 diff --git a/pkg/plot/stdgraph.par b/pkg/plot/stdgraph.par new file mode 100644 index 00000000..a14ea447 --- /dev/null +++ b/pkg/plot/stdgraph.par @@ -0,0 +1,9 @@ +input,s,a,,,,input metacode file +device,s,h,"stdgraph",,,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 +xres,i,h,0,,,number of points of resolution in x +yres,i,h,0,,,number of points of resolution in y diff --git a/pkg/plot/stdplot.par b/pkg/plot/stdplot.par new file mode 100644 index 00000000..8f11f7ec --- /dev/null +++ b/pkg/plot/stdplot.par @@ -0,0 +1,6 @@ +input,s,a,,,,input metacode file +device,s,h,"stdplot",,,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 diff --git a/pkg/plot/surface.par b/pkg/plot/surface.par new file mode 100644 index 00000000..b8449696 --- /dev/null +++ b/pkg/plot/surface.par @@ -0,0 +1,13 @@ +image,s,a,,,,image or image section to be plotted +floor,r,h,INDEF,,,minimum value to be plotted (INDEF for min) +ceiling,r,h,INDEF,,,maximum value to be plotted (INDEF for max) +angh,r,h,-33.0,,,"horizontal viewing angle, degrees" +angv,r,h,25.0,,,"vertical viewing angle, degrees" +device,s,h,stdgraph,,,output device +title,s,h,"imtitle",,,optional title +label,b,h,no,,,label corner points of plot +preserve,b,h,yes,,,preserve aspect ratio when decreasing resolution? +xres,i,h,64,,,number of pixels resolution in x +yres,i,h,64,,,number of pixels resolution in y +subsample,b,h,no,,,subsample (vs block average) to reduce resolution? +append,b,h,no,,,append to an old plot diff --git a/pkg/plot/t_contour.x b/pkg/plot/t_contour.x new file mode 100644 index 00000000..4e0c299e --- /dev/null +++ b/pkg/plot/t_contour.x @@ -0,0 +1,255 @@ +include <error.h> +include <gset.h> +include <config.h> +include <mach.h> +include <imhdr.h> +include <xwhen.h> +include <fset.h> + +define DUMMY 6 + +# T_CONTOUR -- Draw a contour map of a function of two variables. This is an +# interface to the NCAR CONREC routine. Rewritten 8/85 to utilize the NCAR +# GKS based utilities. User has control over device viewport, labelling +# perimeter drawing. This routine also automatically subsamples or block +# averages to the user specified resolution. + +procedure t_contour() + +bool perimeter, fill, pre, sub +char imsect[SZ_FNAME], label[SZ_LINE] +char device[SZ_FNAME], title[SZ_LINE], system_id[SZ_LINE] + +pointer im, subras +int xres, yres, nx, ny +int tcojmp[LEN_JUMPBUF] +int ncols, nlines, epa, status, wkid +int nset, ncontours, dashpat, mode, nhi, old_onint +real interval, floor, ceiling, zero, finc, ybot +real vx1, vx2, vy1, vy2, wx1, wx2, wy1, wy2 +real xs, xe, ys, ye, dmin, dmax + +real clgetr() +pointer gp, gopen() +extern tco_onint() +int clgeti(), btoi() +bool clgetb(), streq(), fp_equalr() +pointer immap(), plt_getdata() +common /tcocom/ tcojmp + +int ioffm, isolid, nla, nlm +real xlt, ybt, side, ext, hold[5] +int isizel, isizem, isizep, nrep, ncrt, ilab, nulbll, ioffd +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 + # First of all, intialize conrec's block data before altering any + # parameters in common. + + first = 1 + call conbd() + + # Get image section string and output device. + call clgstr ("image", imsect, SZ_FNAME) + call clgstr ("device", device, SZ_FNAME) + + zero = clgetr ("zero") + floor = clgetr ("floor") + ceiling = clgetr ("ceiling") + nhi = clgeti ("nhi") + dashpat = clgeti ("dashpat") + call clgstr ("title", title, SZ_LINE) + + # The user can suppress the contour labelling by setting the common + # parameter "ilab" to zero. + + ilab = btoi (clgetb ("label")) + + # 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 = clgeti ("ncontours") + if (ncontours <= 0) { + interval = clgetr ("interval") + if (interval <= 0) + finc = 0 + else + finc = interval + } else + finc = - abs (ncontours) + + mode = NEW_FILE + if (clgetb ("append")) + mode = APPEND + + xres = clgeti ("xres") + yres = clgeti ("yres") + sub = clgetb ("subsample") + pre = clgetb ("preserve") + + # Map image. Retrieve values from header that will be needed. + im = immap (imsect, READ_ONLY, 0) + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + if (streq (title, "imtitle")) { + call strcpy (imsect, title, SZ_LINE) + call strcat (": ", title, SZ_LINE) + call strcat (IM_TITLE(im), title, SZ_LINE) + } + + xs = 1.0 + xe = real (ncols) + ys = 1.0 + ye = real (nlines) + + # Get data with proper resolution. Procedure plt_getdata returns + # a pointer to the data matrix to be contoured. The resolution + # is decreased by the specified mathod in this procedure. The + # dimensions of the data array are also returned. The image + # header pointer can be unmapped after plt_getdata is called. + + nx = 0 + ny = 0 + subras = plt_getdata (im, sub, pre, xres, yres, nx, ny) + call imunmap (im) + + call alimr (Memr[subras], nx*ny, dmin, dmax) + if (fp_equalr (dmin, dmax)) + call error (1, "constant valued array, no plot drawn") + + if (fp_equalr (floor, INDEF)) + floor = dmin + if (fp_equalr (ceiling, INDEF)) + ceiling = dmax + + # The floor and ceiling are in absolute units, but the zero shift is + # applied first, so correct the numbers for the zero shift. + + floor = floor - zero + ceiling = ceiling - zero + + # Apply the zero point shift. + if (abs (zero) > EPSILON) + call asubkr (Memr[subras], zero, Memr[subras], nx * ny) + + # Open device and make contour plot. + call gopks (STDERR) + wkid = 1 + gp = gopen (device, mode, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + # The viewport can be set by the user. If not, the viewport is + # assumed to be centered on the device. In either case, the + # viewport to window mapping is established in pl_map_viewport + # and conrec's automatic mapping scheme is avoided by setting nset=1. + + perimeter = clgetb ("perimeter") + + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + fill = clgetb ("fill") + call pl_map_viewport (gp, nx, ny, vx1, vx2, vy1, vy2, fill, perimeter) + nset = 1 + +# if (perimeter) { +# # Suppress conrec's plot label generation. +# ioffm = 1 +# } else { +# # Draw plain old conrec perimeter, set ioffm = 0 to enable label. +# ioffm = 0 +# nset = -1 +# call perim (nx - 1, 1, ny - 1, 1) +# } + + # If perimeter drawing is disabled don't draw NCAR perimeter, disable + # perimeter drawing entirely. + + ioffm = 1 + + # Install interrupt exception handler. + call zlocpr (tco_onint, epa) + call xwhen (X_INT, epa, old_onint) + + # Make the contour plot. If an interrupt occurs ZSVJMP is reentered + # with an error status. + + call zsvjmp (tcojmp, status) + if (status == OK) { + call conrec (Memr[subras], nx, nx, ny, floor, ceiling, finc, nset, + nhi, -dashpat) + } else { + call gcancel (gp) + call fseti (STDOUT, F_CANCEL, OK) + } + + # Now find window and output text string title. The window is + # set to the full image coordinates for labelling. + + if (perimeter) { + call gswind (gp, xs, xe, ys, ye) + call draw_perimeter (gp) + + call ggview (gp, wx1, wx2, wy1, wy2) + call gseti (gp, G_WCS, 0) + ybot = min (wy2 + .06, 0.99) + call gtext (gp, (wx1 + wx2) / 2.0, ybot, title, "h=c;v=t;f=b;s=.7") + + # Add system id banner to plot. + call gseti (gp, G_CLIP, NO) + call sysid (system_id, SZ_LINE) + ybot = max (wy1 - 0.08, 0.01) + call gtext (gp, (wx1+wx2)/2.0, ybot, system_id, "h=c;v=b;s=.5") + + if (fp_equalr (hold(5), 1.0)) { + call sprintf (label, SZ_LINE, + "contoured from %g to %g, interval = %g") + call pargr (hold(1)) + call pargr (hold(2)) + call pargr (hold(3)) + } else { + call sprintf (label, SZ_LINE, + "contoured from %g to %g, interval = %g, labels scaled by %g") + call pargr (hold(1)) + call pargr (hold(2)) + call pargr (hold(3)) + call pargr (hold(5)) + } + ybot = max (wy1 - 0.06, .03) + call gtext (gp, (wx1 + wx2) / 2.0, ybot, label, "h=c;v=b;s=.6") + } + + call gswind (gp, xs, xe, ys, ye) + call gamove (gp, xe, ye) + + call gdawk (wkid) + call gclwk (wkid) + call gclks () + + call mfree (subras, TY_REAL) +end + + +# TCO_ONINT -- Interrupt handler for the task contour. Branches back to ZSVJMP +# in the main routine to permit shutdown without an error message. + +procedure tco_onint (vex, next_handler) + +int vex # virtual exception +int next_handler # not used + +int tcojmp[LEN_JUMPBUF] +common /tcocom/ tcojmp + +begin + call xer_reset() + call zdojmp (tcojmp, vex) +end diff --git a/pkg/plot/t_gkidir.x b/pkg/plot/t_gkidir.x new file mode 100644 index 00000000..dd9e8303 --- /dev/null +++ b/pkg/plot/t_gkidir.x @@ -0,0 +1,128 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> + +define I_OPCODE Mems[$1+GKI_HDR_OPCODE-1] +define WS_MODE Mems[$1+GKI_OPENWS_M - 1] +define SZ_TEXT (5 * SZ_LINE) + +# T_GKIDIR -- print a directory of frames in the named GKI metacode files. + +procedure t_gkidir () + +pointer sp, mc_fname +int list, mfd +int clpopni(), open(), clgfil() + +begin + call smark (sp) + call salloc (mc_fname, SZ_FNAME, TY_CHAR) + + list = clpopni ("input") + while (clgfil (list, Memc[mc_fname], SZ_FNAME) != EOF) { + mfd = open (Memc[mc_fname], READ_ONLY, BINARY_FILE) + call printf ("\nMETAFILE '%s':\n") + call pargstr (Memc[mc_fname]) + call gkd_read_metacode (mfd) + call close (mfd) + } + + call clpcls (list) + call sfree (sp) +end + + +# GKD_READ_METACODE -- reads through a metacode file, printing a directory of +# the size and title of each frame in the file. + +procedure gkd_read_metacode (mf) + +int mf # Metacode file descriptor + +bool new_frame +char tx_string[SZ_TEXT+1] +pointer gki +int nframe, length, mc_length, seek_text +int nchars, nchars_max, op_code +int gki_fetch_next_instruction() + +errchk gki_fetch_next_instruction + +begin + nframe = 0 + mc_length = 0 + new_frame = false + + repeat { + length = gki_fetch_next_instruction (mf, gki) + if (length == EOF) + break + + op_code = I_OPCODE (gki) + + if ((op_code == GKI_OPENWS && WS_MODE(gki) == NEW_FILE) || + (op_code == GKI_CLEAR)) { + # New frame encountered, marks end of previous frame. + + if (new_frame) { + # Last instruction was also a new frame. Just bump length. + mc_length = mc_length + length + next + } else + new_frame = true + + if (nframe > 0) + call gkd_print_directory (nframe, mc_length, tx_string) + + nframe = nframe + 1 + mc_length = length + nchars_max = 0 + call strcpy ("(no title)", tx_string, SZ_LINE) + seek_text = YES + + } else { + new_frame = false + mc_length = mc_length + length + } + + if (op_code == GKI_MFTITLE) { + # No need to look at gtext commands any more - found a title. + seek_text = NO + nchars_max = min (int(Mems[gki+GKI_MFTITLE_N-1]), SZ_TEXT) + call achtsc (Mems[gki+GKI_MFTITLE_T-1], tx_string, nchars_max) + tx_string[nchars_max+1] = EOS + } + + if (op_code == GKI_TEXT && seek_text == YES) { + # If this is longest string so far, save it as title. + nchars = Mems[gki + GKI_TEXT_N - 1] + if (nchars > nchars_max) { + nchars_max = min (nchars, SZ_TEXT) + call achtsc (Mems[gki+GKI_TEXT_T-1], tx_string, nchars_max) + tx_string[nchars_max+1] = EOS + } + } + } + + # Print information from last frame in index, unless last frame is + # only a clear instruction. + + if (mc_length > GKI_CLEAR_LEN) + call gkd_print_directory (nframe, mc_length, tx_string) +end + + +# GKD_PRINT_DIRECTORY -- Print directory information of metacode frame. + +procedure gkd_print_directory (nframe, size, title) + +int nframe # Frame number +int size # Length of metacode file +char title[ARB] # Metacode title + +begin + call printf (" [%d] (%d words) %26t%s\n") + call pargi (nframe) + call pargi (size) + call pargstr (title) +end diff --git a/pkg/plot/t_gkimos.x b/pkg/plot/t_gkimos.x new file mode 100644 index 00000000..545f7109 --- /dev/null +++ b/pkg/plot/t_gkimos.x @@ -0,0 +1,1067 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <fset.h> +include <gio.h> +include <gki.h> +include <gset.h> +include <math.h> +include <mach.h> + +define END_OF_MC -10 +define QUIT -11 +define SZ_COMMAND 10 +define NEW_FRAME -1 +define SZ_MATCH 3 +define NPAIRS 2 + +define cursor_loop_ 91 + +define LEN_DEFIBUF 2048 +define ONEWORD SZ_SHORT +define TWOWORDS (2*SZ_SHORT) +define MAX_RANGES 100 +define MAX_FRAMES 500 +define I_BOI Mems[$1+GKI_HDR_BOI-1] +define I_OPCODE Mems[$1+GKI_HDR_OPCODE-1] +define I_LENGTH Mems[$1+GKI_HDR_LENGTH-1] +define I_DATA Mems[$1+GKI_DATAFIELDS-1] +define WS_MODE Mems[$1+GKI_OPENWS_M - 1] +define KEY "lib$scr/gkimosaic.key" +define PROMPT "Gkimosaic Options" + +# T_GKIMOSAIC -- Plot multiple metacode frames on a single output page. +# Input is read from either STDIN or a metacode file; output can be +# sent directly to a named device or a metacode file. The number of +# plots in both x and y is set by the user. + +procedure t_gkimosaic () + +pointer sp, device, output, input, vp, ip, wcs +bool fill, rotate, clear_screen +int in, nx, ny, inlist, out, interactive, nwcs, buflen +int nplots_page, index, lastp, nplot, nfiles, nf, pcounter +long fpos, length_mc +bool clgetb(), streq() +int open(), clgeti(), clpopni(), clgfil(), btoi(), fstati(), gm_interact() +int clplen() +long gm_rwframe() + + +begin + call smark (sp) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (wcs, LEN_WCSARRAY, TY_STRUCT) + + call gm_initwcs (wcs) + + # Determine characteristics of input and output; open graphics + inlist = clpopni ("input") + call clgstr ("output", Memc[output], SZ_FNAME) + if (Memc[output] == EOS) + call strcpy ("STDGRAPH", Memc[output], SZ_FNAME) + + out = open (Memc[output], APPEND, BINARY_FILE) + + call clgstr ("device", Memc[device], SZ_FNAME) + if (streq (Memc[device], "stdgraph")) { + if (out != STDGRAPH || fstati (STDGRAPH, F_REDIR) == YES) + interactive = NO + else + interactive = btoi (clgetb ("interactive")) + } else + interactive = NO + + call gki_init (out) + call gki_openws (out, Memc[device], NEW_FILE) + + # Get remaining cl parameters + nx = max (1, clgeti ("nx")) + ny = max (1, clgeti ("ny")) + nplots_page = nx * ny + fill = clgetb ("fill") + rotate = clgetb ("rotate") + + # Calculate initial viewport corner points and store in array vp. + call malloc (vp, nplots_page * 4, TY_REAL) + call gm_getvp (vp, nx, ny, fill) + + # Initialize flag for clearing screen and plot and file counters. + nplot = 1 + clear_screen = false + nwcs = 0 + nfiles = clplen (inlist) + nf = 0 + pcounter = 0 + + # Main processing loop begins here + while (clgfil (inlist, Memc[input], SZ_FNAME) != EOF) { + iferr { + fpos = 1 + nf = nf + 1 + in = open (Memc[input], READ_ONLY, BINARY_FILE) + } then { + call erract (EA_WARN) + next + } + + # Initialize memory and plot counters for maintaining index + buflen = MAX_FRAMES + call calloc (ip, buflen, TY_LONG) + Meml[ip] = long (fpos) + lastp = 0 + + repeat { + if (clear_screen && pcounter > 0) { + # Next plot will be first on page. Attend to any cursor + # commands before clearing screen. Put out accumulated + # SETWCS instruction before reading cursor. + +cursor_loop_ call gki_setwcs (out, Memi[wcs], LEN_WCSARRAY) + + if (interactive == YES) { + call gki_flush (out) + if (gm_interact (in, out, ip, vp, fpos, lastp, nx, ny, + rotate) == QUIT) + break + nplots_page = nx * ny + } + + nplot = 1 + nwcs = 0 + pcounter = 0 + call gm_initwcs (wcs) + + # Don't want to clear screen if there is no more + # data to be plotted. + if (nf == nfiles && fpos == EOF) + break + + call gki_clear (out) + } + + index = (nplot - 1) * 4 + length_mc = gm_rwframe (in, out, Memr[vp+index], rotate, + wcs, nwcs) + + if (length_mc == EOF) { + fpos = EOF + if (nf == nfiles && pcounter > 0) + # Last file in list; bring up cursor + goto cursor_loop_ + else + # Go on to next file in list + break + } + + lastp = lastp + 1 + nplot = nplot + 1 + pcounter = pcounter + 1 + + if (nplots_page == 1 || mod (nplot, nplots_page) == 1) + clear_screen = true + else + clear_screen = false + + if (length_mc == END_OF_MC) + fpos = EOF + + else { + # Positioned at beginning of another plot. See if + # index buffer needs to be extended. + + if (lastp > buflen) { + buflen = buflen + MAX_FRAMES + call realloc (ip, buflen, TY_LONG) + } + + fpos = fpos + length_mc + Meml[ip+lastp] = fpos + } + } + + call close (in) + call mfree (ip, TY_LONG) + } + + call mfree (vp, TY_REAL) + call gki_flush (out) + call gki_closews (out, Memc[device]) + call close (out) + call clpcls (inlist) + + call sfree (sp) +end + + +# GM_INTERACT -- respond to user's interactive cursor commands. The values +# of nx, ny, rotate and fill can change, requiring the vp array to be +# modified. The metacode file can also be repositioned here, and the +# index of frame positions is modified accordingly. A value of QUIT or +# OK is returned. + +int procedure gm_interact (in, out, ip, vp, fpos, lastp, nx, ny, rotate) + +int in # File descriptor for input metacode file +int out # File descriptor for output graphics stream +pointer ip # Pointer to index +pointer vp # Pointre to viewport array +int fpos +int lastp +int nx, ny # The number of plots in x and y +bool rotate # Rotate plots (y/n)? + +pointer sp, bp +bool fill +int nskip, new_vport, junk, key, cval, nxold, nyold +real wx, wy +int clgcur() + +begin + call smark (sp) + call salloc (bp, SZ_COMMAND, TY_CHAR) + nskip = 0 + new_vport = NO + + nxold = nx + nyold = ny + + repeat { + cval = clgcur ("cursor", wx, wy, junk, key, Memc[bp], SZ_LINE) + if (cval == EOF) { + call sfree (sp) + return (QUIT) + } + + switch (key) { + case 'q': + call sfree (sp) + return (QUIT) + case ':': + call gm_colon (Memc[bp], nx, ny, fill, new_vport, rotate, nskip) + case ' ': + break + case '?': + call gm_help (out, KEY) + case 'r': + nskip = -1 * (nxold * nyold) + break + default: + call printf ("\07") + } + } + + # Reset viewport if necessary + if (new_vport == YES) { + call realloc (vp, nx * ny * 4, TY_LONG) + call gm_getvp (vp, nx, ny, fill) + } + + # Position metacode if necessary + if (nskip != 0) + call gm_posmc (in, fpos, lastp, Meml[ip], nskip) + + call sfree (sp) + return (OK) +end + + +# GM_RWFRAME -- Read and write a metacode frame to the graphics stream, +# transforming coordinates as necessary. This procedure returns the +# position in the input file which is entered into the metacode index +# for positioning. + +long procedure gm_rwframe (in, out, vport, rotate, frame_wcs, nwcs) + +int in # Metacode file descriptor +int out # File descriptor for graphics stream +real vport[ARB] # Array of viewport corner points +bool rotate # Rotate frame (y/n?) +pointer frame_wcs # Pointer to accumulated SETWCS instruction +int nwcs # Counter for number of SETWCS instructions encountered + +pointer gki +int n_instructions, nchars_read, stat +long length_mc +int gm_read_next_instruction(), gm_writemc() +errchk gm_read_next_instruction, gm_writemc + +begin + call gm_trinit (vport, rotate) + n_instructions = 0 + length_mc = 0 + + repeat { + if (gm_read_next_instruction (in, gki, nchars_read) == EOF) { + if (length_mc == 0) + return (EOF) + else + return (END_OF_MC) + } + + length_mc = length_mc + nchars_read + stat = gm_writemc (out, Mems[gki], frame_wcs, nwcs) + + if (stat == NEW_FRAME && n_instructions > 1) + return (length_mc) + + else if (stat != NEW_FRAME) + n_instructions = n_instructions + 1 + } +end + + +# GM_COLON -- Get options from colon commands. + +procedure gm_colon (cmdstr, nx, ny, fill, new_vport, rotate, nskip) + +char cmdstr[ARB] +int nx, ny +bool fill +int new_vport +bool rotate +int nskip + +pointer sp, bp, mp +bool tempb, plus_sign +int ncmd, tempi +int strdic(), nscan(), stridxs() +errchk strdic, nscan, stridxs + +string cmds "|nx|ny|fill|rotate|skip|" + +begin + call smark (sp) + call salloc (bp, SZ_COMMAND, TY_CHAR) + call salloc (mp, SZ_MATCH, TY_CHAR) + + # Parse the command string with fmtio. First look for a minus sign, + # then find the string in the string index, matching only the + # first SZ_MATCH characters. + + call sscan (cmdstr) + call gargwrd (Memc[bp], SZ_COMMAND) + + plus_sign = true + if (stridxs ("-", Memc[bp]) > 0) + plus_sign = false + call strcpy (Memc[bp], Memc[mp], SZ_MATCH) + + ncmd = strdic (Memc[mp], Memc[bp], SZ_MATCH, cmds) + + # Switch on the command and parse the arguments. + + switch (ncmd) { + case 1: + # nx + call gargi (tempi) + if (nscan() >= 2) { + new_vport = YES + nx = tempi + } + + case 2: + # ny + call gargi (tempi) + if (nscan() >= 2) { + new_vport = YES + ny = tempi + } + + case 3: + # fill + call gargb (tempb) + new_vport = YES + + if (nscan() >= 2) + fill = tempb + else + # Could be just "fill" or have either a +/- + fill = plus_sign + + case 4: + # rotate + call gargb (tempb) + + if (nscan() >= 2) + rotate = tempb + else + # Could be just "rotate" or have either a +/- + rotate = plus_sign + + case 5: + # skip + call gargi (tempi) + if (nscan() >= 2) + nskip = tempi + else + nskip = 0 + + default: + # beep + call eprintf ("\07") + call flush (STDERR) + } + + call sfree (sp) +end + + +# GM_POSMC -- position metacode file by skipping forward or backward +# as requested. + +procedure gm_posmc (in, file_pos, pcounter, mc_index, nskip) + +int in # File descriptor of input file +long file_pos # Current position in file +int pcounter # Plot number just plotted upon entering +long mc_index[ARB] # Accumulated index of mc plots +int nskip # Requested nplots to skip + +int desired_plot, i, nchars_read, pcounter_in, fpos_in +long desired_position +int gm_findnextplot() +errchk seek, gm_findnextplot + +begin + # Save original plot number counter + pcounter_in = pcounter + fpos_in = file_pos + + # Skipping backwards + if (nskip < 0) { + if (in == STDIN) { + call eprintf ("Cannot skip backwards on STDIN\n") + return + } + + if (abs (nskip) > pcounter) { + call eprintf ("At beginning of file\n") + call seek (in, BOFL) + file_pos = 1 + pcounter = 0 + return + } + + # Rewind mc to desired position and change the pcounter. The + # calling program will redetermine the starting position as + # before. + + desired_plot = pcounter - abs (nskip) + 1 + desired_position = mc_index[desired_plot] + call seek (in, desired_position) + pcounter = desired_plot - 1 + file_pos = desired_position + + } else { + # Skipping forward - updating the index along the way. + + desired_plot = pcounter_in + nskip + 1 + + do i = 1, nskip { + nchars_read = gm_findnextplot (in) + if (nchars_read == EOF) { + call eprintf ("Only %d plots left - position unchanged\n") + call pargi (i - 1) + pcounter = pcounter_in + file_pos = fpos_in + call seek (in, fpos_in) + return + } + + pcounter = pcounter + 1 + file_pos = file_pos + nchars_read + mc_index[pcounter+1] = file_pos + } + + # Reset pcounter; no need to seek to desired position as + # you are already there. + pcounter = desired_plot - 1 + } +end + + +# GM_FINDNEXTPLOT -- read until the start of the next plot in the metacode +# file, returning the number of chars read to get there. + +int procedure gm_findnextplot (in) + +int in +pointer gki +int nchars_read, opcode, plot_length +int gm_read_next_instruction() + +begin + plot_length = 0 + repeat { + if (gm_read_next_instruction (in, gki, nchars_read) == EOF) + return (EOF) + + plot_length = plot_length + nchars_read + opcode = I_OPCODE (gki) + + if ((opcode == GKI_OPENWS && WS_MODE(gki) == NEW_FILE) || + (opcode == GKI_CLEAR)) + + # New frame encountered, terminating previous plot. + return (plot_length) + } +end + + +# GM_READ_NEXT_INSTRUCTION -- read the next instruction from the input +# stream, returning a buffer pointer to the instruction and the number of +# chars read to get to this position. This is a modified version of +# gki_fetch_next_instruction, in that the total number of chars read +# (including partial and botched instructions) is returned as a procedure +# argument. + +int procedure gm_read_next_instruction (fd, instruction, nchars_total) + +int fd # input file containing metacode +pointer instruction # pointer to instruction (output) +int nchars_total # number of chars read from input stream + +int len_ibuf, nchars, nchars_read +pointer ibuf +int read() +errchk read +data ibuf/NULL/ + +begin + # Allocate a default sized instruction buffer. We can reallocate + # a larger buffer later if necessary. + + if (ibuf == NULL) { + call malloc (ibuf, LEN_DEFIBUF, TY_SHORT) + len_ibuf = LEN_DEFIBUF + } + + # Advance to the next instruction. Nulls and botched portions of + # instructions are counted. Read the instruction header to determine + # the length of the instruction, and then read the rest of instruction + # into buffer. If the entire instruction cannot be read we have a + # botched instruction and must try again. The total number of chars + # read from the input stream is accumulated and returned as an + # argument. + + nchars_total = 0 + repeat { + repeat { + nchars_read = read (fd, I_BOI(ibuf), ONEWORD) + if (nchars_read == EOF) + return (EOF) + else + nchars_total = nchars_total + nchars_read + } until (I_BOI(ibuf) == BOI) + + nchars_read = read (fd, I_OPCODE(ibuf), TWOWORDS) + if (nchars_read == EOF) + return (EOF) + else + nchars_total = nchars_total + nchars_read + + # Make instruction buffer large enough to hold instruction. + # Compute length of remainder of instruction in chars. + + if (I_LENGTH(ibuf) > len_ibuf) { + len_ibuf = I_LENGTH(ibuf) + call realloc (ibuf, len_ibuf, TY_SHORT) + } + + nchars = (I_LENGTH(ibuf) - LEN_GKIHDR) * SZ_SHORT + if (nchars == 0) + break + + nchars_read = read (fd, I_DATA(ibuf), nchars) + if (nchars_read != EOF) + nchars_total = nchars_total + nchars_read + } until (nchars_read == nchars) + + instruction = ibuf + + # Check for a soft end of file, otherwise return the length of the + # instruction as the function value. + + if (I_OPCODE(ibuf) == GKI_EOF) + return (EOF) + else + return (I_LENGTH(ibuf)) +end + + +# Test for finding the unitary transformation WCS +define (USERSET_W, (WCS_WX1($1) > EPSILON)||(abs(1. - WCS_WX2($1)) >EPSILON) || + (WCS_WY1($1) > EPSILON) || (abs(1. - WCS_WY2($1)) > EPSILON)) + +define (USERSET_V, (WCS_SX1($1) > EPSILON)| (abs(1. - WCS_SX2($1)) > EPSILON) || + (WCS_SY1($1) > EPSILON) || (abs(1. - WCS_SY2($1)) > EPSILON)) + +# GM_SETWCS -- Find WCS window and viewport information from SETWCS +# instruction. This procedure gets all active wcs from the structure. +# The WCS is transformed in place. + +procedure gm_setwcs (gki, frame_wcs, nwcs_cnt) + +short gki[ARB] # GKI_SETWCS instruction +pointer frame_wcs # Pointer to accumulating SETWCS instruction +int nwcs_cnt # Number of SETWCS instructions encountered + +int nwords, i, nwcs, temp, nwcs_in +real xy_pairs[NPAIRS * 2] +pointer sp, wcs_temp, w, ow + +int rotate +real x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle +common /gm_tform/ x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle, + rotate + +errchk amovi, gm_vtransr + +begin + call smark (sp) + call salloc (wcs_temp, LEN_WCSARRAY, TY_STRUCT) + + nwcs_in = nwcs_cnt + nwords = gki[GKI_SETWCS_N] + nwcs = nwords * SZ_SHORT / SZ_STRUCT / LEN_WCS + + if (nwcs > 1) { + call amovi (gki[GKI_SETWCS_WCS], Memi[wcs_temp], nwcs * LEN_WCS) + + do i = 1, nwcs { + w = ((i - 1) * LEN_WCS) + wcs_temp + + if (USERSET_W(w) || USERSET_V(w)) { + # Got a valid WCS - increment counter and calculate + # pointer into output frame_wcs array. + nwcs_cnt = nwcs_cnt + 1 + ow = ((nwcs_cnt - 1) * LEN_WCS) + frame_wcs + + # Now to do the transformation: + xy_pairs[1] = WCS_SX1(w) + xy_pairs[2] = WCS_SY1(w) + xy_pairs[3] = WCS_SX2(w) + xy_pairs[4] = WCS_SY2(w) + + call gm_vtransr (xy_pairs, NPAIRS) + + # Set those fields that have changed, viewport coordinates. + + WCS_SX1(ow) = xy_pairs[1] + WCS_SY1(ow) = xy_pairs[2] + WCS_SX2(ow) = xy_pairs[3] + WCS_SY2(ow) = xy_pairs[4] + + # X and Y transformations have changed if plot is rotated. + if (rotate == YES) { + temp = WCS_XTRAN(w) + WCS_XTRAN(ow) = WCS_YTRAN(w) + WCS_YTRAN(ow) = temp + xy_pairs[1] = WCS_WX1(w) + xy_pairs[2] = WCS_WX2(w) + xy_pairs[3] = WCS_WY1(w) + xy_pairs[4] = WCS_WY2(w) + WCS_WX1 (ow) = xy_pairs[3] + WCS_WX2 (ow) = xy_pairs[4] + WCS_WY1 (ow) = xy_pairs[1] + WCS_WY2 (ow) = xy_pairs[2] + } else { + WCS_XTRAN(ow) = WCS_XTRAN(w) + WCS_YTRAN(ow) = WCS_YTRAN(w) + WCS_WX1 (ow) = WCS_WX1(w) + WCS_WX2 (ow) = WCS_WX2(w) + WCS_WY1 (ow) = WCS_WY1(w) + WCS_WY2 (ow) = WCS_WY2(w) + } + + WCS_CLIP(ow) = WCS_CLIP(w) + } + } + } + + if (nwcs_in == nwcs_cnt) { + # No user WCS were used - output the default WCS 0, scaled and + # possibly rotated. + + nwcs_cnt = nwcs_cnt + 1 + ow = ((nwcs_cnt - 1) * LEN_WCS) + frame_wcs + + xy_pairs[1] = 0.0 + xy_pairs[2] = 0.0 + xy_pairs[3] = 1.0 + xy_pairs[4] = 1.0 + + call gm_vtransr (xy_pairs, NPAIRS) + + # X and Y transformations have changed if plot is rotated. + if (rotate == YES) { + WCS_SX1 (ow) = xy_pairs[3] + WCS_SX2 (ow) = xy_pairs[4] + WCS_SY1 (ow) = xy_pairs[1] + WCS_SY2 (ow) = xy_pairs[2] + WCS_WX1 (ow) = 0.0 + WCS_WX2 (ow) = 1.0 + WCS_WY1 (ow) = 1.0 + WCS_WY2 (ow) = 0.0 + } else { + WCS_SX1 (ow) = xy_pairs[1] + WCS_SX2 (ow) = xy_pairs[3] + WCS_SY1 (ow) = xy_pairs[2] + WCS_SY2 (ow) = xy_pairs[4] + WCS_WX1 (ow) = 0.0 + WCS_WX2 (ow) = 1.0 + WCS_WY1 (ow) = 0.0 + WCS_WY2 (ow) = 1.0 + } + + WCS_XTRAN(ow) = LINEAR + WCS_YTRAN(ow) = LINEAR + WCS_CLIP(ow) = YES + } + + call sfree (sp) +end + + +# GM_INITWCS -- initialize the WCS structure to default values. +procedure gm_initwcs (wcs) + +pointer wcs # Pointer to wcs structure +pointer w +int i + +begin + # Initialize the WCS to NDC coordinates. + do i = 1, MAX_WCS { + w = ((i - 1) * LEN_WCS) + wcs + WCS_WX1(w) = 0.0 + WCS_WX2(w) = 1.0 + WCS_WY1(w) = 0.0 + WCS_WY2(w) = 1.0 + WCS_SX1(w) = 0.0 + WCS_SX2(w) = 1.0 + WCS_SY1(w) = 0.0 + WCS_SY2(w) = 1.0 + WCS_XTRAN(w) = LINEAR + WCS_YTRAN(w) = LINEAR + WCS_CLIP(w) = YES + } +end + + +# GM_WRITEMC -- Output transformed metacode. Action taken depends on +# individual metacode instruction. Any instruction with (x,y) coordinates +# gets transformed; txset instruction gets rewritten; other instructions +# are simply written to graphics stream. Metacode is rewritten in place. + +int procedure gm_writemc (fd, gki, frame_wcs, nwcs) + +int fd # File descriptor for graphics stream +short gki[ARB] # Metacode instruction +pointer frame_wcs # Pointer to accumulating SETWCS instruction +int nwcs # Counter for number of WCS instructions found + +int npairs, opcode +errchk gm_txset, gm_vtrans, gki_write, gm_setwcs + +begin + opcode = gki[GKI_HDR_OPCODE] + switch (opcode) { + + case GKI_SETWCS: + if (nwcs < MAX_WCS) + iferr (call gm_setwcs (gki, frame_wcs, nwcs)) + call erract (EA_WARN) + + case GKI_CLEAR: + #This marks start of next metacode frame + return (NEW_FRAME) + + case GKI_OPENWS: + if (gki[GKI_OPENWS_M] == NEW_FILE) + # This also marks the start of a new metacode frame + return (NEW_FRAME) + + case GKI_CLOSEWS: + # Just absorb these instructions - don't copy them + ; + + case GKI_POLYLINE: + npairs = gki[GKI_POLYLINE_N] + call gm_vtrans (gki[GKI_POLYLINE_P], npairs) + call gki_write (fd, gki) + + case GKI_TXSET: + # Several instruction fields have to be changed + call gm_txset (gki) + call gki_write (fd, gki) + + case GKI_POLYMARKER: + npairs = gki[GKI_POLYMARKER_N] + call gm_vtrans (gki[GKI_POLYMARKER_P], npairs) + call gki_write (fd, gki) + + case GKI_TEXT: + npairs = 1 + call gm_vtrans (gki[GKI_TEXT_P], npairs) + call gki_write (fd, gki) + + case GKI_FILLAREA: + npairs = gki[GKI_FILLAREA_N] + call gm_vtrans (gki[GKI_FILLAREA_P], npairs) + call gki_write (fd, gki) + + case GKI_PUTCELLARRAY: + # Do both lower left and upper right corners + npairs = 1 + call gm_vtrans (gki[GKI_PUTCELLARRAY_LL], npairs) + call gm_vtrans (gki[GKI_PUTCELLARRAY_UR], npairs) + + call gki_write (fd, gki) + + default: + call gki_write (fd, gki) + } + + return (OK) +end + + +# GM_GETVP -- Calculate cornerpoints for the individual viewports on the page. + +procedure gm_getvp (vp, nx, ny, fill) + +pointer vp # Pointer to array of viewport coordinates +int nx # Number of plots in x direction +int ny # Number of plots in y direction +bool fill # Fill viewport or preserve aspect ratio + +int i, j, plotnumber +real x_sep, y_sep, x_ext, y_ext, x_center, y_center + +begin + if (fill) { + # x and y dimensions of plot viewports calculated independently. + x_sep = 1.0 / real (nx) + y_sep = 1.0 / real (ny) + x_ext = x_sep + y_ext = y_sep + + } else { + # Plot viewports are equal in NDC space for both x and y + x_sep = 1.0 / real (nx) + y_sep = 1.0 / real (ny) + x_ext = min (1.0 / real (nx), 1.0 / real (ny)) + y_ext = min (1.0 / real (nx), 1.0 / real (ny)) + } + + # Find NDC coordinates of the page full of viewports + + plotnumber = 1 + do i = 1, nx { + x_center = 0.5 * x_sep + (i - 1) * x_sep + + do j = 1, ny { + y_center = 1.0 - (0.5 * y_sep + (j - 1) * y_sep) + + # Calculate x1, x2, y1, y2 for each viewport + Memr[vp+plotnumber-1] = x_center - (0.5 * x_ext) + Memr[vp+plotnumber] = x_center + (0.5 * x_ext) + Memr[vp+plotnumber+1] = y_center - (0.5 * y_ext) + Memr[vp+plotnumber+2] = y_center + (0.5 * y_ext) + + plotnumber = plotnumber + 4 + } + } +end + + +# GM_TRINIT -- Initialize transformation variables. Called once per output +# plot - once per transformation. + +procedure gm_trinit (viewport, rot_plot) + +real viewport[4] # Corner points of plotting viewport +bool rot_plot # Rotate plots (y/n?) + +int rotate +real x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle +common /gm_tform/ x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle, + rotate + +begin + # Calculate and store sine, cosine of rotation angle + if (! rot_plot) { + cos_angle = 1.0 + sin_angle = 0.0 + rotate = NO + } else { + cos_angle = 0.0 + sin_angle = 1.0 + rotate = YES + } + + # Calculate origin, center and scale. + x1 = viewport[1] * GKI_MAXNDC + y1 = viewport[3] * GKI_MAXNDC + xcen = (viewport[2] + viewport[1]) * 0.5 * GKI_MAXNDC + ycen = (viewport[4] + viewport[3]) * 0.5 * GKI_MAXNDC + xscale = viewport[2] - viewport[1] + yscale = viewport[4] - viewport[3] +end + + +# GM_TXSET -- Rewrite the text set instruction. The fields that +# need to be changed are the tx_size, chup vector and both the +# vertical and horizontal justification. The instruction is rewritten +# in place. + +procedure gm_txset (instruction) + +short instruction [ARB] # Metacode instruction + +short temp, sz, hj, vj + +int rotate +real x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle +common /gm_tform/ x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle, + rotate + +begin + # First convert size, which is stored as NDC * 100 + sz = instruction[GKI_TXSET_SZ] + temp = short ((real (sz) / 100. * min (xscale, yscale)) * 100.) + instruction [GKI_TXSET_SZ] = temp + + if (rotate == YES) { + # Axes have been rotated by 90 degrees. Change character up vector. + instruction[GKI_TXSET_UP] = instruction[GKI_TXSET_UP] - 90 + + # Change vertical and horizontal text justification + hj = instruction[GKI_TXSET_HJ] + vj = instruction[GKI_TXSET_VJ] + + switch (hj) { + case GT_LEFT: + instruction[GKI_TXSET_VJ] = GT_TOP + case GT_RIGHT: + instruction[GKI_TXSET_VJ] = GT_BOTTOM + default: + instruction[GKI_TXSET_VJ] = hj + } + + switch (vj) { + case GT_TOP: + instruction[GKI_TXSET_HJ] = GT_RIGHT + case GT_BOTTOM: + instruction[GKI_TXSET_HJ] = GT_LEFT + default: + instruction[GKI_TXSET_HJ] = vj + } + } +end + + +# GM_VTRANS -- transform a vector of coordinate pairs. The transformation +# is done in place. + +procedure gm_vtrans (xy_pairs, npairs) + +short xy_pairs[ARB] # Metacode instruction coordinate pairs +int npairs # Number of coordinate pairs + +int i +long xt, yt +real xtemp, ytemp + +int rotate +real x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle +common /gm_tform/ x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle, + rotate + +begin + do i = 1, 2 * npairs, 2 { + xtemp = real (xy_pairs[i]) * xscale + x1 + ytemp = real (xy_pairs[i+1]) * yscale + y1 + + if (rotate == NO) { + xt = xtemp + yt = ytemp + + } else { + # Rotate about center, making sure transformed coordinates + # are in NDC bounds. + + xt = max (0, min (int(((ytemp - ycen) * xscale/yscale) + xcen), + GKI_MAXNDC)) + yt = max (0, min (int(((xcen - xtemp) * yscale/xscale) + ycen), + GKI_MAXNDC)) + } + + xy_pairs[i] = short (xt) + xy_pairs[i+1] = short (yt) + } +end + + +# GM_VTRANSR -- transform a vector of coordinate pairs. The transformation +# is done in place. To be used with real format xy. + +procedure gm_vtransr (xy_pairs, npairs) + +real xy_pairs[ARB] # Metacode binary coordinate pairs (e.g., WCS) +int npairs # Number of coordinate pairs + +int i +real xt, yt, xtemp, ytemp + +int rotate +real x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle +common /gm_tform/ x1, y1, xcen, ycen, xscale, yscale, cos_angle, sin_angle, + rotate + +begin + do i = 1, 2 * npairs, 2 { + xtemp = xy_pairs[i] * real (GKI_MAXNDC) * xscale + x1 + ytemp = xy_pairs[i+1] * real (GKI_MAXNDC) * yscale + y1 + + if (rotate == NO) { + xt = xtemp + yt = ytemp + + } else { + # Rotate about center, making sure transformed coordinates + # are in bounds. + + xt = max (0., min ((((ytemp-ycen) * xscale/yscale) + xcen), + real (GKI_MAXNDC))) + yt = max (0., min ((((xcen-xtemp) * yscale/xscale) + ycen), + real (GKI_MAXNDC))) + + } + + # Convert from GKI coordinates to NDC before returning. + xy_pairs[i] = xt / GKI_MAXNDC + xy_pairs[i+1] = yt / GKI_MAXNDC + } +end + + +# GM_HELP -- Print interactive help for gkimosaic. The workstation must +# be deactivated, then the file paged and the workstation reactivated. + +procedure gm_help (out, file) + +int out # File descriptor of graphics stream +char file[ARB] # File to be printed + +begin + call gki_flush (out) + call gki_deactivatewcs (out, AW_CLEAR) + call pagefile (file, PROMPT) + call flush (STDOUT) + call gki_reactivatewcs (out, AW_PAUSE) +end diff --git a/pkg/plot/t_gkixt.x b/pkg/plot/t_gkixt.x new file mode 100644 index 00000000..fc94b884 --- /dev/null +++ b/pkg/plot/t_gkixt.x @@ -0,0 +1,325 @@ +include <gki.h> + +define LEN_DEFIBUF 2048 +define ONEWORD SZ_SHORT +define TWOWORDS (2*SZ_SHORT) +define MAX_RANGES 100 +define MAX_FRAMES 8192 +define SZ_TEXT (5 * SZ_LINE) + +# Header fields of a GKI instruction. +define I_BOI Mems[$1+GKI_HDR_BOI-1] +define I_OPCODE Mems[$1+GKI_HDR_OPCODE-1] +define I_LENGTH Mems[$1+GKI_HDR_LENGTH-1] +define I_DATA Mems[$1+GKI_DATAFIELDS-1] +define WS_MODE Mems[$1+GKI_OPENWS_M - 1] + +# T_GKIEXTRACT -- extract individual frames from a GKI metacode file. + +procedure t_gkiextract () + +char mc_fname[SZ_FNAME], frames_list[SZ_LINE] +int list, mfd, verify, nframes, junk +int this_frame, frames[3,MAX_RANGES] +pointer index, sp + +bool clgetb() +int clpopni(), clgfil(), open(), get_next_number() +int decode_ranges(), btoi(), gke_user_go_ahead() + +begin + # Allocate space for the index array. + call smark (sp) + call salloc (index, 4 * MAX_FRAMES, TY_INT) + + list = clpopni ("input") + call clgstr ("frames", frames_list, SZ_LINE) + if (decode_ranges (frames_list, frames, MAX_RANGES, junk) == ERR) + call error (1, "Ranges of frames incorrectly specified") + verify = btoi (clgetb ("verify")) + + # Loop through the list of metacode frames. + while (clgfil (list, mc_fname, SZ_FNAME) != EOF) { + mfd = open (mc_fname, READ_ONLY, BINARY_FILE) + call gke_make_index (mfd, Memi[index], nframes) + + # Position to beginning of metacode file. + call seek (mfd, BOF) + + this_frame = 0 + while (get_next_number (frames, this_frame) != EOF) { + if (this_frame > nframes) { + call eprintf ("Metacode file '%s' contains %d frames\n") + call pargstr (mc_fname) + call pargi (nframes) + break + } + + if (verify == YES) { + if (gke_user_go_ahead (this_frame, Memi[index]) == YES) + call gke_extract_plot (mfd, Memi[index], this_frame) + } else + call gke_extract_plot (mfd, Memi[index], this_frame) + } + call close (mfd) + } + + call clpcls (list) + call sfree (sp) +end + + +# GKE_USER_GO_AHEAD -- Print metacode frame directory and query the user. + +int procedure gke_user_go_ahead (this_frame, index) + +int this_frame # Current frame number +int index[4, ARB] # Metacode index + +pointer tty +pointer ttyodes() +bool clgetb() + +begin + # Print directory information for this_frame from index. + call eprintf (" [%d] (%d words) %26t%s") + call pargi (this_frame) + call pargi (index[3, this_frame]) + call pargstr (Memc[index[4, this_frame]]) + + # Now get user response from terminal. + tty = ttyodes ("terminal") + call flush (STDOUT) + call clputb ("go_ahead", clgetb ("default_action")) + call eprintf (" Extract") + call flush (STDERR) + call ttycdes (tty) + + if (!clgetb ("go_ahead")) + return (NO) + else + return (YES) +end + + +# GKE_EXTRACT_PLOT -- extract the specified frame from a metacode file. +# Information about the frame's location and length is stored in "index". + +procedure gke_extract_plot (mf, index, this_frame) + +int mf # Metacode file descriptor +int index[4,ARB] # Index of metacode frames +int this_frame # Current frame number + +int mc_begin, nchars +pointer metacode, sp +int read() +errchk seek, salloc, read, write, mfree + +begin + # Allocate space for the metacode instructions + call smark (sp) + nchars = index[3,this_frame] * SZ_SHORT + call salloc (metacode, nchars, TY_CHAR) + + # Position to proper place in metacode file + mc_begin = index[2,this_frame] + iferr (call seek (mf, mc_begin)) + call error (2, "Unable to position to metacode frame") + + # Now to read the metacode + if (read (mf, Memc[metacode], nchars) == EOF) + call error (3, "Unexpected EOF in metacode file encountered") + + # Write buffer to STDOUT + call write (STDOUT, Memc[metacode], nchars) + call flush (STDOUT) + + call sfree (sp) +end + + +# GKE_MAKE_INDEX -- reads through a metacode file, returning an index of +# all plots in the file. For each frame in the metacode file, the index +# contains 4 entries: plot ordinal, starting location, length and a pointer +# to the title_string. + +procedure gke_make_index (mf, index, nframes) + +int mf # Metacode file descriptor +int index[4,ARB] # Index of metacode frames +int nframes # Number of frames in index (output) + +bool new_frame +char tx_string[SZ_TEXT+1] +pointer gki, ptr +int nframe, length, mc_length, seek_text, nchars_read +int nchars, nchars_max, op_code, file_pos +int gke_read_next_instruction() +errchk gke_read_next_instruction + +begin + nframe = 0 + mc_length = 0 + file_pos = 1 + new_frame = false + + repeat { + length = gke_read_next_instruction (mf, gki, nchars_read) + if (length == EOF) + break + + file_pos = file_pos + nchars_read + op_code = I_OPCODE (gki) + + if ((op_code == GKI_OPENWS && WS_MODE(gki) == NEW_FILE) || + (op_code == GKI_CLEAR)) { + # New frame encountered, terminating previous plot. + + if (new_frame) { + # Last instruction was also new_frame. Just bump length. + mc_length = mc_length + length + next + } else + new_frame = true + + if (nframe > 0) { + # Fill index entries + index[1,nframe] = nframe + index[2,nframe + 1] = file_pos - length + index[3,nframe] = mc_length + call malloc (ptr, nchars_max + 1, TY_CHAR) + call strcpy (tx_string, Memc[ptr], nchars_max) + index[4,nframe] = ptr + } else + # All that can be set is the file position + index[2,nframe + 1] = file_pos - length + + # Increment or reinitialize internal variables + nframe = nframe + 1 + if (nframe > MAX_FRAMES) + call error (4, "Too many frames in metacode file.") + mc_length = length + nchars_max = 0 + call strcpy ("(no title)", tx_string, SZ_LINE) + seek_text = YES + + } else { + new_frame = false + mc_length = mc_length + length + } + + if (op_code == GKI_MFTITLE) { + # No need to look at gtext commands any more -- found a title. + seek_text = NO + nchars_max = Mems[gki + GKI_MFTITLE_N - 1] + nchars_max = min (SZ_TEXT, nchars_max) + call achtsc (Mems[gki+GKI_MFTITLE_T-1], tx_string, nchars_max) + tx_string[nchars_max+1] = EOS + } + + if (op_code == GKI_TEXT && seek_text == YES) { + # If this is the longest string so far, save it as title. + nchars = Mems[gki + GKI_TEXT_N - 1] + if (nchars > nchars_max) { + nchars_max = min (SZ_TEXT, nchars) + call achtsc (Mems[gki+GKI_TEXT_T-1], tx_string, nchars_max) + tx_string[nchars_max+1] = EOS + } + } + } + + # Store information for last plot in index, as long as last plot + # isn't only a clear instruction. + + if (mc_length > GKI_CLEAR_LEN) { + index[1,nframe] = nframe + index[3,nframe] = mc_length + call malloc (ptr, nchars_max + 1, TY_CHAR) + call strcpy (tx_string, Memc[ptr], nchars_max) + index[4,nframe] = ptr + nframes = nframe + } else + nframes = nframe - 1 +end + + +# GKE_READ_NEXT_INSTRUCTION -- read the next instruction from the input +# stream, returning a buffer pointer to the instruction and the number of +# chars read to get to this position. This is a modified version of +# gki_fetch_next_instruction, in that the total number of chars read +# (including partial and botched instructions) is returned as a procedure +# argument. + +int procedure gke_read_next_instruction (fd, instruction, nchars_total) + +int fd # input file containing metacode +pointer instruction # pointer to instruction (output) +int nchars_total # number of chars read from input stream + +int len_ibuf, nchars, nchars_read +pointer ibuf +int read() +errchk read +data ibuf/NULL/ + +begin + # Allocate a default sized instruction buffer. We can reallocate + # a larger buffer later if necessary. + + if (ibuf == NULL) { + call malloc (ibuf, LEN_DEFIBUF, TY_SHORT) + len_ibuf = LEN_DEFIBUF + } + + # Advance to the next instruction. Nulls and botched portions of + # instructions are counted. Read the instruction header to determine + # the length of the instruction, and then read the rest of instruction + # into buffer. If the entire instruction cannot be read we have a + # botched instruction and must try again. The total number of chars + # read from the input stream is accumulated and returned as an + # argument. + + nchars_total = 0 + repeat { + repeat { + nchars_read = read (fd, I_BOI(ibuf), ONEWORD) + if (nchars_read == EOF) + return (EOF) + else + nchars_total = nchars_total + nchars_read + } until (I_BOI(ibuf) == BOI) + + nchars_read = read (fd, I_OPCODE(ibuf), TWOWORDS) + if (nchars_read == EOF) + return (EOF) + else + nchars_total = nchars_total + nchars_read + + # Make instruction buffer large enough to hold instruction. + # Compute length of remainder of instruction in chars. + + if (I_LENGTH(ibuf) > len_ibuf) { + len_ibuf = I_LENGTH(ibuf) + call realloc (ibuf, len_ibuf, TY_SHORT) + } + + nchars = (I_LENGTH(ibuf) - LEN_GKIHDR) * SZ_SHORT + if (nchars == 0) + break + + nchars_read = read (fd, I_DATA(ibuf), nchars) + if (nchars_read != EOF) + nchars_total = nchars_total + nchars_read + } until (nchars_read == nchars) + + instruction = ibuf + + # Check for a soft end of file, otherwise return the length of the + # instruction as the function value. + + if (I_OPCODE(ibuf) == GKI_EOF) + return (EOF) + else + return (I_LENGTH(ibuf)) +end diff --git a/pkg/plot/t_graph.x b/pkg/plot/t_graph.x new file mode 100644 index 00000000..079ff15a --- /dev/null +++ b/pkg/plot/t_graph.x @@ -0,0 +1,731 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <xwhen.h> +include <config.h> +include <imhdr.h> +include <mach.h> +include <error.h> +include <ctype.h> +include <fset.h> +include <gset.h> +include <mwset.h> + +define SZ_BUF 2048 # Initial pixel buffer size +define MAX_CURVES 20 # maximum curves if overplotting +define LIST_OP 1 +define IMAGE_OP 2 + + +# GRAPH -- Graphing utility where input may be one or more lists (y or x,y) +# or image sections. Multidimensional image sections are reduced to a vector +# by computing the projection about the indicated axis. Many options are +# available to personalize the plot; see the manual page for a full description. + +procedure t_graph() + +char input[SZ_LINE] +pointer x[MAX_CURVES], y[MAX_CURVES], size[MAX_CURVES] +int npix[MAX_CURVES], ncurves + +bool append, overplot +char device[SZ_FNAME] +int tgrjmp[LEN_JUMPBUF], epa, old_onint, status, i + +bool clgetb() +int fstati() +extern tgr_onint() +common /tgrcom/ tgrjmp + +begin + # Initialize curve pointers to NULL, in case ggplot aborts without + # allocating any buffers. + do i = 1, MAX_CURVES { + x[i] = NULL + y[i] = NULL + size[i] = NULL + npix[i] = NULL + } + + if (fstati (STDIN, F_REDIR) == YES) + call strcpy ("STDIN", input, SZ_FNAME) + else + call clgstr ("input", input, SZ_LINE) + + # Fetch plotting parameters. + + call clgstr ("device", device, SZ_FNAME) + overplot = clgetb ("overplot") + append = clgetb ("append") + + # Install interrupt exception handler. + call zlocpr (tgr_onint, epa) + call xwhen (X_INT, epa, old_onint) + + call zsvjmp (tgrjmp, status) + if (status == OK) { + # Fetch remaining params and draw the plot. + iferr (call ggplot (device, overplot, append, input, x, y, + size, npix, ncurves)) + status = ERR + } + + if (status == ERR) + call fseti (STDOUT, F_CANCEL, OK) + + # Return buffer space whether or not an error occurs while plotting. + + do i = 1, MAX_CURVES { + call mfree (x[i], TY_REAL) + call mfree (y[i], TY_REAL) + call mfree (size[i], TY_REAL) + } + + if (status == ERR) + call erract (EA_ERROR) +end + + +# TGR_ONINT -- Interrupt handler for the task graph. Branches back to ZSVJMP +# in the main routine to permit shutdown without an error message. + +procedure tgr_onint (vex, next_handler) + +int vex # Virtual exception +int next_handler # not used + +int tgrjmp[LEN_JUMPBUF] +common /tgrcom/ tgrjmp + +begin + call xer_reset() + call zdojmp (tgrjmp, vex) +end + + +# GGPLOT -- Does the real work of making the graph, after the graphics +# devics has been opened. Fetch remaining parameters, read in the data, +# and make the plot. + +procedure ggplot (device, overplot, append, input, x, y, size, npix, ncurves) + +char device[SZ_FNAME] # Graphics device +bool overplot # Overplot graph +bool append # Append graph +char input[ARB] # List of operands to be plotted +pointer x[MAX_CURVES] # X values +pointer y[MAX_CURVES] # Y values +pointer size[MAX_CURVES] # Size of markers to plot +int npix[MAX_CURVES] # Number of points per curve +int ncurves # Number of curves to overplot + +pointer gd +char xlabel[SZ_LINE], ylabel[SZ_LINE], title[SZ_LINE] +char marker[SZ_FNAME], wcs[SZ_FNAME], xformat[SZ_FNAME], yformat[SZ_FNAME] +bool pointmode, lintran, xautoscale, yautoscale +bool drawbox, transpose, rdmarks +int ltype, color, ip1, ip2 +int xtran, ytran, axis, ticklabels, i, marker_type, j +real p1, p2, q1, q2, wx1, wx2, wy1, wy2, szmarker, vx1, vx2, vy1, vy2 +real xx, yy, sz, szx, szy +pointer sp, ltypes, colors, ptemp + +pointer gopen() +bool clgetb(), streq(), fp_equalr() +int clgeti(), gg_rdcurves(), ctoi(), gstati() +real clgetr(), plt_iformatr() +errchk clgetb, clgeti, clgstr, clgetr, glabax, gpmark +errchk gswind, gseti, gg_rdcurves, gascale, grscale + +begin + call smark (sp) + call salloc (ltypes, SZ_LINE, TY_CHAR) + call salloc (colors, SZ_LINE, TY_CHAR) + + # If computing projection along an axis (collapsing a multidimensional + # section to a vector), fetch axis number. Get wcs string. + axis = clgeti ("axis") + call clgstr ("wcs", wcs, SZ_FNAME) + + # Set the line type and color lists. + i = 0 + call clgstr ("ltypes", Memc[ltypes], SZ_LINE) + for (ip1=ltypes; Memc[ip1]!=EOS; ip1=ip1+1) { + if (Memc[ip1] == ',') + Memc[ip1] = ' ' + if (IS_DIGIT(Memc[ip1])) + i = i + 1 + } + if (i == 0) + Memc[ltypes] = EOS + ip1 = 1 + ltype = 0 + + i = 0 + call clgstr ("colors", Memc[colors], SZ_LINE) + for (ip2=colors; Memc[ip2]!=EOS; ip2=ip2+1) { + if (Memc[ip2] == ',') + Memc[ip2] = ' ' + if (IS_DIGIT(Memc[ip2])) + i = i + 1 + } + if (i == 0) + Memc[colors] = EOS + ip2 = 1 + color = 0 + + # If pointmode is enabled, get marker character to be used to mark + # points. The size of the character is given + # by szmarker; if zero, the size will be taken from the input list. + + pointmode = clgetb ("pointmode") + szmarker = 0.0 + rdmarks = false + + if (pointmode) { + call clgstr ("marker", marker, SZ_FNAME) + call init_marker (marker, marker_type) + if (marker_type != GM_POINT) { + szmarker = clgetr ("szmarker") + rdmarks = (szmarker <= 0) + } + } else + call clgstr ("marker", marker, SZ_FNAME) + + # Read all the curves specified by the operands in input into memory. + # Get the first image title and coordinate label. + + title[1] = EOS + xlabel[1] = EOS + ylabel[1] = EOS + xformat[1] = EOS + yformat[1] = EOS + ncurves = gg_rdcurves (input, title, xlabel, ylabel, xformat, + x, y, size, npix, axis, wcs, rdmarks) + + if (overplot || append) + gd = gopen (device, APPEND, STDGRAPH) + else + gd = gopen (device, NEW_FILE, STDGRAPH) + + xautoscale = false + yautoscale = false + + # Set window and viewport. If user window has not been set, enable + # autoscaling. If device viewport has not been set, let glabax + # handle the viewport internally. + + if (!append) { + wx1 = clgetr ("wx1") + wx2 = clgetr ("wx2") + wy1 = clgetr ("wy1") + wy2 = clgetr ("wy2") + + if (fp_equalr (wx1, wx2)) + xautoscale = true + if (fp_equalr (wy1, wy2)) + yautoscale = true + + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + + if (!(fp_equalr (vx1, vx2)) && !(fp_equalr (vy1, vy2))) + call gsview (gd, vx1, vx2, vy1, vy2) + + if (!clgetb ("fill")) + call gseti (gd, G_ASPECT, 1) + + if (clgetb ("round")) + call gseti (gd, G_ROUND, YES) + } + + # Draw box around plot? + drawbox = false + if (!append) + if (clgetb ("box")) + drawbox = true + + if (drawbox) { + # Get number of major and minor tick marks. + call gseti (gd, G_XNMAJOR, clgeti ("majrx")) + call gseti (gd, G_XNMINOR, clgeti ("minrx")) + call gseti (gd, G_YNMAJOR, clgeti ("majry")) + call gseti (gd, G_YNMINOR, clgeti ("minry")) + + # Fetch plot title, labels and format + call clgstr ("title", wcs, SZ_LINE) + if (!streq (wcs, "imtitle")) + call strcpy (wcs, title, SZ_LINE) + + call clgstr ("xlabel", wcs, SZ_LINE) + if (!streq (wcs, "wcslabel")) + call strcpy (wcs, xlabel, SZ_LINE) + + call clgstr ("ylabel", ylabel, SZ_LINE) + + call clgstr ("xformat", wcs, SZ_LINE) + if (!streq (wcs, "wcsformat")) + call strcpy (wcs, xformat, SZ_FNAME) + + call clgstr ("yformat", yformat, SZ_LINE) + + # Label tick marks on axes? + ticklabels = NO + if (clgetb ("ticklabels")) + ticklabels = YES + } + + # Perform linear transformation on the X axis? + lintran = clgetb ("lintran") + if (lintran) { + p1 = clgetr ("p1") + p2 = clgetr ("p2") + q1 = clgetr ("q1") + q2 = clgetr ("q2") + } + + # Transpose X,Y axes? + transpose = clgetb ("transpose") + + # Log scale? Call gswind to set log scaling regardless of whether + # the user window is known; if the user window was not input, + # autoscaling will reset it later. + + if (append) { + xtran = gstati (gd, G_XTRAN) + ytran = gstati (gd, G_YTRAN) + call ggwind (gd, wx1, wx2, wy1, wy2) + } else { + xtran = GW_LINEAR + if (clgetb ("logx")) + xtran = GW_LOG + ytran = GW_LINEAR + if (clgetb ("logy")) + ytran = GW_LOG + wx1 = plt_iformatr (wx1, xformat) + wx2 = plt_iformatr (wx2, xformat) + wy1 = plt_iformatr (wy1, yformat) + wy2 = plt_iformatr (wy2, yformat) + call gswind (gd, wx1, wx2, wy1, wy2) + call gseti (gd, G_XTRAN, xtran) + call gseti (gd, G_YTRAN, ytran) + } + + # Carry out linear transformation on X coords, if desired. + if (lintran) + do i = 1, ncurves + call gg_lintran (Memr[x[i]], npix[i], p1,p2, q1,q2) + + # Swap axes, if enabled. Note that the linear transformation of + # the x-axis should be performed before axes are swapped. This is + # because the purpose of the lintran option is to provide a means + # of assigning a coordinate system to a pixel array. + + if (transpose) + do i = 1, ncurves { + ptemp = x[i] + x[i] = y[i] + y[i] = ptemp + } + + # Autoscale if enabled. + if (xautoscale) { + call gascale (gd, Memr[x[1]], npix[1], 1) + if (ncurves > 1) { + do i = 2, ncurves + call grscale (gd, Memr[x[i]], npix[i], 1) + } + } + + if (yautoscale) { + call gascale (gd, Memr[y[1]], npix[1], 2) + if (ncurves > 1) { + do i = 2, ncurves + call grscale (gd, Memr[y[i]], npix[i], 2) + } + } + + # Draw box around plot if enabled. + if (drawbox) { + call gsets (gd, G_XTICKFORMAT, xformat) + call gsets (gd, G_YTICKFORMAT, yformat) + call gseti (gd, G_LABELTICKS, ticklabels) + call glabax (gd, title, xlabel, ylabel) + } + + # Draw the curves. + do i = 1, ncurves { + if (Memc[ltypes] == EOS) + ltype = ltype + 1 + else if (ctoi (Memc[ltypes], ip1, j) > 0) + ltype = j + ltype = mod (ltype - 1, 4) + 1 + call gseti (gd, G_PLTYPE, ltype) + if (Memc[colors] == EOS) + color = color + 1 + else if (ctoi (Memc[colors], ip2, j) > 0) + color = j + color = mod (color - 1, 9) + 1 + call gseti (gd, G_PLCOLOR, color) + if (pointmode) { + if (!rdmarks) { + call amovkr (szmarker, Memr[size[i]], npix[i]) + call gpmark (gd, Memr[x[i]], Memr[y[i]], npix[i], + marker_type, Memr[size[i]], Memr[size[i]]) + } else { + if (szmarker < 0) + call amulkr (Memr[size[i]], szmarker, Memr[size[i]], + npix[i]) + do j = 1, npix[i] { + xx = Memr[x[i]+j-1] + yy = Memr[y[i]+j-1] + sz = Memr[size[i]+j-1] + szx= sz; szy = sz + if (marker_type == GM_VEBAR) + szx = 1.0 + else if (marker_type == GM_HEBAR) + szy = 1.0 + call gmark (gd, xx, yy, marker_type, szx, szy) + } + } + } else + call hgpline (gd, Memr[x[i]], Memr[y[i]], npix[i], marker) + } + + call gclose (gd) + call sfree (sp) +end + + +# GG_RDCURVES -- Given the operand list as input, read in all the referenced +# lists and/or image sections, producing a list of vectors as output. Return +# as the function value the number of curves. + +int procedure gg_rdcurves (oplist, title, xlabel, ylabel, xformat, + x, y, size, npix, axis, wcs, rdmarks) + +char oplist[ARB] # Operand list +char title[ARB] # Title +char xlabel[ARB] # X label +char ylabel[ARB] # Y label +char xformat[ARB] # WCS coordinate format +pointer x[ARB] # Pointer to x vector +pointer y[ARB] # Pointer to y vector +pointer size[ARB] # Pointer to vector of marker sizes +int npix[ARB] # Number of values per vector +int axis # Axis for projection +char wcs[ARB] # WCS type +bool rdmarks # Read marks from list? + +char operand[SZ_FNAME] +int ncurves, i, fd +int gg_rdcurve(), imtopen(), imtgetim() + +begin + ncurves = 0 + + # Read all the curves into memory. + + fd = imtopen (oplist) + while (imtgetim (fd, operand, SZ_FNAME) != EOF) { + ncurves = ncurves + 1 + if (ncurves > MAX_CURVES) + call error (0, "Maximum of 20 curves can be overplotted") + i = ncurves + iferr { + npix[i] = gg_rdcurve (operand, title, xlabel, ylabel, + xformat, x[i], y[i], size[i], axis, wcs, rdmarks) + } then { + call erract (EA_WARN) + ncurves = ncurves - 1 + } + } + + call imtclose (fd) + + if (ncurves == 0) + call error (0, "No curves read") + else + return (ncurves) +end + + +# GG_RDCURVE -- Read a curve into memory. The operand may specify either +# list or image input; we determine which and then call the appropriate +# input routine to access the data. Set the image title and coordinate +# label if not previously defined. + +int procedure gg_rdcurve (operand, title, xlabel, ylabel, xformat, + x, y, size, axis, wcs, rdmarks) + +char operand[ARB] # List of operaands to be plotted +char title[ARB] # Title +char xlabel[ARB] # X label +char ylabel[ARB] # Y label +char xformat[ARB] # WCS coordinate format +pointer x, y, size # Pointers to x, y and size arrays +int axis # Axis of image projection +char wcs[ARB] # WCS type +bool rdmarks # Read marks from list? + +int gg_rdlist2(), gg_rdimage2(), gg_optype() +errchk gg_rdlist2, gg_rdimage2, gg_optype + +begin + if (gg_optype (operand) == LIST_OP) + return (gg_rdlist2 (operand, x, y, size, rdmarks)) + else + return (gg_rdimage2 (operand, title, xlabel, ylabel, xformat, + x, y, size, axis, wcs)) +end + + +# GG_OPTYPE -- Determine whether the operand argument is an image section +# or a list. If the string is STDIN, it is a list; if a subscript is +# present, it is an image; otherwise we must test whether or not it is a +# binary file and make the decision based on that. + +int procedure gg_optype (operand) + +char operand[ARB] # Operand to be plotted +int first, last, ip +int access(), strncmp() + +begin + # Strip off any whitespace at the beginning or end of the string. + for (ip=1; IS_WHITE(operand[ip]); ip=ip+1) + ; + first = ip + for (last=ip; operand[ip] != EOS; ip=ip+1) + if (!IS_WHITE(operand[ip])) + last = ip + + if (first == last) + return (LIST_OP) + else if (strncmp (operand[first], "STDIN", 5) == 0) + return (LIST_OP) + else if (operand[last] == ']') + return (IMAGE_OP) + else if (access (operand, 0, TEXT_FILE) == YES) + return (LIST_OP) + else + return (IMAGE_OP) +end + + +# GG_RDIMAGE2 -- Read an image section and compute the projection about +# one dimension, producing x and y vectors as output. Set the title +# and coordinate label if not previously defined. + +int procedure gg_rdimage2 (imsect, title, xlabel, ylabel, xformat, x, y, size, + axis, wcs) + +char imsect[ARB] # Image section to be plotted +char title[ARB] # Image title +char xlabel[ARB] # Coordinate label +char ylabel[ARB] # Pixel value label +char xformat[ARB] # WCS coordinate format +pointer x, y, size # Pointer to x, y and size vector +int axis # Axis about which the projection is to be taken +char wcs[ARB] # WCS type + +int npix, i, stridxs() +pointer sp, im, mw, ct, axvals, str +pointer immap(), mw_openim(), mw_sctran() +errchk immap, im_projection, malloc, mw_openim, mw_sctran, plt_wcs + +begin + call smark (sp) + call salloc (axvals, IM_MAXDIM, TY_REAL) + call salloc (str, SZ_FNAME, TY_CHAR) + + im = immap (imsect, READ_ONLY, 0) + + if (axis < 1 || axis > IM_NDIM(im)) + call error (2, "Attempt to take projection over nonexistent axis") + npix = IM_LEN(im,axis) + + call malloc (y, npix, TY_REAL) + call im_projection (im, Memr[y], npix, axis) + + iferr { + call malloc (x, npix, TY_REAL) + call malloc (size, npix, TY_REAL) + } then + call erract (EA_FATAL) + + # Set title if not previously defined + if (title[1] == EOS) { + call strcpy (IM_TITLE(im), title, SZ_LINE) + if (stridxs ("\n", title) == 0) + call strcat ("\n", title, SZ_LINE) + call imgsection (imsect, Memc[str], SZ_LINE) + if (Memc[str] != EOS) + call strcat (Memc[str], title, SZ_LINE) + } + + # Set WCS coordinates + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", wcs, 0) + call strcpy (wcs, Memc[str], SZ_LINE) + do i = 1, IM_NDIM(im) + Memr[axvals+i-1] = (1 + IM_LEN(im, i)) / 2. + call plt_wcs (im, mw, ct, axis, Memr[axvals], 1., real(npix), Memr[x], + npix, Memc[str], xformat, SZ_FNAME) + if (xlabel[1] == EOS) + call strcpy (Memc[str], xlabel, SZ_LINE) + call mw_close (mw) + + call imunmap (im) + + call sfree (sp) + return (npix) +end + + +# GG_RDLIST2 -- Read a list of two dimensional data pairs into two type +# real arrays in memory. Return pointers to the arrays and a count of the +# number of pixels. If mark sizes are to be read from the input list, +# a third array of mark sizes is returned. Mark sizes can only be given +# in two column (x,y) mode, with the mark size given as a third column. + +int procedure gg_rdlist2 (fname, x, y, size, rdmarks) + +char fname[ARB] # Name of list file +pointer x, y, size # Pointers to x, y and size vectors +bool rdmarks # Read markers from file? + +int buflen, n, fd, ncols, lineno +pointer sp, lbuf, ip +real xval, yval, szmark +int getline(), nscan(), open() +errchk open, sscan, getline, malloc + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + fd = open (fname, READ_ONLY, TEXT_FILE) + + buflen = SZ_BUF + iferr { + call malloc (x, buflen, TY_REAL) + call malloc (y, buflen, TY_REAL) + call malloc (size, buflen, TY_REAL) + } then + call erract (EA_FATAL) + + n = 0 + ncols = 0 + lineno = 0 + szmark = 1E-2 + + while (getline (fd, Memc[lbuf]) != EOF) { + # Skip comment lines and blank lines. + lineno = lineno + 1 + 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) + if (rdmarks) + call gargr (szmark) + + # The first line determines whether we have an x,y list or a + # y-list. It is an error if only one value can be decoded when + # processing a two column list. + + if (ncols == 0 && nscan() > 0) + ncols = nscan() + + switch (nscan()) { + case 0: + call eprintf ("no args; %s, line %d: %s\n") + call pargstr (fname) + call pargi (lineno) + call pargstr (Memc[lbuf]) + next + case 1: + if (ncols == 2) { + call eprintf ("only 1 arg; %s, line %d: %s\n") + call pargstr (fname) + call pargi (lineno) + call pargstr (Memc[lbuf]) + next + } else { + yval = xval + xval = n + 1.0 + } + case 2: + if (rdmarks) { + call eprintf ("no szmark field; %s, line %d: %s\n") + call pargstr (fname) + call pargi (lineno) + call pargstr (Memc[lbuf]) + szmark = 1E-2 + } + } + + n = n + 1 + if (n > buflen) { + buflen = buflen + SZ_BUF + call realloc (x, buflen, TY_REAL) + call realloc (y, buflen, TY_REAL) + call realloc (size, buflen, TY_REAL) + } + + Memr[x+n-1] = xval + Memr[y+n-1] = yval + if (rdmarks) + Memr[size+n-1] = szmark + } + + call realloc (x, n, TY_REAL) + call realloc (y, n, TY_REAL) + call realloc (size, n, TY_REAL) + + call close (fd) + call sfree (sp) + return (n) +end + + +# GG_LINTRAN -- Linearly transform a vector. Map pixel values P1,P2 +# onto Q1,Q2. + +procedure gg_lintran (x, npix, p1in, p2in, q1, q2) + +real x[npix] # Vector to transform +int npix # Number of pixels in vector +real p1in, p2in # Range of input values to map +real q1, q2 # Range for output values +real p1, p2 +real xscale + +begin + # If P1 and P2 are not set, use full range of input pixels indices. + if (p1in == 0 && p2in == 0) { + p1 = 1.0 + p2 = npix + } else { + p1 = p1in + p2 = p2in + } + + if (p2 - p1 == 0) + xscale = (q2 - q1) + else + xscale = (q2 - q1) / (p2 - p1) + + call asubkr (x, p1, x, npix) + call amulkr (x, xscale, x, npix) + call aaddkr (x, q1, x, npix) +end diff --git a/pkg/plot/t_hafton.x b/pkg/plot/t_hafton.x new file mode 100644 index 00000000..07e70393 --- /dev/null +++ b/pkg/plot/t_hafton.x @@ -0,0 +1,305 @@ +# 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> + +define DUMMY 6 +define SAMPLE_SIZE 1000 +define LEN_STDLINE 40 + +# HAFTON -- Draw a half tone plot of an image section. This is an +# interface to the NCAR HAFTON routine. + +procedure t_hafton() + +int sign +bool sub, pre +pointer im, subras, gp +int tcojmp[LEN_JUMPBUF] +char imsect[SZ_FNAME], mapping_function[SZ_FNAME] +char device[SZ_FNAME], title[SZ_LINE], system_id[SZ_LINE] +int ncols, nlines, epa, status, wkid, mode, old_onint +int nlevels, nprm, nopt, xres, yres, nfunction, nx, ny +real z1, z2, wx1, wx2, wy1, wy2, contrast +real xs, xe, ys, ye, vx1, vx2, vy1, vy2 + +real clgetr() +extern hf_tco_onint() +int clgeti(), strncmp() +pointer gopen(), plt_getdata(), immap() +bool clgetb(), fp_equalr(), streq() +common /tcocom/ tcojmp + +begin + # Get image section string and output device. + call clgstr ("image", imsect, SZ_FNAME) + call clgstr ("device", device, SZ_FNAME) + + # Map image. + im = immap (imsect, READ_ONLY, 0) + + z1 = clgetr ("z1") + z2 = clgetr ("z2") + + # Gaurantee that image min/max is up to date + if (IM_LIMTIME(im) < IM_MTIME(im)) + call hf_minmax (im, IM_MIN(im), IM_MAX(im)) + + if (fp_equalr (z1, z2)) { + z1 = IM_MIN(im) + z2 = IM_MAX(im) + } + + # User can specify the type of mapping function used, and whether + # the contrast is negative or positive. + + nlevels = clgeti ("nlevels") + contrast = clgetr ("contrast") + call clgstr ("mapping_function", mapping_function, SZ_FNAME) + + # Assign integer code to specified mapping function + if (strncmp (mapping_function, "linear", 2) == 0) + nfunction = 1 + else if (strncmp (mapping_function, "exponential", 1) == 0) + nfunction = 2 + else if (strncmp (mapping_function, "logarithmic", 2) == 0) + nfunction = 3 + else if (strncmp (mapping_function, "sinusoidal", 1) == 0) + nfunction = 4 + else if (strncmp (mapping_function, "arcsine", 1) == 0) + nfunction = 5 + else if (strncmp (mapping_function, "crtpict", 1) == 0) + nfunction = 6 + else + call error (0, "Hafton: unknown mapping function") + + sign = 1.0 + if (contrast < 0.0) + sign = -1.0 + nopt = sign * nfunction + + mode = NEW_FILE + if (clgetb ("append")) + mode = APPEND + + # Read in subraster. Image resolution can be decreased by + # subsampling or block averaging. + + xres = clgeti ("xres") + yres = clgeti ("yres") + sub = clgetb ("subsample") + pre = clgetb ("preserve") + + # Retrieve values from image header that will be needed. + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + if (streq (title, "imtitle")) { + call strcpy (imsect, title, SZ_LINE) + call strcat (": ", title, SZ_LINE) + call strcat (IM_TITLE(im), title, SZ_LINE) + } + + xs = 1.0 + xe = real (ncols) + ys = 1.0 + ye = real (nlines) + + # Get data with proper resolution. Procedure plt_getdata returns + # a pointer to the data matrix to be contoured. The resolution + # is decreased by the specified mathod in this procedure. The + # dimensions of the data array are also returned. The image + # header pointer can be unmapped after plt_getdata is called. + + nx = 0 + ny = 0 + subras = plt_getdata (im, sub, pre, xres, yres, nx, ny) + + if (nfunction == 6) { + # User wants crtpict automatic algorithm - linear mapping + # between calculated z1, z2 using possible non-integer contrast. + # Get z1, z2 as if positive contrast. Set nopt later to negative + # if necessary. + + call zscale (im, z1, z2, abs(contrast), SAMPLE_SIZE, LEN_STDLINE) + } + + call eprintf ("Intensities from z1=%.2f to z2=%.2f mapped with a") + call pargr (z1) + call pargr (z2) + + switch (nfunction) { + case (1): + call eprintf (" linear function\n") + case (2): + call eprintf ("n exponential function\n") + case (3): + call eprintf (" logarithmic function\n") + case (4): + call eprintf (" sinusodial function\n") + case (5): + call eprintf ("n arcsine function\n") + case (6): + call eprintf (" CRTPICT function\n") + if (nopt > 0) { + # Positive contrast. Set nopt to positive linear mapping. + nopt = 1 + } else { + # Negative contrast. Set nopt to negative linear mapping. + nopt = -1 + } + } + + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + + # Open device and make contour plot. + call gopks (STDERR) + wkid = 1 + gp = gopen (device, mode, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call pl_map_viewport (gp, + ncols, nlines, vx1, vx2, vy1, vy2, clgetb ("fill"), true) + nprm = -1 + + # Install interrupt exception handler. + call zlocpr (hf_tco_onint, epa) + call xwhen (X_INT, epa, old_onint) + + # Make the hafton plot. If an interrupt occurs ZSVJMP is reentered + # with an error status. + + call zsvjmp (tcojmp, status) + if (status == OK) { + call hafton (Memr[subras], nx, nx, ny, z1, z2, + nlevels, nopt, nprm, 0, 0.) + } else { + call gcancel (gp) + call fseti (STDOUT, F_CANCEL, OK) + } + + # Should a fancy (crtpict like) perimeter be drawn around the plot? + if (clgetb ("perimeter")) { + call gswind (gp, xs, xe, ys, ye) + call draw_perimeter (gp) + } else + call perim (1, ncols - 1, nlines - 1, 1) + + # Now find window and output text string title. The window is + # set to the full image coordinates for labelling. + + call ggview (gp, wx1, wx2, wy1, wy2) + call gseti (gp, G_WCS, 0) + call gtext (gp, (wx1 + wx2) / 2.0, wy2 + .03, title, "h=c;v=b;f=b;s=.7") + + # Add system id banner to plot. + call gseti (gp, G_CLIP, NO) + call sysid (system_id, SZ_LINE) + call gtext (gp, (wx1+wx2)/2.0, wy1-0.07, system_id, "h=c;v=b;s=.5") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () + call imunmap (im) + + # Free space used for scaled input routines. + call mfree (subras, TY_REAL) +end + + +# HF_TCO_ONINT -- Interrupt handler for the task hafton. Branches back to +# ZSVJMP in the main routine to permit shutdown without an error message. + +procedure hf_tco_onint (vex, next_handler) + +int vex # virtual exception +int next_handler # not used + +int tcojmp[LEN_JUMPBUF] +common /tcocom/ tcojmp + +begin + call xer_reset() + call zdojmp (tcojmp, vex) +end + + +# HF_MINMAX -- Compute the minimum and maximum pixel values of an image. +# Works for images of any dimensionality, size, or datatype, although +# the min and max values can currently only be stored in the image header +# as real values. + +procedure hf_minmax (im, min_value, max_value) + +pointer im # image descriptor +real min_value # minimum pixel value in image (out) +real max_value # maximum pixel value in image (out) + +pointer buf +bool first_line +long v[IM_MAXDIM] +short minval_s, maxval_s +long minval_l, maxval_l +real minval_r, maxval_r +int imgnls(), imgnll(), imgnlr() +errchk amovkl, imgnls, imgnll, imgnlr, alims, aliml, alimr + +begin + call amovkl (long(1), v, IM_MAXDIM) # start vector + first_line = true + min_value = INDEF + max_value = INDEF + + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + while (imgnls (im, buf, v) != EOF) { + call alims (Mems[buf], IM_LEN(im,1), minval_s, maxval_s) + if (first_line) { + min_value = minval_s + max_value = maxval_s + first_line = false + } else { + if (minval_s < min_value) + min_value = minval_s + if (maxval_s > max_value) + max_value = maxval_s + } + } + case TY_USHORT, TY_INT, TY_LONG: + while (imgnll (im, buf, v) != EOF) { + call aliml (Meml[buf], IM_LEN(im,1), minval_l, maxval_l) + if (first_line) { + min_value = minval_l + max_value = maxval_l + first_line = false + } else { + if (minval_l < min_value) + min_value = minval_l + if (maxval_l > max_value) + max_value = maxval_l + } + } + default: + while (imgnlr (im, buf, v) != EOF) { + call alimr (Memr[buf], IM_LEN(im,1), minval_r, maxval_r) + if (first_line) { + min_value = minval_r + max_value = maxval_r + first_line = false + } else { + if (minval_r < min_value) + min_value = minval_r + if (maxval_r > max_value) + max_value = maxval_r + } + } + } +end diff --git a/pkg/plot/t_implot.x b/pkg/plot/t_implot.x new file mode 100644 index 00000000..fbf8f00a --- /dev/null +++ b/pkg/plot/t_implot.x @@ -0,0 +1,1202 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <ctype.h> +include <imhdr.h> +include <mach.h> +include <gset.h> +include <mwset.h> + +define SEGLEN 10 +define SZ_PLOTTITLE 512 +define KEYSFILE "lib$scr/implot.key" +define MAX_COLORS 8 + + +# IMPLOT -- Image plot program. An interactive, cursor driven program for +# plotting lines and columns of images. This is an early version of the program +# lacking averaging and interaction with the image display cursor. +# +# implot (image [,line]) +# +# Keystrokes: +# +# ? help +# a plot the average of a range of lines of columns +# c plot column at position of cursor +# e expand plot by marking corners of new window +# j move down +# k move up +# l plot line at position of cursor +# m previous image +# n next image +# p measure profile (mark region and baseline with 2 pos) +# o overplot next vector +# r redraw +# s print statistics on a region +# / scroll status line +# +# +# In addition to the above keystrokes, the following ':' escapes are recognized +# by the program: +# +# :a N set number of lines or columns to average +# :c M [N] plot column M or avg of M to N +# :f format set label format +# :i imagename open a new image for input +# :l M [N] plot line M or avg of M to N +# :o overplot +# :log+,log- enable, disable log scaling in Y +# :step N set step size for j,k +# :solid overplot with solid, not dashed, lines +# :mono disable coloring of overplotted vectors +# :x x1 x2 fix plot window in X (no args to unfix) +# :y y1 y2 fix plot window in Y (no args to unfix) +# :w wcstype change world coordinate type + +procedure t_implot() + +int list +char image[SZ_FNAME] +char wcstype[SZ_FNAME] +char xlabel[SZ_FNAME] +char format[SZ_FNAME] +char fmt[SZ_FNAME] +char command[SZ_FNAME] +char device[SZ_FNAME] + +int xnticks, ynticks +bool overplot, lineplot, logscale, erase, rescale[2], p_rescale[2] +int key, wcs, ip, i1, i2, n, linetype, color, nltypes, linestep, navg +int npix, nlines, ncols, line, col, shift, step, p_navg, sline, nim, index +real x, y, px, py, qx, qy, x1, x2, y1, y2 +real median, mean, sigma, sum +pointer im, mw, ct, gp, xold, yold, xnew, ynew, sl, ptr + +real asumr(), amedr(), plt_iformatr() +int clgeti(), clgcur(), ctoi(), ctor(), ggeti(), imtlen(), imaccess() +pointer gopen(), immap(), mw_openim(), mw_sctran(), sl_getstr() +pointer imtopenp(), imtrgetim() +errchk mw_sctran + +define line_ 91 +define col_ 92 +define replotline_ 93 +define replotcol_ 94 +define nextim_ 95 +define quit_ 96 +string bell "\007" +string again "again:" + +begin + list = imtopenp ("image") + call clgstr ("device", device, SZ_FNAME) + gp = gopen (device, NEW_FILE, STDGRAPH) + call clgstr ("wcs", wcstype, SZ_FNAME) + + if (clgeti ("$nargs") > 1) + line = clgeti ("line") + else + line = INDEFI + + p_rescale[1] = true + rescale[1] = true + p_rescale[2] = true + rescale[2] = true + + logscale = false + overplot = false + lineplot = true + erase = false + xnticks = 5 + ynticks = 5 + format[1] = EOS + + linestep = 1 + linetype = 1 + color = 1 + nltypes = ggeti (gp, "lt") + p_navg = 1 + navg = 1 + step = clgeti ("step") + + # Loop through the images. Currently this loop is not actually + # used and instead the 'm' and 'n' keys explicitly change the + # image. The 'q' key exits the loop regardless of the position + # of the list. + + nim = imtlen (list) + index = 1 + while (imtrgetim (list, index, image, SZ_FNAME) != EOF) { + iferr { + im = NULL; mw = NULL; sl = NULL + + if (imaccess (image, READ_ONLY) == YES) { + ptr = immap (image, READ_ONLY, 0); + im = ptr + + } else { + call eprintf ("Error opening image '%s'") + call pargstr (image) + goto nextim_ + } + + ptr = mw_openim (im); mw = ptr + call mw_seti (mw, MW_USEAXMAP, NO) + + ct = mw_sctran (mw, "logical", wcstype, 0) + + ncols = IM_LEN(im,1) + if (IM_NDIM(im) <= 0) + call error (1, "image has no pixels") + else if (IM_NDIM(im) > 1) + nlines = IM_LEN(im,2) + else + nlines = 1 + + if (IS_INDEFI(line)) + line = max(1, min(nlines, (nlines + 1) / 2)) + + if (IS_INDEFI(step) || step < 1) + step = max (1, nlines / 10) + + npix = max (ncols, nlines) + call malloc (xold, npix, TY_REAL) + call malloc (yold, npix, TY_REAL) + call malloc (xnew, npix, TY_REAL) + call malloc (ynew, npix, TY_REAL) + + if (!overplot) + call gclear (gp) + call imp_getvector (im, mw, ct, wcstype, xnew, ynew, xlabel, + fmt, line, navg, lineplot) + if (format[1] == '%') + call strcpy (format, fmt, SZ_FNAME) + npix = ncols + + call gsets (gp, G_XTICKFORMAT, fmt) + if (xnticks >= 0) + call gseti (gp, G_XNMAJOR, xnticks) + if (ynticks >= 0) + call gseti (gp, G_YNMAJOR, ynticks) + call gseti (gp, G_NMINOR, 0) + call gseti (gp, G_PLTYPE, 1) + call gseti (gp, G_PLCOLOR, 1) + + call imp_plotvector (gp, im, Memr[xnew], Memr[ynew], ncols, + nlines, real(line), navg, lineplot, rescale, image, xlabel) + overplot = false + + call sl_init (sl, 1) + while (clgcur ("coords", x, y, wcs, key, command, SZ_FNAME) != + EOF) { + if (key == 'q') +quit_ break + + switch (key) { + case 'a': + # Plot the average over a range of lines or columns + # marked interactively with the cursor. + + x1 = x; y1 = y + call printf (again) + if (clgcur ("gcur", x2, y2, wcs, key, command, + SZ_FNAME) == EOF) + next + + if (abs(x2-x1) > abs(y2-y1)) { + # Range is in X. + + navg = abs (x2 - x1) + 1 + if (lineplot) { + col = nint (min (x1, x2)) + goto col_ + } else { + line = nint (min (x1, x2)) + goto line_ + } + + } else { + # Range is in Y. + + if (lineplot) { + call imp_tran (gp, x1, y1, x1, y1, Memr[xnew], + ncols, nlines) + call imp_tran (gp, x2, y2, x2, y2, Memr[xnew], + ncols, nlines) + navg = abs (y2 - y1) + 1 + line = nint (min (y1, y2)) + goto line_ + } else { + call imp_tran (gp, x1, y1, x1, y1, Memr[xnew], + nlines, ncols) + call imp_tran (gp, x2, y2, x2, y2, Memr[xnew], + nlines, ncols) + navg = abs (y2 - y1) + 1 + col = nint (min (y1, y2)) + goto col_ + } + } + + case 'j', 'k': + # Move viewport into image up (k) or down (j). This + # is done by erasing the old data vector and drawing + # a new one. + + erase = true + navg = p_navg + overplot = true + call amovr (Memr[xnew], Memr[xold], npix) + call amovr (Memr[ynew], Memr[yold], npix) + + shift = step + if (key == 'j') + shift = -shift + + if (lineplot) { + line = line + shift + goto line_ + } else { + col = col + shift + goto col_ + } + + case 'l': + # Plot a line. + if (lineplot) { + call imp_tran (gp, x, y, px, py, Memr[xnew], ncols, + nlines) + line = max(1, min(nlines, nint(py))) + } else { + call imp_tran (gp, x, y, px, py, Memr[xnew], nlines, + ncols) + line = max(1, min(nlines, nint(px))) + } + navg = p_navg + line = line - (navg - 1) / 2 +line_ + lineplot = true + line = max(1, min(nlines, line)) + call imp_getvector (im, mw, ct, wcstype, xnew, ynew, + xlabel, fmt, line, navg, lineplot) + if (format[1] == '%') + call strcpy (format, fmt, SZ_FNAME) + npix = ncols +replotline_ + if (overplot) { + if (erase) { + # Erase old vector and replace it with new + # vector. + + call imp_redraw (gp, Memr[xold], Memr[yold], + Memr[xnew], Memr[ynew], npix) + erase = false + + } else { + # Overplot new vector. + + linetype = linetype + linestep + if (linetype > nltypes) + linetype = 1 + call gseti (gp, G_PLTYPE, linetype) + + color = color + 1 + if (color > MAX_COLORS) + color = 1 + call gseti (gp, G_PLCOLOR, color) + + call gpline (gp, Memr[xnew], Memr[ynew], ncols) + } + + call imp_markpos (gp, line, nlines) + overplot = false + + } else { + call gclear (gp) + call gsets (gp, G_XTICKFORMAT, fmt) + if (logscale) + call gseti (gp, G_YTRAN, GW_LOG) + call gseti (gp, G_NMINOR, 0) + if (xnticks >= 0) + call gseti (gp, G_XNMAJOR, xnticks) + if (ynticks >= 0) + call gseti (gp, G_YNMAJOR, ynticks) + linetype = 1 + color = 1 + call imp_plotvector (gp, im, Memr[xnew], Memr[ynew], + ncols, nlines, real(line), navg, lineplot, + rescale, image, xlabel) + rescale[1] = p_rescale[1] + rescale[2] = p_rescale[2] + } + + case 'm', 'n': + if (key == 'm') { + if (index > 1) + index = index - 1 + else + next + } else if (key == 'n') { +nextim_ if (index < nim) + index = index + 1 + else + next + } + + if (imtrgetim (list, index, command, SZ_FNAME) == EOF) + break + + # Open a different image. + call mw_close (mw) + call imunmap (im) + + iferr (im = immap (command, READ_ONLY, 0)) { + call erract (EA_WARN) + im = immap (image, READ_ONLY, 0) + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", wcstype, 0) + next + } + + if (IM_NDIM(im) <= 0) { + call eprintf ("image has no pixels\n") + im = immap (image, READ_ONLY, 0) + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", wcstype, 0) + next + + } else { + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", wcstype, 0) + + ncols = IM_LEN(im,1) + if (IM_NDIM(im) > 1) + nlines = IM_LEN(im,2) + else { + lineplot = true + nlines = 1 + } + + npix = max (ncols, nlines) + call strcpy (command, image, SZ_FNAME) + call realloc (xold, npix, TY_REAL) + call realloc (yold, npix, TY_REAL) + call realloc (xnew, npix, TY_REAL) + call realloc (ynew, npix, TY_REAL) + + if (lineplot) + goto line_ + else + goto col_ + } + + case 'c': + # Plot a column. + if (lineplot) { + call imp_tran (gp, x, y, px, py, Memr[xnew], ncols, + nlines) + col = max(1, min(ncols, nint(px))) + } else { + call imp_tran (gp, x, y, px, py, Memr[xnew], nlines, + ncols) + col = max(1, min(ncols, nint(py))) + } + navg = p_navg + col = col - (navg - 1) / 2 +col_ + if (nlines == 1) { + call printf (bell) + next + } + lineplot = false + col = max(1, min(ncols, col)) + call imp_getvector (im, mw, ct, wcstype, xnew, ynew, + xlabel, fmt, col, navg, lineplot) + if (format[1] == '%') + call strcpy (format, fmt, SZ_FNAME) + npix = nlines +replotcol_ + if (overplot) { + if (erase) { + # Erase old vector and replace it with new + # vector. + + call imp_redraw (gp, Memr[xold], Memr[yold], + Memr[xnew], Memr[ynew], npix) + erase = false + + } else { + linetype = linetype + linestep + if (linetype > nltypes) + linetype = 1 + call gseti (gp, G_PLTYPE, linetype) + + color = color + 1 + if (color > MAX_COLORS) + color = 1 + call gseti (gp, G_PLCOLOR, color) + + call gpline (gp, Memr[xnew], Memr[ynew], nlines) + } + + call imp_markpos (gp, col, ncols) + overplot = false + + } else { + call gclear (gp) + call gsets (gp, G_XTICKFORMAT, fmt) + if (logscale) + call gseti (gp, G_YTRAN, GW_LOG) + call gseti (gp, G_NMINOR, 0) + if (xnticks >= 0) + call gseti (gp, G_XNMAJOR, xnticks) + if (ynticks >= 0) + call gseti (gp, G_YNMAJOR, ynticks) + linetype = 1 + color = 1 + call imp_plotvector (gp, im, Memr[xnew], Memr[ynew], + nlines, ncols, real(col), navg, lineplot, + rescale, image, xlabel) + rescale[1] = p_rescale[1] + rescale[2] = p_rescale[2] + } + + case 'e': + # Expand plot by marking corners of new window. We are + # called with the coords of the lower left corner. + + x1 = x; y1 = y + call printf (again) + if (clgcur ("gcur", x2, y2, wcs, key, command, + SZ_FNAME) == EOF) + next + + rescale[1] = false + rescale[2] = false + p_rescale[1] = true + p_rescale[2] = true + + # If the cursor moved only in X, with negligible range + # in Y, expand only in X. Do the comparisons in NDC + # space to avoid scaling problems. + + call gctran (gp, x1, y1, px, py, wcs, 0) + call gctran (gp, x2, y2, qx, qy, wcs, 0) + + if (abs (py - qy) < .01) { + y1 = INDEF; y2 = INDEF + rescale[2] = true + } + call imp_swind (x1, x2, y1, y2) + + if (lineplot) + goto replotline_ + else + goto replotcol_ + + case 'o': + overplot = true + + case 'r': + if (lineplot) + goto replotline_ + else + goto replotcol_ + + case 'p': + # Profile analysis. + x1 = x + y1 = y + call printf (again) + if (clgcur ("gcur", x2, y2, wcs, key, command, + SZ_FNAME) == EOF) + next + + call imp_profile (gp, Memr[xnew], Memr[ynew], npix, + x1, y1, x2, y2, sl, sline) + call printf (Memc[sl_getstr(sl,sline)]) + + case 's': + # Statistics. + x1 = x + call printf (again) + if (clgcur ("gcur", x2, y, wcs, key, command, + SZ_FNAME) == EOF) + next + + i1 = max(1, min(npix, nint(x1))) + i2 = max(1, min(npix, nint(x2))) + if (i1 > i2) { + n = i1 + i1 = i2 + i2 = n + } else if (i1 == i2) + i2 = i1 + 1 + + n = i2 - i1 + 1 + call aavgr (Memr[ynew+i1-1], n, mean, sigma) + median = amedr (Memr[ynew+i1-1], n) + sum = asumr (Memr[ynew+i1-1], n) + + call sl_init (sl, 1) + call sprintf (Memc[sl_getstr(sl,1)], SZ_LINE, + "median=%g, mean=%g, rms=%g, sum=%g, npix=%d\n") + call pargr (median) + call pargr (mean) + call pargr (sigma) + call pargr (sum) + call pargi (n) + sline = 1 + call printf (Memc[sl_getstr(sl,sline)]) + + case ' ': + # Print cursor coordinates. + call sl_init (sl, 1) + if (lineplot) { + call imp_tran (gp, x, y, px, py, Memr[xnew], ncols, + nlines) + col = px + call plt_wcscoord (im, mw, ct, wcstype, format, col, + line, Memr[ynew+col-1], Memc[sl_getstr(sl,1)], + SZ_LINE) + } else { + call imp_tran (gp, x, y, px, py, Memr[xnew], nlines, + ncols) + line = px + call plt_wcscoord (im, mw, ct, wcstype, format, col, + line, Memr[ynew+line-1], Memc[sl_getstr(sl,1)], + SZ_LINE) + } + sline = 1 + call printf (Memc[sl_getstr(sl,sline)]) + + case '?': + # Print command summary. + call gpagefile (gp, KEYSFILE, "implot cursor commands") + + case ':': + # Command mode. + for (ip=1; IS_WHITE (command[ip]); ip=ip+1) + ; + if (command[ip] == 'o') { + overplot = true + ip = ip + 1 + } + + switch (command[ip]) { + case 'a': + # Set number of lines or columns to average. + ip = ip + 1 + if (ctoi (command, ip, p_navg) <= 0) { + call printf (bell) + p_navg = 1 + } + + case 'i': + # Open a different image. + call mw_close (mw) + call imunmap (im) + ip = ip + 1 + while (IS_WHITE (command[ip])) + ip = ip + 1 + + iferr (im = immap (command[ip], READ_ONLY, 0)) { + call erract (EA_WARN) + im = immap (image, READ_ONLY, 0) + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", wcstype, 0) + + } else if (IM_NDIM(im) <= 0) { + call eprintf ("image has no pixels\n") + im = immap (image, READ_ONLY, 0) + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", wcstype, 0) + + } else { + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", wcstype, 0) + + ncols = IM_LEN(im,1) + if (IM_NDIM(im) > 1) + nlines = IM_LEN(im,2) + else + nlines = 1 + + npix = max (ncols, nlines) + call strcpy (command[ip], image, SZ_FNAME) + call realloc (xold, npix, TY_REAL) + call realloc (yold, npix, TY_REAL) + call realloc (xnew, npix, TY_REAL) + call realloc (ynew, npix, TY_REAL) + } + + case 'w': + # Change wcs type. + call mw_ctfree (ct) + ip = ip + 1 + while (IS_WHITE (command[ip])) + ip = ip + 1 + + iferr { + ct = mw_sctran (mw, "logical", command[ip], 0) + call strcpy (command[ip], wcstype, SZ_FNAME) + } then { + call erract (EA_WARN) + ct = mw_sctran (mw, "logical", wcstype, 0) + } else { + # Only replot if WCS command succeeds, + # otherwise the error message is lost. + if (lineplot) + goto line_ + else + goto col_ + } + + case 'f': + # Change label format. + ip = ip + 1 + while (IS_WHITE (command[ip])) + ip = ip + 1 + if (command[ip] == '%') { + call strcpy (command[ip], format, SZ_FNAME) + call strcpy (format, fmt, SZ_FNAME) + if (lineplot) + goto replotline_ + else + goto replotcol_ + } else if (format[1] == '%') { + call strcpy (command[ip], format, SZ_FNAME) + if (lineplot) + goto line_ + else + goto col_ + } + + case 'l': + if (command[ip+1] != 'o') { + # Plot a line. + ip = ip + 1 + if (ctoi (command, ip, i1) <= 0) { + call printf (bell) + next + } else if (ctoi (command, ip, i2) <= 0) { + line = max(1, min(nlines, i1)) + navg = p_navg + line = line - (navg - 1) / 2 + goto line_ + } else { + i1 = max(1, min(nlines, i1)) + i2 = max(1, min(nlines, i2)) + line = min (i1, i2) + navg = max (1, abs (i2 - i1) + 1) + goto line_ + } + } else { + # Enable/disable log scaling. + while (IS_ALPHA(command[ip])) + ip = ip + 1 + logscale = (command[ip] == '+') + } + + case 'c': + # Plot a column. + ip = ip + 1 + if (ctoi (command, ip, i1) <= 0) { + call printf (bell) + next + } else if (ctoi (command, ip, i2) <= 0) { + col = max(1, min(ncols, i1)) + navg = p_navg + col = col - (navg - 1) / 2 + goto col_ + } else { + i1 = max(1, min(ncols, i1)) + i2 = max(1, min(ncols, i2)) + col = min (i1, i2) + navg = max (1, abs (i2 - i1) + 1) + goto col_ + } + + case 's': + if (command[ip+1] == 'o') { + # Use only linetype=1 (solid). + linetype = 1 + linestep = 0 + color = 1 + } else { + # Set step size. + while (IS_ALPHA (command[ip])) + ip = ip + 1 + if (ctoi (command, ip, step) <= 0) { + call printf (bell) + step = 1 + } + } + + case 'x': + # Fix window in X and replot vector. If no args + # are given, unfix the window. + + ip = ip + 1 + if (ctor (command, ip, x1) <= 0) { + rescale[1] = true + p_rescale[1] = true + } else if (ctor (command, ip, x2) <= 0) { + call printf (bell) + } else { + x1 = plt_iformatr (x1, fmt) + x2 = plt_iformatr (x2, fmt) + call imp_swind (x1, x2, INDEF, INDEF) + rescale[1] = false + p_rescale[1] = false + } + + if (lineplot) + goto replotline_ + else + goto replotcol_ + + case 'y': + # Fix window in Y and replot vector. If no args + # are given, unfix the window. + + ip = ip + 1 + if (ctor (command, ip, y1) <= 0) { + rescale[2] = true + p_rescale[2] = true + } else if (ctor (command, ip, y2) <= 0) { + call printf (bell) + } else { + y1 = plt_iformatr (y1, fmt) + y2 = plt_iformatr (y2, fmt) + call imp_swind (INDEF, INDEF, y1, y2) + p_rescale[2] = false + rescale[2] = false + } + + if (lineplot) + goto replotline_ + else + goto replotcol_ + + case 'n': + ip = ip + 1 + if (command[ip] == 'x') { + while (IS_ALPHA(command[ip])) + ip = ip + 1 + if (ctoi (command, ip, xnticks) <= 0) + xnticks = -1 + } else if (command[ip] == 'y') { + while (IS_ALPHA(command[ip])) + ip = ip + 1 + if (ctoi (command, ip, ynticks) <= 0) + ynticks = -1 + } else + call printf (bell) + + default: + call printf (bell) + } + + case '/': + # Scroll or rewrite the status line. + + sline = sline + 1 + call printf (Memc[sl_getstr(sl,sline)]) + + default: + call printf (bell) + } + } + } then + call erract (EA_WARN) + + call mfree (xnew, TY_REAL) + call mfree (ynew, TY_REAL) + call mfree (xold, TY_REAL) + call mfree (yold, TY_REAL) + if (sl != NULL) + call sl_free (sl) + + if (mw != NULL) + call mw_close (mw) + if (im != NULL) + call imunmap (im) + + if (key == 'q') + break + } + + call gclose (gp) + call imtclose (list) +end + + +# IMP_GETVECTOR -- Get a data vector, i.e., line or column or average of +# lines and columns. + +procedure imp_getvector (im, mw, ct, wcstype, x, y, xlabel, format, linecol, + navg, lineplot) + +pointer im # image descriptor +pointer mw # mwcs descriptor +pointer ct # coordinate descriptor +char wcstype[ARB] # WCS type +pointer x, y # output vector +char xlabel[SZ_FNAME] # WCS label +char format[SZ_FNAME] # WCS format +int linecol # line or column number +int navg # number of lines or columns to be averaged +bool lineplot # true if line is to be extracted + +real norm +pointer sp, axvals, buf, off +int x1, x2, y1, y2 +int nx, ny, width, i, ndim +real asumr() +pointer imgl2r(), imgs2r(), imgl1r(), imgs1r() +errchk imgl2r, imgs2r, imgl1r, imgs1r, plt_wcs + +begin + call smark (sp) + call salloc (axvals, IM_NDIM(im), TY_REAL) + + call strcpy (wcstype, xlabel, SZ_FNAME) + + ndim = IM_NDIM(im) + nx = IM_LEN(im,1) + if (ndim > 1) + ny = IM_LEN(im,2) + else + ny = 1 + call amovkr (1., Memr[axvals], ndim) + + if (lineplot) { + # Extract a line vector. + + x1 = 1 + x2 = nx + y1 = max(1, min (ny, linecol)) + y2 = max(1, min (ny, linecol + navg - 1)) + + Memr[axvals+1] = (y1 + y2) / 2. + call plt_wcs (im, mw, ct, 1, Memr[axvals], real(x1), real(x2), + Memr[x], nx, xlabel, format, SZ_FNAME) + + if (ndim == 1) + call amovr (Memr[imgl1r(im)], Memr[y], nx) + + else { + # Compute sum. + call aclrr (Memr[y], nx) + do i = y1, y2 + call aaddr (Memr[imgl2r(im,i)], Memr[y], Memr[y], nx) + + # Normalize. + width = y2 - y1 + 1 + if (width > 1) + call amulkr (Memr[y], 1. / width, Memr[y], nx) + } + + } else { + # Extract a column vector. + + x1 = max(1, min(nx, linecol)) + x2 = max(1, min(nx, linecol + navg - 1)) + y1 = 1 + y2 = ny + + Memr[axvals] = (x1 + x2) / 2. + call plt_wcs (im, mw, ct, 2, Memr[axvals], real(y1), real(y2), + Memr[x], ny, xlabel, format, SZ_LINE) + + width = x2 - x1 + 1 + norm = 1.0 / real(width) + + if (width > 1) { + call aclrr (Memr[y], ny) + do i = y1, y2 { + if (ndim == 1) { + buf = imgs1r (im, x1, x2) + off = buf + } else if (nx > 1024) { + buf = imgs2r (im, x1, x2, i, i) + off = buf + } else { + buf = imgl2r (im, i) + off = buf + x1 - 1 + } + Memr[y+i-1] = asumr (Memr[off], width) * norm + } + } else { + buf = imgs2r (im, x1, x2, y1, y2) + call amovr (Memr[buf], Memr[y], ny) + } + } + + call sfree (sp) +end + + +# IMP_PLOTVECTOR -- Plot a line or column vector. + +procedure imp_plotvector (gp, im, xv, yv, nx, ny, y, navg, lineplot, rescale, + image, xlabel) + +pointer gp # graphics descriptor +pointer im # image descriptor +real xv[ARB] # coordinate vector +real yv[ARB] # data vector +int nx # number of pixels in vector +int ny # number of pixels on plot-Y axis +real y # position on plot Y-axis +int navg # number of lines or columns averaged +bool lineplot # are we plotting a line or a column +bool rescale[2] # rescale plot +char image[ARB] # image name +char xlabel[ARB] # X label + +real junkr +int i, i1, i2, npix, maxch +pointer sp, ip, plot_title, op +bool fp_equalr() + +real x1, x2, y1, y2 +common /implcom/ x1, x2, y1, y2 + +begin + call smark (sp) + call salloc (plot_title, SZ_PLOTTITLE, TY_CHAR) + + # Format the plot title, starting with the system banner. + call sysid (Memc[plot_title], SZ_PLOTTITLE) + for (op=plot_title; Memc[op] != '\n' && Memc[op] != EOS; op=op+1) + ; + Memc[op] = '\n' + op = op + 1 + maxch = SZ_PLOTTITLE - (op - plot_title) + # Format the remainder of the plot title. + + if (IM_LEN(im,2) <= 1) { + # Plot of a one-dim image. + call strcpy (IM_TITLE(im), Memc[op], maxch) + + } else if (navg > 1) { + call sprintf (Memc[op], maxch, "Average of %s %d to %d of %s\n%s") + if (lineplot) { + call pargstr ("lines") + npix = IM_LEN(im,2) + } else { + call pargstr ("columns") + npix = IM_LEN(im,1) + } + + i1 = max (1, min (npix, nint (y))) + i2 = max (1, min (npix, nint (y) + navg - 1)) + call pargi (i1) + call pargi (i2) + call pargstr (image) + call pargstr (IM_TITLE(im)) + + } else { + call sprintf (Memc[op], maxch, "%s %d of %s\n%s") + if (lineplot) + call pargstr ("Line") + else + call pargstr ("Column") + call pargi (nint(y)) + call pargstr (image) + call pargstr (IM_TITLE(im)) + } + + + # Delete trailing newline and any whitespace from image title string. + # Trailing whitespace causes plot title to not be drawn centered on + # plot. + + for (ip=plot_title; Memc[ip] != EOS; ip=ip+1) + ; + ip = ip - 1 + if (ip > plot_title && Memc[ip] == '\n') + ip = ip - 1 + while (ip > plot_title && IS_WHITE(Memc[ip])) + ip = ip - 1 + Memc[ip+1] = EOS + + # Autoscale the plot in X and or Y if so indicated. + if (rescale[1]) + call gascale (gp, xv, nx, 1) + else + call gswind (gp, x1, x2, INDEF, INDEF) + + call ggwind (gp, x1, x2, junkr, junkr) + junkr = min (x1, x2) + for (i1=1; i1<nx && xv[i1] < junkr; i1=i1+1) + ; + junkr = max (x1, x2) + for (i2=nx; i2>1 && xv[i2] > junkr; i2=i2-1) + ; + if (i2 < i1) { + i = i1 + i1 = i2 + i2 = i + } + npix = max (1, i2 - i1 + 1) + + if (rescale[2]) { + if (npix < 2) + call gascale (gp, yv[i1], nx, 2) + else + call gascale (gp, yv[i1], npix, 2) + } else + call gswind (gp, INDEF, INDEF, y1, y2) + + call ggwind (gp, x1, x2, y1, y2) + + # If the image is two dimensional plot the position within the image + # of the plotted vector on the plot-Y axis (which may refer to either + # X or Y on the image). + + if (IM_LEN(im,2) > 1) { + # Draw all but right axes. + if (fp_equalr (y1, y2)) { + y1 = 0.99 * y1 + y2 = 1.01 * y2 + call gswind (gp, INDEF, INDEF, y1, y2) + } + call gseti (gp, G_YDRAWAXES, 1) + call glabax (gp, Memc[plot_title], xlabel, "") + + # Draw right axis (pixel scale) + call ggwind (gp, x1, x2, y1, y2) + call gswind (gp, 1., real (nx), 1., real (ny)) + call gseti (gp, G_XDRAWAXES, 0) + call gseti (gp, G_YDRAWAXES, 2) + call glabax (gp, "", "", "") + call gswind (gp, x1, x2, y1, y2) + + # Mark position on Y axis. + if (abs(y) > .001) + call imp_markpos (gp, nint(y), ny) + } else { + call glabax (gp, Memc[plot_title], xlabel, "") + call ggwind (gp, x1, x2, y1, y2) + } + + # Draw data vector. + call gpline (gp, xv, yv, nx) + + call sfree (sp) +end + + +# IMP_SWIND -- Set all or part of the plotting window if autoscaling is not +# desired. + +procedure imp_swind (n_x1, n_x2, n_y1, n_y2) + +real n_x1, n_x2 # range of world coords in X +real n_y1, n_y2 # range of world coords in Y + +real x1, x2, y1, y2 +common /implcom/ x1, x2, y1, y2 + +begin + if (!IS_INDEF(n_x1)) + x1 = n_x1 + if (!IS_INDEF(n_x2)) + x2 = n_x2 + if (!IS_INDEF(n_y1)) + y1 = n_y1 + if (!IS_INDEF(n_y2)) + y2 = n_y2 +end + + +# IMP_REDRAW -- Erase the old vector and draw a new one in its place. + +procedure imp_redraw (gp, xold, yold, xnew, ynew, npix) + +pointer gp # graphics descriptor +real xold[ARB], yold[ARB] # old data vector +real xnew[ARB], ynew[ARB] # new data vector +int npix # length of the data vectors + +int i, n + +begin + # Erase the old vector and redraw the new in its place, in segments + # of length SEGLEN. These segments must overlap by one pixel to + # produce a continuous output polyline. + + do i = 1, npix, SEGLEN { + n = min (SEGLEN + 1, npix - i + 1) + + # Erase next segment of old vector. + call gseti (gp, G_PLTYPE, 0) + call gpline (gp, xold[i], yold[i], n) + + # Plot same segment of new vector. + call gseti (gp, G_PLTYPE, 1) + call gseti (gp, G_PLCOLOR, 1) + call gpline (gp, xnew[i], ynew[i], n) + } +end + + +# IMP_MARKPOS -- Mark the line or column number on the right axis of the plot. + +procedure imp_markpos (gp, line, nlines) + +pointer gp # graphics descriptor +int line # line or column +int nlines # number of lines or columns +real y, x1, x2, y1, y2 + +begin + if (nlines < 2) + return + + call ggwind (gp, x1, x2, y1, y2) + y = (y2 - y1) / (nlines - 1) * (line - 1) + y1 + call gmark (gp, x2, y, GM_PLUS, 3., 4.) +end + + +# IMP_TRAN -- Transform cursor coordinate to line and column in image. + +procedure imp_tran (gp, x, y, px, py, xvec, nx, ny) + +pointer gp # graphics descriptor +real x, y # cursor coordinate +real px, py # image coordinate +real xvec[nx] # x vector +int nx, ny # number of columns and lines + +int i +real x1, x2, y1, y2, diff, diffmin +bool fp_equalr() + +begin + call ggwind (gp, x1, x2, y1, y2) + if (fp_equalr (y1, y2)) + py = nint (ny / 2.) + else + py = nint ((ny - 1) / (y2 - y1) * (y - y1) + 1) + + px = 1 + diffmin = abs (x - xvec[1]) + do i = 2, nx { + diff = abs (x - xvec[i]) + if (diff < diffmin) { + px = i + diffmin = diff + } + } +end diff --git a/pkg/plot/t_pcol.x b/pkg/plot/t_pcol.x new file mode 100644 index 00000000..7e5c7cfd --- /dev/null +++ b/pkg/plot/t_pcol.x @@ -0,0 +1,58 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <mach.h> +include <imhdr.h> +include <mwset.h> + +# T_PCOL -- Plot an image column. + +procedure t_pcol () + +pointer image, wcslab, fmt +pointer im, mw, ct, sp, x_vec, y_vec +int col, ncols, nlines +real zmin, zmax +int clgeti() +pointer immap(), mw_openim(), mw_sctran() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (wcslab, SZ_LINE, TY_CHAR) + call salloc (fmt, SZ_LINE, TY_CHAR) + + # Open image + call clgstr ("image", Memc[image], SZ_FNAME) + im = immap (Memc[image], READ_ONLY, 0) + call clgstr ("wcs", Memc[wcslab], SZ_LINE) + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", Memc[wcslab], 0) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + col = clgeti ("col") + if (col < 1 || col > ncols) { + call imunmap (im) + call error (2, "column index references outside image") + } + + # Now get the requested column. + call malloc (x_vec, nlines, TY_REAL) + call malloc (y_vec, nlines, TY_REAL) + call plt_gcols (im, mw, ct, col, col, Memr[x_vec], Memr[y_vec], + zmin, zmax, Memc[wcslab], Memc[fmt], SZ_LINE) + + # Draw the requested column to the screen. + call pc_draw_vector (Memc[image], Memr[x_vec], Memr[y_vec], nlines, + zmin, zmax, col, col, Memc[wcslab], Memc[fmt], false) + + # Free resources. + call mfree (x_vec, TY_REAL) + call mfree (y_vec, TY_REAL) + + call imunmap (im) + call sfree (sp) +end diff --git a/pkg/plot/t_pcols.x b/pkg/plot/t_pcols.x new file mode 100644 index 00000000..db4529ef --- /dev/null +++ b/pkg/plot/t_pcols.x @@ -0,0 +1,243 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <mach.h> +include <imhdr.h> +include <mwset.h> + +# T_PCOLS -- Plot the average of a range of columns from an image. + +procedure t_pcols () + +pointer image, wcslab, fmt +pointer im, mw, ct, sp, x_vec, y_vec +int col1, col2, ncols, nlines +real zmin, zmax +int clgeti() +pointer immap(), mw_openim(), mw_sctran() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (wcslab, SZ_LINE, TY_CHAR) + call salloc (fmt, SZ_LINE, TY_CHAR) + + # Open image + call clgstr ("image", Memc[image], SZ_FNAME) + im = immap (Memc[image], READ_ONLY, 0) + call clgstr ("wcs", Memc[wcslab], SZ_LINE) + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", Memc[wcslab], 0) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + col1 = clgeti ("col1") + col2 = clgeti ("col2") + if (min(col1,col2) < 1 || max(col1,col2) > ncols) { + call imunmap (im) + call error (2, "column index references outside image") + } + + # Get the requested columns from the image. + call malloc (x_vec, nlines, TY_REAL) + call malloc (y_vec, nlines, TY_REAL) + call plt_gcols (im, mw, ct, min(col1,col2), max(col1,col2), + Memr[x_vec], Memr[y_vec], zmin, zmax, Memc[wcslab], Memc[fmt], + SZ_LINE) + + # Now draw the vector to the screen. + call pc_draw_vector (Memc[image], Memr[x_vec], Memr[y_vec], nlines, + zmin, zmax, col1, col2, Memc[wcslab], Memc[fmt], true) + + # Free resources. + call mfree (x_vec, TY_REAL) + call mfree (y_vec, TY_REAL) + call imunmap (im) + call sfree (sp) +end + + +# PLT_GCOLS -- Get average of specified columns from an image. The average +# data vector is returned as y_vector; the line coordinates are returned in +# x_vector. The data vector min and max are also returned. + +procedure plt_gcols (im, mw, ct, col1, col2, x_vector, y_vector, zmin, zmax, + wcslab, format, sz_wcslab) + +pointer im # Pointer to image header +pointer mw # MWCS pointer +pointer ct # CT pointer +int col1 # First column to extract +int col2 # Last column to extract +real x_vector[ARB] # The row ordinal values (returned) +real y_vector[ARB] # The column data values (returned) +real zmin, zmax # Minimum and maximum data values (returned) +char wcslab[sz_wcslab] # WCS label if present +char format[sz_wcslab] # WCS format if present +int sz_wcslab # String length + +int i, nrows, ncols +pointer sp, axvals, off, imgl2r() +real asumr() + +begin + call smark (sp) + call salloc (axvals, IM_MAXDIM, TY_REAL) + + # Fill x and y arrays. + nrows = IM_LEN(im,2) + ncols = col2 - col1 + 1 + + Memr[axvals] = (col1 + col2) / 2. + call plt_wcs (im, mw, ct, 2, Memr[axvals], 1., real(nrows), x_vector, + nrows, wcslab, format, sz_wcslab) + + do i = 1, nrows { + off = imgl2r (im, i) + y_vector[i] = asumr (Memr[off+col1-1], ncols) / real (ncols) + } + + # Find min and max values in y array. + call alimr (y_vector, nrows, zmin, zmax) + + call sfree (sp) +end + + +# PC_DRAW_VECTOR - Draw the projected vector to the screen. + +procedure pc_draw_vector (image, + xvec, yvec, nlines, zmin, zmax, col1, col2, wcslab, format, pcols) + +char image[SZ_FNAME] #I Image name +real xvec[nlines], yvec[nlines] #I Vectors to be plot +int nlines #I Npts in vector +real zmin, zmax #I Vector min max +int col1, col2 #I Selected columns +char wcslab[ARB] #I WCS label +char format[ARB] #I WCS format +bool pcols #I Is task PCOLS? (y/n) + +pointer sp, gp +pointer device, marker, xlabel, ylabel, title, suffix +real wx1, wx2, wy1, wy2, vx1, vx2, vy1, vy2, szm, tol +int mode, imark +bool pointmode + +pointer gopen() +real clgetr(), plt_iformatr() +bool clgetb(), streq() +int btoi(), clgeti() + +begin + call smark (sp) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (marker, SZ_FNAME, TY_CHAR) + call salloc (xlabel, SZ_LINE, TY_CHAR) + call salloc (ylabel, SZ_LINE, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (suffix, SZ_FNAME, TY_CHAR) + + call clgstr ("device", Memc[device], SZ_FNAME) + mode = NEW_FILE + if (clgetb ("append")) + mode = APPEND + + gp = gopen (Memc[device], mode, STDGRAPH) + tol = 10. * EPSILONR + + if (mode != APPEND) { + call clgstr ("xformat", Memc[xlabel], SZ_LINE) + if (!streq (Memc[xlabel], "wcsformat")) + call strcpy (Memc[xlabel], format, SZ_FNAME) + + call clgstr ("xlabel", Memc[xlabel], SZ_LINE) + if (streq (Memc[xlabel], "wcslabel")) + call strcpy (wcslab, Memc[xlabel], SZ_LINE) + + call clgstr ("title", Memc[title], SZ_LINE) + if (streq (Memc[title], "imtitle")) { + call strcpy (image, Memc[title], SZ_LINE) + if (pcols) { + call sprintf (Memc[suffix], SZ_FNAME, ": columns %d to %d") + call pargi (col1) + call pargi (col2) + } else { + call sprintf (Memc[suffix], SZ_FNAME, ": column %d") + call pargi (col1) + } + call strcat (Memc[suffix], Memc[title], SZ_LINE) + } + + call clgstr ("ylabel", Memc[ylabel], SZ_LINE) + + # Establish window. + wx1 = plt_iformatr (clgetr ("wx1"), format) + wx2 = plt_iformatr (clgetr ("wx2"), format) + wy1 = clgetr ("wy1") + wy2 = clgetr ("wy2") + + # Set window limits to defaults if not specified by user. + if ((wx2 - wx1) < tol) { + wx1 = x_vec[1] + wx2 = x_vec[nlines] + } + + if ((wy2 - wy1) < tol) { + wy1 = zmin + wy2 = zmax + } + + call gswind (gp, wx1, wx2, wy1, wy2) + + # Establish viewport. + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + + # Set viewport only if specified by user. + if ((vx2 - vx1) > tol && (vy2 - vy1) > tol) { + call gsview (gp, vx1, vx2, vy1, vy2) + } else { + if (!clgetb ("fill")) + call gseti (gp, G_ASPECT, 1) + } + + call gsets (gp, G_XTICKFORMAT, format) + call gseti (gp, G_XNMAJOR, clgeti ("majrx")) + call gseti (gp, G_XNMINOR, clgeti ("minrx")) + call gseti (gp, G_YNMAJOR, clgeti ("majry")) + call gseti (gp, G_YNMINOR, clgeti ("minry")) + + call gseti (gp, G_ROUND, btoi (clgetb ("round"))) + + if (clgetb ("logx")) + call gseti (gp, G_XTRAN, GW_LOG) + if (clgetb ("logy")) + call gseti (gp, G_YTRAN, GW_LOG) + + # Draw axes using all this information. + call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel]) + } + + pointmode = clgetb ("pointmode") + if (pointmode) { + call clgstr ("marker", Memc[marker], SZ_FNAME) + szm = clgetr ("szmarker") + call init_marker (Memc[marker], imark) + } else + call clgstr ("marker", Memc[marker], SZ_FNAME) + + # Now to actually draw the plot. + if (pointmode) + call gpmark (gp, xvec, yvec, nlines, imark, szm, szm) + else + call hgpline (gp, xvec, yvec, nlines, Memc[marker]) + + call gflush (gp) + call gclose (gp) + call sfree (sp) +end diff --git a/pkg/plot/t_pradprof.x b/pkg/plot/t_pradprof.x new file mode 100644 index 00000000..dbf7aae1 --- /dev/null +++ b/pkg/plot/t_pradprof.x @@ -0,0 +1,548 @@ +include <imhdr.h> +include <gset.h> +include <math.h> + +# T_ PRADPROF -- Compute a radial profile using user specified coordinates +# and plot or list the result. + +procedure t_pradprof() + +int images # the list of images +real xinit, yinit # the initial guess for the profile center +real pradius # the plotting radius +real paz1, paz2 # azimuth limits +bool center # center the object before computing profile +int cboxsize # the centering box width +bool list # list output instead of plot output + +int rboxsize, npts +pointer sp, imname, im, radius, azimuth, intensity +real xcntr, ycntr + +bool clgetb() +int imtopenp(), imtgetim(), clgeti(), rp_radius() +pointer immap() +real clgetr() + +begin + # Allocate stack space. + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + # Get the radial profiling parameters. The width of the extraction + # box mut be odd. + images = imtopenp ("input") + xinit = clgetr ("xinit") + yinit = clgetr ("yinit") + pradius = clgetr ("radius") + paz1 = clgetr ("az1") + paz2 = clgetr ("az2") + rboxsize = 2 * (nint (pradius + 1.0)) + 1 + + # Get the centering parameters. The centering box must be odd. + center = clgetb ("center") + if (center) { + cboxsize = clgeti ("cboxsize") + if (mod (cboxsize, 2) == 0) + cboxsize = cboxsize + 1 + } + + # List the radial profile instead of plotting it? + list = clgetb ("list") + + # Allocate memory for vectors. + call malloc (radius, rboxsize * rboxsize, TY_REAL) + call malloc (azimuth, rboxsize * rboxsize, TY_REAL) + call malloc (intensity, rboxsize * rboxsize, TY_REAL) + + # Loop over all images + while (imtgetim (images, Memc[imname], SZ_FNAME) != EOF) { + + # Open the image. + iferr (im = immap (Memc[imname], READ_ONLY, 0)) { + call eprintf ("Image %s not found\n") + call pargstr (Memc[imname]) + next + } + + # Find the star center, if center=yes. + if (center) + call rp_cntr (im, xinit, yinit, cboxsize, xcntr, ycntr) + else { + xcntr = xinit + ycntr = yinit + } + + # Get the radius and intensity vectors. + npts = rp_radius (im, xcntr, ycntr, rboxsize, pradius, paz1, paz2, + Memr[radius], Memr[azimuth], Memr[intensity]) + + # Make list of the radial profile if list=yes or plot if list=no. + if (list) + call rp_rlist (Memc[imname], xcntr, ycntr, paz1, paz2, + Memr[radius], Memr[azimuth], Memr[intensity], npts) + else + call rp_rplot (Memc[imname], xcntr, ycntr, paz1, paz2, + Memr[radius], Memr[azimuth], Memr[intensity], npts) + + call imunmap (im) + } + + call mfree (radius, TY_REAL) + call mfree (intensity, TY_REAL) + call imtclose (images) + call sfree (sp) +end + + +# RP_CNTR -- Compute the star center using a simple 1D centroiding algorithm +# on the x and y marginals, after thresholding at the mean. + +procedure rp_cntr (im, xstart, ystart, boxsize, xcntr, ycntr) + +pointer im # pointer to the input image +real xstart, ystart # starting coordinates +int boxsize # width of the centering box +real xcntr, ycntr # centered coordinates + +int half_box, x1, x2, y1, y2 +int ncols, nrows, nx, ny, try +pointer bufptr, sp, x_vect, y_vect +real xinit, yinit +pointer imgs2r() + +begin + # Initialize. + half_box = (boxsize - 1) / 2 + xinit = xstart + yinit = ystart + ncols = IM_LEN (im, 1) + nrows = IM_LEN (im, 2) + + try = 0 + repeat { + + # Compute the extraction region. + x1 = max (xinit - half_box, 1.0) + 0.5 + x2 = min (xinit + half_box, real (ncols)) + 0.5 + y1 = max (yinit - half_box, 1.0) + 0.5 + y2 = min (yinit + half_box, real (nrows)) + 0.5 + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + + # Get the data. + bufptr = imgs2r (im, x1, x2, y1, y2) + + call smark (sp) + call salloc (x_vect, nx, TY_REAL) + call salloc (y_vect, ny, TY_REAL) + + # Compute the marginals. + call aclrr (Memr[x_vect], nx) + call aclrr (Memr[y_vect], ny) + call rp_rowsum (Memr[bufptr], Memr[x_vect], nx, ny) + call rp_colsum (Memr[bufptr], Memr[y_vect], nx, ny) + + # Compute the centers. + call rp_getcenter (Memr[x_vect], nx, xcntr) + call rp_getcenter (Memr[y_vect], ny, ycntr) + + # Add in offsets to image coordinate system. + xcntr = xcntr + x1 + ycntr = ycntr + y1 + + call sfree (sp) + + # If the shifts are greater than a pixel to 1 more iteration. + try = try + 1 + if (try == 1) { + if ((abs (xcntr-xinit) > 1.0) || (abs (ycntr-yinit) > 1.0)) { + xinit = xcntr + yinit = ycntr + } + } else + break + } +end + + +# RP_RADIUS -- Get the data and compute the radius and intensity vectors. + +int procedure rp_radius (im, xcntr, ycntr, rboxsize, pradius, paz1, paz2, + radius, azimuth, intensity) + +pointer im # pointer to the input image +real xcntr, ycntr # the center of the extraction box +int rboxsize # the width of the extraction box +real pradius # the plotting radius +real paz1, paz2 # the azimuth limits +real radius[ARB] # the output radius vector +real azimuth[ARB] # the output azimuth vector +real intensity[ARB] # the output intensity vector + +int half_box, ncols, nrows, x1, x2, y1, y2, nx, ny, npts +pointer bufptr +real xinit, yinit +int rp_vectors() +pointer imgs2r() + +begin + # Initialize. + half_box = (rboxsize - 1) / 2 + xinit = xcntr + yinit = ycntr + ncols = IM_LEN(im,1) + nrows = IM_LEN(im,2) + + # Get the data. + x1 = max (xinit - half_box, 1.0) + 0.5 + x2 = min (xinit + half_box, real (ncols)) + 0.5 + y1 = max (yinit - half_box, 1.0) + 0.5 + y2 = min (yinit + half_box, real (nrows)) + 0.5 + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + bufptr = imgs2r (im, x1, x2, y1, y2) + + # Compute the radius and intensity vectors. + npts = rp_vectors (Memr[bufptr], nx, ny, x1, y1, xcntr, ycntr, + pradius, paz1, paz2, radius, azimuth, intensity) + + return (npts) +end + + +# RP_RLIST -- Print the intensity as a function of radial distance on the +# standard output. + +procedure rp_rlist (imname, xcntr, ycntr, paz1, paz2, radius, azimuth, + intensity, npts) + +char imname[ARB] # the name of the input image +real xcntr, ycntr # the center of the radial profile +real paz1, paz2 # the azimuth limits +real radius[npts] # the radius vector +real azimuth[npts] # the azimuth vector +real intensity[npts] # the intensity vector +int npts # the number of points + +int i + +begin + call printf ("# [%s] xcntr:%7.2f ycntr:%7.2f\n") + call pargstr (imname) + call pargr (xcntr) + call pargr (ycntr) + call printf ("# az1:%7.2f az2:%7.2f\n") + call pargr (min(paz1,paz2)) + call pargr (max(paz1,paz2)) + + do i = 1, npts { + call printf ("%7.2f %g\n") + call pargr (radius[i]) + call pargr (intensity[i]) + } +end + + +# RP_RPLOT -- Plot intensity as a function of radial distance. + +procedure rp_rplot (imname, xcntr, ycntr, az1, az2, + radius, azimuth, intensity, npts) + +char imname[ARB] +int npts +real xcntr, ycntr, az1, az2 +real radius[npts], azimuth[npts], intensity[npts] + +char device[SZ_LINE] +int mode +pointer gp + +bool clgetb() +pointer gopen() + +begin + call clgstr ("graphics", device, SZ_LINE) + + if (clgetb("append")) + mode = APPEND + else + mode = NEW_FILE + + gp = gopen (device, mode, STDGRAPH) + call rp_graph (gp, imname, xcntr, ycntr, az1, az2, + mode, radius, intensity, npts) + call gclose (gp) +end + + +# RP_VECTORS -- Compute the radius and intensity vectors. + +int procedure rp_vectors (a, nx, ny, x1, y1, xcntr, ycntr, pradius, paz1, paz2, + radius, azimuth, intensity) + +real a[nx,ny] # the input data array +int nx, ny # dimensions of the input array +int x1, y1 # lower left corner of input array +real xcntr, ycntr # coordinates of center pixel +real pradius # the plotting radius +real paz1, paz2 # the azimuth limits +real radius[ARB] # the output radius vector +real azimuth[ARB] # the output azimuth vector +real intensity[ARB] # the output intensity vector + +int i, j, npts +real dx, dy, az, pr2, az1, az2, r2, dy2 + +begin + az1 = DEGTORAD (min (paz1, paz2)) + az2 = DEGTORAD (max (paz1, paz2)) + while (az1 < 0.) { + az1 = az1 + TWOPI + az2 = az2 + TWOPI + } + while (az1 > TWOPI) { + az1 = az1 - TWOPI + az2 = az2 - TWOPI + } + pr2 = pradius * pradius + + npts = 0 + do i = 1, ny { + dy = (ycntr - y1 + 1 - i) + dy2 = dy ** 2 + do j = 1, nx { + dx = (xcntr - x1 + 1 - j) + r2 = dx ** 2 + dy2 + if (r2 > pr2) + next + az = atan2 (dy, dx) + if (az < 0.) + az = az + TWOPI + if (az < az1 || az > az2) + next + npts = npts + 1 + radius[npts] = sqrt (r2) + azimuth[npts] = RADTODEG (az) + intensity[npts] = a[j,i] + } + } + + return (npts) +end + + +# RP_ROWSUM -- Sum all the rows in a raster. + +procedure rp_rowsum (v, row, nx, ny) + +real v[nx,ny] # the input subraster +real row[ARB] # the output summed row +int nx, ny # the dimensions of the input subraster + +int i, j + +begin + do i = 1, ny + do j = 1, nx + row[j] = row[j] + v[j,i] +end + + +# RP_COLSUM -- Sum all the columns in a raster. + +procedure rp_colsum (v, col, nx, ny) + +real v[nx,ny] # the input subraster +real col[ARB] # the output summed column +int nx, ny # the dimensions of the input subraster + +int i, j + +begin + do i = 1, ny + do j = 1, nx + col[j] = col[j] + v[i,j] +end + + +# RP_GETCENTER -- Compute the centroid of an array. + +procedure rp_getcenter (v, nv, vc) + +real v[ARB] # the input array +int nv # length of the input array +real vc # the output centroid + +int i +real sum1, sum2, sigma, cont + +begin + sum1 = 0.0 + sum2 = 0.0 + + call aavgr (v, nv, cont, sigma) + do i = 1, nv + if (v[i] > cont) { + sum1 = sum1 + (i-1) * (v[i] - cont) + sum2 = sum2 + (v[i] - cont) + } + + vc = sum1 / sum2 +end + + +define MTYPES "|point|box|plus|cross|circle|hebar|vebar|hline|vline|diamond|" +define RP_GBUF 0.10 +define RP_SZTITLE 512 +define DEF_IMTITLE "imtitle" + +# RP_GRAPH -- Graph the radial profile. + +procedure rp_graph (gp, imname, xcntr, ycntr, az1, az2, mode, x, y, npts) + +pointer gp # GIO pointer +char imname[ARB] # image name +real xcntr # starting x coordinate +real ycntr # starting y coordinate +real az1, az2 # azimuth limits +int mode # Mode +real x[npts] # X data +real y[npts] # Y data +int npts # Number of points + +int i, marks[10], linepattern, patterns[4], clgeti(), btoi(), strdic() +pointer sp, marker, title, xlabel, ylabel +real x1, x2, y1, y2, wx1, wx2, wy1, wy2, vx1, vx2, vy1,vy2, temp, + szmarker, clgetr() +bool clgetb(), 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 (marker, 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 = clgetr ("wx1") + x2 = clgetr ("wx2") + y1 = clgetr ("wy1") + y2 = clgetr ("wy2") + + 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 - RP_GBUF * temp + if (IS_INDEF (x2)) + wx2 = wx2 + RP_GBUF * temp + + temp = wy2 - wy1 + if (IS_INDEF (y1)) + wy1 = wy1 - RP_GBUF * temp + if (IS_INDEF (y2)) + wy2 = wy2 + RP_GBUF * temp + + call gswind (gp, wx1, wx2, wy1, wy2) + call gsetr (gp, G_ASPECT, 0.) + call gseti (gp, G_ROUND, btoi (clgetb ("round"))) + + if (clgetb("fill")) + call gsetr (gp, G_ASPECT, 0.0) + else + call gsetr (gp, G_ASPECT, 1.0) + + i = GW_LINEAR + if (clgetb ("logx")) + i = GW_LOG + call gseti (gp, G_XTRAN, i) + i = GW_LINEAR + if (clgetb ("logy")) + i = GW_LOG + call gseti (gp, G_YTRAN, i) + + # Set the view port + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + call gsview (gp, vx1, vx2, vy1, vy2) + + if (clgetb ("box")) { + + # Get number of major and minor tick marks. + call gseti (gp, G_XNMAJOR, clgeti ("majrx")) + call gseti (gp, G_XNMINOR, clgeti ("minrx")) + call gseti (gp, G_YNMAJOR, clgeti ("majry")) + call gseti (gp, G_YNMINOR, clgeti ("minry")) + + # Label tick marks on axes? + call gseti (gp, G_LABELTICKS, + btoi (clgetb ("ticklabels"))) + + # Fetch labels and plot title string. + call salloc (title, RP_SZTITLE, TY_CHAR) + call salloc (xlabel, SZ_LINE, TY_CHAR) + call salloc (ylabel, SZ_LINE, TY_CHAR) + + # Build system info string + call sysid (Memc[title], SZ_LINE) + call strcat ("\n", Memc[title], RP_SZTITLE) + + # Build the title string + call clgstr ("title", Memc[marker], SZ_LINE) + if (streq (Memc[marker], DEF_IMTITLE)) { + call sprintf (Memc[marker], SZ_LINE, + "Radial Plot of %s at [%0.2f,%0.2f] az=[%.1f,%.1f]") + call pargstr (imname) + call pargr (xcntr) + call pargr (ycntr) + call pargr (az1) + call pargr (az2) + } + call strcat (Memc[marker], Memc[title], RP_SZTITLE) + + call clgstr ("xlabel", Memc[xlabel], SZ_LINE) + call clgstr ("ylabel", Memc[ylabel], SZ_LINE) + + call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel]) + } + } + + # Draw the data. + if (clgetb ("pointmode")) { + call clgstr ("marker", Memc[marker], SZ_LINE) + i = strdic (Memc[marker], Memc[marker], SZ_LINE, MTYPES) + if (i == 0) + i = 2 + if (marks[i] == GM_POINT) + szmarker = 0.0 + else + szmarker = clgetr ("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/plot/t_prow.x b/pkg/plot/t_prow.x new file mode 100644 index 00000000..feae53fb --- /dev/null +++ b/pkg/plot/t_prow.x @@ -0,0 +1,58 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <mach.h> +include <imhdr.h> +include <mwset.h> + +# T_PROW -- Plot an image row. + +procedure t_prow () + +pointer image, wcslab, fmt +pointer im, mw, ct, sp, x_vec, y_vec +int row, ncols, nlines +real zmin, zmax +int clgeti() +pointer immap(), mw_openim(), mw_sctran() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (wcslab, SZ_LINE, TY_CHAR) + call salloc (fmt, SZ_LINE, TY_CHAR) + + # Open image + call clgstr ("image", Memc[image], SZ_FNAME) + im = immap (Memc[image], READ_ONLY, 0) + call clgstr ("wcs", Memc[wcslab], SZ_LINE) + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", Memc[wcslab], 0) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + row = clgeti ("row") + if (row < 1 || row > nlines) { + call imunmap (im) + call error (2, "line index references outside image") + } + + # Get the requested row from the image. + call malloc (x_vec, ncols, TY_REAL) + call malloc (y_vec, ncols, TY_REAL) + call plt_grows (im, mw, ct, row, row, Memr[x_vec], Memr[y_vec], + zmin, zmax, Memc[wcslab], Memc[fmt], SZ_LINE) + + # Now draw the vector to the screen. + call pr_draw_vector (Memc[image], Memr[x_vec], Memr[y_vec], ncols, + zmin, zmax, row, row, Memc[wcslab], Memc[fmt], false) + + # Free resources. + call mfree (x_vec, TY_REAL) + call mfree (y_vec, TY_REAL) + + call imunmap (im) + call sfree (sp) +end diff --git a/pkg/plot/t_prows.x b/pkg/plot/t_prows.x new file mode 100644 index 00000000..8edbc7a0 --- /dev/null +++ b/pkg/plot/t_prows.x @@ -0,0 +1,243 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <mach.h> +include <imhdr.h> +include <mwset.h> + +# T_PROWS -- Plot the average of a range of rows from an image. + +procedure t_prows() + +pointer image, wcslab, fmt +pointer im, mw, ct, sp, x_vec, y_vec +int row1, row2, ncols, nlines +real zmin, zmax +int clgeti() +pointer immap(), mw_openim(), mw_sctran() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (wcslab, SZ_LINE, TY_CHAR) + call salloc (fmt, SZ_LINE, TY_CHAR) + + # Open image + call clgstr ("image", Memc[image], SZ_FNAME) + im = immap (Memc[image], READ_ONLY, 0) + call clgstr ("wcs", Memc[wcslab], SZ_LINE) + mw = mw_openim (im) + call mw_seti (mw, MW_USEAXMAP, NO) + ct = mw_sctran (mw, "logical", Memc[wcslab], 0) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + row1 = clgeti ("row1") + row2 = clgeti ("row2") + if (min(row1,row2) < 1 || max(row1,row2) > nlines) { + call imunmap (im) + call error (2, "line index references outside image") + } + + # Get the requested rows from the image. + call malloc (x_vec, ncols, TY_REAL) + call malloc (y_vec, ncols, TY_REAL) + call plt_grows (im, mw, ct, min(row1,row2), max(row1,row2), + Memr[x_vec], Memr[y_vec], zmin, zmax, Memc[wcslab], Memc[fmt], + SZ_LINE) + + # Now draw the vector to the screen. + call pr_draw_vector (Memc[image], Memr[x_vec], Memr[y_vec], ncols, + zmin, zmax, row1, row2, Memc[wcslab], Memc[fmt], true) + + # Free resources. + call mfree (x_vec, TY_REAL) + call mfree (y_vec, TY_REAL) + call imunmap (im) + call sfree (sp) +end + + +# PLT_GROWS -- Get the average of specified rows from the image. The average +# data vector is returned as y_vector; the column coordinates are returned in +# x_vector. The data vector min and max are also returned. + +procedure plt_grows (im, mw, ct, row1, row2, x_vector, y_vector, zmin, zmax, + wcslab, format, sz_wcslab) + +pointer im # Pointer to image section header +pointer mw # MWCS pointer +pointer ct # CT pointer +int row1 # The first row to be extracted +int row2 # The last row to be extracted +real x_vector[ARB] # Data values in x direction (returned) +real y_vector[ARB] # Data values in y direction (returned) +real zmin, zmax # Minimum and maximum values in y_vector (returned) +char wcslab[sz_wcslab] # WCS label if present +char format[sz_wcslab] # WCS format if present +int sz_wcslab # String length + +int i, ncols, nrows +pointer sp, axvals, imgl2r() + +begin + call smark (sp) + call salloc (axvals, IM_MAXDIM, TY_REAL) + + # Fill x and y arrays. + ncols = IM_LEN(im,1) + nrows = row2 - row1 + 1 + + Memr[axvals+1] = (row1 + row2) / 2. + call plt_wcs (im, mw, ct, 1, Memr[axvals], 1., real(ncols), x_vector, + ncols, wcslab, format, sz_wcslab) + + call aclrr (y_vector, ncols) + do i = row1, row2 { + call aaddr (Memr[imgl2r(im,i)], y_vector, y_vector, ncols) + } + call adivkr (y_vector, real(nrows), y_vector, ncols) + + # Now find min and max values in y array. + call alimr (y_vector, ncols, zmin, zmax) + + call sfree (sp) +end + + +# PR_DRAW_VECTOR -- Draw the projected vector to the screen. + +procedure pr_draw_vector (image, + xvec, yvec, ncols, zmin, zmax, row1, row2, wcslab, format, prows) + +char image[SZ_FNAME] #I image name +real xvec[ncols], yvec[ncols] #I vectors to be plot +int ncols #I number of columns +real zmin, zmax #I vector min max +int row1, row2 #I selected rows +char wcslab[ARB] #I WCS label +char format[ARB] #I WCS format +bool prows #I is task PROWS (y/n) + +pointer sp, gp +pointer device, marker, xlabel, ylabel, title, suffix +real wx1, wx2, wy1, wy2, vx1, vx2, vy1, vy2, szm, tol +int mode, imark +bool pointmode + +pointer gopen() +real clgetr(), plt_iformatr() +bool clgetb(), streq() +int btoi(), clgeti() + +begin + call smark (sp) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (marker, SZ_FNAME, TY_CHAR) + call salloc (xlabel, SZ_LINE, TY_CHAR) + call salloc (ylabel, SZ_LINE, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (suffix, SZ_FNAME, TY_CHAR) + + call clgstr ("device", Memc[device], SZ_FNAME) + mode = NEW_FILE + if (clgetb ("append")) + mode = APPEND + + gp = gopen (Memc[device], mode, STDGRAPH) + tol = 10. * EPSILONR + + if (mode != APPEND) { + call clgstr ("xformat", Memc[xlabel], SZ_LINE) + if (!streq (Memc[xlabel], "wcsformat")) + call strcpy (Memc[xlabel], format, SZ_FNAME) + + call clgstr ("xlabel", Memc[xlabel], SZ_LINE) + if (streq (Memc[xlabel], "wcslabel")) + call strcpy (wcslab, Memc[xlabel], SZ_LINE) + + call clgstr ("title", Memc[title], SZ_LINE) + if (streq (Memc[title], "imtitle")) { + call strcpy (image, Memc[title], SZ_LINE) + if (prows) { + call sprintf (Memc[suffix], SZ_FNAME, ": rows %d to %d") + call pargi (row1) + call pargi (row2) + } else { + call sprintf (Memc[suffix], SZ_FNAME, ": row %d") + call pargi (row1) + } + call strcat (Memc[suffix], Memc[title], SZ_LINE) + } + + call clgstr ("ylabel", Memc[ylabel], SZ_LINE) + + # Establish window. + wx1 = plt_iformatr (clgetr ("wx1"), format) + wx2 = plt_iformatr (clgetr ("wx2"), format) + wy1 = clgetr ("wy1") + wy2 = clgetr ("wy2") + + # Set window limits to defaults if not specified by user. + if ((wx2 - wx1) < tol) { + wx1 = x_vec[1] + wx2 = x_vec[ncols] + } + + if ((wy2 - wy1) < tol) { + wy1 = zmin + wy2 = zmax + } + + call gswind (gp, wx1, wx2, wy1, wy2) + + # Establish viewport. + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + + # Set viewport only if specified by user. + if ((vx2 - vx1) > tol && (vy2 - vy1) > tol) + call gsview (gp, vx1, vx2, vy1, vy2) + else { + if (!clgetb ("fill")) + call gseti (gp, G_ASPECT, 1) + } + + call gsets (gp, G_XTICKFORMAT, format) + call gseti (gp, G_XNMAJOR, clgeti ("majrx")) + call gseti (gp, G_XNMINOR, clgeti ("minrx")) + call gseti (gp, G_YNMAJOR, clgeti ("majry")) + call gseti (gp, G_YNMINOR, clgeti ("minry")) + + call gseti (gp, G_ROUND, btoi (clgetb ("round"))) + + if (clgetb ("logx")) + call gseti (gp, G_XTRAN, GW_LOG) + if (clgetb ("logy")) + call gseti (gp, G_YTRAN, GW_LOG) + + # Draw axes using all this information. + call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel]) + } + + pointmode = clgetb ("pointmode") + if (pointmode) { + call clgstr ("marker", Memc[marker], SZ_FNAME) + szm = clgetr ("szmarker") + call init_marker (Memc[marker], imark) + } else + call clgstr ("marker", Memc[marker], SZ_FNAME) + + # Now to actually draw the plot. + if (pointmode) + call gpmark (gp, xvec, yvec, ncols, imark, szm, szm) + else + call hgpline (gp, xvec, yvec, ncols, Memc[marker]) + + call gflush (gp) + call gclose (gp) + call sfree (sp) +end diff --git a/pkg/plot/t_pvector.x b/pkg/plot/t_pvector.x new file mode 100644 index 00000000..d1c83f46 --- /dev/null +++ b/pkg/plot/t_pvector.x @@ -0,0 +1,979 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <mach.h> +include <math.h> +include <imhdr.h> +include <imset.h> +include <math/iminterp.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 + +# T_PVECTOR -- Plot the vector of image data between two pixels. + +procedure t_pvector() + +pointer image, boundary, output, outtype +pointer sp, im, x_vec, y_vec +int wrt_image, wrt_text +int btype, ndim, nxvals, nyvals, nzvals, width +real xc, yc, x1, y1, x2, y2, theta, length, zmin, zmax, bconstant + +bool streq(), fp_equalr() +int clgeti(), clgwrd(), nowhite() +pointer immap() +real clgetr() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (boundary, SZ_BTYPE, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (outtype, SZ_FNAME, TY_CHAR) + + # Get boundary extension parameters. + btype = clgwrd ("boundary", Memc[boundary], SZ_BTYPE, BTYPES) + bconstant = clgetr ("constant") + + # Open the image. + call clgstr ("image", Memc[image], SZ_FNAME) + im = immap (Memc[image], READ_ONLY, 0) + ndim = IM_NDIM(im) + if (ndim > 2) + call error (0, "The number of image dimensions is greater then 2.") + + # See if we're going to output the vector + call clgstr ("vec_output", Memc[output], SZ_FNAME) + call clgstr ("out_type", Memc[outtype], SZ_FNAME) + + wrt_text = NO + wrt_image = NO + if (nowhite (Memc[output], Memc[output], SZ_FNAME) > 0) { + if (streq("image",Memc[outtype])) + wrt_image = YES + else if (streq("text",Memc[outtype])) + wrt_text = YES + } + + # Store the maximum coordinate values in the parameter file. + nxvals = IM_LEN(im,1) + if (ndim == 1) + nyvals = 1 + else + nyvals = IM_LEN(im,2) + call clputi ("x1.p_maximum", nxvals) + call clputi ("x2.p_maximum", nxvals) + call clputi ("y1.p_maximum", nyvals) + call clputi ("y2.p_maximum", nyvals) + + # Get the beginning and ending coordinates and width of the strip. + theta = clgetr ("theta") + if (IS_INDEFR(theta)) { + x1 = clgetr ("x1") + y1 = clgetr ("y1") + x2 = clgetr ("x2") + y2 = clgetr ("y2") + } else { + xc = clgetr ("xc") + yc = clgetr ("yc") + length = clgetr ("length") + call pv_get_bound (xc, yc, length, theta, nxvals, nyvals, x1, y1, + x2, y2) + } + width = clgeti ("width") + + # 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 pv_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)) { + if (ndim == 1) { + call pv_get_row1 (im, x1, x2, nzvals, btype, bconstant, + Memr[x_vec], Memr[y_vec], zmin, zmax) + } else { + call pv_get_row (im, x1, y1, x2, y2, nzvals, width, btype, + bconstant, Memr[x_vec], Memr[y_vec], zmin, zmax) + } + } else { + call pv_get_vector (im, x1, y1, x2, y2, nzvals, width, btype, + bconstant, Memr[x_vec], Memr[y_vec], zmin, zmax) + } + + # Output the plot, via the graphics stream, or as a textfile or image. + if (wrt_image == YES) { + call pv_wrt_image (im, Memc[image], Memc[output], + Memr[x_vec], Memr[y_vec], nzvals, x1, x2, y1, y2, width) + } else if (wrt_text == YES) { + call pv_wrt_pixels (Memc[output], + Memr[x_vec], Memr[y_vec], nzvals) + } else { + call pv_draw_vector (Memr[x_vec], Memr[y_vec], nzvals, + x1, x2, y1, y2, zmin, zmax, width, Memc[image]) + } + + # Free resources. + call mfree (x_vec, TY_REAL) + call mfree (y_vec, TY_REAL) + call imunmap (im) + call sfree (sp) +end + + +# PV_DRAW_VECTOR - Draw the vector to the specified output device. + +procedure pv_draw_vector (xvec, yvec, nzvals, + x1, x2, y1, y2, zmin, zmax, width, image) + +real xvec[nzvals], yvec[nzvals] #I Vectors to draw +int nzvals, width #I Plot parameters +real x1, x2, y1, y2, zmin, zmax #I Plot parameters +char image[SZ_FNAME] #I Image name + +pointer sp, gp +int mode, imark +pointer device, marker, xlabel, ylabel, title, suffix, hostid +real wx1, wx2, wy1, wy2, vx1, vx2, vy1, vy2, szm, tol +bool pointmode + +bool clgetb(), streq() +int clgeti(), btoi() +pointer gopen() +real clgetr() +errchk gopen + +begin + call smark (sp) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (marker, SZ_FNAME, TY_CHAR) + call salloc (xlabel, SZ_LINE, TY_CHAR) + call salloc (ylabel, SZ_LINE, TY_CHAR) + call salloc (hostid, 2 * SZ_LINE, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (suffix, SZ_FNAME, TY_CHAR) + + # Open the graphics stream. + call clgstr ("device", Memc[device], SZ_FNAME) + if (clgetb ("append")) + mode = APPEND + else + mode = NEW_FILE + iferr (gp = gopen (Memc[device], mode, STDGRAPH)) + call error (0, "Error opening graphics device.") + + tol = 10. * EPSILONR + + if (mode != APPEND) { + # Establish window. + wx1 = clgetr ("wx1") + wx2 = clgetr ("wx2") + wy1 = clgetr ("wy1") + wy2 = clgetr ("wy2") + + # Set window limits to defaults if not specified by user. + if (abs(wx2 - wx1) < tol) { + wx1 = 1.0 + wx2 = real (nzvals) + } + if (abs(wy2 - wy1) < tol) { + wy1 = zmin + wy2 = zmax + } + call gswind (gp, wx1, wx2, wy1, wy2) + + # Establish viewport. + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + + # Set viewport only if specified by user. + if ((vx2 - vx1) > tol && (vy2 - vy1) > tol) + call gsview (gp, vx1, vx2, vy1, vy2) + else { + if (!clgetb ("fill")) + call gseti (gp, G_ASPECT, 1) + } + + call clgstr ("xlabel", Memc[xlabel], SZ_LINE) + call clgstr ("ylabel", Memc[ylabel], SZ_LINE) + call clgstr ("title", Memc[title], SZ_LINE) + call sysid (Memc[hostid], SZ_LINE) + call strcat ("\n", Memc[hostid], SZ_LINE) + if (streq (Memc[title], "imtitle")) { + call strcpy (image, Memc[title], SZ_LINE) + call sprintf (Memc[suffix], SZ_FNAME, + ": vector %.1f,%.1f to %.1f,%.1f width: %d") { + call pargr (x1) + call pargr (y1) + call pargr (x2) + call pargr (y2) + call pargi (width) + } + call strcat (Memc[suffix], Memc[title], SZ_LINE) + } + call strcat (Memc[title], Memc[hostid], 2 * SZ_LINE) + + call gseti (gp, G_XNMAJOR, clgeti ("majrx")) + call gseti (gp, G_XNMINOR, clgeti ("minrx")) + call gseti (gp, G_YNMAJOR, clgeti ("majry")) + call gseti (gp, G_YNMINOR, clgeti ("minry")) + call gseti (gp, G_ROUND, btoi (clgetb ("round"))) + + if (clgetb ("logx")) + call gseti (gp, G_XTRAN, GW_LOG) + if (clgetb ("logy")) + call gseti (gp, G_YTRAN, GW_LOG) + + # Draw axes using all this information + call glabax (gp, Memc[hostid], Memc[xlabel], Memc[ylabel]) + } + + pointmode = clgetb ("pointmode") + if (pointmode) { + call clgstr ("marker", Memc[marker], SZ_FNAME) + szm= clgetr ("szmarker") + call init_marker (Memc[marker], imark) + } else + call clgstr ("marker", Memc[marker], SZ_FNAME) + + # Now to actually draw the plot. + if (pointmode) + call gpmark (gp, x_vec, y_vec, nzvals, imark, szm, szm) + else + call hgpline (gp, x_vec, y_vec, nzvals, Memc[marker]) + + # Close up graphics and image. + call gclose (gp) + call sfree (sp) +end + + +# PV_WRT_PIXELS - Write out the vector to the specified file. File may be +# specified as STDOUT. Behaves much like LISTPIX. + +procedure pv_wrt_pixels (file, x, y, npts) + +char file[SZ_FNAME] #I Output file name +real x[npts], y[npts] #I Vector to write +int npts #I Npts in vector + +int i +pointer fd, open() +bool streq() +errchk open + +begin + if (streq("STDOUT", file)) + fd = STDOUT + else if (streq("STDERR", file)) + fd = STDERR + else + iferr (fd = open (file, APPEND, TEXT_FILE)) + call error (0, "Error opening output file.") + + do i = 1, npts { + call fprintf (fd, "%.1f %.4f\n") + call pargr (x[i]) + call pargr (y[i]) + } + + call flush (fd) + if (fd != STDOUT && fd != STDERR) + call close (fd) +end + + +# PV_WRT_IMAGE - Write out the vector to the specified image name. The original +# image header is coptired to the new image and a acomment added describing the +# computed vector + +procedure pv_wrt_image (im, image, file, x, y, npts, x1, x2, y1, y2, width) + +pointer im #I Parent image pointer +char image[SZ_FNAME] #I Name of original image +char file[SZ_FNAME] #I Ouput image name +real x[npts], y[npts] #I Vector to write +int npts #I Npts in vector +real x1, x2, y1, y2 #I Endpoints of vector +int width #I Width of sampled points + +pointer sp, comment, imo +pointer immap(), impl2r() +bool streq() +errchk immap, impl2r + +begin + if (streq(file,"STDOUT") || streq(file,"STDERR")) + call error (0, "Illegal filename for output image.") + + # Open a (new) image + iferr (imo = immap(file, NEW_COPY, im)) + call error (0, "Error opening output image.") + + call smark (sp) + call salloc (comment, SZ_LINE, TY_CHAR) + + # Do some header manipulations + IM_NDIM(imo) = 1 + IM_LEN(imo,1) = npts + call sprintf (Memc[comment], SZ_LINE, + "%s: vector %.1f,%.1f to %.1f,%.1f width: %d") + call pargstr (image) + call pargr (x1) + call pargr (x2) + call pargr (y1) + call pargr (y2) + call pargi (width) + call imastr (imo, "VSLICE", Memc[comment]) + + # Now dump it into the image + call amovr (y, Memr[impl2r(imo,1)], npts) + + # Do some housecleaning + call imunmap (imo) + call sfree (sp) +end + + +# PV_GET_BOUND -- Find the point where a vector, defined by it's starting +# point and an theta (ccw from +x), intersects the image boundary. The +# image is defined from 1 - nxvals; 1 - nyvals. + +procedure pv_get_bound (xc, yc, length, theta, nxvals, nyvals, x1, y1, x2, y2) + +real xc, yc # x and y center points +real length # length of the vector +real theta # angle of vector (ccw from +x) +int nxvals, nyvals # image dimensions +real x1, y1 # starting point of vector +real x2, y2 # point where vector intersects boundary + +real half_length, angle, dx, dy + +begin + if (IS_INDEFR(length)) + half_length = sqrt (real (nxvals ** 2 + nyvals ** 2)) / 2.0 + else + half_length = length / 2.0 + dx = cos (DEGTORAD (theta)) + dy = sin (DEGTORAD (theta)) + + # Compute the coordinates of the end of the vector + x1 = xc - dx * half_length + y1 = yc - dy * half_length + x2 = xc + dx * half_length + y2 = yc + dy * half_length + + if (x2 < 1.0 || x2 > nxvals || y2 < 1.0 || y2 > nyvals) + call pv_limits (xc, yc, theta, nxvals, nyvals, x2, y2) + + angle = theta + 180.0 + if (angle > 360.0) + angle = angle - 360.0 + if (x1 < 1.0 || x1 > nxvals || y1 < 1.0 || y1 > nyvals) + call pv_limits (xc, yc, angle, nxvals, nyvals, x1, y1) + +end + + +# PV_LIMITS -- Find the point where a vector, defined by it's starting +# point and an theta (ccw from +x), intersects the image boundary. The +# image is defined from 1 - nxvals; 1 - nyvals. + +procedure pv_limits (x1, y1, theta, nxvals, nyvals, x2, y2) + +real x1, y1 # starting point of vector +real theta # angle of vector (ccw from +x) +int nxvals, nyvals # size of image +real x2, y2 # point where vector intersects boundary + +real tan_theta, xx +bool fp_equalr() + +begin + tan_theta = tan (DEGTORAD (theta)) + + if (fp_equalr (theta, 0.0)) { + x2 = nxvals + y2 = y1 + } else if (fp_equalr (theta, 90.0)) { + x2 = x1 + y2 = nyvals + } else if (fp_equalr (theta, 180.0)) { + x2 = 1 + y2 = y1 + } else if (fp_equalr (theta, 270.0)) { + x2 = x1 + y2 = 1 + } else if (fp_equalr (theta, 360.0)) { + x2 = nxvals + y2 = y1 + + # Assume it intersects y = nyvals boundary. + } else if (theta > 0.0 && theta < 180.0) { + + xx = (nyvals - y1) / tan_theta + x1 + if (xx > nxvals || xx < 1.0) { + if (theta < 90.) + x2 = nxvals + else + x2 = 1.0 + y2 = y1 + (x2 - x1) * tan_theta + } else { + y2 = nyvals + x2 = (y2 - y1) / tan_theta + x1 + } + + # Assume it intersects y = 1.0 boundary. + } else if (theta > 180.0 && theta < 360.0) { + + xx = (1.0 - y1) / tan_theta + x1 + if (xx > nxvals || xx < 1.0) { + if (theta < 270.) + x2 = 1.0 + else + x2 = nxvals + y2 = y1 + (x2 - x1) * tan_theta + } else { + y2 = 1.0 + x2 = (y2 - y1) / tan_theta + x1 + } + } +end + + +# PV_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 pv_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() + +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 pv_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 + + +# PV_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 pv_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() + +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 pv_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 + + +# PV_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 pv_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 +pointer imgs2r() +errchk imgs2r, msifit + +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 pv_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 + + +# PV_GET_ROW1 -- 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 pv_get_row1 (im, x1, x2, nvals, btype, bconstant, x_vector, + y_vector, zmin, zmax) + +pointer im # pointer to image header +real x1 # starting pixel of vector +real x2 # ending pixel of pixel +int nvals # number of samples along the vector +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, xv +int i, nedge, col1, col2 +pointer sp, xs, asi, buf +pointer imgs1r() +errchk imgs1r + +begin + call smark (sp) + call salloc (xs, nvals, TY_REAL) + + # Initialize the interpolator. + call asiinit (asi, II_LINEAR] + + # Set the boundary. + nedge = 2 + col1 = int (min (x1, x2)) - nedge + col2 = nint (max (x1, x2)) + nedge + call pv_setboundary (im, col1, col2, 1, 1, btype, bconstant) + + # Compute the x vector. + if (nvals == 1) + dx = 0.0d0 + else + dx = (x2 - x1) / (nvals - 1) + xv = x1 - col1 + 1 + do i = 1, nvals { + Memr[xs+i-1] = xv + xv = xv + dx + } + + # Get the image data, fit and evaluate the interpolant. + buf = imgs1r (im, col1, col2) + if (buf == NULL) + call error (0, "Error reading input image.") + call asifit (asi, Memr[buf], col2 - col1 + 1) + call asivector (asi, Memr[xs], y_vector, nvals) + + # Compute the output x vector. + do i = 1, nvals + x_vector[i] = real (i) + + # Compute min and max values. + call alimr (y_vector, nvals, zmin, zmax) + + # Free memory . + call asifree (asi) + call sfree (sp) +end + + +# PV_SETBOUNDARY -- Set boundary extension. + +procedure pv_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 + + +# PV_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 pv_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 + +int i, ncols, nlines, nclast, llast1, llast2, nllast +pointer buf1, buf2 +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/plot/t_surface.x b/pkg/plot/t_surface.x new file mode 100644 index 00000000..7faa38a2 --- /dev/null +++ b/pkg/plot/t_surface.x @@ -0,0 +1,501 @@ +include <error.h> +include <mach.h> +include <gset.h> +include <config.h> +include <xwhen.h> +include <imhdr.h> +include <fset.h> + +define DUMMY 6 +define SZ_TLABEL 10 +define CSIZE 24 + + +# SURFACE -- Draw a perspective view of an image section. The altitude +# and azimuth of the viewing angle are variable. Floor and ceiling +# constraints may be applied to the image data before plotting if desired. + +procedure t_surface() + +char imsect[SZ_FNAME] +char device[SZ_FNAME], title[SZ_LINE] +bool label, sub, pre +pointer im, subras, work +int ncols, nlines, mode, wkid, nx, ny, npix +int epa, status, old_onint, tsujmp[LEN_JUMPBUF] +int xres, yres, first +real angh, angv, imcols, imlines +real floor, ceiling, vpx1, vpx2, vpy1, vpy2 + +pointer gp, gopen() +bool clgetb(), streq() +int clgeti(), surf_limits() +real clgetr() +extern tsu_onint() +pointer immap(), plt_getdata() +common /tsucom/ tsujmp +common /noaovp/ vpx1, vpx2, vpy1, vpy2 +common /frstfg/ first + +define exit_ 91 +begin + # First initialize srface common blocks before changing any parameters + first = 1 + call srfabd + + # Get image section string and output device. + call clgstr ("image", imsect, SZ_FNAME) + call clgstr ("device", device, SZ_FNAME) + + # Map image and open graphics device. + im = immap (imsect, READ_ONLY, 0) + + angh = clgetr ("angh") + angv = clgetr ("angv") + floor = clgetr ("floor") + ceiling = clgetr ("ceiling") + label = clgetb ("label") + + call clgstr ("title", title, SZ_LINE) + if (streq (title, "imtitle")) { + call strcpy (imsect, title, SZ_LINE) + call strcat (": ", title, SZ_LINE) + call strcat (IM_TITLE(im), title, SZ_LINE) + } + + # If a label is to be drawn, don't use the full device viewport for + # the surface plot. This doesn't allow room for the axes and labels. + + if (label) { + vpx1 = 0.10 + vpx2 = 0.90 + vpy1 = 0.10 + vpy2 = 0.90 + } + + mode = NEW_FILE + if (clgetb ("append")) + mode = APPEND + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + imcols = real (ncols) + imlines = real (nlines) + + xres = clgeti ("xres") + yres = clgeti ("yres") + sub = clgetb ("subsample") + pre = clgetb ("preserve") + + # Get data with proper resolution. Procedure plt_getdata returns a + # pointer to the data matrix to be contoured. The resolution is + # decreased by the specified method in this procedure. The image + # header pointer can be unmapped after plt_getdata is called. + + nx = 0 + ny = 0 + subras = plt_getdata (im, sub, pre, xres, yres, nx, ny) + call imunmap (im) + + # Allocate the working storage needed by EZSRFC. + #call malloc (work, (2 * nx * ny) + nx + ny, TY_REAL) + call malloc (work, 2 * ((2 * nx * ny) + nx + ny), TY_REAL) + + # Take floor and ceiling if enabled (nonzero). + npix = nx * ny + if (surf_limits (Memr[subras], npix, floor, ceiling) == ERR) + goto exit_ + + # Open graphics device and make plot. + call gopks (STDERR) + wkid = 1 + gp = gopen (device, mode, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + call gtext (gp, 0.5, .96, title, "s=0.8;f=b;h=c") + call set (vpx1, vpx2, vpy1, vpy2, 1.0, 1024., 1.0, 1024., 1) + + # Install interrupt exception handler. + call zlocpr (tsu_onint, epa) + call xwhen (X_INT, epa, old_onint) + + call zsvjmp (tsujmp, status) + if (status == OK) + call ezsrfc (Memr[subras], nx, ny, angh, angv, Memr[work]) + else { + call gcancel (gp) + call fseti (STDOUT, F_CANCEL, OK) + } + + if (label) { + # Establish plotting window in full scale image coordinates. + call gswind (gp, 1.0, imcols, 1.0, imlines) + call gseti (gp, G_CLIP, NO) + call srf_perimeter (gp, Memr[subras], nx, ny, angh, angv) + } + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +exit_ + call mfree (subras, TY_REAL) + call mfree (work, TY_REAL) + +end + + +# TSU_ONINT -- Interrupt handler for the task surface. Branches back to ZSVJMP +# in the main routine to permit shutdown without an error message. + +procedure tsu_onint (vex, next_handler) + +int vex # virtual exception +int next_handler # not used + +int tsujmp[LEN_JUMPBUF] +common /tsucom/ tsujmp + +begin + call xer_reset() + call zdojmp (tsujmp, vex) +end + + +# SURF_LIMITS -- Apply the floor and ceiling constraints to the subraster. +# If both values are exactly zero, they are not applied. + +int procedure surf_limits (ras, npix, floor, ceiling) + +real ras[npix] # Input array of pixels +int npix # npixels in array +real floor, ceiling # user specified parameters +int apply, i +real tfloor, tceiling, delta, dmin, dmax +bool fp_equalr() + +begin + tfloor = floor + tceiling = ceiling + apply = YES + + call alimr (ras, npix, dmin, dmax) + if (fp_equalr (dmin, dmax)) { + call eprintf ("Constant valued array; no plot drawn\n") + return (ERR) + } + + if (fp_equalr (tfloor, INDEF)) + tfloor = dmin + if (fp_equalr (tceiling, INDEF)) + tceiling = dmax + + delta = tceiling - tfloor + if (delta < 0.0) { + # specified ceiling is lower than floor, flip them + floor = tceiling + ceiling = tfloor + } else if (fp_equalr (delta, 0.0)) { + # degenerate values + apply = NO + floor = dmin + ceiling = dmax + call eprintf ( + "Floor and ceiling are degenerate values and will be ignored\n") + } else { + # Non-degenerate, ceiling exceedes floor as expected + floor = tfloor + ceiling = tceiling + } + + if (apply == YES) { + # First verify that floor and ceiling are valid + if (dmax <= floor) { + call eprintf ("Entire image is at or below specified floor\n") + return (ERR) + } + if (dmin >= ceiling) { + call eprintf ("Entire image is at or above specified ceiling\n") + return (ERR) + } + + do i = 1, npix { + # Apply surface limits + ras[i] = max (floor, ras[i]) + ras[i] = min (ceiling, ras[i]) + } + } + return (OK) +end + + +# SRF_PERIMETER -- draw and label axes around the surface plot. + +procedure srf_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[SZ_TLABEL] +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 srf_draw_axis (Memr[x_val+1], Memr[kvec], flo, ncols + 1) + call srf_label_axis (xcen, y2_perim+del, flo, "X-AXIS", -1, -2) + call srf_draw_ticksx (Memr[x_val+1], y2_perim, y2_perim+delta, + flo, ncols) + call srf_label_axis (xmin, y2_perim+del, flo, "1", -1, -2) + junk = itoc (int (wc2), tlabel, SZ_TLABEL) + call srf_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 srf_draw_axis (Memr[kvec], Memr[y_val+1], flo, nlines + 1) + call srf_label_axis (x2_perim+del, ycen, flo, "Y-AXIS", 2, -1) + call srf_draw_ticksy (x2_perim, x2_perim+delta, Memr[y_val+1], + flo, nlines) + call srf_label_axis (x2_perim+del, ymin, flo, "1", 2, -1) + junk = itoc (int (wl2), tlabel, SZ_TLABEL) + call srf_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 srf_draw_axis (Memr[x_val], Memr[kvec], flo, ncols + 1) + call srf_label_axis (xcen, y1_perim-del, flo, "X-AXIS", -1, 2) + call srf_draw_ticksx (Memr[x_val+1], y1_perim, y1_perim-delta, + flo, ncols) + call srf_label_axis (xmin, y1_perim-del, flo, "1", -1, 2) + junk = itoc (int (wc2), tlabel, SZ_TLABEL) + call srf_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 srf_draw_axis (Memr[kvec], Memr[y_val], flo, nlines + 1) + call srf_label_axis (x1_perim-del, ycen, flo, "Y-AXIS", 2, 1) + call srf_draw_ticksy (x1_perim, x1_perim-delta, Memr[y_val+1], + flo, nlines) + call srf_label_axis (x1_perim-del, ymin, flo, "1", 2, 1) + junk = itoc (int (wl2), tlabel, SZ_TLABEL) + call srf_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 srf_draw_axis (Memr[x_val+1], Memr[kvec], flo, ncols + 1) + call srf_label_axis (xcen, y1_perim-del, flo, "X-AXIS", 1, 2) + call srf_draw_ticksx (Memr[x_val+1], y1_perim, y1_perim-delta, + flo, ncols) + call srf_label_axis (xmin, y1_perim-del, flo, "1", 1, 2) + junk = itoc (int (wc2), tlabel, SZ_TLABEL) + call srf_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 srf_draw_axis (Memr[kvec], Memr[y_val], flo, nlines + 1) + call srf_label_axis (x2_perim+del, ycen, flo, "Y-AXIS", 2, -1) + call srf_draw_ticksy (x2_perim, x2_perim+delta, Memr[y_val+1], + flo, nlines) + call srf_label_axis (x2_perim+del, ymin, flo, "1", 2, -1) + junk = itoc (int (wl2), tlabel, SZ_TLABEL) + call srf_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 srf_draw_axis (Memr[x_val], Memr[kvec], flo, ncols + 1) + call srf_label_axis (xcen, y2_perim+del, flo, "X-AXIS", 1, -2) + call srf_draw_ticksx (Memr[x_val+1], y2_perim, y2_perim+delta, + flo, ncols) + call srf_label_axis (xmin, y2_perim+del, flo, "1", 1, -2) + junk = itoc (int (wc2), tlabel, SZ_TLABEL) + call srf_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 srf_draw_axis (Memr[kvec], Memr[y_val+1], flo, nlines + 1) + call srf_label_axis (x1_perim-del, ycen, flo, "Y-AXIS", 2, 1) + call srf_draw_ticksy (x1_perim, x1_perim-delta, Memr[y_val+1], + flo, nlines) + call srf_label_axis (x1_perim-del, ymin, flo, "1", 2, 1) + junk = itoc (int (wl2), tlabel, SZ_TLABEL) + call srf_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 srf_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 srf_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 srf_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 srf_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 diff --git a/pkg/plot/t_velvect.x b/pkg/plot/t_velvect.x new file mode 100644 index 00000000..79ded164 --- /dev/null +++ b/pkg/plot/t_velvect.x @@ -0,0 +1,124 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> +include <config.h> +include <mach.h> +include <imhdr.h> +include <xwhen.h> +include <fset.h> + +# T_VELVECT -- Draw a representation of a two-dimensional velocity field +# by drawing arrows from each data location. The length of each arrow +# is proportional to the strength of the field at that location, and the +# direction of the arrow indicates the direction of flow at that location. +# This is an interface to the NCAR GKS VELVCT routine. + +procedure t_velvect() + +char u_imsect[SZ_FNAME], v_imsect[SZ_FNAME] +char device[SZ_FNAME], title[SZ_LINE] +pointer u_im, v_im, u_subras, v_subras +int tcojmp[LEN_JUMPBUF] +int u_ncols, v_ncols, u_nlines, v_nlines, epa, status, wkid +int mode, old_onint + +pointer gp, gopen() + +bool clgetb(), streq() +extern vl_tco_onint() +pointer immap(), imgs2r() +common /tcocom/ tcojmp + +begin + # Get image section strings and output device. + call clgstr ("u_image", u_imsect, SZ_FNAME) + call clgstr ("v_image", v_imsect, SZ_FNAME) + call clgstr ("device", device, SZ_FNAME) + + # Map image. + u_im = immap (u_imsect, READ_ONLY, 0) + v_im = immap (v_imsect, READ_ONLY, 0) + + call clgstr ("title", title, SZ_LINE) + if (streq (title, "imtitle")) { + call strcpy (u_imsect, title, SZ_LINE) + call strcat (": ", title, SZ_LINE) + call strcat (IM_TITLE(u_im), title, SZ_LINE) + } + + + mode = NEW_FILE + if (clgetb ("append")) + mode = APPEND + + # Read in subraster. Warn the user if the subraster is very large, + # because the plot will take a long time to generate. + + u_ncols = IM_LEN(u_im,1) + u_nlines = IM_LEN(u_im,2) + v_ncols = IM_LEN(v_im,1) + v_nlines = IM_LEN(v_im,2) + + if ((u_ncols != v_ncols) || (u_nlines != v_nlines)) + call error (0, "U and V subrasters must be same size") + + u_subras = imgs2r (u_im, 1, u_ncols, 1, u_nlines) + v_subras = imgs2r (v_im, 1, v_ncols, 1, v_nlines) + + if (u_ncols * u_nlines > 128 ** 2 || v_ncols * v_nlines > 128 ** 2 && + clgetb ("verbose")) { + call eprintf("Warning: image is quite large; subsampling with an\n") + call eprintf("image section would speed things up considerably\n") + } + + + # Open device and make contour plot. + call gopks (STDERR) + wkid = 1 + gp = gopen (device, mode, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + call gtext (gp, 0.5, 0.96, title, "f=b;h=c;s=.80") + + # Install interrupt exception handler. + call zlocpr (vl_tco_onint, epa) + call xwhen (X_INT, epa, old_onint) + + # Make the contour plot. If an interrupt occurs ZSVJMP is reeentered + # with an error status. + + call zsvjmp (tcojmp, status) + if (status == OK) { + call ezvec (Memr[u_subras], Memr[v_subras], u_ncols, u_nlines) + } else { + call gcancel (gp) + call fseti (STDOUT, F_CANCEL, OK) + } + + call gdawk (wkid) + call gclwk (wkid) + call gclks () + + call imunmap (u_im) + call imunmap (v_im) +end + + +# VL_TCO_ONINT -- Interrupt handler for the task contour. Branches back to +# ZSVJMP in the main routine to permit shutdown without an error message. + +procedure vl_tco_onint (vex, next_handler) + +int vex # virtual exception +int next_handler # not used + +int tcojmp[LEN_JUMPBUF] +common /tcocom/ tcojmp + +begin + call xer_reset() + call zdojmp (tcojmp, vex) +end diff --git a/pkg/plot/velvect.par b/pkg/plot/velvect.par new file mode 100644 index 00000000..c67d2e62 --- /dev/null +++ b/pkg/plot/velvect.par @@ -0,0 +1,6 @@ +u_image,s,a,,,,image or image section to be plotted +v_image,s,a,,,,image or image section to be plotted +device,s,h,stdgraph,,,output device +title,s,h,"imtitle",,,optional title +append,b,h,no,,,append to an old plot +verbose,b,h,yes,,,print warning messages diff --git a/pkg/plot/vport.x b/pkg/plot/vport.x new file mode 100644 index 00000000..47fbd659 --- /dev/null +++ b/pkg/plot/vport.x @@ -0,0 +1,94 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> + +define XCEN 0.5 +define YCEN 0.52 +define EDGE1 0.1 +define EDGE2 0.93 + +# PL_MAP_VIEWPORT -- set device viewport for contour and hafton plots. If not +# specified by user, a default viewport centered on the device is used. +# +# The value of "extreme" (ext) axes ratios changed from 1/4 to 1/16 +# (ShJ 6-10-88) + +procedure pl_map_viewport (gp, ncols, nlines, ux1, ux2, uy1, uy2, fill, perim) + +pointer gp #I pointer to graphics descriptor +int ncols, nlines #I size of image area, after block reduction +real ux1, ux2, uy1, uy2 #I NDC coordinates of requested viewort +bool fill #I fill viewport (vs preserve aspect ratio) +bool perim #I draw perimeter + +real xcen, ycen +real ncolsr, nlinesr, ratio, aspect_ratio +real x1, x2, y1, y2, ext, xdis, ydis +data ext /0.0625/ +bool fp_equalr() +real ggetr() + +begin + ncolsr = real (ncols) + nlinesr = real (nlines) + + if (fp_equalr (ux1, 0.0) && fp_equalr (ux2, 0.0) && + fp_equalr (uy1, 0.0) && fp_equalr (uy2, 0.0)) { + + if (fill && !perim) { + x1 = 0.0; x2 = 1.0 + y1 = 0.0; y2 = 1.0 + xcen = 0.5; ycen = 0.5 + } else { + x1 = EDGE1; x2 = EDGE2 + y1 = EDGE1; y2 = EDGE2 + xcen = XCEN; ycen = YCEN + } + + # 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 + + # 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) + } + + # Set window and viewport for WCS 1 + call gseti (gp, G_WCS, 1) + call gsview (gp, ux1, ux2, uy1, uy2) + call gswind (gp, 1.0, ncolsr, 1.0, nlinesr) + call set (ux1, ux2, uy1, uy2, 1.0, ncolsr, 1.0, nlinesr, 1) +end diff --git a/pkg/plot/x_ncar.x b/pkg/plot/x_ncar.x new file mode 100644 index 00000000..d580f38c --- /dev/null +++ b/pkg/plot/x_ncar.x @@ -0,0 +1,8 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# Package task statement for the NCAR utilities package. + +task contour = t_contour, + surface = t_surface, + hafton = t_hafton, + velvect = t_velvect diff --git a/pkg/plot/x_plot.x b/pkg/plot/x_plot.x new file mode 100644 index 00000000..0e87ba6d --- /dev/null +++ b/pkg/plot/x_plot.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# Package task statement for the PLOT package. + +task implot = t_implot, + crtpict = t_crtpict, + gdevices = t_gdevices, + phistogram = t_phistogram, + pradprof = t_pradprof, + prows = t_prows, + prow = t_prow, + pcols = t_pcols, + pcol = t_pcol, + pvector = t_pvector, + graph = t_graph, + gkiextract = t_gkiextract, + gkidir = t_gkidir, + gkimosaic = t_gkimosic |