diff options
Diffstat (limited to 'pkg/plot/t_gkimos.x')
| -rw-r--r-- | pkg/plot/t_gkimos.x | 1067 |
1 files changed, 1067 insertions, 0 deletions
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 |