aboutsummaryrefslogtreecommitdiff
path: root/sys/gio/nsppkern/zzdebug.x
diff options
context:
space:
mode:
Diffstat (limited to 'sys/gio/nsppkern/zzdebug.x')
-rw-r--r--sys/gio/nsppkern/zzdebug.x472
1 files changed, 472 insertions, 0 deletions
diff --git a/sys/gio/nsppkern/zzdebug.x b/sys/gio/nsppkern/zzdebug.x
new file mode 100644
index 00000000..b2ae6144
--- /dev/null
+++ b/sys/gio/nsppkern/zzdebug.x
@@ -0,0 +1,472 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+include <mach.h>
+include <fset.h>
+include <gset.h>
+include "font.h"
+
+define XS 0.216
+define XE 0.719
+define YS 0.214
+define YE 0.929
+
+task grid = t_grid,
+ grey = t_grey,
+ text = t_text,
+ seefont = t_seefont,
+ txup = t_txup,
+ font = t_font,
+ efont = t_efont
+
+
+# GRID -- Test program for graphics plotting. A labelled grid is output.
+
+procedure t_grid ()
+
+pointer gp
+bool redir
+char command[SZ_LINE], image[SZ_FNAME], word[SZ_LINE]
+char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME]
+int cmd, input_fd, stat, fd
+
+pointer gopen()
+bool streq()
+int fstati(), open(), getline(), sscan()
+
+begin
+ # If the input has been redirected, input is read from the named
+ # command file. If not, each image name in the input template is
+ # plotted.
+
+ if (fstati (STDIN, F_REDIR) == YES) {
+call eprintf ("Input has been redirected\n")
+ redir = true
+ cmd = open (STDIN, READ_ONLY, TEXT_FILE)
+ }
+
+ # Loop over commands until EOF
+ repeat {
+ if (redir) {
+ if (getline (STDIN, command, SZ_LINE) == EOF)
+ break
+ stat = sscan (command)
+ call gargwrd (word, SZ_LINE)
+ if (!streq (word, "plot")) {
+ # Pixel window has been stored as WCS 2
+ call gseti (gp, G_WCS, 2)
+ call gscan (command)
+ next
+ } else
+ call gargwrd (image)
+ }
+
+ call clgstr ("output", output, SZ_FNAME)
+ if (!streq (output, "")) {
+ call strcpy (output, output_file, SZ_FNAME)
+ fd = open (output_file, NEW_FILE, BINARY_FILE)
+ } else
+ fd = open ("dev$crt", NEW_FILE, BINARY_FILE)
+
+ call clgstr ("device", device, SZ_FNAME)
+ gp = gopen (device, NEW_FILE, fd)
+
+ call gseti (gp, G_XDRAWGRID, 1)
+ call gseti (gp, G_YDRAWGRID, 1)
+ call gseti (gp, G_NMAJOR, 21)
+ call glabax (gp, "TEST", "NDC_X", "NDC_Y")
+ call gline (gp, XS, YS, XE, YS)
+ call gline (gp, XE, YS, XE, YE)
+ call gline (gp, XE, YE, XS, YE)
+ call gline (gp, XS, YE, XS, YS)
+ call gmark (gp, 0.5, 0.5, GM_CROSS, 3.0, 3.0)
+ call gtext (gp, XS, YS-0.1, "DICOMED crtpict film area")
+ call gclose (gp)
+ call close (fd)
+ }
+
+ call clpcls (input_fd)
+end
+
+
+# GREY -- test code to generate grey scale on plotters
+
+procedure t_grey()
+
+pointer gp
+real size
+int i, fd, count
+short celldata[1024]
+char output[SZ_FNAME], device[SZ_FNAME]
+
+pointer gopen()
+real clgetr()
+int open(), clgeti()
+string fmt "hj=c;vj=c"
+
+begin
+ call clgstr ("device", device, SZ_FNAME)
+ call clgstr ("output", output, SZ_FNAME)
+
+ fd = open (output, NEW_FILE, BINARY_FILE)
+ gp = gopen (device, NEW_FILE, fd)
+
+ size = clgetr ("size")
+
+ call gsetr (gp, G_TXSIZE, size)
+ call gtext (gp, .5, .9, "! !\"#$%&'()*+,-./", fmt)
+ call gtext (gp, .5, .8, "1234567890", fmt)
+ call gtext (gp, .5, .7, "ABCDEFGHIJKLMNOPQR", fmt)
+ call gtext (gp, .5, .6, "STUVWXYZ[\\]^_`", fmt)
+ call gtext (gp, .5, .5, "abcdefghijklmnopqr", fmt)
+ call gtext (gp, .5, .4, "stuvwxyz{}|~", fmt)
+
+ call gtext (gp, .5, .1, "Grey Scale Test", fmt)
+
+ count = clgeti ( "count")
+ if (count > 1024)
+ count = 1024
+ for (i=1; i <= count; i=i+1)
+ celldata[i] = i - 1
+
+ call gpcell (gp, celldata, count, 1, 0.05, 0.2, .95, 0.3)
+
+ call gclose (gp)
+ call close (fd)
+end
+
+
+# TEXT -- Test character drawing.
+
+procedure t_text()
+
+char device[SZ_FNAME]
+char output[SZ_FNAME]
+int fd, open()
+pointer gp, gopen()
+
+begin
+ call clgstr ("device", device, SZ_FNAME)
+ call clgstr ("output", output, SZ_FNAME)
+
+ fd = open (output, NEW_FILE, BINARY_FILE)
+ gp = gopen (device, NEW_FILE, fd)
+
+ call gsetr (gp, G_TXSIZE, 1.0)
+
+ call gtext (gp, .1, .1,
+ "abcdefghijklmnopqrstuvwxyz", "hj=l,vj=b")
+ call gtext (gp, .1, .2,
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "hj=l,vj=b")
+ call gtext (gp, .1, .3,
+ "0123456789", "hj=l,vj=b")
+ call gtext (gp, .1, .4,
+ " ,./<>?;:'\"\\|[]{}!@#$%^&*()-_=+`~", "hj=l,vj=b")
+
+ call gsetr (gp, G_TXSIZE, 2.0)
+
+ call gtext (gp, .1, .5,
+ "abcdefghijklmnopqrstuvwxyz", "hj=l,vj=b")
+ call gtext (gp, .1, .6,
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "hj=l,vj=b")
+ call gtext (gp, .1, .7,
+ "0123456789", "hj=l,vj=b")
+ call gtext (gp, .1, .8,
+ " ,./<>?;:'\"\\|[]{}!@#$%^&*()-_=+`~", "hj=l,vj=b")
+
+ call gclose (gp)
+ call close (fd)
+end
+
+
+# SEEFONT definitions.
+define L .40
+define R .60
+define U .75
+define D .25
+define W (R-L)
+define H (U-D)
+
+
+# SEEFONT -- Draw a character from the font table.
+
+procedure t_seefont()
+
+char ch
+pointer gp
+real x, y
+int wcs, key
+char strval[SZ_FNAME]
+
+pointer gopen()
+int clgcur()
+
+begin
+ gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+
+ call gline (gp, L, D, R, D)
+ call gline (gp, R, D, R, U)
+ call gline (gp, R, U, L, U)
+ call gline (gp, L, U, L, D)
+
+ ch = 'A'
+ call gdrwch (gp, L, D, ch, W, H)
+
+ while (clgcur ("gcur", x, y, wcs, key, strval, SZ_FNAME) != EOF) {
+ call gclear (gp)
+
+ call gline (gp, L, D, R, D)
+ call gline (gp, R, D, R, U)
+ call gline (gp, R, U, L, U)
+ call gline (gp, L, U, L, D)
+
+ ch = key
+ call gdrwch (gp, L, D, ch, W, H)
+ }
+
+ call gclose (gp)
+end
+
+
+# GDRWCH -- Draw a character of the given size and orientation at the given
+# position.
+
+procedure gdrwch (gp, x, y, ch, xsize, ysize)
+
+pointer gp # graphics descriptor
+real x, y # lower left NDC coords of character
+char ch # character to be drawn
+real xsize, ysize # size of character in NDC units
+
+real px, py
+int stroke, tab1, tab2, i, pen
+int bitupk()
+include "font.com"
+common /font/ chridx, chrtab
+
+begin
+ if (ch < CHARACTER_START || ch > CHARACTER_END)
+ i = '?' - CHARACTER_START + 1
+ else
+ i = ch - CHARACTER_START + 1
+
+ tab1 = chridx[i]
+ tab2 = chridx[i+1] - 1
+
+ do i = tab1, tab2 {
+ stroke = chrtab[i]
+ px = bitupk (stroke, COORD_X_START, COORD_X_LEN)
+ py = bitupk (stroke, COORD_Y_START, COORD_Y_LEN)
+ pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+ px = x + ((px + FONT_LEFT) / FONT_WIDTH) * xsize
+ py = y + ((py + FONT_BOTTOM) / FONT_HEIGHT) * ysize
+
+ if (pen == 0)
+ call gamove (gp, px, py)
+ else
+ call gadraw (gp, px, py)
+ }
+end
+
+
+# TXUP -- Draw text strings with various character up vectors and paths.
+
+procedure t_txup()
+
+char device[SZ_FNAME]
+char output[SZ_FNAME]
+char text[SZ_LINE]
+int fd, open(), clgeti()
+pointer gp, gopen()
+
+begin
+ call clgstr ("device", device, SZ_FNAME)
+ call clgstr ("output", output, SZ_FNAME)
+
+ fd = open (output, NEW_FILE, BINARY_FILE)
+ gp = gopen (device, NEW_FILE, fd)
+
+ call clgstr ("text", text, SZ_LINE)
+
+ call gseti (gp, G_TXHJUSTIFY, clgeti("hjustify"))
+ call gseti (gp, G_TXVJUSTIFY, clgeti("vjustify"))
+
+ call gmark (gp, .1, .2, GM_CROSS, 3., 3.)
+ call gtext (gp, .1, .2, text, "up=0,path=right")
+ # --
+ call gmark (gp, .2, .2, GM_CROSS, 3., 3.)
+ call gtext (gp, .2, .2, text, "up=45,path=right")
+ # --
+ call gmark (gp, .3, .2, GM_CROSS, 3., 3.)
+ call gtext (gp, .3, .2, text, "up=90,path=right")
+ # --
+ call gmark (gp, .4, .2, GM_CROSS, 3., 3.)
+ call gtext (gp, .4, .2, text, "up=135,path=right")
+ # --
+ call gmark (gp, .5, .2, GM_CROSS, 3., 3.)
+ call gtext (gp, .5, .2, text, "up=180,path=right")
+
+ call gmark (gp, .1, .4, GM_CROSS, 3., 3.)
+ call gtext (gp, .1, .4, text, "up=90,path=left")
+ # --
+ call gmark (gp, .2, .4, GM_CROSS, 3., 3.)
+ call gtext (gp, .2, .4, text, "up=90,path=right")
+ # --
+ call gmark (gp, .3, .4, GM_CROSS, 3., 3.)
+ call gtext (gp, .3, .4, text, "up=90,path=up")
+ # --
+ call gmark (gp, .4, .4, GM_CROSS, 3., 3.)
+ call gtext (gp, .4, .4, text, "up=90,path=down")
+
+ call gclose (gp)
+ call close (fd)
+end
+
+
+# FONT -- Test the font change escapes.
+
+procedure t_font()
+
+char device[SZ_FNAME]
+char output[SZ_FNAME]
+char text[SZ_LINE], format[SZ_FNAME]
+int fd, i, open()
+pointer gp, gopen()
+
+begin
+ call clgstr ("device", device, SZ_FNAME)
+ call clgstr ("output", output, SZ_FNAME)
+
+ fd = open (output, NEW_FILE, BINARY_FILE)
+ gp = gopen (device, NEW_FILE, fd)
+
+ do i = 2, 8, 2 {
+ call clgstr ("text", text, SZ_LINE)
+ call clgstr ("format", format, SZ_FNAME)
+ call gtext (gp, .2, i / 10.0, text, format)
+ }
+
+ call gclose (gp)
+ call close (fd)
+end
+
+
+# EFONT -- Font editor.
+
+procedure t_efont()
+
+char cmd[SZ_LINE]
+real scale
+int pen, x, y, nw, w1, w2, ch, fcn
+int ip, i, tab1, tab2, stroke, junk
+
+int bitupk(), ctoi(), ctor(), getline()
+short chridx[96], chrtab[800]
+common /font/ chridx, chrtab
+define decode_ 91
+
+begin
+ repeat {
+ # Get command.
+ call clgstr ("cmd", cmd, SZ_FNAME)
+ if (cmd[1] == 'q')
+ break
+
+ # Decode function and integer arguments (range of words).
+ # Format "fcn [scale] ch w1 w2".
+
+ fcn = cmd[1]
+ ip = 2
+
+ scale = 0
+ if (fcn == 'x' || fcn == 'y')
+ if (ctor (cmd, ip, scale) <= 0)
+ scale = 1.0
+
+ while (IS_WHITE(cmd[ip]))
+ ip = ip + 1
+
+ ch = cmd[ip]
+ ip = ip + 1
+
+ if (ctoi (cmd, ip, w1) < 0)
+ w1 = 1
+ if (ctoi (cmd, ip, w2) < 0)
+ w2 = w1
+
+ if (ch < CHARACTER_START || ch > CHARACTER_END)
+ next
+ else
+ i = ch - CHARACTER_START + 1
+
+ tab1 = chridx[i]
+ tab2 = chridx[i+1] - 1
+
+ nw = tab2 - tab1 + 1
+ w1 = max(1, min(nw, w1))
+ w2 = max(1, min(nw, w2))
+
+call eprintf ("fcn=%c [%g], ch=%c, tab1=%d, tab2=%d, nw=%d, w1=%d, w2=%d\n")
+call pargi(fcn); call pargr (scale);
+call pargi(ch); call pargi(tab1); call pargi(tab2)
+call pargi(nw); call pargi(w1); call pargi(w2)
+
+ # Functions:
+ #
+ # w write codes
+ # r read and encode
+ # x scale in X
+ # y scale in Y
+
+ do i = w1-1+tab1, w2-1+tab1 {
+ stroke = chrtab[i]
+ x = bitupk (stroke, COORD_X_START, COORD_X_LEN)
+ y = bitupk (stroke, COORD_Y_START, COORD_Y_LEN)
+ pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN)
+
+ switch (fcn) {
+ case 'w':
+decode_ call eprintf ("%2d %6d (%6o) %d %3d %3d\n")
+ call pargi (i - tab1 + 1)
+ call pargi (stroke)
+ call pargi (stroke)
+ call pargi (pen)
+ call pargi (x)
+ call pargi (y)
+ next
+
+ case 'r':
+ junk = getline (STDIN, cmd)
+ ip = 1
+ junk = ctoi (cmd, ip, pen)
+ junk = ctoi (cmd, ip, x)
+ junk = ctoi (cmd, ip, y)
+ call bitpak (x, stroke, COORD_X_START, COORD_X_LEN)
+ call bitpak (y, stroke, COORD_Y_START, COORD_Y_LEN)
+ call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+ chrtab[i] = stroke
+ goto decode_
+
+ case 'x':
+ x = x * scale
+ call bitpak (x, stroke, COORD_X_START, COORD_X_LEN)
+ call bitpak (y, stroke, COORD_Y_START, COORD_Y_LEN)
+ call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+ chrtab[i] = stroke
+ goto decode_
+
+ case 'y':
+ y = (y - FONT_BASE) * scale + FONT_BASE
+ call bitpak (x, stroke, COORD_X_START, COORD_X_LEN)
+ call bitpak (y, stroke, COORD_Y_START, COORD_Y_LEN)
+ call bitpak (pen, stroke, COORD_PEN_START, COORD_PEN_LEN)
+ chrtab[i] = stroke
+ goto decode_
+
+ default:
+ call eprintf ("unknown function code\n")
+ }
+ }
+ }
+end
generated by cgit (git 2.34.1) at 2025-09-20 06:30:37 -0400