Initial commit

53 files changed, 1498 insertions, 0 deletions

diff --git a/sys/gio/gks/README b/sys/gio/gks/README
new file mode 100644
index 00000000..fc3307c7
--- /dev/null
+++ b/sys/gio/gks/README
@@ -0,0 +1,50 @@
+GKS - This directory contains code for a partial implementation of the Fortran
+binding of GKS level OA.  The GKS functions are layered upon GIO.  The functions
+provided are:
+
+	gacwk	---	activate workstation
+	gca	---	output (integer) cell array
+	gcas	---	output (short) cell array
+	gclks	---	close GKS
+	gclrwk	---	clear workstation
+	gclwk	---	close workstation
+	gdawk	---	deactivate workstation
+	gfa	---	fill area
+	gopks	---	open GKS
+	gopwk	---	open workstation
+	gpl	---	polyline
+	gpm	---	polymarker
+	gqasf	---	query aspect source flag
+	gqchh	---	query character height
+	gqchup	---	query character up vector
+	gqcntn	---	query current transformation number
+	gqnt	---	query normalization transformation (window and viewport)
+	gqopwk	---	query open workstations
+	gqplci	---	query polyline color index
+	gqpmi   ---     query polymarker index
+	gqtxal	---	query text alignment
+	gqtxci	---	query text color index
+	gqtxp	---	query text path
+	gqwks	---	query workstation state
+	qsasf	--- 	query aspect source flag
+	gschh	---	set character height
+	gschup	---	set character up vector
+	gscr    ---     set color representation
+	gselnt	---	set normalization transformation
+	gsfaci  ---     set fill area color index
+	gsfais	---	set fill area interior style
+	gslwsc  ---     set line width scale factor
+	gsmk	---	set marker type
+	gsplci	---	set polyline color index
+	gspmci	---	set polymarker color index
+	gspmi   ---     set polymarker index
+	gstxal	---	set text alignment
+	gstxci	---	set text color index
+	gstxp	---	set text path
+	gsvp	---	set viewport
+	gswn	---	set window
+	gtx	---	text (gtx.f, gxgtx.x)
+
+Two functions were added 8Sep86:
+	gsclip	---	set clipping flag
+	gqclip	---	query clipping flag
diff --git a/sys/gio/gks/gacwk.x b/sys/gio/gks/gacwk.x
new file mode 100644
index 00000000..c9393d07
--- /dev/null
+++ b/sys/gio/gks/gacwk.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GACWK -- Activate workstation.
+
+procedure gacwk (wkid)
+
+int	wkid 		# Workstation identifier
+include	"gks.com"
+
+begin
+	# This procedure sets the active flag for a particular workstation.
+	gk_status[wkid] = ACTIVE
+
+	# Also, set gk_std to be the first activated workstation.  Once
+	# gk_std has been set, it will no longer = NULL.
+	if (gk_std == NULL)
+	    gk_std = wkid
+end
diff --git a/sys/gio/gks/gca.x b/sys/gio/gks/gca.x
new file mode 100644
index 00000000..918c3e37
--- /dev/null
+++ b/sys/gio/gks/gca.x
@@ -0,0 +1,36 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GCA -- Cell array.  Output a cell array to the specified output device
+# area.
+
+procedure gca (px, py, qx, qy, dimx, dimy, ncs, nrs, dx, dy, colia)
+
+real	px, py, qx, qy		# Two points (P, Q) in world coordinates
+int	dx, dy			# Number of columns, number of rows 
+int	dimx, dimy		# Dimensions of color index array
+int	ncs, nrs		# Starting column, row of color array
+int	colia[dimx,dimy]	# Colour index array
+
+int	i, j, off
+pointer	sp, pixels
+include	"gks.com"
+
+begin
+	# Extract subraster and convert to type short.
+	call smark (sp)
+	call salloc (pixels, dx * dy, TY_SHORT)
+	do j = 1, dy {
+	    off = (j - 1) * dx
+	    call achtis (colia[ncs,nrs+j-1], Mems[pixels+off], dx)
+	}
+
+	# Output color array to all active workstations.
+	do i = 1, NDEV 
+	    if (gk_status[i] == ACTIVE)
+		call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+
+	call sfree (sp)
+end
diff --git a/sys/gio/gks/gcas.x b/sys/gio/gks/gcas.x
new file mode 100644
index 00000000..3ab44f99
--- /dev/null
+++ b/sys/gio/gks/gcas.x
@@ -0,0 +1,46 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GCAS -- Cell array.  Output a cell array to the specified output device
+# area.  This version of GCA intended for input color array of type short.
+
+procedure gcas (px, py, qx, qy, dimx, dimy, ncs, nrs, dx, dy, colia)
+
+real	px, py, qx, qy		# Two points (P, Q) in world coordinates
+int	dx, dy			# Number of columns, number of rows 
+int	dimx, dimy		# Dimensions of color index array
+int	ncs, nrs		# Starting column, row of color array
+short	colia[dimx, dimy]	# Colour index array
+
+int	i, j, off
+pointer	sp, pixels
+include	"gks.com"
+
+begin
+	if (ncs == 1 && nrs == 1) {
+	    # Output color array to all active workstations.
+	    do i = 1, NDEV 
+	        if (gk_status[i] == ACTIVE)
+		    call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+	
+	} else {
+	    # Cell array is subraster of a larger array
+	    call smark (sp)
+	    call salloc (pixels, dx * dy, TY_SHORT)
+
+	    # Extract subraster
+	    do j = 1, dy {
+		off = (j - 1) * dx
+		call amovs (colia[ncs,nrs+j-1], Mems[off], dx)
+	    }
+
+	    # Output color array to all active workstations.
+	    do i = 1, NDEV 
+	        if (gk_status[i] == ACTIVE)
+		    call gpcell (gp[i], Mems[pixels], dx, dy, px, py, qx, qy)
+
+	    call sfree (sp)
+	}
+end
diff --git a/sys/gio/gks/gclks.x b/sys/gio/gks/gclks.x
new file mode 100644
index 00000000..a82b760d
--- /dev/null
+++ b/sys/gio/gks/gclks.x
@@ -0,0 +1,9 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GCLKS -- Close GKS.
+
+procedure gclks ()
+
+begin
+	# This procedure performs no function in the GKS emulator.
+end
diff --git a/sys/gio/gks/gclrwk.x b/sys/gio/gks/gclrwk.x
new file mode 100644
index 00000000..7f92bc91
--- /dev/null
+++ b/sys/gio/gks/gclrwk.x
@@ -0,0 +1,19 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GCLRWK -- Clear workstation.
+
+procedure gclrwk (wkid, cofl)
+
+int	wkid		# Workstation identifier
+int	cofl		# Control flags (GCONDI, GALWAY)
+include	"gks.com"
+
+begin
+	# Clear the screen or advance film on the specified workstation.  GKS
+	# allows this to be done conditionally, dependent on whether or not
+	# something has been drawn.
+
+	call gclear (gp[wkid])
+end
diff --git a/sys/gio/gks/gclwk.x b/sys/gio/gks/gclwk.x
new file mode 100644
index 00000000..6fc3c16a
--- /dev/null
+++ b/sys/gio/gks/gclwk.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GCLWK -- Close workstation.
+
+procedure gclwk (wkid)
+
+int	wkid		# Workstation identifier
+include	"gks.com"
+
+begin
+	call gclose (gp[wkid])
+end
diff --git a/sys/gio/gks/gdawk.x b/sys/gio/gks/gdawk.x
new file mode 100644
index 00000000..23eaff14
--- /dev/null
+++ b/sys/gio/gks/gdawk.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GDAWK -- Deactivate workstation.
+
+procedure gdawk (wkid)
+
+int	wkid		# Workstation identifier
+int	i
+include	"gks.com"
+
+begin
+	# This procedure sets the status flag to INACTIVE for a particular
+	# device.  Because this workstation may have been the reference
+	# workstation, gk_std, it may also necessary to update gk_std.
+	# In this case, the reference workstation will be the one with the
+	# lowest workstation id number.
+
+	gk_status[wkid] = INACTIVE
+
+	if (wkid == gk_std) {
+	    gk_std = NULL
+	    # Find next activated workstation, if any
+	    do i = 1, NDEV {
+	        if (gk_status[i] == ACTIVE) {
+		    gk_std = i
+		    break
+		}
+	    }
+	}
+end
diff --git a/sys/gio/gks/gfa.x b/sys/gio/gks/gfa.x
new file mode 100644
index 00000000..9eb612b2
--- /dev/null
+++ b/sys/gio/gks/gfa.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GFA -- Fill area.  The style of fill has already been set and is read
+# from gio.com.
+
+procedure gfa (n, px, py)
+
+int	n		# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+include "gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gfill (gp[i], px, py, n, gk_style)
+	}
+end
diff --git a/sys/gio/gks/gks.com b/sys/gio/gks/gks.com
new file mode 100644
index 00000000..63c20568
--- /dev/null
+++ b/sys/gio/gks/gks.com
@@ -0,0 +1,10 @@
+# Common for GKS emulator.
+
+pointer	gp[NDEV]	# Graphics file descriptor for gio calls
+int	gk_status[NDEV]	# Active bit = INACTIVE or ACTIVE
+int	gk_std		# Index of gp array used for reference in set/get calls
+int	gk_style	# Fill area type of fill - set by GSFAIS
+int	gk_marker	# Marker type for use by GPM
+int	gk_asf[NASF]	# Array for maintaining aspect source flags
+
+common /gksemu/ gp, gk_status, gk_std, gk_style, gk_marker, gk_asf
diff --git a/sys/gio/gks/gks.h b/sys/gio/gks/gks.h
new file mode 100644
index 00000000..2373c55f
--- /dev/null
+++ b/sys/gio/gks/gks.h
@@ -0,0 +1,40 @@
+# Definitions for the gks emulator.
+
+define	NDEV		10	# Maximum number of open devices possible
+define	INACTIVE	0
+define	ACTIVE		1
+define	MAX_WCS		16	# Maximum number of world coordinate systems
+define	NASF		13	# Number of aspect source flags
+
+# Following are emuneration types used by the GKS emulator.
+define	GRIGHT		0
+define	GLEFT		1
+define	GUP		2
+define	GDOWN		3
+define	GAHNOR		0
+define	GALEFT		1
+define	GACENT		2
+define	GARITE		3
+define	GAVNOR		0
+define	GATOP		1
+define	GACAP		2
+define	GAHALF		3
+define	GABASE		4
+define	GABOTT		5
+define	GPOINT		1
+define	GPLUS		2
+define	GAST		3
+define	GOMARK		4
+define	GXMARK		5
+define	GHOLLO		0
+define	GSOLID		1
+define	GPATTR		2
+define	GHATCH		3
+define	GBUNDL		0
+define	GINDIV		1
+define	GRIGHT		0
+define	GLEFT		1
+define	GUP		2
+define	GDOWN		3
+define	GCONDI		0
+define	GALWAY		1
diff --git a/sys/gio/gks/gopks.x b/sys/gio/gks/gopks.x
new file mode 100644
index 00000000..48f39de0
--- /dev/null
+++ b/sys/gio/gks/gopks.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GOPKS -- Open GKS.  In the GIO implementation, this routine sets the
+# file to receive error output to STDERR and initializes all possible
+# workstations to inactive.  It also initializes the ASF array to GINDIV.
+
+procedure gopks (errfil)
+
+int	errfil		# Unit number for error output
+int	i
+include	"gks.com"
+
+begin
+	# This procedure initializes the gk_status and gk_std variables.
+	do i = 1, NDEV 
+	    gk_status[i] = INACTIVE
+	
+	gk_std = NULL
+
+	do i = 1, NASF
+	    gk_asf[i] = GINDIV
+end
diff --git a/sys/gio/gks/gopwk.x b/sys/gio/gks/gopwk.x
new file mode 100644
index 00000000..baa040e3
--- /dev/null
+++ b/sys/gio/gks/gopwk.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GOPWK -- Open workstation.
+
+procedure gopwk (wkid, conid, wtype)
+
+int	wkid		# Workstation identifier
+int	conid		# Connection identifier, not used.
+int	wtype		# Workstation type 
+
+include	"gks.com"
+
+
+begin
+	# This procedure sets "gp[wkid]" to be the "gp" of workstation "wkid".
+	# Procedure gopen has been called by the calling routine.  The wkid
+	# runs sequentially from 1 to the maximum allowable number of open
+	# workstations.  Parameter wtype is the gp returned from gopen.
+
+	gp[wkid] = wtype
+end
diff --git a/sys/gio/gks/gpl.x b/sys/gio/gks/gpl.x
new file mode 100644
index 00000000..ea5b880f
--- /dev/null
+++ b/sys/gio/gks/gpl.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GPL -- Polyline.  Draw a line connecting the points.
+
+procedure gpl (n, px, py)
+
+int	n	 	# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gpline (gp[i], px, py, n)
+	}
+end
diff --git a/sys/gio/gks/gpm.x b/sys/gio/gks/gpm.x
new file mode 100644
index 00000000..1a7d8ac7
--- /dev/null
+++ b/sys/gio/gks/gpm.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GPM -- Polymarker.  Draw marks of type "gk_marker" and size 2.0
+# at the given positions.  Marker type has already been set.
+
+procedure gpm (n, px, py)
+
+int	n		# Number of points
+real	px[n], py[n]	# Coordinates of points in world coordinates
+
+int	i
+real	size
+include	"gks.com"
+
+begin
+	# Marker size is a constant.
+	size = 2.0
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+    	        call gpmark (gp[i], px, py, n, gk_marker, size, size)
+	}
+end
diff --git a/sys/gio/gks/gqasf.x b/sys/gio/gks/gqasf.x
new file mode 100644
index 00000000..828ddef0
--- /dev/null
+++ b/sys/gio/gks/gqasf.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQASF -- Inquire aspect source flags. 
+
+procedure gqasf (ierror, lasf)
+
+int	lasf[13]		# Array of source aspect flags
+int	ierror			# Error indicator, where ierror = 0 for no error
+int	i
+include	"gks.com"
+
+begin
+	ierror = 0
+	do i = 1, NASF
+	    lasf[i] = gk_asf[i]
+end
diff --git a/sys/gio/gks/gqchh.x b/sys/gio/gks/gqchh.x
new file mode 100644
index 00000000..733d0a2a
--- /dev/null
+++ b/sys/gio/gks/gqchh.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCHH - Inquire character height.
+
+procedure gqchh (ierror, chh)
+
+int	ierror			# Error indicator
+real	chh			# Character height, in world coordinates
+
+real	dx, dy
+real	gstatr()
+include	"gks.com"
+errchk	gstatr, ggscale
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    chh = -1.0
+	    return
+	} else 
+	    ierror = 0
+
+	iferr {
+	    chh = gstatr (gp[gk_std], G_CHARSIZE)
+
+	    # The character height is expressed in NDC units.  It must be 
+	    # converted to world coordinates before returning.
+
+	    call ggscale (gp[gk_std], 0., 0., dx, dy)
+	    chh = chh * dy
+	} then {
+	    ierror = 1
+	    chh = -1.0
+	}
+end
diff --git a/sys/gio/gks/gqchup.x b/sys/gio/gks/gqchup.x
new file mode 100644
index 00000000..3f12d8c4
--- /dev/null
+++ b/sys/gio/gks/gqchup.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCHUP -- Inquire character up vector.
+
+procedure gqchup (ierror, chupx, chupy)
+
+int	ierror			# Error code; ierror = 0 for no error 
+real	chupx, chupy		# Character up vector x and y components
+
+int	angle
+real	txup
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    chupx = 0.0
+	    chupy = 0.0
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    angle = gstati (gp[gk_std], G_TXUP) 
+
+	    txup = real (angle) * 3.1415926 / 180.
+	    chupx = cos (txup)
+	    chupy = sin (txup)
+	} then {
+	    ierror = 1
+	    chupx = 0.0
+	    chupy = 0.0
+	}
+end
diff --git a/sys/gio/gks/gqclip.x b/sys/gio/gks/gqclip.x
new file mode 100644
index 00000000..5694b353
--- /dev/null
+++ b/sys/gio/gks/gqclip.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCLIP -- Inquire value of clipping flag
+
+procedure gqclip (errind, iclip, iar)
+
+int	errind			# Error indicator
+int	iclip			# Clipping flag - returned value
+real	iar[4]			# Clipping array 
+
+int	gstati()
+include	"gks.com"
+
+begin
+	# Until I know what this argument is, set iar to full viewport.  
+	# Consulting with NCAR was not enlightning.  This argument (iar) 
+	# is not documented in the GKS level 0A standard.
+	iar[1] = 0.0
+	iar[2] = 1.0
+	iar[3] = 0.0
+	iar[4] = 1.0
+
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    iclip = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    iclip = gstati (gp[gk_std], G_CLIP)
+	} then {
+	    errind = 1
+	    iclip = -1
+	}
+end
diff --git a/sys/gio/gks/gqcntn.x b/sys/gio/gks/gqcntn.x
new file mode 100644
index 00000000..aaaa79bf
--- /dev/null
+++ b/sys/gio/gks/gqcntn.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQCNTN -- Inquire current normalization transformation number (WCS).
+
+procedure gqcntn (errind, cntr)
+
+int	errind		# Error indicator; errind = 0 means no error
+int	cntr		# Current normalization transformation  number
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    cntr = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    cntr = gstati (gp[gk_std], G_WCS)
+	} then {
+	    errind = 1
+	    cntr = -1
+	}
+end
diff --git a/sys/gio/gks/gqmk.x b/sys/gio/gks/gqmk.x
new file mode 100644
index 00000000..0e90fbe7
--- /dev/null
+++ b/sys/gio/gks/gqmk.x
@@ -0,0 +1,31 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQMK -- Query marker type.  Integer variable "marker" is read from
+# "gks.com" and returned.  
+
+procedure gqmk (ierr, mtype)
+
+int	ierr			# Error indicator - no way it can be set
+int	mtype			# Marker type for polymarker
+include	"gks.com"
+
+begin
+	ierr = 0
+	switch (gk_marker) {
+	case GM_POINT:
+	    mtype = GPOINT
+	case GM_PLUS:
+	    mtype = GPLUS
+	case GM_BOX:
+	    mtype = GAST
+	case GM_DIAMOND:
+	    mtype = GOMARK
+	case GM_CROSS:
+	    mtype = GXMARK
+	default:
+	    mtype = GPOINT
+	}
+end
diff --git a/sys/gio/gks/gqnt.x b/sys/gio/gks/gqnt.x
new file mode 100644
index 00000000..c172647f
--- /dev/null
+++ b/sys/gio/gks/gqnt.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQNT -- Inquire normalization transformation (window and vport).  Note
+# that this procedure gets the information for WCS ntnr, then resets to
+# the current WCS before returning.
+
+procedure gqnt (ntnr, errind, window, vport)
+
+int	ntnr			# Normalization transformation number to query
+int	errind			# Error indicator; errind = 0 means no error
+real	window[4]		# Window coordinates for WCS ntnr
+real	vport[4]		# Viewport coordinates for WCS ntnr
+
+int	current_wcs
+int	gstati()
+include	"gks.com"
+errchk	gstati, gseti, ggwind, ggview
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	    return
+	} else
+	    errind = 0
+
+	if (ntnr < 0 || ntnr > MAX_WCS) {
+	    errind = 50
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	    return
+	}
+
+	iferr {
+	    current_wcs = gstati (gp[gk_std], G_WCS)
+
+	    call gseti  (gp[gk_std], G_WCS, ntnr)
+	    call ggwind (gp[gk_std], window[1], window[2], window[3], window[4])
+	    call ggview (gp[gk_std], vport[1], vport[2], vport[3], vport[4])
+
+	    call gseti  (gp[gk_std], G_WCS, current_wcs)
+	} then {
+	    errind = 1
+	    window[1] = 0.0
+	    window[2] = 0.0
+	    window[3] = 0.0
+	    window[4] = 0.0
+	    vport[1] = -1.0
+	    vport[2] = -1.0
+	    vport[3] = -1.0
+	    vport[4] = -1.0
+	}
+end
diff --git a/sys/gio/gks/gqopwk.x b/sys/gio/gks/gqopwk.x
new file mode 100644
index 00000000..cf297f45
--- /dev/null
+++ b/sys/gio/gks/gqopwk.x
@@ -0,0 +1,56 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQOPWK -- Inquire number of open work stations.  From looking at how this
+# procedure is called, it seems to have two functions, depending on the value
+# of "n".  It returns either the number of active workstations (n=0), or the
+# wkid for nth open workstation.
+
+procedure gqopwk (n, errind, ol, wkid)
+
+int	n			# Number of workstation to query
+int	errind			# Error indicator; errind = 0 means no error
+int	ol			# Returned value (number of open workstations)
+int	wkid			# WKID of nth open workstation - returned
+
+int	i, this_wkstation
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    wkid = -1
+	    return
+	} else
+	    errind = 0
+
+	if (n < 0 || n > NDEV) {
+	    # Invalid workstation identifier
+	    wkid = -1
+	    errind = 502
+	    return
+	} else {
+	    ol = 0
+	    if (n == 0) {
+	        # return the number of active workstations
+	        do i = 1, NDEV {
+		    if (gk_status[i] == ACTIVE)
+		        ol = ol + 1
+	        }
+	    } else {
+	        # Find the nth open workstation and return its wkid
+	        this_wkstation = 0
+	        do i = 1, NDEV {
+		    if (gk_status[i] == ACTIVE) {
+		        this_wkstation = this_wkstation + 1
+		        if (this_wkstation == n) {
+			    wkid = i
+			    break
+		        }
+		    }
+	        }
+	    }
+	}
+end
diff --git a/sys/gio/gks/gqplci.x b/sys/gio/gks/gqplci.x
new file mode 100644
index 00000000..23858491
--- /dev/null
+++ b/sys/gio/gks/gqplci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPLCI -- Inquire Polyline color index.
+
+procedure gqplci (errind, coli)
+
+int	coli			# Color index - returned value
+int	errind			# Error indicator
+real	gstatr()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    coli = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    coli = int (gstatr (gp[gk_std], G_PLWIDTH))
+	} then {
+	    errind = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqpmci.x b/sys/gio/gks/gqpmci.x
new file mode 100644
index 00000000..d1760d15
--- /dev/null
+++ b/sys/gio/gks/gqpmci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPMCI -- Inquire Polymarker color index.
+
+procedure gqpmci (errind, coli)
+
+int	coli			# Color index - returned value
+int	errind			# Error indicator
+real	gstatr()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    errind = 7
+	    coli = -1
+	    return
+	} else
+	    errind = 0
+
+	iferr {
+	    coli = int (gstatr (gp[gk_std], G_PMWIDTH))
+	} then {
+	    errind = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqpmi.x b/sys/gio/gks/gqpmi.x
new file mode 100644
index 00000000..b1332b54
--- /dev/null
+++ b/sys/gio/gks/gqpmi.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQPMI -- Inquire Polymarker index.
+
+procedure gqpmi (errind, index)
+
+real	index                   # Polymarker index - returned value.
+int	errind			# Error indicator
+include	"gks.com"
+
+begin
+	errind = 0
+	index = 1.0
+end
diff --git a/sys/gio/gks/gqtxal.x b/sys/gio/gks/gqtxal.x
new file mode 100644
index 00000000..36a90186
--- /dev/null
+++ b/sys/gio/gks/gqtxal.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXAL -- Inquire text alignment.
+
+procedure gqtxal (ierror, txalh, txalv)
+
+int	ierror			# Error indicator; ierror = 0 means no error
+int	txalh			# Horizontal text alignment
+int	txalv			# Vertical text alignment
+
+int	justify
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    txalh = -1
+	    txalv = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    # Get value of horizontal text justification
+	    justify = gstati (gp[gk_std], G_TXHJUSTIFY)
+
+	    switch (justify) {
+	    case GT_NORMAL:
+	        txalh = GAHNOR
+	    case GT_CENTER:
+	        txalh = GACENT
+	    case GT_LEFT:
+	        txalh = GALEFT
+	    case GT_RIGHT:
+	        txalh = GARITE
+	    default:
+	        txalh = GAHNOR
+	    }
+
+	    # Get value of vertical text justification
+	    justify =  gstati (gp[gk_std], G_TXVJUSTIFY)
+
+	    switch (justify) {
+	    case GT_NORMAL:
+		txalv = GAVNOR
+	    case GT_CENTER:
+		txalv = GAHALF
+	    case GT_TOP:
+		txalv = GATOP
+	    case GT_BOTTOM:
+		txalv = GABOTT
+	    default:
+		txalv = GAVNOR
+	    }
+	} then {
+	    ierror = 1
+	    txalv = -1
+	    txalh = -1
+	}
+end
diff --git a/sys/gio/gks/gqtxci.x b/sys/gio/gks/gqtxci.x
new file mode 100644
index 00000000..e327660b
--- /dev/null
+++ b/sys/gio/gks/gqtxci.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXCI -- Inquire text color index.
+
+procedure gqtxci (ierror, coli)
+
+int	ierror			# Error indicator
+int	coli			# Color index - returned value.
+int	gstati ()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    coli = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    coli = gstati (gp[gk_std], G_TXCOLOR)
+	} then {
+	    ierror = 1
+	    coli = -1
+	}
+end
diff --git a/sys/gio/gks/gqtxp.x b/sys/gio/gks/gqtxp.x
new file mode 100644
index 00000000..53dfd1af
--- /dev/null
+++ b/sys/gio/gks/gqtxp.x
@@ -0,0 +1,45 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GQTXP -- Inquire text path.
+
+procedure gqtxp (ierror, path)
+
+int	ierror			# Error indicator
+int	path			# Text path - returned value.
+
+int	text_path
+int	gstati()
+include	"gks.com"
+
+begin
+	if (gk_std == NULL) {
+	    # GKS not in proper state; no active workstations
+	    ierror = 7
+	    path = -1
+	    return
+	} else
+	    ierror = 0
+
+	iferr {
+	    text_path =  gstati (gp[gk_std], G_TXPATH)
+
+	    switch (text_path) {
+	    case (GT_LEFT):
+	        path = GLEFT
+	    case (GT_RIGHT):
+	        path = GRIGHT
+	    case (GT_UP):
+	        path = GUP
+	    case (GT_DOWN):
+	        path = GDOWN
+	    default:
+	        path = GRIGHT
+	    }
+	} then {
+	    ierror = 1
+	    path = -1
+	}
+end
diff --git a/sys/gio/gks/gqwks.x b/sys/gio/gks/gqwks.x
new file mode 100644
index 00000000..b555fee0
--- /dev/null
+++ b/sys/gio/gks/gqwks.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"gks.h"
+
+# GQWKS -- Inquire workstation state.  State is either ACTIVE or INACTIVE;
+# this information has been stored in gks.com by GACWK.
+
+procedure gqwks (wkid, errind, state)
+
+int	wkid			# Workstation id for inquire
+int	errind			# Error indicator
+int	state			# Returned state value: ACTIVE or INACTIVE
+include	"gks.com"
+
+begin
+	errind = 0
+	if (wkid > NDEV)
+	    errind = 1
+	else
+	    state = gk_status[wkid]
+end
diff --git a/sys/gio/gks/gsasf.x b/sys/gio/gks/gsasf.x
new file mode 100644
index 00000000..be321060
--- /dev/null
+++ b/sys/gio/gks/gsasf.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "gks.h"
+
+# GSASF -- Set aspect source flags.  Aspect source flags allow the following 
+# elements to be set to either GBUNDL or GINDIV:
+#	 1	linetype ASF
+#	 2	linewidth scale factor ASF
+#	 3	polyline colour index ASF
+#	 4	marker type ASF
+#	 5	marker size scale factor ASF
+#	 6	polymarker colout index ASF
+#	 7	text font and precision factor ASF
+#	 8	character expansion factor ASF
+#	 9	character spacing ASF
+#	 10	text colour index ASF
+#	 11	fill area interior style ASF
+#	 12	fill area style index ASF
+#	 13	fill area colout index ASF
+
+procedure gsasf (lasf)
+
+int	lasf[13]	# List of aspect source flags
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NASF
+	    gk_asf[i] = lasf[i]
+end
diff --git a/sys/gio/gks/gsaw.x b/sys/gio/gks/gsaw.x
new file mode 100644
index 00000000..dbbc0190
--- /dev/null
+++ b/sys/gio/gks/gsaw.x
@@ -0,0 +1,37 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSAW[IR] -- Sets integer or real parameters for all active workstations.
+
+procedure gsawi (param, value)
+
+int	param		# Parameter to be set
+int	value		# New value for parameter
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gseti (gp[i], param, value)
+	}
+end
+
+
+procedure gsawr (param, value)
+
+int	param		# Parameter to be set
+real	value		# New value for parameter
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gsetr (gp[i], param, value)
+	}
+end
diff --git a/sys/gio/gks/gschh.x b/sys/gio/gks/gschh.x
new file mode 100644
index 00000000..172af231
--- /dev/null
+++ b/sys/gio/gks/gschh.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSCHH -- Set character height.
+
+procedure gschh (chh)
+
+real	chh		# Character height in world coordinates
+
+real	dx, dy, ndc_chh
+include	"gks.com"
+
+begin
+	# Input chh is in world coordinates; it must be transformed to NDC.
+	# Assuming spatial transformation is linear, input coordinates to
+	# ggscale are not used and so are set to 0.0.
+
+	call ggscale (gp[gk_std], 0.0, 0.0, dx, dy)
+	if (dy != 0) {
+	    ndc_chh = chh / dy
+	    call gsawr (G_CHARSIZE, ndc_chh)
+	} else
+	    call gsawr (G_CHARSIZE, chh)
+end
diff --git a/sys/gio/gks/gschup.x b/sys/gio/gks/gschup.x
new file mode 100644
index 00000000..d7698c41
--- /dev/null
+++ b/sys/gio/gks/gschup.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSCHUP -- Set character up vector.
+
+procedure gschup (chux, chuy)
+
+real	chux, chuy		# Character up vector, in world coordinates
+int	char_up
+bool	fp_equalr()
+
+begin
+	# Find the angle normal to the text baseline.  The angle is stored
+	# in degrees between -180 and +180.
+
+	if (fp_equalr (chux, 0.0))
+	    char_up = 90
+	else
+	    char_up = nint (atan2 (chuy, chux) * 180. / 3.1415926)
+
+	call gsawi (G_TXUP, char_up)
+end
diff --git a/sys/gio/gks/gsclip.x b/sys/gio/gks/gsclip.x
new file mode 100644
index 00000000..80fe32c0
--- /dev/null
+++ b/sys/gio/gks/gsclip.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSCLIP -- Set clipping flag.
+
+procedure gsclip (iclip)
+
+int	iclip		# New value of clipping flag
+
+begin
+	call gsawi (G_CLIP, iclip)
+end
diff --git a/sys/gio/gks/gscr.x b/sys/gio/gks/gscr.x
new file mode 100644
index 00000000..39a248e1
--- /dev/null
+++ b/sys/gio/gks/gscr.x
@@ -0,0 +1,17 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSCR -- Set color representation.  Currently implemented as a no-op.
+
+procedure gscr (wkstation, color_index, rgb)
+
+int	wkstation		# Workstation id
+int	color_index
+real	rgb[3]
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gselnt.x b/sys/gio/gks/gselnt.x
new file mode 100644
index 00000000..dfe39a3b
--- /dev/null
+++ b/sys/gio/gks/gselnt.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSELNT -- Select normalization transformation (same as world coord sys)
+
+procedure gselnt (wcs)
+
+int	wcs		# Transformation number
+
+begin
+	call gsawi (G_WCS, wcs)
+end
diff --git a/sys/gio/gks/gsfaci.x b/sys/gio/gks/gsfaci.x
new file mode 100644
index 00000000..620b0bca
--- /dev/null
+++ b/sys/gio/gks/gsfaci.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSFACI -- Set fill area color index.  Currently implemented as a no-op.
+
+procedure gsfaci (index)
+
+int	index		# Fill area color index.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsfais.x b/sys/gio/gks/gsfais.x
new file mode 100644
index 00000000..461cab8d
--- /dev/null
+++ b/sys/gio/gks/gsfais.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSFAIS -- Set fill area interior style.  Integer variable "gk_style" is
+# set and stored in "gks.com".  Procedure GFA will use this value.
+
+procedure gsfais (ints)
+
+int	ints		# Fill area interior style
+
+include	"gks.com"
+
+begin
+	switch (ints) {
+	case GHOLLO:
+	    gk_style = GF_HOLLOW
+	case GSOLID:
+	    gk_style = GF_SOLID
+	case GPATTR:
+	    gk_style = GF_HATCH4
+	case GHATCH:
+	    gk_style = GF_HATCH1
+	default:
+	    gk_style = GF_HOLLOW
+	}
+end
diff --git a/sys/gio/gks/gslwsc.x b/sys/gio/gks/gslwsc.x
new file mode 100644
index 00000000..b6f75963
--- /dev/null
+++ b/sys/gio/gks/gslwsc.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSLWSC -- Set linewidth scale.  Currently implemented as a no-op.
+
+procedure gslwsc (width)
+
+real	width		# Linewidth scale width.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsmk.x b/sys/gio/gks/gsmk.x
new file mode 100644
index 00000000..41a7b05d
--- /dev/null
+++ b/sys/gio/gks/gsmk.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSMK -- Set marker type.  Integer variable "marker" is set and
+# stored in "gks.com".  Procedure gpm uses this value.
+
+procedure gsmk (mtype)
+
+int	mtype			# Marker type for polymarker
+include	"gks.com"
+
+begin
+	switch (mtype) {
+	case GPOINT:
+	    gk_marker = GM_POINT
+	case GPLUS:
+	    gk_marker = GM_PLUS
+	case GAST:
+	    gk_marker = GM_BOX
+	case GOMARK:
+	    gk_marker = GM_DIAMOND
+	case GXMARK:
+	    gk_marker = GM_CROSS
+	default:
+	    gk_marker = GM_POINT
+	}
+end
diff --git a/sys/gio/gks/gsmksc.x b/sys/gio/gks/gsmksc.x
new file mode 100644
index 00000000..4936d7ea
--- /dev/null
+++ b/sys/gio/gks/gsmksc.x
@@ -0,0 +1,16 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSMKSC -- Set marker scale.  Currently implemented as a no-op.
+
+procedure gsmksc (width)
+
+real	width		# Marker scale width.
+
+include	"gks.com"
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gsplci.x b/sys/gio/gks/gsplci.x
new file mode 100644
index 00000000..afb74b4d
--- /dev/null
+++ b/sys/gio/gks/gsplci.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPLC -- Set polyline colour index.  This function is currently 
+# implemented as setting the polyline width, not color.
+
+procedure gsplci (coli)
+
+int	coli		# Polyline colour index
+
+begin
+	call gsawr (G_PLWIDTH, real (coli))
+end
diff --git a/sys/gio/gks/gspmci.x b/sys/gio/gks/gspmci.x
new file mode 100644
index 00000000..909800cf
--- /dev/null
+++ b/sys/gio/gks/gspmci.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPMCI -- Set polymarker colour index.  This function is currently
+# implemented as setting the polymarker width, not color.
+
+procedure gspmci (coli)
+
+int	coli		# Polymarker colour index.
+
+begin
+	call gsawr (G_PMCOLOR, real (coli))
+end
diff --git a/sys/gio/gks/gspmi.x b/sys/gio/gks/gspmi.x
new file mode 100644
index 00000000..e238fc10
--- /dev/null
+++ b/sys/gio/gks/gspmi.x
@@ -0,0 +1,14 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSPMI -- Set polymarker index.  This function is currently
+# implemented as a no-op.
+
+procedure gspmi (index)
+
+int	index		# Polymarker index. (whatever that is)
+
+begin
+	;
+end
diff --git a/sys/gio/gks/gstxal.x b/sys/gio/gks/gstxal.x
new file mode 100644
index 00000000..aecae88f
--- /dev/null
+++ b/sys/gio/gks/gstxal.x
@@ -0,0 +1,43 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSTXAL -- Set format alignment.  
+
+procedure gstxal (txalh, txalv)
+
+int	txalh		# Horizontal alignment
+int	txalv		# Vertical alignment
+
+begin
+	switch (txalh) {
+	case GAHNOR:
+	    call gsawi (G_TXHJUSTIFY, GT_NORMAL)
+	case GALEFT:
+	    call gsawi (G_TXHJUSTIFY, GT_LEFT)
+	case GACENT:
+	    call gsawi (G_TXHJUSTIFY, GT_CENTER)
+	case GARITE:
+	    call gsawi (G_TXHJUSTIFY, GT_RIGHT)
+	default:
+	    call gsawi (G_TXHJUSTIFY, GT_NORMAL)
+	}
+
+	switch (txalv) {
+	case GAVNOR:
+	    call gsawi (G_TXVJUSTIFY, GT_NORMAL)
+	case GATOP:
+	    call gsawi (G_TXVJUSTIFY, GT_TOP)
+	case GACAP:
+	    call gsawi (G_TXVJUSTIFY, GT_TOP)
+	case GAHALF:
+	    call gsawi (G_TXVJUSTIFY, GT_CENTER)
+	case GABASE:
+	    call gsawi (G_TXVJUSTIFY, GT_BOTTOM)
+	case GABOTT:
+	    call gsawi (G_TXVJUSTIFY, GT_BOTTOM)
+	default:
+	    call gsawi (G_TXVJUSTIFY, GT_NORMAL)
+	}
+end
diff --git a/sys/gio/gks/gstxci.x b/sys/gio/gks/gstxci.x
new file mode 100644
index 00000000..ec04132c
--- /dev/null
+++ b/sys/gio/gks/gstxci.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# GSTXCI -- Set colour index.  This function is currently implemented
+# by setting the text font to bold when the color index > 1, and to
+# the default (roman) otherwise.
+
+procedure gstxci (coli)
+
+int	coli		# Text colour index
+
+begin
+	if (coli > 1)
+	    call gsawi (G_TXFONT, GT_BOLD)
+	else 
+	    call gsawi (G_TXFONT, GT_ROMAN)
+end
diff --git a/sys/gio/gks/gstxp.x b/sys/gio/gks/gstxp.x
new file mode 100644
index 00000000..cf87e4f2
--- /dev/null
+++ b/sys/gio/gks/gstxp.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSTXP -- Set text path.
+
+procedure gstxp (txp)
+
+int	txp		# Text path to be set
+
+begin
+	switch (txp) {
+	case GRIGHT:
+	    call gsawi (G_TXPATH, GT_RIGHT)
+	case GLEFT:
+	    call gsawi (G_TXPATH, GT_LEFT)
+	case GUP:
+	    call gsawi (G_TXPATH, GT_UP)
+	case GDOWN:
+	    call gsawi (G_TXPATH, GT_DOWN)
+	default:
+	    call gsawi (G_TXPATH, GT_RIGHT)
+	}
+end
diff --git a/sys/gio/gks/gsvp.x b/sys/gio/gks/gsvp.x
new file mode 100644
index 00000000..f2a61711
--- /dev/null
+++ b/sys/gio/gks/gsvp.x
@@ -0,0 +1,30 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSVP -- Set viewport.  This procedure sets the viewport for world coord
+# sys "wcs", which may not be the current WCS.
+
+procedure gsvp (wcs, x1, x2, y1, y2)
+
+int	wcs		# Number of world coordinate system
+real	x1, x2		# Range of viewport coordinate in x (NDC)
+real	y1, y2		# Range of viewport coordinate in y (NDC)
+
+int	current_wcs, i
+int	gstati()
+include	"gks.com"
+
+begin
+	current_wcs = gstati (gp[gk_std], G_WCS)
+	call gsawi (G_WCS, wcs)
+
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gsview (gp[i], x1, x2, y1, y2)
+	}
+
+	# Now return to the current WCS
+	call gsawi (G_WCS, current_wcs)
+end
diff --git a/sys/gio/gks/gswn.x b/sys/gio/gks/gswn.x
new file mode 100644
index 00000000..713ae487
--- /dev/null
+++ b/sys/gio/gks/gswn.x
@@ -0,0 +1,29 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GSWN -- Set window.  Window of world coord system "wcs" is set, which
+# is not necessarily the current WCS.
+
+procedure gswn (wcs, x1, x2, y1, y2)
+
+int	wcs		# Number of world coordinate system (transformation)
+real	x1, x2		# Range of world coordinates in x
+real	y1, y2		# Range of world coordinates in y
+
+int	current_wcs, i
+int	gstati()
+include	"gks.com"
+
+begin
+	current_wcs = gstati (gp[gk_std], G_WCS)
+	call gsawi (G_WCS, wcs)
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+	    call gswind (gp[i], x1, x2, y1, y2)
+	}
+
+	# Now return to current WCS before returning
+	call gsawi (G_WCS, current_wcs)
+end
diff --git a/sys/gio/gks/gtx.f b/sys/gio/gks/gtx.f
new file mode 100644
index 00000000..c09ef7c4
--- /dev/null
+++ b/sys/gio/gks/gtx.f
@@ -0,0 +1,16 @@
+c GTX -- Text.  Unpack an f77 string and call gx_gtx to output the string.
+c
+	subroutine gtx (px, py, f77chars)
+c
+	real		px, py
+	character*(*) 	f77chars
+	integer*2     	sppchars(161)
+c
+c
+c	Unpack characters from packed input array
+c
+	call f77upk (f77chars, sppchars, min (len(f77chars), 161))
+	call gxgtx (px, py, sppchars)
+c
+c
+	end
diff --git a/sys/gio/gks/gxgtx.x b/sys/gio/gks/gxgtx.x
new file mode 100644
index 00000000..0ca39bb5
--- /dev/null
+++ b/sys/gio/gks/gxgtx.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+include	"gks.h"
+
+# GXGTX -- Text.  Ouptut an spp string with gtext.  The string has already
+# been unpacked from an f77 to spp string.
+
+procedure gxgtx (px, py, chars)
+
+real	px, py		# Text position in world coordinates
+char	chars[ARB]	# String of characters
+
+int	i
+include	"gks.com"
+
+begin
+	do i = 1, NDEV {
+	    if (gk_status[i] == ACTIVE)
+		call gtext (gp[i], px, py, chars, "")
+	}
+end
diff --git a/sys/gio/gks/mkpkg b/sys/gio/gks/mkpkg
new file mode 100644
index 00000000..864c3ba7
--- /dev/null
+++ b/sys/gio/gks/mkpkg
@@ -0,0 +1,58 @@
+# Make the GKS emulator.
+
+$checkout libgks.a lib$
+$update	  libgks.a
+$checkin  libgks.a lib$
+$exit
+
+libgks.a:
+	gacwk.x		gks.com gks.h
+	gca.x		gks.com gks.h <gset.h>
+	gcas.x		gks.com gks.h <gset.h>
+	gclks.x
+	gclrwk.x	gks.com gks.h
+	gclwk.x		gks.com gks.h
+	gdawk.x		gks.com gks.h
+	gfa.x		gks.h <gset.h> gks.com
+	gopks.x		gks.com gks.h
+	gopwk.x		gks.com gks.h
+	gpl.x		gks.com gks.h
+	gpm.x		gks.com gks.h <gset.h>
+	gqasf.x		gks.com gks.h
+	gqchh.x		gks.com gks.h <gset.h>
+	gqchup.x	gks.com gks.h <gset.h>
+	gqclip.x 	gks.com gks.h <gset.h> 
+	gqcntn.x	gks.com gks.h <gset.h>
+	gqmk.x		gks.com gks.h <gset.h>
+	gqnt.x		gks.com gks.h <gset.h>
+	gqopwk.x	gks.com gks.h
+	gqplci.x	gks.com gks.h <gset.h>
+	gqpmci.x	gks.com gks.h <gset.h>
+	gqpmi.x		gks.com gks.h <gset.h>
+	gqtxal.x	gks.com gks.h <gset.h>
+	gqtxci.x	gks.com gks.h <gset.h>
+	gqtxp.x		gks.com gks.h <gset.h>
+	gqwks.x		gks.com gks.h
+	gsasf.x		gks.com gks.h
+	gsaw.x		gks.com gks.h <gset.h>
+	gschh.x		gks.com gks.h <gset.h>
+	gschup.x	<gset.h>
+	gsclip.x	<gset.h>
+	gscr.x		gks.com gks.h <gset.h>
+	gselnt.x	<gset.h>
+	gsfaci.x	gks.com gks.h <gset.h>
+	gsfais.x	gks.com gks.h <gset.h>
+	gslwsc.x	gks.com gks.h <gset.h>
+	gsmk.x		gks.com gks.h <gset.h>
+	gsmksc.x	gks.com gks.h <gset.h>
+	gsplci.x	<gset.h>
+	gspmci.x	<gset.h>
+	gspmi.x		<gset.h>
+	gstxal.x	gks.h <gset.h>
+	gstxci.x	<gset.h>
+	gstxp.x		gks.h <gset.h>
+	gsvp.x		gks.com gks.h <gset.h>
+	gswn.x		gks.com gks.h <gset.h>
+	gtx.f
+	gxgtx.x		gks.com gks.h <gset.h>
+	;