aboutsummaryrefslogtreecommitdiff
path: root/sys/gio/cursor/grccmd.x
diff options
context:
space:
mode:
Diffstat (limited to 'sys/gio/cursor/grccmd.x')
-rw-r--r--sys/gio/cursor/grccmd.x533
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
generated by cgit (git 2.34.1) at 2025-09-20 09:50:02 -0400