Initial commit

1 files changed, 533 insertions, 0 deletions

diff --git a/sys/gio/cursor/grccmd.x b/sys/gio/cursor/grccmd.x
new file mode 100644
index 00000000..5aca0f84
--- /dev/null
+++ b/sys/gio/cursor/grccmd.x
@@ -0,0 +1,533 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ttyset.h>
+include	<ctype.h>
+include	<mach.h>
+include	<fset.h>
+include	<gset.h>
+include	<gki.h>
+include	<gio.h>
+include	"gtr.h"
+include	"grc.h"
+
+define	MAX_KWLEN	10
+
+# Assign opcodes to the recognized keywords.
+
+define	KW_AXES		1
+define	KW_CASE		2
+define	KW_CLEAR	3
+define	KW_CURSOR	4
+define	KW_GFLUSH	5
+define	KW_HELP		6
+define	KW_INIT		7
+define	KW_MARKCUR	8
+define	KW_OFF		9
+define	KW_ON		10
+define	KW_PAGE		11
+define	KW_READ		12
+define	KW_SHOW		13
+define	KW_SNAP		14
+define	KW_TXQUALITY	15
+define	KW_TXSET	16
+define	KW_VIEWPORT	17
+define	KW_WRITE	18
+define	KW_XRES		19
+define	KW_YRES		20
+define	KW_ZERO		21
+
+
+# GRC_COMMAND -- Process a ":." cursor mode option string.  The RC structure
+# contains the current values of the cursor mode options.  Some option strings
+# are commands that do something, others set options, and still others show
+# the status of the program.
+
+int procedure grc_command (rc, stream, sx, sy, raster, rx, ry, opstr)
+
+pointer	rc			#I rcursor descriptor
+int	stream			#I graphics stream
+real	sx, sy			#I screen coords of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coords of cursor
+char	opstr[ARB]		#I options string excluding the leading ":.".
+
+pointer	tr, p_tr, sp, fname, lbuf, tty
+bool	clobber, fullframe, auto_gflush
+int	ip, op, ch, opcode, cursor
+int	save1, save2, i, xres, yres, quality
+char	kwname[MAX_KWLEN]
+
+pointer	gtr_init(), grc_open(), ttyodes()
+int	strdic(), grc_boolval(), ttygeti(), ttystati()
+real	grc_realval()
+string	keywords "|axes|case|clear|cursor|gflush|help|init|markcur|off|on|page|\
+read|show|snap|txquality|txset|viewport|write|xres|yres|zero|"
+errchk	gtr_redraw, gki_flush, gtr_init
+define	exit_ 91
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	# The terminal is left in graphics mode when the user types return to
+	# enter the command.  Echo the user command to the terminal without
+	# the newline to leave the terminal in status line mode, so that any
+	# output directly to the terminal from the lower level code in the CL
+	# goes into the status line.
+
+	call strcpy (":.", Memc[lbuf], SZ_LINE)
+	op = lbuf + 2
+	for (ip=1;  opstr[ip] != EOS && opstr[ip] != '\n';  ip=ip+1) {
+	    Memc[op] = opstr[ip]
+	    op = op + 1
+	}
+	Memc[op] = EOS
+	call stg_putline (STDERR, Memc[lbuf])
+
+	tr = gtr_init (stream)
+	ip = 1
+
+	while (ip == 1 || opstr[ip] != EOS) {
+	    while (IS_WHITE(opstr[ip]))
+		ip = ip + 1
+
+	    # If EOS and not first command, all done.  If first command do
+	    # not quit, rather assume ":.help" (see below).
+
+	    if (ip > 1 && opstr[ip] == EOS)
+		break
+
+	    # Extract the keyword into the KWNAME buffer.  Leave the input
+	    # pointer positioned to the first char following the keyword.
+
+	    for (op=1;  opstr[ip] != EOS;  ip=ip+1) {
+		ch = opstr[ip]
+		if (IS_ALNUM(ch)) {
+		    kwname[op] = ch
+		    op = op + 1
+		} else
+		    break
+	    }
+	    kwname[op] = EOS
+
+	    # Look up the keyword in the dictionary.  If not found ring the bell
+	    # but do not return EOF (do not quit cursor mode).
+
+	    if (op == 1)
+		opcode = KW_HELP
+	    else {
+		opcode = strdic (kwname, kwname, MAX_KWLEN, keywords)
+		if (opcode <= 0) {
+		    call fprintf (STDERR, "\7")
+		    goto exit_
+		}
+	    }
+
+	    # Process the command.
+
+	    switch (opcode) {
+	    case KW_AXES:
+		# Set flag to draw axes of viewport when screen readrawn.
+		RC_AXES(rc) = grc_boolval (opstr, ip)
+
+	    case KW_CASE:
+		# Enable/disable case sensitivity.
+		RC_CASE(rc) = grc_boolval (opstr, ip)
+
+	    case KW_CLEAR:
+		# Clear the alpha screen.
+		iferr (tty = ttyodes ("terminal"))
+		    call grc_warn (STDERR)
+		else {
+		    do i = 1, ttystati (tty, TTY_NLINES) {
+			call ttygoto (STDOUT, tty, 1, i)
+			call ttyclearln (STDOUT, tty)
+		    }
+		    call flush (STDOUT)
+		    call ttycdes (tty)
+		}
+
+	    case KW_CURSOR:
+		# Select the cursor to be referenced in all subsequent reads
+		# and writes.
+
+		ip = ip + 1
+		cursor = max (0, nint (grc_realval (opstr, ip)))
+		call stg_lockcursor (cursor)
+
+	    case KW_GFLUSH:
+		# Flush any buffered graphics output (dispose of spooled
+		# plotter output).
+
+		call stg_putline (STDERR, " - ")
+		call gtr_gflush (STDPLOT)
+
+	    case KW_HELP:
+		# Print help text for cursor mode.
+		call gtr_page (STDERR, stream)
+		iferr (call pagefile (KEYSFILE, "cursor mode help"))
+		    call grc_warn (STDERR)
+		ip = ip + 1
+
+	    case KW_INIT:
+		# Disconnect all kernels and free memory.  Exits cursor mode
+		# with an EOF.
+
+		call stg_putline (STDERR, " - ")
+		call gtr_reset (OK)
+		call sfree (sp)
+		return (EOF)
+
+	    case KW_MARKCUR:
+		# Enable marking of the cursor position when the cursor is read.
+		RC_MARKCUR(rc) = grc_boolval (opstr, ip)
+
+	    case KW_OFF:
+		# Disable the listed keys.
+		call grc_keys (rc, opstr, ip, 0)
+
+	    case KW_ON:
+		# Enable or set the listed keys.
+		call grc_keys (rc, opstr, ip, 1)
+
+	    case KW_PAGE:
+		# Enable screen clear when ?, show, etc. print text.
+		TR_PAGE(tr) = grc_boolval (opstr, ip)
+
+	    case KW_READ:
+		# Fill the frame buffer from a metacode spool file.
+
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+		call grc_read (tr, stream, Memc[fname])
+
+	    case KW_SHOW:
+		# Show status of RCURSOR and GIOTR.
+
+		call gtr_page (STDERR, stream)
+		call fprintf (STDERR, "Cursor Mode Parameters:\n\n")
+		call grc_status (STDERR, rc)
+
+		call fprintf (STDERR, "\n\nGraphics Kernel Status:\n\n")
+		call gtr_status (STDERR)
+
+	    case KW_SNAP:
+		# Write a snapshot of the screen to a plotter.  Open a subkernel
+		# on STDPLOT, redraw the screen into the STDPLOT fio buffer,
+		# flush the buffered metacode to the kernel, then restore
+		# everything.  NOTE: should restore things automatically if an
+		# interrupt occurs.
+
+		call stg_putline (STDERR, " - ")
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+		iferr (p_tr = grc_open (Memc[fname], NEW_FILE, STDPLOT, rc)) {
+		    call grc_warn (STDERR)
+		    goto exit_
+		}
+
+		call gki_redir (stream, STDPLOT, save1, save2)
+		call fseti (STDPLOT, F_CANCEL, OK)
+
+		iferr {
+		    call gtr_redraw (stream)
+		    call gki_flush (STDPLOT)
+		} then
+		    call grc_warn (STDERR)
+
+		call gki_redir (stream, 0, save1, save2)
+
+		auto_gflush = (ttygeti (TR_TTY(p_tr), "MF") <= 1)
+		call grc_close (STDPLOT, rc)
+
+		if (auto_gflush)
+		    call gtr_gflush (STDPLOT)
+
+		call stg_putline (STDERR, " done")
+
+	    case KW_VIEWPORT:
+		# Set the viewport in world coordinates.
+		call grc_viewport (tr, stream,
+		    sx, sy, raster, rx, ry, opstr, ip)
+
+	    case KW_WRITE:
+		# Save the contents of the frame buffer in a file.
+		# "w!" clobbers any existing file and "w+" writes the
+		# full frame.  By default the frame is appended to the
+		# output file.
+
+		if (opstr[ip] == '!') {
+		    clobber = true
+		    ip = ip + 1
+		} else
+		    clobber = false
+
+		if (opstr[ip] == '+') {
+		    fullframe = true
+		    ip = ip + 1
+		} else
+		    fullframe = false
+
+		# Extract the filename.
+		call grc_word (opstr, ip, Memc[fname], SZ_FNAME)
+
+		# Write to the spoolfile.
+		call grc_write (tr, stream, Memc[fname], clobber, fullframe)
+
+	    case KW_XRES:
+		# Set the stdgraph X resolution.
+		xres = nint (grc_realval (opstr, ip))
+		yres = 0
+		call stg_resolution (xres, yres)
+
+	    case KW_YRES:
+		# Set the stdgraph Y resolution.
+		xres = 0
+		yres = nint (grc_realval (opstr, ip))
+		call stg_resolution (xres, yres)
+
+	    case KW_TXQUALITY:
+		# Set character generator quality.
+
+		while (IS_WHITE(opstr[ip]))
+		    ip = ip + 1
+
+		switch (opstr[ip]) {
+		case 'l':
+		    quality = GT_LOW
+		case 'm':
+		    quality = GT_MEDIUM
+		case 'h':
+		    quality = GT_HIGH
+		default:
+		    quality = 0
+		}
+		call stg_txquality (quality)
+
+	    case KW_TXSET:
+		# Set the text drawing attributes.
+		call gtxset (TR_TXAP(tr), opstr, ip)
+
+	    case KW_ZERO:
+		# Reset and redraw.
+		call gtr_ptran (stream, 0., 1., 0., 1.)
+		call gtr_writecursor (stream, .5, .5)
+		call gtr_redraw (stream)
+	    }
+
+	    # Advance to the next statement or the end of string.  Any unused
+	    # characters in the statement just processed are discarded.
+
+	    while (opstr[ip] != ';' && opstr[ip] != EOS)
+		ip = ip + 1
+	    while (opstr[ip] == ';' || opstr[ip] == '.')
+		ip = ip + 1
+	}
+exit_
+	# Restore the terminal to graphics mode if gtr_page was not called to
+	# deactivate the ws. (this leaves the waitpage flag set).
+
+	if (TR_WAITPAGE(tr) == NO)
+	    call stg_putline (STDERR, "\n")
+
+	# Leave the graphics descriptor set up as we found it.
+	tr = gtr_init (stream)
+
+	call flush (STDERR)
+	call sfree (sp)
+	return (OK)
+end
+
+
+# GRC_WORD -- Extract the next whitespace delimited word from the command line.
+
+procedure grc_word (opstr, ip, outstr, maxch)
+
+char	opstr[ARB]		# input string
+int	ip			# pointer into input string
+char	outstr[ARB]		# output string
+int	maxch			# max chars out
+int	op
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	op = 1
+	while (!IS_WHITE (opstr[ip]) && opstr[ip] != EOS) {
+	    outstr[op] = opstr[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+
+	outstr[op] = EOS
+end
+
+
+# GRC_BOOL -- Get the boolean value of a parameter.  Upon entry, the input
+# pointer is positioned to the first character following the parameter name.
+
+int procedure grc_boolval (opstr, ip)
+
+char	opstr[ARB]			# command string
+int	ip				# input pointer
+int	value
+int	btoi()
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	if (opstr[ip] == '=') {
+	    ip = ip + 1
+	    while (IS_WHITE (opstr[ip]))
+		ip = ip + 1
+	    value = btoi (opstr[ip] != 'n' && opstr[ip] != 'N')
+	    while (IS_ALPHA (opstr[ip]))
+		ip = ip + 1
+	} else
+	    value = btoi (opstr[ip] != '-')
+
+	return (value)
+end
+
+
+# GRC_REALVAL -- Get the real value of a parameter.  Upon entry, the input
+# pointer is positioned to the first character following the parameter name.
+# Zero is returned if no value is given.
+
+real procedure grc_realval (opstr, ip)
+
+char	opstr[ARB]			# command string
+int	ip				# input pointer
+real	value
+int	ctor()
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+	if (opstr[ip] == '=')
+	    ip = ip + 1
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	if (ctor (opstr, ip, value) <= 0)
+	    value = 0
+
+	return (value)
+end
+
+
+# GRC_KEYS -- Enable the listed keys or ranges of keys.  The operation is
+# additive, i.e., only the named keys are affected.
+
+procedure grc_keys (rc, opstr, ip, onoff)
+
+pointer	rc			# rcursor descriptor
+char	opstr[ARB]		# command string
+int	ip			# next char in opstr
+int	onoff			# set keys on (1) or off (0)
+
+int	new_value
+int	ch, ch1, ch2, ip_start, i
+string	keys KEYSTROKES
+
+begin
+	while (IS_WHITE (opstr[ip]))
+	    ip = ip + 1
+
+	ip_start = ip
+	for (ch=opstr[ip];  ch != EOS;  ch=opstr[ip]) {
+	    if (ch == ';' || ch == '\n' || IS_WHITE(ch))
+		break
+
+	    ch1 = ch
+	    if (opstr[ip+1] == '-' && opstr[ip+2] != EOS) {
+		# Enable a range of keys.
+		ip  = ip + 2
+		ch2 = opstr[ip]
+	    } else if (opstr[ip+1] == '=' && opstr[ip+2] != EOS) {
+		# Assign the value of a key.
+		ip = ip + 3
+		RC_KEYS(rc,ch) = opstr[ip]
+		next
+	    } else
+		ch2 = ch
+
+	    for (ch=ch1;  ch <= ch2;  ch=ch+1) {
+		if (onoff == 0)
+		    new_value = 0
+		else
+		    new_value = ch
+		RC_KEYS(rc,ch) = new_value
+	    }
+
+	    ip = ip + 1
+	}
+
+	# If no keys were listed, set all cursor mode keys.
+	if (ip == ip_start)
+	    for (i=1;  keys[i] != EOS;  i=i+1) {
+		ch = keys[i]
+		if (onoff == 0)
+		    new_value = 0
+		else
+		    new_value = ch
+		RC_KEYS(rc,ch) = new_value
+	    }
+		
+	# The ":" key cannot be mapped or disabled.
+	RC_KEYS(rc,':') = ':'
+end
+
+
+# GRC_VIEWPORT -- Set the viewport in world coordinates.  Use the current
+# cursor position to determine the WCS, then convert the world coordinates
+# of the viewport given by the user into NDC coordinates and set the work-
+# station transformation.
+
+procedure grc_viewport (tr, stream, sx, sy, raster, rx, ry, opstr, ip)
+
+pointer	tr			#I giotr descriptor
+int	stream			#I graphics stream
+real	sx, sy			#I screen coordinates of cursor
+int	raster			#I raster number
+real	rx, ry			#I raster coordinates of cursor
+char	opstr[ARB]		#I command string
+int	ip			#I input pointer
+
+pointer	w
+int	i, wcs
+real	wx, wy, value
+real	vn[4], vw[4], ct[LEN_CT]
+int	ctor()
+
+begin
+	# Select a WCS.  We are not otherwise interested in the cursor value.
+	call grc_scrtowcs (stream, sx, sy, raster, rx, ry, wx, wy, wcs)
+	w = TR_WCSPTR(tr,wcs)
+	call grc_settran (w, ct)
+
+	# Start with the current viewport.
+	call gtr_gtran (stream, vn[1], vn[2], vn[3], vn[4])
+
+	# Transform to world coordinates.
+	call grc_ndctowcs (ct, vn[1], vn[3], vw[1], vw[3])
+	call grc_ndctowcs (ct, vn[2], vn[4], vw[2], vw[4])
+
+	# Get the new viewport (world) coordinates.
+	do i = 1, 4
+	    if (ctor (opstr, ip, value) <= 0)
+		break
+	    else
+		vw[i] = value
+
+	# Transform to NDC coordinates.
+	call grc_wcstondc (ct, vw[1], vw[3], vn[1], vn[3])
+	call grc_wcstondc (ct, vw[2], vw[4], vn[2], vn[4])
+
+	# Set the new workstation transformation.
+	call gtr_ptran (stream, vn[1], vn[2], vn[3], vn[4])
+
+	# Redraw the screen.
+	call gtr_redraw (stream)
+end