path: root/pkg/plot/t_gkimos.x

# 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