diff options
Diffstat (limited to 'sys/gio/nsppkern')
39 files changed, 3471 insertions, 0 deletions
diff --git a/sys/gio/nsppkern/README b/sys/gio/nsppkern/README new file mode 100644 index 00000000..0990eac0 --- /dev/null +++ b/sys/gio/nsppkern/README @@ -0,0 +1,399 @@ +This directory contains the source for the NSPP/GIO kernel, the interface +between GIO and the old Ncar system plot package and associated metacode +translators. + +Special graphcap entries used by this kernel: + + MF maximum frame count per metafile + FS frame advance req'd at start of metafile + FE frame advance req'd at end of metafile + +Rev 1.0 installed in March 1985. +---------------------------------------------------------------------------- + +Differences between Rev 1.0 and Rev 1.1 of the NSPP/GIO kernel. +Collated at installation of Rev 1.1 on 24 April 1985. +---------------------------------------------------------------------------- + +gktclose.x ++ diff gktclose.x ../nsppkern.old/gktclose.x +12,13d11 +< call frame +< call gkt_flush ++ echo gktclosews.x +gktinit.x ++ diff gktinit.x ../nsppkern.old/gktinit.x +49a50,59 +> # get the window offsets +> +> g_xoff = ttygeti (tty, "XO") +> if (g_xoff < 0) +> g_xoff = 0 +> g_yoff = ttygeti (tty, "YO") +> if (g_yoff < 0) +> g_yoff = 0 +> +> +112d121 +< GKT_PIXREP(g_kt) = btoi (ttygetb (tty, "pr")) +gktopenws.x ++ diff gktopenws.x ../nsppkern.old/gktopenws.x +98,104c98,99 +< if (mode == NEW_FILE) { +< # Frame call only if NEW_FILE and not first time open with +< # this device. This prevents frame before first data. +< if (!need_open) +< call frame +< call gkt_reset +< } +--- +> if (mode == NEW_FILE) +> call frame() ++ echo gktpcell.x +gktpcell.x ++ diff gktpcell.x ../nsppkern.old/gktpcell.x +8a9 +> +12c13 +< procedure gkt_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2) +--- +> procedure gkt_putcellarray (m, nc, nr, x1,y1, x2,y2) +17,18c18,19 +< int ax1, ay1 # lower left corner of output window +< int ax2, ay2 # upper right corner of output window +--- +> int x1, y1 # lower left corner of output window +> int x2, y2 # upper right corner of output window +20d20 +< int x1,y1,x2,y2 # device coordinates +22c22 +< int nx, ny, y +--- +> int nx, ny +28c28 +< bool ca, use_orig, new_row, pr +--- +> bool ca, use_orig, new_row +31,32d30 +< real delta_y +< int xrep, yrep +43c41 +< # Determine if can do real cell array. If not, use character +--- +> # determine if can do real cell array. If not, use character +49d46 +< pr = false +53d49 +< pr = (GKT_PIXREP(g_kt) != 0) +65,66c61 +< # Input arguments (ax, ay) refer to corners of put cell array; +< # we need corners of the corresponding device array. +--- +> # find out how many real pixels we have to fill +68,73c63,66 +< x1 = ax1 +< x2 = ax2 +< y1 = ay1 +< y2 = ay2 +< call adjust(x1,x2,xres) +< call adjust(y1,y2,yres) +--- +> px1 = real(x1)/GKI_MAXNDC +> py1 = real(y1)/GKI_MAXNDC +> px2 = real(x2)/GKI_MAXNDC +> py2 = real(y2)/GKI_MAXNDC +75,79c68,69 +< # Find out how many real pixels we have to fill +< px1 = real(x1)/(GKI_MAXNDC+1) +< py1 = real(y1)/(GKI_MAXNDC+1) +< px2 = real(x2)/(GKI_MAXNDC+1) +< py2 = real(y2)/(GKI_MAXNDC+1) +--- +> nx = int( (px2 - px1) * (xres-1.0) + 1.5 ) +> ny = int( (py2 - py1) * (yres-1.0) + 1.5 ) +81,90c71 +< nx = int( px2 * xres ) - int( px1 * xres ) + 1 +< ny = int( py2 * yres ) - int( py1 * yres ) + 1 +< +< if ( ny > 1) +< delta_y = (real(y2) - real(y1))/ny +< else { +< delta_y = 0. +< } +< +< # If too many data points in input, set skip. If skip is close +--- +> # if too many data points in input, set skip. If skip is close +92,93c73,74 +< # Set block replication factors - will be > 1.0 if too few input points. +< # Cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have +--- +> # set block replication factors - will be > 1.0 if too few input points. +> # cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have +110c91,101 +< # Allocate storage for a row of pixels. This is quite inefficient +--- +> +> # try for the simplest case: 1:1 match with input data +> +> if ( ca && (nx == nc) && (ny == nr) ) { +> call pixels( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC, +> nx, ny, m) +> call sfree(sp) +> return +> } +> +> # allocate storage for a row of pixels. This is quite inefficient +113d103 +< # need nx+1 in case nx odd ... pixels() wants to pad output. +115,116c105 +< call salloc ( cell, nx+1, TY_SHORT) +< Mems[cell + nx] = 0 +--- +> call salloc ( cell, nx, TY_SHORT) +118c107 +< # Initialize counters +--- +> # initialize counters +125c114 +< # See if we can use original data ... no massaging +--- +> # see if we can use original data ... no massaging +128c117 +< # Note that if blockx > 1.0, skip_x must be 1.0, and vv +--- +> # note that if blockx > 1.0, skip_x must be 1.0, and vv +138,152c127 +< # If device can pixel replicate, use that feature where we can +< if( pr) { +< if( (skip_x == 1.0) && ( int(blockx) == blockx) ) { +< xrep = int(blockx) +< use_orig = true +< nx = nc +< } else +< xrep = 1 +< if( (skip_y == 1.0) && ( int(blocky) == blocky) ) { +< yrep = int(blocky) +< ny = 1 +< } else +< yrep = 1 +< } +< call pixel0(1,0,xrep,0,1,yrep) +--- +> # do it +154c129 +< # Do it +--- +> for (i = 1; i <= ny; i = i + 1) { +156c131 +< for ( i = 1; i <= ny ; i = i + 1) { +--- +> # Build the row data. +158,159d132 +< # Build the row data +< +161c134 +< if ( skip_x == 1.0) { +--- +> if ( skip_x == 1.0) +163c136 +< } else { +--- +> else { +181d153 +< y = y1 + ((i - 1)*delta_y + 0.5) +183,184c155,159 +< call pixels( px1, real(y)/GKI_MAXNDC, +< nx, 1, m[element]) +--- +> if ( i == 1 ) +> call pixelr( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC, +> nx, ny, m[element]) +> else +> call pixeli( 0., 0., nx, 1, m[element]) +186c161,165 +< call pixels( px1, real(y)/GKI_MAXNDC, nx, 1, Mems[cell]) +--- +> if ( i == 1 ) +> call pixelr( real(x1)/GKI_MAXNDC, real(y1)/GKI_MAXNDC, +> nx, ny, Mems[cell]) +> else +> call pixeli( 0., 0., nx, 1, Mems[cell]) +188,189c167 +< } +< else +--- +> } else +192c170 +< # Advance a row +--- +> # Advance a row. +206c184 +< # All done, restore text parameters and release storage +--- +> # all done, restore text parameters and release storage +209c187 +< call restoretx (txsave,tx) +--- +> call restoretx(txsave,tx) +212a191 +> +218d196 +< pointer savep, txp +219a198 +> pointer savep, txp +254a234 +> +258d237 +< pointer savep, txp +259a239 +> pointer savep, txp +263c243 +< # Restore values +--- +> # restore values +283a264 +> +287c268,269 +< procedure fakepc (indata, outdata, nx, scale) +--- +> procedure fakepc( indata, outdata, nx, scale) +> +298c280 +< data cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/ +--- +> data cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/ +330,374d311 +< end +< +< # ADJUST -- round/truncate putcell array corners to device coordinates +< # move up lower bound if it is above center point of device cell, +< # move down upper bound if below. Don't allow bounds to go beyond +< # resolution or below zero. Do not allow bounds to cross. Part of the +< # assumptions behind all this is that putcells will be continguous and +< # rows/columns must not be plotted twice. +< +< procedure adjust ( lower, upper, res) +< +< int lower, upper +< real res +< +< real factor +< real low, up +< +< begin +< factor = res/(GKI_MAXNDC+1) +< low = real(lower) * factor +< up = real(upper) * factor +< +< # if boundaries result in same row, return +< if ( int(low) == int(up) ) +< return +< +< # if low is in upper half of device pixel, round up +< if ( (low - int(low)) >= 0.5 ) { +< low = int(low) + 1 +< # don't go to or beyond upper bound +< if ( low < up ) { +< # ... 0.2 just for "rounding protection"; +< lower = (low + 0.2)/factor +< # if now reference same cell, return +< if ( int(low) == int(up) ) +< return +< } +< } +< +< # if "up" in bottom half of pixel, drop down one. Note that +< # due to two "==" tests above, upper will not drop below lower. +< # 0.2 means drop partway down into pixel below; calling code will +< # truncate. +< if ( (up - int(up)) < 0.5 ) +< upper = real(int(up) - 0.2)/factor ++ echo gktpl.x +gktpl.x ++ diff gktpl.x ../nsppkern.old/gktpl.x +51,52c51,52 +< x = p[1] +< y = p[2] +--- +> x = p[1] + g_xoff +> y = p[2] + g_yoff +58,59c58,59 +< x = p[i] +< y = p[i+1] +--- +> x = p[i] + g_xoff +> y = p[i+1] + g_yoff +gktpm.x ++ diff gktpm.x ../nsppkern.old/gktpm.x +48,49c48,49 +< x = p[1] +< y = p[2] +--- +> x = p[1] + g_xoff +> y = p[2] + g_yoff +63,64c63,64 +< x = p[i] +< y = p[i+1] +--- +> x = p[i] + g_xoff +> y = p[i+1] + g_yoff ++ echo gktpmset.x +gkttx.x ++ diff gkttx.x ../nsppkern.old/gkttx.x +109,110c109,110 +< call pwrity (real(x)/GKI_MAXNDC, +< real(y)/GKI_MAXNDC, Memc[pstring], seglen, +--- +> call pwrity (real(x+g_xoff)/GKI_MAXNDC, +> real(y+g_yoff)/GKI_MAXNDC, Memc[pstring], seglen, +_____________________________________________________________________________ + +25Apr85 gktpl.x + Call to optn to set line width changed to set option "inten" instead + of "spot size", which was not changing the line width. + +26Apr85 gktpm.x + Same change as one to gktpl.x + + Character size as used in gkttx.x is a floating point number, but + NCAR pwry.f uses an integer value -- the conversion was causing + centering errors as gkttx.x would calculate a "path length" for + the text based on one size, and pwry.f would use a different size + to generate the text. Changed pwry.f to use a floating point + size as an input variable, changed gkttx.x to send same. + + gktpcell.x + Moved pixel0 call inside the "if (pr) {" statment, where it should + have been. + + graphcap + Added "pr" capablility flag to dicomed entry. Changed character + height to reflect the 9 to 8 ratio that pwry uses. + + +--------------------------------------------------------------------------- +Rev 1.2 10 May 1985 Dct. + +Fairly extensive modifications made to minimize the number of frame calls +and metafiles generated. Redundant CLEAR calls or clear calls immediately +after open workstation are ignored. Multiple frames are permitted in a +metafile (formerly the metafile was disposed after each frame). Graphcap +parameters were added to control automatic frame advances at the beginning +and end of metafiles. + +--------------------------------------------------------------------------- +Rev 1.3 1 June 1985 Dct. + +[1] Fixed a bug in polymarker; was drawing polylines. + +[2] Replaced the old character generation code by all new code, using the stroke +table from the NCAR/GKS code. Replaced "pwry.f" by the much simpler +"gktdrawch.x". Largely copied the stdgraph "stgtx.x", including the clipping +logic therein. + +17-Aug-85 Dct. + Added support for the new DD graphcap parameter, used to pass device + dependent information to the device driver. This information was + formerly encoded in a table at compile time, with the table defined + in <libc/kernel.h>. diff --git a/sys/gio/nsppkern/font.com b/sys/gio/nsppkern/font.com new file mode 100644 index 00000000..ec1b0ec9 --- /dev/null +++ b/sys/gio/nsppkern/font.com @@ -0,0 +1,207 @@ +# CHRTAB -- Table of strokes for the printable ASCII characters. Each character +# is encoded as a series of strokes. Each stroke is expressed by a single +# integer containing the following bitfields: +# +# 2 1 +# 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 +# | | | | | | | +# | | | +---------+ +---------+ +# | | | | | +# | | | X Y +# | | | +# | | +-- pen up/down +# | +---- begin paint (not used at present) +# +------ end paint (not used at present) +# +#------------------------------------------------------------------------------ + +# Define the database. + +short chridx[96] # character index in chrtab +short chrtab[800] # stroke data to draw the characters + +# Index into CHRTAB of each printable character (starting with SP). + +data (chridx(i), i=01,05) / 1, 3, 12, 21, 30/ +data (chridx(i), i=06,10) / 45, 66, 79, 85, 92/ +data (chridx(i), i=11,15) / 99, 106, 111, 118, 121/ +data (chridx(i), i=16,20) / 128, 131, 141, 145, 154/ +data (chridx(i), i=21,25) / 168, 177, 187, 199, 203/ +data (chridx(i), i=26,30) / 221, 233, 246, 259, 263/ +data (chridx(i), i=31,35) / 268, 272, 287, 307, 314/ +data (chridx(i), i=36,40) / 327, 336, 344, 352, 359/ +data (chridx(i), i=41,45) / 371, 378, 385, 391, 398/ +data (chridx(i), i=46,50) / 402, 408, 413, 425, 433/ +data (chridx(i), i=51,55) / 445, 455, 468, 473, 480/ +data (chridx(i), i=56,60) / 484, 490, 495, 501, 506/ +data (chridx(i), i=61,65) / 511, 514, 519, 523, 526/ +data (chridx(i), i=66,70) / 529, 543, 554, 563, 574/ +data (chridx(i), i=71,75) / 585, 593, 607, 615, 625/ +data (chridx(i), i=76,80) / 638, 645, 650, 663, 671/ +data (chridx(i), i=81,85) / 681, 692, 703, 710, 723/ +data (chridx(i), i=86,90) / 731, 739, 743, 749, 754/ +data (chridx(i), i=91,95) / 759, 764, 776, 781, 793/ +data (chridx(i), i=96,96) / 801/ + +# Stroke data. + +data (chrtab(i), i=001,005) / 36, 1764, 675, 29328, 585/ +data (chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/ +data (chrtab(i), i=011,015) / 1764, 355, 29023, 351, 29027/ +data (chrtab(i), i=016,020) / 931, 29599, 927, 29603, 1764/ +data (chrtab(i), i=021,025) / 603, 29066, 842, 29723, 1302/ +data (chrtab(i), i=026,030) / 28886, 143, 29839, 1764, 611/ +data (chrtab(i), i=031,035) / 29256, 78, 20810, 21322, 21581/ +data (chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/ +data (chrtab(i), i=041,045) / 20833, 21345, 29789, 1764, 419/ +data (chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/ +data (chrtab(i), i=051,055) / 21022, 21025, 20899, 1187, 28744/ +data (chrtab(i), i=056,060) / 717, 21194, 21320, 21512, 21642/ +data (chrtab(i), i=061,065) / 21645, 21519, 21327, 21197, 1764/ +data (chrtab(i), i=066,070) / 1160, 20700, 20704, 20835, 21027/ +data (chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/ +data (chrtab(i), i=076,080) / 21192, 29841, 1764, 611, 21023/ +data (chrtab(i), i=081,085) / 21087, 21155, 21091, 1764, 739/ +data (chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/ +data (chrtab(i), i=091,095) / 1764, 547, 21151, 21210, 21201/ +data (chrtab(i), i=096,100) / 21132, 29192, 1764, 93, 29774/ +data (chrtab(i), i=101,105) / 608, 29259, 78, 29789, 1764/ +data (chrtab(i), i=106,110) / 604, 29260, 84, 29780, 1764/ +data (chrtab(i), i=111,115) / 516, 21062, 21065, 21001, 21000/ +data (chrtab(i), i=116,120) / 21064, 1764, 84, 29780, 1764/ +data (chrtab(i), i=121,125) / 585, 21063, 21191, 21193, 21065/ +data (chrtab(i), i=126,130) / 21191, 1764, 72, 29859, 1764/ +data (chrtab(i), i=131,135) / 419, 20573, 20558, 20872, 21320/ +data (chrtab(i), i=136,140) / 21646, 21661, 21347, 20899, 1764/ +data (chrtab(i), i=141,145) / 221, 21155, 29320, 1764, 95/ +data (chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/ +data (chrtab(i), i=151,155) / 20552, 29832, 1764, 95, 20899/ +data (chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/ +data (chrtab(i), i=161,165) / 854, 5266, 21644, 21320, 20872/ +data (chrtab(i), i=166,170) / 28749, 1764, 904, 21411, 21283/ +data (chrtab(i), i=171,175) / 20561, 20559, 21391, 911, 13455/ +data (chrtab(i), i=176,180) / 1764, 136, 21320, 21645, 21652/ +data (chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/ +data (chrtab(i), i=186,190) / 1764, 83, 20888, 21336, 21651/ +data (chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/ +data (chrtab(i), i=196,200) / 20635, 29347, 1764, 99, 21667/ +data (chrtab(i), i=201,205) / 29064, 1764, 355, 20575, 20570/ +data (chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/ +data (chrtab(i), i=211,215) / 21644, 21650, 21398, 20822, 918/ +data (chrtab(i), i=216,220) / 5274, 21663, 21411, 20835, 1764/ +data (chrtab(i), i=221,225) / 648, 21584, 21656, 21662, 21347/ +data (chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/ +data (chrtab(i), i=231,235) / 21656, 1764, 602, 21210, 21207/ +data (chrtab(i), i=236,240) / 21079, 21082, 21207, 592, 21069/ +data (chrtab(i), i=241,245) / 21197, 21200, 21072, 21197, 1764/ +data (chrtab(i), i=246,250) / 602, 21146, 21143, 21079, 21082/ +data (chrtab(i), i=251,255) / 21143, 585, 21132, 21136, 21072/ +data (chrtab(i), i=256,260) / 21071, 21135, 1764, 988, 20628/ +data (chrtab(i), i=261,265) / 29644, 1764, 1112, 28824, 144/ +data (chrtab(i), i=266,270) / 29776, 1764, 156, 21460, 28812/ +data (chrtab(i), i=271,275) / 1764, 221, 20704, 20899, 21218/ +data (chrtab(i), i=276,280) / 21471, 21466, 21011, 21007, 521/ +data (chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/ +data (chrtab(i), i=286,290) / 1764, 908, 20812, 20560, 20571/ +data (chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/ +data (chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/ +data (chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/ +data (chrtab(i), i=306,310) / 1764, 72, 20963, 21219, 29768/ +data (chrtab(i), i=311,315) / 210, 5074, 1764, 99, 21411/ +data (chrtab(i), i=316,320) / 21663, 21658, 21398, 20566, 918/ +data (chrtab(i), i=321,325) / 5266, 21644, 21384, 20552, 20579/ +data (chrtab(i), i=326,330) / 1764, 1165, 21320, 20872, 20557/ +data (chrtab(i), i=331,335) / 20574, 20899, 21347, 29854, 1764/ +data (chrtab(i), i=336,340) / 99, 21347, 21662, 21645, 21320/ +data (chrtab(i), i=341,345) / 20552, 20579, 1764, 99, 20552/ +data (chrtab(i), i=346,350) / 29832, 86, 13078, 99, 29859/ +data (chrtab(i), i=351,355) / 1764, 99, 20552, 86, 13078/ +data (chrtab(i), i=356,360) / 99, 29859, 1764, 722, 21650/ +data (chrtab(i), i=361,365) / 29832, 1165, 4936, 20872, 20557/ +data (chrtab(i), i=366,370) / 20574, 20899, 21347, 29854, 1764/ +data (chrtab(i), i=371,375) / 99, 28744, 85, 5269, 1160/ +data (chrtab(i), i=376,380) / 29859, 1764, 291, 29603, 611/ +data (chrtab(i), i=381,385) / 4680, 328, 29576, 1764, 77/ +data (chrtab(i), i=386,390) / 20872, 21256, 21581, 29795, 1764/ +data (chrtab(i), i=391,395) / 99, 28744, 1160, 20887, 82/ +data (chrtab(i), i=396,400) / 13475, 1764, 99, 20552, 29832/ +data (chrtab(i), i=401,405) / 1764, 72, 20579, 21077, 21603/ +data (chrtab(i), i=406,410) / 29768, 1764, 72, 20579, 21640/ +data (chrtab(i), i=411,415) / 29859, 1764, 94, 20899, 21347/ +data (chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/ +data (chrtab(i), i=421,425) / 20574, 862, 29859, 1764, 72/ +data (chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/ +data (chrtab(i), i=431,435) / 20564, 1764, 94, 20557, 20872/ +data (chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/ +data (chrtab(i), i=441,445) / 20574, 536, 29828, 1764, 72/ +data (chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/ +data (chrtab(i), i=451,455) / 20566, 918, 13448, 1764, 76/ +data (chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/ +data (chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/ +data (chrtab(i), i=466,470) / 29855, 1764, 648, 21155, 99/ +data (chrtab(i), i=471,475) / 29923, 1764, 99, 20557, 20872/ +data (chrtab(i), i=476,480) / 21320, 21645, 29859, 1764, 99/ +data (chrtab(i), i=481,485) / 21064, 29795, 1764, 99, 20808/ +data (chrtab(i), i=486,490) / 21141, 21448, 29923, 1764, 99/ +data (chrtab(i), i=491,495) / 29832, 72, 29859, 1764, 99/ +data (chrtab(i), i=496,500) / 21079, 29256, 599, 13411, 1764/ +data (chrtab(i), i=501,505) / 99, 21667, 20552, 29832, 1764/ +data (chrtab(i), i=506,510) / 805, 20965, 20935, 29447, 1764/ +data (chrtab(i), i=511,515) / 99, 29832, 1764, 421, 21221/ +data (chrtab(i), i=516,520) / 21191, 29063, 1764, 288, 21091/ +data (chrtab(i), i=521,525) / 29600, 1764, 3, 29891, 1764/ +data (chrtab(i), i=526,530) / 547, 29341, 1764, 279, 21207/ +data (chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/ +data (chrtab(i), i=536,540) / 20558, 20753, 21201, 21391, 907/ +data (chrtab(i), i=541,545) / 13447, 1764, 99, 28744, 76/ +data (chrtab(i), i=546,550) / 4424, 21256, 21516, 21523, 21271/ +data (chrtab(i), i=551,555) / 20823, 20563, 1764, 981, 21271/ +data (chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/ +data (chrtab(i), i=561,565) / 29642, 1764, 1043, 4887, 20823/ +data (chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=571,575) / 1032, 29731, 1764, 80, 5136/ +data (chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/ +data (chrtab(i), i=581,585) / 20808, 21256, 29707, 1764, 215/ +data (chrtab(i), i=586,590) / 29591, 456, 20958, 21153, 21409/ +data (chrtab(i), i=591,595) / 29727, 1764, 67, 20800, 21248/ +data (chrtab(i), i=596,600) / 21508, 29719, 1043, 21271, 20823/ +data (chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=606,610) / 1764, 99, 28744, 83, 4439/ +data (chrtab(i), i=611,615) / 21271, 21523, 29704, 1764, 541/ +data (chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/ +data (chrtab(i), i=621,625) / 533, 21077, 29256, 1764, 541/ +data (chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/ +data (chrtab(i), i=631,635) / 533, 21077, 21058, 20928, 20736/ +data (chrtab(i), i=636,640) / 28802, 1764, 99, 28744, 84/ +data (chrtab(i), i=641,645) / 29530, 342, 13320, 1764, 483/ +data (chrtab(i), i=646,650) / 21089, 21066, 29384, 1764, 87/ +data (chrtab(i), i=651,655) / 28744, 584, 21076, 84, 4375/ +data (chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/ +data (chrtab(i), i=661,665) / 29768, 1764, 87, 28744, 83/ +data (chrtab(i), i=666,670) / 20823, 21271, 21523, 29704, 1764/ +data (chrtab(i), i=671,675) / 83, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=676,680) / 21523, 21271, 20823, 20563, 1764/ +data (chrtab(i), i=681,685) / 87, 28736, 83, 20823, 21271/ +data (chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/ +data (chrtab(i), i=691,695) / 1764, 1047, 29696, 1036, 21256/ +data (chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/ +data (chrtab(i), i=701,705) / 21523, 1764, 87, 28744, 83/ +data (chrtab(i), i=706,710) / 20823, 21271, 29716, 1764, 74/ +data (chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/ +data (chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/ +data (chrtab(i), i=721,725) / 21461, 1764, 279, 29591, 970/ +data (chrtab(i), i=726,730) / 21320, 21128, 21002, 21025, 1764/ +data (chrtab(i), i=731,735) / 87, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=736,740) / 1032, 29719, 1764, 151, 21064/ +data (chrtab(i), i=741,745) / 29719, 1764, 87, 20808, 21077/ +data (chrtab(i), i=746,750) / 21320, 29783, 1764, 151, 29704/ +data (chrtab(i), i=751,755) / 136, 29719, 1764, 87, 21064/ +data (chrtab(i), i=756,760) / 320, 29783, 1764, 151, 21527/ +data (chrtab(i), i=761,765) / 20616, 29704, 1764, 805, 21157/ +data (chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/ +data (chrtab(i), i=771,775) / 21011, 21001, 21127, 21255, 1764/ +data (chrtab(i), i=776,780) / 611, 29273, 594, 29256, 1764/ +data (chrtab(i), i=781,785) / 485, 21093, 21218, 21209, 21271/ +data (chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/ +data (chrtab(i), i=791,795) / 29127, 1764, 83, 20758, 20950/ +data (chrtab(i), i=796,800) / 21265, 21457, 29844, 1764, 0/ diff --git a/sys/gio/nsppkern/font.h b/sys/gio/nsppkern/font.h new file mode 100644 index 00000000..c33dc6ee --- /dev/null +++ b/sys/gio/nsppkern/font.h @@ -0,0 +1,29 @@ +# NCAR font definitions. + +define CHARACTER_START 32 +define CHARACTER_END 126 +define CHARACTER_HEIGHT 26 +define CHARACTER_WIDTH 17 + +define FONT_LEFT 0 +define FONT_CENTER 9 +define FONT_RIGHT 27 +define FONT_TOP 36 +define FONT_CAP 34 +define FONT_HALF 23 +define FONT_BASE 9 +define FONT_BOTTOM 0 +define FONT_WIDTH 27 +define FONT_HEIGHT 36 + +define COORD_X_START 7 +define COORD_Y_START 1 +define COORD_PEN_START 13 +define COORD_X_LEN 6 +define COORD_Y_LEN 6 +define COORD_PEN_LEN 1 + +define PAINT_BEGIN_START 14 +define PAINT_END_START 15 +define PAINT_BEGIN_LEN 1 +define PAINT_END_LEN 1 diff --git a/sys/gio/nsppkern/gkt.com b/sys/gio/nsppkern/gkt.com new file mode 100644 index 00000000..828b39bb --- /dev/null +++ b/sys/gio/nsppkern/gkt.com @@ -0,0 +1,17 @@ +# GKTRANS common. A common is necessary since there is no graphics descriptor +# in the argument list of the kernel procedures. The stdgraph data structures +# are designed along the lines of FIO: a small common is used to hold the time +# critical data elements, and an auxiliary dynamically allocated descriptor is +# used for everything else. + +pointer g_kt # kernel transform graphics descriptor +pointer g_tty # graphcap descriptor +int g_nframes # number of frames written +int g_maxframes # max frames per device metafile +int g_ndraw # no draw instr. in current frame +int g_in, g_out # input, output files +int g_xres, g_yres # desired device resolution +char g_device[SZ_GDEVICE] # force output to named device + +common /gktcom/ g_kt, g_tty, g_nframes, g_maxframes, g_ndraw, + g_in, g_out, g_xres, g_yres, g_device diff --git a/sys/gio/nsppkern/gkt.h b/sys/gio/nsppkern/gkt.h new file mode 100644 index 00000000..09ab7b80 --- /dev/null +++ b/sys/gio/nsppkern/gkt.h @@ -0,0 +1,75 @@ +# GKTRANS definitions. + +define MAX_CHARSIZES 10 # max discreet device char sizes +define SZ_SBUF 1024 # initial string buffer size +define SZ_MFRECORD (1440/SZB_CHAR) # metafile record size +define SZ_GDEVICE 31 # maxsize forced device name +define DEF_MAXFRAMES 16 # maximum frames/metafile + +# The GKTRANS state/device descriptor. + +define LEN_GKT 81 + +define GKT_SBUF Memi[$1] # string buffer +define GKT_SZSBUF Memi[$1+1] # size of string buffer +define GKT_NEXTCH Memi[$1+2] # next char pos in string buf +define GKT_NCHARSIZES Memi[$1+3] # number of character sizes +define GKT_POLYLINE Memi[$1+4] # device supports polyline +define GKT_POLYMARKER Memi[$1+5] # device supports polymarker +define GKT_FILLAREA Memi[$1+6] # device supports fillarea +define GKT_CELLARRAY Memi[$1+7] # device supports cell array +define GKT_ZRES Memi[$1+8] # device resolution in Z +define GKT_FILLSTYLE Memi[$1+9] # number of fill styles +define GKT_ROAM Memi[$1+10] # device supports roam +define GKT_ZOOM Memi[$1+11] # device supports zoom +define GKT_SELERASE Memi[$1+12] # device has selective erase +define GKT_PIXREP Memi[$1+13] # device supports pixel replic. +define GKT_STARTFRAME Memi[$1+14] # frame advance at metafile BOF +define GKT_ENDFRAME Memi[$1+15] # frame advance at metafile EOF + # extra space +define GKT_CURSOR Memi[$1+20] # last cursor accessed +define GKT_COLOR Memi[$1+21] # last color set +define GKT_TXSIZE Memi[$1+22] # last text size set +define GKT_TXFONT Memi[$1+23] # last text font set +define GKT_TYPE Memi[$1+24] # last line type set +define GKT_WIDTH Memi[$1+25] # last line width set +define GKT_DEVNAME Memi[$1+26] # name of open device + # extra space +define GKT_CHARHEIGHT Memi[$1+30+$2-1] # character height +define GKT_CHARWIDTH Memi[$1+40+$2-1] # character width +define GKT_CHARSIZE Memr[P2R($1+50+$2-1)] # text sizes permitted +define GKT_PLAP ($1+60) # polyline attributes +define GKT_PMAP ($1+64) # polymarker attributes +define GKT_FAAP ($1+68) # fill area attributes +define GKT_TXAP ($1+71) # default text attributes + +# Substructure definitions. + +define LEN_PL 4 +define PL_STATE Memi[$1] # polyline attributes +define PL_LTYPE Memi[$1+1] +define PL_WIDTH Memi[$1+2] +define PL_COLOR Memi[$1+3] + +define LEN_PM 4 +define PM_STATE Memi[$1] # polymarker attributes +define PM_LTYPE Memi[$1+1] +define PM_WIDTH Memi[$1+2] +define PM_COLOR Memi[$1+3] + +define LEN_FA 3 # fill area attributes +define FA_STATE Memi[$1] +define FA_STYLE Memi[$1+1] +define FA_COLOR Memi[$1+2] + +define LEN_TX 10 # text attributes +define TX_STATE Memi[$1] +define TX_UP Memi[$1+1] +define TX_SIZE Memi[$1+2] +define TX_PATH Memi[$1+3] +define TX_SPACING Memr[P2R($1+4)] +define TX_HJUSTIFY Memi[$1+5] +define TX_VJUSTIFY Memi[$1+6] +define TX_FONT Memi[$1+7] +define TX_QUALITY Memi[$1+8] +define TX_COLOR Memi[$1+9] diff --git a/sys/gio/nsppkern/gktcancel.x b/sys/gio/nsppkern/gktcancel.x new file mode 100644 index 00000000..17679f89 --- /dev/null +++ b/sys/gio/nsppkern/gktcancel.x @@ -0,0 +1,27 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <fset.h> +include "gkt.h" + +# GKT_CANCEL -- Cancel any buffered output. + +procedure gkt_cancel (dummy) + +int dummy # not used at present +include "gkt.com" + +begin + if (g_kt == NULL) + return + + # First we cancel any output in the FIO stream, then + # flush the nspp buffers. This might, of course, + # put something in the FIO stream, so we cancel again. + # note the Fortran escape for "flush"...spp has a reserved + # word of the same name. + + call fseti (g_out, F_CANCEL, OK) +% call mcflsh + call fseti (g_out, F_CANCEL, OK) + call gkt_reset() +end diff --git a/sys/gio/nsppkern/gktclear.x b/sys/gio/nsppkern/gktclear.x new file mode 100644 index 00000000..4132d371 --- /dev/null +++ b/sys/gio/nsppkern/gktclear.x @@ -0,0 +1,60 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "gkt.h" + +# GKT_CLEAR -- Advance a frame on the plotter. All attribute packets are +# initialized to their default values. Redundant calls or calls immediately +# after a workstation open (before anything has been drawn) are ignored. + +procedure gkt_clear (dummy) + +int dummy # not used at present + +int gkt_mfopen() +errchk gkt_mfopen +include "gkt.com" + +begin + # This is a no-op if nothing has been drawn. + if (g_kt == NULL || g_ndraw == 0) + return + + # Start a new frame. This is done either by calling NSPP to do a frame + # advance or by starting a new metafile. Close the output file and + # start a new metafile if the maximum frame count has been reached. + # This disposes of the metafile to the system, causing the actual + # plots to be drawn. Open a new metafile ready to receive next frame. + + g_nframes = g_nframes + 1 + if (g_nframes >= g_maxframes) { + + # Does this device require a frame advance at end of metafile? + if (GKT_ENDFRAME(g_kt) == YES) + call frame() + + # The call to the NSPP flush procedure must be escaped to avoid + # interpretation as the FIO flush procedure. + +% call mcflsh + + g_nframes = 0 + call close (g_out) + + g_out = gkt_mfopen (g_tty, NEW_FILE) + + # Does this device require a frame advance at beginning of metafile? + if (GKT_STARTFRAME(g_kt) == YES) + call frame() + + } else { + # Merely output NSPP frame instruction to start a new frame in + # the same metafile. + + call frame() + } + + # Init kernel data structures. + call gkt_reset() + g_ndraw = 0 +end diff --git a/sys/gio/nsppkern/gktclose.x b/sys/gio/nsppkern/gktclose.x new file mode 100644 index 00000000..9ab73c34 --- /dev/null +++ b/sys/gio/nsppkern/gktclose.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "gkt.h" + +# GKT_CLOSE -- Close the nspp translation kernel. Close the spool file so +# the output is finally plotted. Free up storage. + +procedure gkt_close() + +include "gkt.com" + +begin + # If there is anything in the metafile, flush it and add a frame + # advance if required for the device. + + if (g_ndraw > 0 || g_nframes > 0) { + # Does this device require a frame advance at end of metafile? + if (GKT_ENDFRAME(g_kt) == YES) + call frame() + + # The call to the NSPP flush procedure must be escaped to avoid + # interpretation as the FIO flush procedure. + +% call mcflsh + } + + # Close output metafile, disposing of it to the host system. + call close (g_out) + + # Free kernel data structures. + call mfree (GKT_SBUF(g_kt), TY_CHAR) + call mfree (g_kt, TY_STRUCT) + + g_kt = NULL +end diff --git a/sys/gio/nsppkern/gktclws.x b/sys/gio/nsppkern/gktclws.x new file mode 100644 index 00000000..27889c7c --- /dev/null +++ b/sys/gio/nsppkern/gktclws.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "gkt.h" + +# GKT_CLOSEWS -- Close the named workstation. Flush the output. +# The spool file is closed only on the next plot or at gktclose time. +# If the spool file is closed here, APPEND mode would not work. + +procedure gkt_closews (devname, n) + +short devname[ARB] # device name (not used) +int n # length of device name +include "gkt.com" + +begin + call gkt_flush (0) +end diff --git a/sys/gio/nsppkern/gktcolor.x b/sys/gio/nsppkern/gktcolor.x new file mode 100644 index 00000000..7d24368a --- /dev/null +++ b/sys/gio/nsppkern/gktcolor.x @@ -0,0 +1,33 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "gkt.h" + +# nspp particulars +# colors +define BLACK 1 +define WHITE 2 +define RED 3 +define GREEN 4 +define BLUE 5 + +# GKT_COLOR set the color option in the nspp world + +procedure gkt_color(index) + +int index # index for color switch statement +include "gkt.com" + +begin + switch (index) { + case WHITE: + call optn (*"co", *"white") + case RED: + call optn (*"co", *"red") + case GREEN: + call optn (*"co", *"green") + case BLUE: + call optn (*"co", *"blue") + default: + call optn (*"co", *"black") + } +end diff --git a/sys/gio/nsppkern/gktdrawch.x b/sys/gio/nsppkern/gktdrawch.x new file mode 100644 index 00000000..dd7dbeb1 --- /dev/null +++ b/sys/gio/nsppkern/gktdrawch.x @@ -0,0 +1,68 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include <gki.h> +include <gset.h> +include "gkt.h" +include "font.h" + +define ITALIC_TILT 0.30 # fraction of xsize to tilt italics at top + + +# GKT_DRAWCHAR -- Draw a character of the given size and orientation at the +# given position. + +procedure gkt_drawchar (ch, x, y, xsize, ysize, orien, font) + +char ch # character to be drawn +int x, y # lower left GKI coords of character +int xsize, ysize # width, height of char in GKI units +int orien # orientation of character (0 degrees normal) +int font # desired character font + +real px, py, sx, sy, coso, sino, theta +int stroke, tab1, tab2, i, pen +int bitupk() +include "font.com" + +begin + if (ch < CHARACTER_START || ch > CHARACTER_END) + i = '?' - CHARACTER_START + 1 + else + i = ch - CHARACTER_START + 1 + + # Set the font. + call gkt_font (font) + + tab1 = chridx[i] + tab2 = chridx[i+1] - 1 + + theta = -DEGTORAD(orien) + coso = cos(theta) + sino = sin(theta) + + 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) + + # Scale size of character. + px = px / FONT_WIDTH * xsize + py = py / FONT_HEIGHT * ysize + + # The italic font is implemented applying a tilt. + if (font == GT_ITALIC) + px = px + ((py / ysize) * xsize * ITALIC_TILT) + + # Rotate and shift. + sx = x + px * coso + py * sino + sy = y - px * sino + py * coso + + # Draw the line segment or move pen. + if (pen == 0) + call frstpt (sx / GKI_MAXNDC, sy / GKI_MAXNDC) + else + call vector (sx / GKI_MAXNDC, sy / GKI_MAXNDC) + } +end diff --git a/sys/gio/nsppkern/gktescape.x b/sys/gio/nsppkern/gktescape.x new file mode 100644 index 00000000..ad8ff494 --- /dev/null +++ b/sys/gio/nsppkern/gktescape.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# GKt_ESCAPE -- Pass a device dependent instruction on to the kernel. +# The nspp kernel does not have any escape functions at present. + +procedure gkt_escape (fn, instruction, nwords) + +int fn # function code +short instruction[ARB] # instruction data words +int nwords # length of instruction + +begin +end diff --git a/sys/gio/nsppkern/gktfa.x b/sys/gio/nsppkern/gktfa.x new file mode 100644 index 00000000..4df21260 --- /dev/null +++ b/sys/gio/nsppkern/gktfa.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "gkt.h" + +# GKT_FILLAREA -- Fill a closed area. + +procedure gkt_fillarea (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs +include "gkt.com" + +begin + # Not implemented yet. + call gkt_polyline (p, npts) +end diff --git a/sys/gio/nsppkern/gktfaset.x b/sys/gio/nsppkern/gktfaset.x new file mode 100644 index 00000000..f5851cb9 --- /dev/null +++ b/sys/gio/nsppkern/gktfaset.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "gkt.h" + +# GKT_FASET -- Set the fillarea attributes. + +procedure gkt_faset (gki) + +short gki[ARB] # attribute structure +pointer fa +include "gkt.com" + +begin + fa = GKT_FAAP(g_kt) + FA_STYLE(fa) = gki[GKI_FASET_FS] + FA_COLOR(fa) = gki[GKI_FASET_CI] +end diff --git a/sys/gio/nsppkern/gktflush.x b/sys/gio/nsppkern/gktflush.x new file mode 100644 index 00000000..decb5300 --- /dev/null +++ b/sys/gio/nsppkern/gktflush.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "gkt.h" + +# GKT_FLUSH -- Flush output. + +procedure gkt_flush (dummy) + +int dummy # not used at present +include "gkt.com" + +begin + # Since the NSPP devices are not interactive, calls to FLUSH + # are ignored. +end diff --git a/sys/gio/nsppkern/gktfont.x b/sys/gio/nsppkern/gktfont.x new file mode 100644 index 00000000..cbcb9f90 --- /dev/null +++ b/sys/gio/nsppkern/gktfont.x @@ -0,0 +1,38 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "gkt.h" + +# GKT_FONT -- Set the character font. The roman font is normal. Bold is +# implemented by increasing the vector line width; care must be taken to +# set GKT_WIDTH so that the other vector drawing procedures remember to +# change the width back. The italic font is implemented in the character +# generator by a geometric transformation. + +procedure gkt_font (font) + +int font # code for font to be set +int pk1, pk2, width +include "gkt.com" + +begin + pk1 = GKI_PACKREAL(1.0) + pk2 = GKI_PACKREAL(2.0) + + width = GKT_WIDTH(g_kt) + + if (font == GT_BOLD) { + if (width != pk2) { + call optn (*"inten", *"high") + width = pk2 + } + } else { + if (GKI_UNPACKREAL(width) > 1.5) { + call optn (*"inten", *"low") + width = pk1 + } + } + + GKT_WIDTH(g_kt) = width +end diff --git a/sys/gio/nsppkern/gktgcell.x b/sys/gio/nsppkern/gktgcell.x new file mode 100644 index 00000000..197bf018 --- /dev/null +++ b/sys/gio/nsppkern/gktgcell.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# GKT_GETCELLARRAY -- Input a cell array, i.e., two dimensional array of pixels +# (greylevels or colors). + +procedure gkt_getcellarray (nx, ny, x1,y1, x2,y2) + +int nx, ny # number of pixels in X and Y +int x1, y1 # lower left corner of input window +int x2, y2 # lower left corner of input window + +begin + # Not implemented yet. +end diff --git a/sys/gio/nsppkern/gktinit.x b/sys/gio/nsppkern/gktinit.x new file mode 100644 index 00000000..78ae0840 --- /dev/null +++ b/sys/gio/nsppkern/gktinit.x @@ -0,0 +1,194 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <ctype.h> +include <gki.h> +include "gkt.h" + +# GKT_INIT -- Initialize the gkt data structures from the graphcap entry +# for the device. Called once, at OPENWS time, with the TTY pointer already +# set in the common. The companion routine GKT_RESET initializes the attribute +# packets when the frame is flushed. + +procedure gkt_init (tty, devname) + +pointer tty # graphcap descriptor +char devname[ARB] # device name + +pointer nextch +int maxch, i +real char_height, char_width, char_size + +bool ttygetb() +real ttygetr() +int ttygeti(), btoi(), gstrcpy() +include "gkt.com" +include "nspp.com" +int pow2() + +begin + # Allocate the gkt descriptor and the string buffer. + if (g_kt == NULL) { + call calloc (g_kt, LEN_GKT, TY_STRUCT) + call malloc (GKT_SBUF(g_kt), SZ_SBUF, TY_CHAR) + } + + # Get the maximum frame count and the flags controlling frame advance + # at start and end of metafile (NSPP parameters). + + g_maxframes = ttygeti (tty, "MF") + if (g_maxframes == 0) + g_maxframes = DEF_MAXFRAMES + GKT_STARTFRAME(g_kt) = btoi (ttygetb (tty, "FS")) + GKT_ENDFRAME(g_kt) = btoi (ttygetb (tty, "FE")) + + # Init string buffer parameters. The first char of the string buffer + # is reserved as a null string, used for graphcap control strings + # omitted from the graphcap entry for the device. + + GKT_SZSBUF(g_kt) = SZ_SBUF + GKT_NEXTCH(g_kt) = GKT_SBUF(g_kt) + 1 + Memc[GKT_SBUF(g_kt)] = EOS + + # Get the device resolution from the graphcap entry. + + g_xres = ttygeti (tty, "xr") + if (g_xres <= 0) + g_xres = 1024 + g_yres = ttygeti (tty, "yr") + if (g_yres <= 0) + g_yres = 1024 + + # Set up coordinate transformations. + + call seti (pow2(g_xres), pow2(g_yres)) + call set (0., 1., 0., 1., 0., 1., 0., 1., 1) + call z8zpii() + + # Set byteswap flag for output metacode. + mbswap = btoi (ttygetb (tty, "BS")) + + # Initialize the character scaling parameters, required for text + # generation. The heights are given in NDC units in the graphcap + # file, which we convert to GKI units. Estimated values are + # supplied if the parameters are missing in the graphcap entry. + + char_height = ttygetr (tty, "ch") + if (char_height < EPSILON) + char_height = 1.0 / 35.0 + char_height = char_height * GKI_MAXNDC + + char_width = ttygetr (tty, "cw") + if (char_width < EPSILON) + char_width = 1.0 / 80.0 + char_width = char_width * GKI_MAXNDC + + # If the device has a set of discreet character sizes, get the + # size of each by fetching the parameter "tN", where the N is + # a digit specifying the text size index. Compute the height and + # width of each size character from the "ch" and "cw" parameters + # and the relative scale of character size I. + # ... not relevant for nspp, but leave here anyway for now + + GKT_NCHARSIZES(g_kt) = min (MAX_CHARSIZES, ttygeti (tty, "th")) + nextch = GKT_NEXTCH(g_kt) + + if (GKT_NCHARSIZES(g_kt) <= 0) { + GKT_NCHARSIZES(g_kt) = 1 + GKT_CHARSIZE(g_kt,1) = 1.0 + GKT_CHARHEIGHT(g_kt,1) = char_height + GKT_CHARWIDTH(g_kt,1) = char_width + } else { + Memc[nextch+2] = EOS + for (i=1; i <= GKT_NCHARSIZES(g_kt); i=i+1) { + Memc[nextch] = 't' + Memc[nextch+1] = TO_DIGIT(i) + char_size = ttygetr (tty, Memc[nextch]) + GKT_CHARSIZE(g_kt,i) = char_size + GKT_CHARHEIGHT(g_kt,i) = char_height * char_size + GKT_CHARWIDTH(g_kt,i) = char_width * char_size + } + } + + # Initialize the output parameters. All boolean parameters are stored + # as integer flags. All string valued parameters are stored in the + # string buffer, saving a pointer to the string in the gkt + # descriptor. If the capability does not exist the pointer is set to + # point to the null string at the beginning of the string buffer. + + GKT_POLYLINE(g_kt) = btoi (ttygetb (tty, "pl")) + GKT_POLYMARKER(g_kt) = btoi (ttygetb (tty, "pm")) + GKT_FILLAREA(g_kt) = btoi (ttygetb (tty, "fa")) + GKT_FILLSTYLE(g_kt) = ttygeti (tty, "fs") + GKT_ROAM(g_kt) = btoi (ttygetb (tty, "ro")) + GKT_ZOOM(g_kt) = btoi (ttygetb (tty, "zo")) + GKT_ZRES(g_kt) = ttygeti (tty, "zr") + GKT_CELLARRAY(g_kt) = btoi (ttygetb (tty, "ca")) + GKT_SELERASE(g_kt) = btoi (ttygetb (tty, "se")) + GKT_PIXREP(g_kt) = btoi (ttygetb (tty, "pr")) + + # Initialize the input parameters. + + GKT_CURSOR(g_kt) = 1 + + # Save the device string in the descriptor. + nextch = GKT_NEXTCH(g_kt) + GKT_DEVNAME(g_kt) = nextch + maxch = GKT_SBUF(g_kt) + SZ_SBUF - nextch + 1 + nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1 + GKT_NEXTCH(g_kt) = nextch +end + + +# GKT_GSTRING -- Get a string value parameter from the graphcap table, +# placing the string at the end of the string buffer. If the device does +# not have the named capability return a pointer to the null string, +# otherwise return a pointer to the string. Since pointers are used, +# rather than indices, the string buffer is fixed in size. The additional +# degree of indirection required with an index was not considered worthwhile +# in this application since the graphcap entries are never very large. + +pointer procedure gkt_gstring (cap) + +char cap[ARB] # device capability to be fetched +pointer strp, nextch +int maxch, nchars +int ttygets() +include "gkt.com" + +begin + nextch = GKT_NEXTCH(g_kt) + maxch = GKT_SBUF(g_kt) + SZ_SBUF - nextch + 1 + + nchars = ttygets (g_tty, cap, Memc[nextch], maxch) + if (nchars > 0) { + strp = nextch + nextch = nextch + nchars + 1 + } else + strp = GKT_SBUF(g_kt) + + GKT_NEXTCH(g_kt) = nextch + return (strp) +end + + +# POW2 -- Return the integer base two exponent of the first power of two +# greater than the argument. The technique is to use successive one bit +# shift rights to determine the index of the leftmost one-bit. + +int procedure pow2 (num) + +int num +int bitshift, n, pow + +begin + bitshift = 0 + for (n=max(1,num); n > 0; n=n/2) + bitshift = bitshift + 1 + pow = bitshift - 1 + + if (num > 2 ** pow) + return (pow + 1) + else + return (pow) +end diff --git a/sys/gio/nsppkern/gktline.x b/sys/gio/nsppkern/gktline.x new file mode 100644 index 00000000..08318c91 --- /dev/null +++ b/sys/gio/nsppkern/gktline.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include "gkt.h" + +# GKT_LINETYPE -- Set the line type option in the nspp world. + +procedure gkt_linetype (index) + +int index # index for line type switch statement + +int linetype +include "gkt.com" + +begin + switch (index) { + case GL_CLEAR: + linetype = 0 + case GL_DASHED: + linetype = 0FF00X + case GL_DOTTED: + linetype = 08888X + case GL_DOTDASH: + linetype = 0F040X + default: + linetype = 0FFFFX # GL_SOLID and default + } + + call optn (*"dp", linetype) +end diff --git a/sys/gio/nsppkern/gktmfopen.x b/sys/gio/nsppkern/gktmfopen.x new file mode 100644 index 00000000..97ab92f9 --- /dev/null +++ b/sys/gio/nsppkern/gktmfopen.x @@ -0,0 +1,45 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <knet.h> +include <mach.h> +include <fset.h> +include "gkt.h" + +define SZ_DDSTR 256 + + +# GKT_MFOPEN -- Open the NSPP metacode output file. The device is connected +# to FIO as a binary file. Metacode output to the device will be spooled +# and then disposed of to the device when the file descriptor we return is +# later closed. + +int procedure gkt_mfopen (tty, mode) + +pointer tty # pointer to graphcap entry for device +int mode # access mode + +int fd +pointer sp, ddstr +int fopnbf(), ttygets() +extern zopnpl(), zardpl(), zawrpl(), zawtpl(), zsttpl(), zclspl() +errchk fopnbf + +begin + call smark (sp) + call salloc (ddstr, SZ_DDSTR, TY_CHAR) + + # The DD string is used to pass device dependent information to the + # NSPP graphics device driver. + + if (ttygets (tty, "DD", Memc[ddstr], SZ_DDSTR) <= 0) + call error (1, "nsppkern: missing DD parameter in graphcap") + + fd = fopnbf (Memc[ddstr], mode, + zopnpl, zardpl, zawrpl, zawtpl, zsttpl, zclspl) + + # Set the FIO buffer size to the size of a metafile record. + call fseti (fd, F_BUFSIZE, SZ_MFRECORD) + + call sfree (sp) + return (fd) +end diff --git a/sys/gio/nsppkern/gktopen.x b/sys/gio/nsppkern/gktopen.x new file mode 100644 index 00000000..41e3b19a --- /dev/null +++ b/sys/gio/nsppkern/gktopen.x @@ -0,0 +1,77 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "gkt.h" + +# GKT_OPEN -- Install the nspp kernel as a graphics kernel device driver. +# The device table DD consists of an array of the entry point addresses for +# the driver procedures. If a driver does not implement a particular +# instruction the table entry for that procedure may be set to zero, causing +# the interpreter to ignore the instruction. + +procedure gkt_open (devname, dd) + +char devname[ARB] # nonnull for forced output to a device +int dd[ARB] # device table to be initialized + +pointer sp, devns +int len_devname +int locpr(), strlen() +extern gkt_openws(), gkt_closews(), gkt_clear(), gkt_cancel() +extern gkt_flush(), gkt_polyline(), gkt_polymarker(), gkt_text() +extern gkt_fillarea(), gkt_putcellarray(), gkt_plset() +extern gkt_pmset(), gkt_txset(), gkt_faset() +extern gkt_escape() +include "gkt.com" + +begin + call smark (sp) + call salloc (devns, SZ_FNAME, TY_SHORT) + + # Flag first pass. Save forced device name in common for OPENWS. + # Zero the frame and instruction counters. + + g_kt = NULL + g_nframes = 0 + g_ndraw = 0 + call strcpy (devname, g_device, SZ_GDEVICE) + + # Install the device driver. + + dd[GKI_OPENWS] = locpr (gkt_openws) + dd[GKI_CLOSEWS] = locpr (gkt_closews) + dd[GKI_DEACTIVATEWS] = 0 + dd[GKI_REACTIVATEWS] = 0 + dd[GKI_MFTITLE] = 0 + dd[GKI_CLEAR] = locpr (gkt_clear) + dd[GKI_CANCEL] = locpr (gkt_cancel) + dd[GKI_FLUSH] = locpr (gkt_flush) + dd[GKI_POLYLINE] = locpr (gkt_polyline) + dd[GKI_POLYMARKER] = locpr (gkt_polymarker) + dd[GKI_TEXT] = locpr (gkt_text) + dd[GKI_FILLAREA] = locpr (gkt_fillarea) + dd[GKI_PUTCELLARRAY] = locpr (gkt_putcellarray) + dd[GKI_SETCURSOR] = 0 + dd[GKI_PLSET] = locpr (gkt_plset) + dd[GKI_PMSET] = locpr (gkt_pmset) + dd[GKI_TXSET] = locpr (gkt_txset) + dd[GKI_FASET] = locpr (gkt_faset) + dd[GKI_GETCURSOR] = 0 + dd[GKI_GETCELLARRAY] = 0 + dd[GKI_ESCAPE] = locpr (gkt_escape) + dd[GKI_SETWCS] = 0 + dd[GKI_GETWCS] = 0 + dd[GKI_UNKNOWN] = 0 + + # If a device was named open the workstation as well. This is + # necessary to permit processing of metacode files which do not + # contain the open workstation instruction. + + len_devname = strlen (devname) + if (len_devname > 0) { + call achtcs (devname, Mems[devns], len_devname) + call gkt_openws (Mems[devns], len_devname, NEW_FILE) + } + + call sfree (sp) +end diff --git a/sys/gio/nsppkern/gktopenws.x b/sys/gio/nsppkern/gktopenws.x new file mode 100644 index 00000000..2ef91e3d --- /dev/null +++ b/sys/gio/nsppkern/gktopenws.x @@ -0,0 +1,104 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <gki.h> +include <error.h> +include "gkt.h" + +# GKT_OPENWS -- Open the named workstation. Once a workstation has been +# opened we leave it open until some other workstation is opened or the +# kernel is closed. Opening a workstation involves initialization of the +# kernel data structures, following by initialization of the device itself. + +procedure gkt_openws (devname, n, mode) + +short devname[ARB] # device name +int n # length of device name +int mode # access mode + +pointer sp, buf +pointer ttygdes() +bool streq() +int gkt_mfopen() +bool need_open, same_dev + +include "gkt.com" +include "nspp.com" + +begin + call smark (sp) + call salloc (buf, max (SZ_FNAME, n), TY_CHAR) + + # If a device was named when the kernel was opened then output will + # always go to that device (g_device) regardless of the device named + # in the OPENWS instruction. If no device was named (null string) + # then unpack the device name, passed as a short integer array. + + if (g_device[1] == EOS) { + call achtsc (devname, Memc[buf], n) + Memc[buf+n] = EOS + } else + call strcpy (g_device, Memc[buf], SZ_FNAME) + + # Find out if first time, and if not, if same device as before + # note that if (g_kt == NULL), then same_dev is false. + + same_dev = false + need_open = true + + if (g_kt != NULL) { + same_dev = (streq (Memc[GKT_DEVNAME(g_kt)], Memc[buf])) + if (!same_dev) { + # Does this device require a frame advance at end of metafile? + if (GKT_ENDFRAME(g_kt) == YES) + call frame() + call close (g_out) + } else + need_open = false + } + + # Initialize the kernel data structures. Open graphcap descriptor + # for the named device, allocate and initialize descriptor and common. + # graphcap entry for device must exist. + + if (need_open) { + if (!same_dev) { + if (g_kt != NULL) + call ttycdes (g_tty) + iferr (g_tty = ttygdes (Memc[buf])) + call erract (EA_ERROR) + + # Initialize data structures if we had to open a new device. + call gkt_init (g_tty, Memc[buf]) + call gkt_reset() + } + + # Open the output file. The device is connected to FIO as a + # binary file. Metacode output to the device will be spooled + # and then disposed of to the device at CLOSEWS time. + + iferr (g_out = gkt_mfopen (g_tty, mode)) { + call ttycdes (g_tty) + call erract (EA_ERROR) + } else { + # Does this device require a frame advance at start of metafile? + if (GKT_STARTFRAME(g_kt) == YES) + call frame() + g_nframes = 0 + g_ndraw = 0 + } + + # Initialize output file descriptor in nspp common. + munit = g_out + } + + # Clear the screen if device is being opened in new_file mode. + # This is a nop if we really opened a new device, but it will clear + # the screen if this is just a reopen of the same device in new file + # mode. + + if (mode == NEW_FILE) + call gkt_clear (0) + + call sfree (sp) +end diff --git a/sys/gio/nsppkern/gktpcell.x b/sys/gio/nsppkern/gktpcell.x new file mode 100644 index 00000000..e7e0ca4a --- /dev/null +++ b/sys/gio/nsppkern/gktpcell.x @@ -0,0 +1,383 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "gkt.h" + +# Number of grey scale symbols +define NSYMBOL 11 +define TSIZE (1.0/2.0) + +# GKT_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels +# (greylevels or colors). + +procedure gkt_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2) + +short m[ARB] # cell array +int nc, nr # number of pixels in X and Y + # (number of columns[x], rows[y] +int ax1, ay1 # lower left corner of output window +int ax2, ay2 # upper right corner of output window + +int x1,y1,x2,y2 # device coordinates +real px1, py1, px2, py2 +int nx, ny, y +real skip_x, skip_y, sx, sy +real blockx, blocky, bcy +int i, j, startrow, element +real xres, yres +pointer sp, cell, tx, txsave +bool ca, use_orig, new_row, pr +real z_scale +real charheight, charwidth +real delta_y +int xrep, yrep + +include "gkt.com" + +begin + call smark(sp) + + # Keep track of the number of drawing instructions since the last frame + # clear. + + g_ndraw = g_ndraw + 1 + + skip_x = 1.0 + skip_y = 1.0 + blockx = 1.0 + blocky = 1.0 + + # Determine if can do real cell array. If not, use character + # sized boxes as pixels. In that case, we need to save all + # the character attributes since we will want to force default + # character size, orientation, etc. + + ca = (GKT_CELLARRAY(g_kt) != 0) + pr = false + if ( ca ) { + xres = real(g_xres) + yres = real(g_yres) + pr = (GKT_PIXREP(g_kt) != 0) + } else { + charwidth = real(GKT_CHARWIDTH(g_kt,1))*TSIZE + charheight = real(GKT_CHARHEIGHT(g_kt,1))*TSIZE + xres = real(GKI_MAXNDC)/ charwidth + yres = real(GKI_MAXNDC)/ charheight + z_scale = 1.0 / sqrt ( real(max(NSYMBOL, GKT_ZRES(g_kt))) ) + tx = GKT_TXAP(g_kt) + call salloc(txsave, LEN_TX, TY_INT) + call savetx(txsave,tx) + } + + # Input arguments (ax, ay) refer to corners of put cell array; + # we need corners of the corresponding device array. + + x1 = ax1 + x2 = ax2 + y1 = ay1 + y2 = ay2 + call adjust(x1,x2,xres) + call adjust(y1,y2,yres) + + # Find out how many real pixels we have to fill + px1 = real(x1)/(GKI_MAXNDC+1) + py1 = real(y1)/(GKI_MAXNDC+1) + px2 = real(x2)/(GKI_MAXNDC+1) + py2 = real(y2)/(GKI_MAXNDC+1) + + nx = int( px2 * xres ) - int( px1 * xres ) + 1 + ny = int( py2 * yres ) - int( py1 * yres ) + 1 + + if ( ny > 1) + delta_y = (real(y2) - real(y1))/ny + else { + delta_y = 0. + } + + # If too many data points in input, set skip. If skip is close + # enough to one, set it to one. + # Set block replication factors - will be > 1.0 if too few input points. + # Cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have + # enough points and so *some* have to be replicated. + + if ( nc > nx ) { + skip_x = real(nc)/nx + if ( (skip_x - 1.0)*(nx-1) < 1.0 ) + skip_x = 1.0 + } else + blockx = real(nx)/nc + + if ( nr > ny ) { + skip_y = real(nr)/ny + if ( (skip_y - 1.0)*(ny-1) < 1.0 ) + skip_y = 1.0 + } else + blocky = real(ny)/nr + + # Allocate storage for a row of pixels. This is quite inefficient + # if the x dimension of the cell array is small, but the metacode + # won't be too much bigger (?). + # need nx+1 in case nx odd ... pixels() wants to pad output. + + call salloc ( cell, nx+1, TY_SHORT) + Mems[cell + nx] = 0 + + # Initialize counters + + sy = skip_y + bcy = blocky + startrow = 1 + element = startrow + + # See if we can use original data ... no massaging + # also set the initial value of the new_row flag, which tells + # if we have to rebuild the row data + # Note that if blockx > 1.0, skip_x must be 1.0, and vv + + if ( (skip_x == 1.0) && (blockx == 1.0) ) { + use_orig = true + new_row = false + } else { + use_orig = false + new_row = true + } + + # If device can pixel replicate, use that feature where we can + if( pr) { + if( (skip_x == 1.0) && ( int(blockx) == blockx) ) { + xrep = int(blockx) + use_orig = true + nx = nc + } else + xrep = 1 + if( (skip_y == 1.0) && ( int(blocky) == blocky) ) { + yrep = int(blocky) + ny = 1 + } else + yrep = 1 + call pixel0(1,0,xrep,0,1,yrep) + } + + # Do it + + for ( i = 1; i <= ny ; i = i + 1) { + + # Build the row data + + if ( !use_orig && new_row ) { + if ( skip_x == 1.0) { + call blockit(m[element], Mems[cell], nx, blockx) + } else { + sx = skip_x + for ( j = 1; j <= nx; j = j + 1) { + Mems[cell+j-1] = m[element] + element = startrow + int(sx+0.5) + sx = sx + skip_x + } + } + if ( !ca ) + if ( use_orig) + call fakepc(m[element], Mems[cell], nx, z_scale) + else + call fakepc(Mems[cell], Mems[cell], nx, z_scale) + } + + # Send the row data. + + if ( ca ) { + y = y1 + ((i - 1)*delta_y + 0.5) + if ( use_orig ) { + call pixels( px1, real(y)/GKI_MAXNDC, + nx, 1, m[element]) + } else { + call pixels( px1, real(y)/GKI_MAXNDC, nx, 1, Mems[cell]) + } + } + else + call gkt_text( x1, y1+(i-1)*int(charheight), Mems[cell], nx) + + # Advance a row + + element = startrow + if ( bcy <= real(i) ) { + startrow = 1 + nc * int(sy+0.5) + element = startrow + sy = sy + skip_y + bcy = bcy + blocky + new_row = true + } else { + new_row = false + } + } + + # All done, restore text parameters and release storage + + if ( !ca ) + call restoretx (txsave,tx) + call sfree(sp) +end + +# SAVETX --- save the current text parameters as pointed to by "txp" +# in the area pointed to by "savep", and then set the necessary +# defaults. + +procedure savetx (savep, txp) +pointer savep, txp + +include "gkt.com" + +begin + # save old values + + TX_UP(savep) = TX_UP(txp) + TX_SIZE(savep) = TX_SIZE(txp) + TX_PATH(savep) = TX_PATH(txp) + TX_HJUSTIFY(savep) = TX_HJUSTIFY(txp) + TX_VJUSTIFY(savep) = TX_VJUSTIFY(txp) + TX_FONT(savep) = TX_FONT(txp) + TX_COLOR(savep) = TX_COLOR(txp) + TX_SPACING(savep) = TX_SPACING(txp) + + # set new (default) ones + + TX_UP(txp) = 90 + TX_SIZE(txp) = GKI_PACKREAL(TSIZE) + TX_PATH(txp) = GT_RIGHT + TX_HJUSTIFY(txp)= GT_LEFT + TX_VJUSTIFY(txp)= GT_BOTTOM + TX_FONT(txp) = GT_ROMAN + TX_COLOR(txp) = 1 + TX_SPACING(txp) = 0.0 + + # Set the device attributes to undefined, forcing them to be reset + # when the next output instruction is executed. + + GKT_TYPE(g_kt) = -1 + GKT_WIDTH(g_kt) = -1 + GKT_COLOR(g_kt) = -1 + GKT_TXSIZE(g_kt) = -1 + GKT_TXFONT(g_kt) = -1 +end + +# RESTORETX --- restore the text parameters from the save area + +procedure restoretx (savep, txp) +pointer savep, txp + +include "gkt.com" + +begin + # Restore values + + TX_UP(txp) = TX_UP(savep) + TX_SIZE(txp) = TX_SIZE(savep) + TX_PATH(txp) = TX_PATH(savep) + TX_HJUSTIFY(txp) = TX_HJUSTIFY(savep) + TX_VJUSTIFY(txp) = TX_VJUSTIFY(savep) + TX_FONT(txp) = TX_FONT(savep) + TX_COLOR(txp) = TX_COLOR(savep) + TX_SPACING(txp) = TX_SPACING(savep) + + # Set the device attributes to undefined, forcing them to be reset + # when the next output instruction is executed. + + GKT_TYPE(g_kt) = -1 + GKT_WIDTH(g_kt) = -1 + GKT_COLOR(g_kt) = -1 + GKT_TXSIZE(g_kt) = -1 + GKT_TXFONT(g_kt) = -1 +end + +# FAKEPC --- fake putcell output by using appropriately chosen text +# characters to make grey scale. + +procedure fakepc (indata, outdata, nx, scale) +int nx # number of points in row +short indata[ARB] # input row data +short outdata[ARB] # output row data +real scale # intensity scaling factor + +include "gkt.com" + +int i +real temp +char cdata[NSYMBOL] # characters to represent intensity +data cdata /' ', '.', ':', '|', 'i', 'l', 'J', 'm', '#', 'S', 'B', EOS/ + +begin + # + for ( i = 1 ; i <= nx ; i = i + 1 ) { + temp = sqrt( max(0., real(indata[i])) ) + outdata[i] = cdata[ min( NSYMBOL, int(NSYMBOL*scale*temp)+1 ) ] + } +end + +# BLOCKIT -- block replication of data + +procedure blockit( from, to, count, factor) + +short from[ARB] # input data +short to[ARB] # output data +int count # number of output pixels +real factor # blocking factor + +int i, j +real bc + +begin + bc = factor + j = 1 + for ( i = 1; i <= count ; i = i + 1 ) { + to[i] = from[j] + if ( bc <= real(i) ) { + j = j + 1 + bc = bc + factor + } + } +end + +# ADJUST -- round/truncate putcell array corners to device coordinates +# move up lower bound if it is above center point of device cell, +# move down upper bound if below. Don't allow bounds to go beyond +# resolution or below zero. Do not allow bounds to cross. Part of the +# assumptions behind all this is that putcells will be continguous and +# rows/columns must not be plotted twice. + +procedure adjust ( lower, upper, res) + +int lower, upper +real res + +real factor +real low, up + +begin + factor = res/(GKI_MAXNDC+1) + low = real(lower) * factor + up = real(upper) * factor + + # if boundaries result in same row, return + if ( int(low) == int(up) ) + return + + # if low is in upper half of device pixel, round up + if ( (low - int(low)) >= 0.5 ) { + low = int(low) + 1 + # don't go to or beyond upper bound + if ( low < up ) { + # ... 0.2 just for "rounding protection"; + lower = (low + 0.2)/factor + # if now reference same cell, return + if ( int(low) == int(up) ) + return + } + } + + # if "up" in bottom half of pixel, drop down one. Note that + # due to two "==" tests above, upper will not drop below lower. + # 0.2 means drop partway down into pixel below; calling code will + # truncate. + if ( (up - int(up)) < 0.5 ) + upper = real(int(up) - 0.2)/factor +end diff --git a/sys/gio/nsppkern/gktpl.x b/sys/gio/nsppkern/gktpl.x new file mode 100644 index 00000000..7e7243cf --- /dev/null +++ b/sys/gio/nsppkern/gktpl.x @@ -0,0 +1,64 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "gkt.h" + +# GKT_POLYLINE -- Draw a polyline. The polyline is defined by the array of +# points P, consisting of successive (x,y) coordinate pairs. The first point +# is not plotted but rather defines the start of the polyline. The remaining +# points define line segments to be drawn. + +procedure gkt_polyline (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs + +pointer pl +int i, len_p +int x,y +include "gkt.com" + +begin + if (npts <= 0) + return + + len_p = npts * 2 + + # Keep track of the number of drawing instructions since the last frame + # clear. + g_ndraw = g_ndraw + 1 + + # Update polyline attributes if necessary. + pl = GKT_PLAP(g_kt) + + if (GKT_TYPE(g_kt) != PL_LTYPE(pl)) { + call gkt_linetype (PL_LTYPE(pl)) + GKT_TYPE(g_kt) = PL_LTYPE(pl) + } + if (GKT_WIDTH(g_kt) != PL_WIDTH(pl)) { + if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5) + call optn (*"inten", *"low") + else + call optn (*"inten", *"high") + GKT_WIDTH(g_kt) = PL_WIDTH(pl) + } + if (GKT_COLOR(g_kt) != PL_COLOR(pl)) { + call gkt_color (PL_COLOR(pl)) + GKT_COLOR(g_kt) = PL_COLOR(pl) + } + + # Transform the first point from GKI coords to nspp coords and + # move to the transformed point. + + x = p[1] + y = p[2] + call frstpt(real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC) + + # Draw the polyline. + + for (i=3; i <= len_p; i=i+2) { + x = p[i] + y = p[i+1] + call vector (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC) + } +end diff --git a/sys/gio/nsppkern/gktplset.x b/sys/gio/nsppkern/gktplset.x new file mode 100644 index 00000000..9342fccc --- /dev/null +++ b/sys/gio/nsppkern/gktplset.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "gkt.h" + +# GKT_PLSET -- Set the polyline attributes. The polyline width parameter is +# passed to the encoder as a packed floating point number, i.e., int(LWx100). + +procedure gkt_plset (gki) + +short gki[ARB] # attribute structure +pointer pl +include "gkt.com" + +begin + pl = GKT_PLAP(g_kt) + PL_LTYPE(pl) = gki[GKI_PLSET_LT] + PL_WIDTH(pl) = gki[GKI_PLSET_LW] + PL_COLOR(pl) = gki[GKI_PLSET_CI] +end diff --git a/sys/gio/nsppkern/gktpm.x b/sys/gio/nsppkern/gktpm.x new file mode 100644 index 00000000..fe6a9a0a --- /dev/null +++ b/sys/gio/nsppkern/gktpm.x @@ -0,0 +1,64 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "gkt.h" + +# Nspp particulars. +define BASELW 8 # base width of line + + +# GKT_POLYMARKER -- Draw a polymarker. The polymarker is defined by the array +# of points P, consisting of successive (x,y) coordinate pairs. + +procedure gkt_polymarker (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs + +pointer pm +int i, len_p +int x, y, oldx, oldy +include "gkt.com" + +begin + if (npts <= 0) + return + + len_p = npts * 2 + + # Keep track of the number of drawing instructions since the last frame + # clear. + g_ndraw = g_ndraw + 1 + + # Update polymarker attributes if necessary. + + pm = GKT_PMAP(g_kt) + + if (GKT_TYPE(g_kt) != PM_LTYPE(pm)) { + call gkt_linetype (PM_LTYPE(pm)) + GKT_TYPE(g_kt) = PM_LTYPE(pm) + } + if (GKT_WIDTH(g_kt) != PM_WIDTH(pm)) { + if (GKI_UNPACKREAL(PM_WIDTH(pm)) < 1.5) + call optn (*"inten", *"low") + else + call optn (*"inten", *"high") + GKT_WIDTH(g_kt) = PM_WIDTH(pm) + } + if (GKT_COLOR(g_kt) != PM_COLOR(pm)) { + call gkt_color (PM_COLOR(pm)) + GKT_COLOR(g_kt) = PM_COLOR(pm) + } + + # Get to start of marker. + call frstpt (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC) + oldx = 0; oldy = 0 + + # Draw the polymarker. + for (i=1; i <= len_p; i=i+2) { + x = p[i]; y = p[i+1] + if (x != oldx && y != oldy) + call point (real(x)/GKI_MAXNDC, real(y)/GKI_MAXNDC) + oldx = x; oldy = y + } +end diff --git a/sys/gio/nsppkern/gktpmset.x b/sys/gio/nsppkern/gktpmset.x new file mode 100644 index 00000000..8a3ebe24 --- /dev/null +++ b/sys/gio/nsppkern/gktpmset.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "gkt.h" + +# GKT_PMSET -- Set the polymarker attributes. + +procedure gkt_pmset (gki) + +short gki[ARB] # attribute structure +pointer pm +include "gkt.com" + +begin + pm = GKT_PMAP(g_kt) + PM_LTYPE(pm) = gki[GKI_PMSET_MT] + PM_WIDTH(pm) = gki[GKI_PMSET_MW] + PM_COLOR(pm) = gki[GKI_PMSET_CI] +end diff --git a/sys/gio/nsppkern/gktreset.x b/sys/gio/nsppkern/gktreset.x new file mode 100644 index 00000000..6e34cec4 --- /dev/null +++ b/sys/gio/nsppkern/gktreset.x @@ -0,0 +1,59 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "gkt.h" + +# GKT_RESET -- Reset the state of the transform common, i.e., in response to +# a clear or a cancel. Initialize all attribute packets to their default +# values and set the current state of the device to undefined, forcing the +# device state to be reset when the next output instruction is executed. + +procedure gkt_reset() + +pointer pl, pm, fa, tx +include "gkt.com" + +begin + # Set pointers to attribute substructures. + pl = GKT_PLAP(g_kt) + pm = GKT_PMAP(g_kt) + fa = GKT_FAAP(g_kt) + tx = GKT_TXAP(g_kt) + + # Initialize the attribute packets. + PL_LTYPE(pl) = 1 + PL_WIDTH(pl) = GKI_PACKREAL(1.) + PL_COLOR(pl) = 1 + PM_LTYPE(pm) = 1 + PM_WIDTH(pm) = GKI_PACKREAL(1.) + PM_COLOR(pm) = 1 + FA_STYLE(fa) = 1 + FA_COLOR(fa) = 1 + TX_UP(tx) = 90 + TX_SIZE(tx) = GKI_PACKREAL(1.) + TX_PATH(tx) = GT_RIGHT + TX_HJUSTIFY(tx) = GT_LEFT + TX_VJUSTIFY(tx) = GT_BOTTOM + TX_FONT(tx) = GT_ROMAN + TX_COLOR(tx) = 1 + TX_SPACING(tx) = 0.0 + + # Set the device attributes to undefined, forcing them to be reset + # when the next output instruction is executed. + + GKT_TYPE(g_kt) = -1 + GKT_WIDTH(g_kt) = -1 + GKT_COLOR(g_kt) = -1 + GKT_TXSIZE(g_kt) = -1 + GKT_TXFONT(g_kt) = -1 + + # Reset the nspp common. + + call z8zpii() + + # If cellarray allowed, reset pixel size to standard one. + + if (GKT_CELLARRAY(g_kt) != 0) + call pixel0 (1,0,1,0,1,1) +end diff --git a/sys/gio/nsppkern/gkttx.x b/sys/gio/nsppkern/gkttx.x new file mode 100644 index 00000000..7aaf3c31 --- /dev/null +++ b/sys/gio/nsppkern/gkttx.x @@ -0,0 +1,428 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include <gset.h> +include <gki.h> +include "gkt.h" + +define BASECS_X 12 # Base (size 1.0) char width in GKI coords. +define BASECS_Y 12 # Base (size 1.0) char height in GKI coords. + + +# GKT_TEXT -- Draw a text string. The string is drawn at the position (X,Y) +# using the text attributes set by the last GKI_TXSET instruction. The text +# string to be drawn may contain embedded set font escape sequences of the +# form \fR (roman), \fG (greek), etc. We break the input text sequence up +# into segments at font boundaries and draw these on the output device, +# setting the text size, color, font, and position at the beginning of each +# segment. + +procedure gkt_text (xc, yc, text, n) + +int xc, yc # where to draw text string +short text[ARB] # text string +int n # number of characters + +real x, y, dx, dy, tsz +int x1, x2, y1, y2, orien +int x0, y0, gki_dx, gki_dy, ch, cw +int xstart, ystart, newx, newy +int totlen, polytext, font, seglen +pointer sp, seg, ip, op, tx, first +int stx_segment() +include "gkt.com" + +real g_dx, g_dy # scale GKI to window coords +int g_x1, g_y1 # origin of device window +int g_x2, g_y2 # upper right corner of device window +data g_dx /1.0/, g_dy /1.0/ +data g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/ + +begin + call smark (sp) + call salloc (seg, n + 2, TY_CHAR) + + # Keep track of the number of drawing instructions since the last frame + # clear. + g_ndraw = g_ndraw + 1 + + # Set pointer to the text attribute structure. + tx = GKT_TXAP(g_kt) + + # Set the text size and color if not already set. Both should be + # invalidated when the screen is cleared. Text color should be + # invalidated whenever another color is set. The text size was + # set by gkt_txset, and is just a scaling factor. + + GKT_TXSIZE(g_kt) = TX_SIZE(tx) + if (TX_COLOR(tx) != GKT_COLOR(g_kt)) { + call gkt_color (TX_COLOR(tx)) + GKT_COLOR(g_kt) = TX_COLOR(tx) + } + + # Set the linetype to a solid line, and invalidate last setting. + call gkt_linetype (GL_SOLID) + GKT_TYPE(g_kt) = -1 + + # Break the text string into segments at font boundaries and count + # the total number of printable characters. + + totlen = stx_segment (text, n, Memc[seg], TX_FONT(tx)) + + # Compute the text drawing parameters, i.e., the coordinates of the + # first character to be drawn, the step between successive characters, + # and the polytext flag (GKI coords). + + call stx_parameters (xc,yc, totlen, x0,y0, gki_dx,gki_dy, polytext, + orien) + + # For nspp, have 32767 sizes, so just scale the the base sizes. + tsz = GKI_UNPACKREAL(TX_SIZE(tx)) # scale factor + ch = GKT_CHARHEIGHT(g_kt,1) * tsz + cw = GKT_CHARWIDTH(g_kt,1) * tsz + + # Draw the segments, setting the font at the beginning of each segment. + # The first segment is drawn at (X0,Y0). The separation between + # characters is DX,DY. A segment is drawn as a block if the polytext + # flag is set, otherwise each character is drawn individually. + + x = x0 * g_dx + g_x1 + y = y0 * g_dy + g_y1 + dx = gki_dx * g_dx + dy = gki_dy * g_dy + + for (ip=seg; Memc[ip] != EOS; ip=ip+1) { + # Process the font control character heading the next segment. + font = Memc[ip] + ip = ip + 1 + + # Draw the segment. + while (Memc[ip] != EOS) { + # Clip leading out of bounds characters. + for (; Memc[ip] != EOS; ip=ip+1) { + x1 = x; x2 = x1 + cw + y1 = y; y2 = y1 + ch + + if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2) + break + else { + x = x + dx + y = y + dy + } + + if (polytext == NO) { + ip = ip + 1 + break + } + } + + # Coords of first char to be drawn. + xstart = x + ystart = y + + # Move OP to first out of bounds char. + for (op=ip; Memc[op] != EOS; op=op+1) { + x1 = x; x2 = x1 + cw + y1 = y; y2 = y1 + ch + + if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2) + break + else { + x = x + dx + y = y + dy + } + + if (polytext == NO) { + op = op + 1 + break + } + } + + # Count number of inbounds chars. + seglen = op - ip + + # Leave OP pointing to the end of this segment. + if (polytext == NO) + op = ip + 1 + else { + while (Memc[op] != EOS) + op = op + 1 + } + + # Compute X,Y of next segment. + newx = xstart + (dx * (op - ip)) + newy = ystart + dy + + # Quit if no inbounds chars. + if (seglen == 0) { + x = newx + y = newy + ip = op + next + } + + # Output the inbounds chars. + + first = ip + x = xstart + y = ystart + + while (seglen > 0 && (polytext == YES || ip == first)) { + call gkt_drawchar (Memc[ip], nint(x), nint(y), cw, ch, + orien, font) + ip = ip + 1 + seglen = seglen - 1 + x = x + dx + y = y + dy + } + + x = newx + y = newy + ip = op + } + } + + call sfree (sp) +end + + +# STX_SEGMENT -- Process the text string into segments, in the process +# converting from type short to char. The only text attribute that can +# change within a string is the font, so segments are broken by \fI, \fG, +# etc. font select sequences embedded in the text. The segments are encoded +# sequentially in the output string. The first character of each segment is +# the font number. A segment is delimited by EOS. A font number of EOS +# marks the end of the segment list. The output string is assumed to be +# large enough to hold the segmented text string. + +int procedure stx_segment (text, n, out, start_font) + +short text[ARB] # input text +int n # number of characters in text +char out[ARB] # output string +int start_font # initial font code + +int ip, op +int totlen, font + +begin + out[1] = start_font + totlen = 0 + op = 2 + + for (ip=1; ip <= n; ip=ip+1) { + if (text[ip] == '\\' && text[ip+1] == 'f') { + # Select font. + out[op] = EOS + op = op + 1 + ip = ip + 2 + + switch (text[ip]) { + case 'B': + font = GT_BOLD + case 'I': + font = GT_ITALIC + case 'G': + font = GT_GREEK + default: + font = GT_ROMAN + } + + out[op] = font + op = op + 1 + + } else { + # Deposit character in segment. + out[op] = text[ip] + op = op + 1 + totlen = totlen + 1 + } + } + + # Terminate last segment and add null segment. + + out[op] = EOS + out[op+1] = EOS + + return (totlen) +end + + +# STX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates +# of the lower left corner of the first character to be drawn, the spacing +# between characters, and the polytext flag. Input consists of the coords +# of the text string, the length of the string, and the text attributes +# defining the character size, justification in X and Y of the coordinates, +# and orientation of the string. All coordinates are in GKI units. + +procedure stx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien) + +int xc, yc # coordinates at which string is to be drawn +int totlen # number of characters to be drawn +int x0, y0 # lower left corner of first char to be drawn +int dx, dy # step in X and Y between characters +int polytext # OK to output text segment all at once +int orien # rotation angle of characters + +pointer tx +int up, path +real dir, sz, ch, cw, cosv, sinv, space +real xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q +include "gkt.com" + +begin + tx = GKT_TXAP(g_kt) + + # Get character sizes in GKI(NSPP) coords. + sz = GKI_UNPACKREAL (TX_SIZE(tx)) + ch = GKT_CHARHEIGHT(g_kt,1) * sz + cw = GKT_CHARWIDTH(g_kt,1) * sz + + # Compute the character rotation angle. This is independent of the + # direction in which characters are drawn. A character up vector of + # 90 degrees (normal) corresponds to a rotation angle of zero. + + up = TX_UP(tx) + orien = up - 90 + + # Determine the direction in which characters are to be plotted. + # This depends on both the character up vector and the path, which + # is defined relative to the up vector. + + path = TX_PATH(tx) + switch (path) { + case GT_UP: + dir = up + case GT_DOWN: + dir = up - 180 + case GT_LEFT: + dir = up + 90 + default: # GT_NORMAL, GT_RIGHT + dir = up - 90 + } + + # ------- DX, DY --------- + # Convert the direction vector into the step size between characters. + # Note CW and CH are in GKI coordinates, hence DX and DY are too. + # Additional spacing of some fraction of the character size is used + # if TX_SPACING is nonzero. + + dir = -DEGTORAD(dir) + cosv = cos (dir) + sinv = sin (dir) + + # Correct for spacing (unrotated). + space = (1.0 + TX_SPACING(tx)) + if (path == GT_UP || path == GT_DOWN) + p = ch * space + else + p = cw * space + q = 0 + + # Correct for rotation. + dx = p * cosv + q * sinv + dy = -p * sinv + q * cosv + + # ------- XU, YU --------- + # Determine the coordinates of the center of the first character req'd + # to justify the string, assuming dimensionless characters spaced on + # centers DX,DY apart. + + xvlen = dx * (totlen - 1) + yvlen = dy * (totlen - 1) + + switch (TX_HJUSTIFY(tx)) { + case GT_CENTER: + xu = - (xvlen / 2.0) + case GT_RIGHT: + # If right justify and drawing to the left, no offset req'd. + if (xvlen < 0) + xu = 0 + else + xu = -xvlen + default: # GT_LEFT, GT_NORMAL + # If left justify and drawing to the left, full offset right req'd. + if (xvlen < 0) + xu = -xvlen + else + xu = 0 + } + + switch (TX_VJUSTIFY(tx)) { + case GT_CENTER: + yu = - (yvlen / 2.0) + case GT_TOP: + # If top justify and drawing downward, no offset req'd. + if (yvlen < 0) + yu = 0 + else + yu = -yvlen + default: # GT_BOTTOM, GT_NORMAL + # If bottom justify and drawing downward, full offset up req'd. + if (yvlen < 0) + yu = -yvlen + else + yu = 0 + } + + # ------- XV, YV --------- + # Compute the offset from the center of a single character required + # to justify that character, given a particular character up vector. + # (This could be combined with the above case but is clearer if + # treated separately.) + + p = -DEGTORAD(orien) + cosv = cos(p) + sinv = sin(p) + + # Compute the rotated character in size X and Y. + xsize = abs ( cw * cosv + ch * sinv) + ysize = abs (-cw * sinv + ch * cosv) + + switch (TX_HJUSTIFY(tx)) { + case GT_CENTER: + xv = 0 + case GT_RIGHT: + xv = - (xsize / 2.0) + default: # GT_LEFT, GT_NORMAL + xv = xsize / 2 + } + + switch (TX_VJUSTIFY(tx)) { + case GT_CENTER: + yv = 0 + case GT_TOP: + yv = - (ysize / 2.0) + default: # GT_BOTTOM, GT_NORMAL + yv = ysize / 2 + } + + # ------- X0, Y0 --------- + # The center coordinates of the first character to be drawn are given + # by the reference position plus the string justification vector plus + # the character justification vector. + + x0 = xc + xu + xv + y0 = yc + yu + yv + + # The character drawing primitive requires the coordinates of the + # lower left corner of the character (irrespective of orientation). + # Compute the vector from the center of a character to the lower left + # corner of a character, rotate to the given orientation, and correct + # the starting coordinates by addition of this vector. + + p = - (cw / 2.0) + q = - (ch / 2.0) + + x0 = x0 + ( p * cosv + q * sinv) + y0 = y0 + (-p * sinv + q * cosv) + + # ------- POLYTEXT --------- + # Set the polytext flag. Polytext output is possible only if chars + # are to be drawn to the right with no extra spacing between chars. + + if (abs(dy) == 0 && dx == cw) + polytext = YES + else + polytext = NO +end diff --git a/sys/gio/nsppkern/gkttxset.x b/sys/gio/nsppkern/gkttxset.x new file mode 100644 index 00000000..28ed1d32 --- /dev/null +++ b/sys/gio/nsppkern/gkttxset.x @@ -0,0 +1,29 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <gki.h> +include "gkt.h" + +# GKT_TXSET -- Set the text drawing attributes. + +procedure gkt_txset (gki) + +short gki[ARB] # attribute structure + +pointer tx +include "gkt.com" + +begin + tx = GKT_TXAP(g_kt) + + TX_UP(tx) = gki[GKI_TXSET_UP] + TX_PATH(tx) = gki[GKI_TXSET_P ] + TX_HJUSTIFY(tx) = gki[GKI_TXSET_HJ] + TX_VJUSTIFY(tx) = gki[GKI_TXSET_VJ] + TX_FONT(tx) = gki[GKI_TXSET_F ] + TX_QUALITY(tx) = gki[GKI_TXSET_Q ] + TX_COLOR(tx) = gki[GKI_TXSET_CI] + + TX_SPACING(tx) = GKI_UNPACKREAL (gki[GKI_TXSET_SP]) + TX_SIZE(tx) = gki[GKI_TXSET_SZ] +end diff --git a/sys/gio/nsppkern/mkpkg b/sys/gio/nsppkern/mkpkg new file mode 100644 index 00000000..e9f92d6e --- /dev/null +++ b/sys/gio/nsppkern/mkpkg @@ -0,0 +1,56 @@ +# Make the NSPPKERN GIO graphics kernel. Requires LIBNSPP. Requires +# a host system metacode translation task for each device. + +$checkout libgkt.a lib$ +$update libgkt.a +$checkin libgkt.a lib$ +$call relink +$exit + +update: # update lib$x_nsppkern.e + $call relink + $call install + ; + +relink: # make x_nsppkern.e in local directory + $omake writeb.x <mach.h> <error.h> gkt.h gkt.com + $omake x_nsppkern.x + $link x_nsppkern.o writeb.o -lgkt -lnspp + ; + +install: # install in system library + $move x_nsppkern.e bin$ + ; + +libgkt.a: + gktcancel.x gkt.com gkt.h <fset.h> + gktclear.x gkt.com gkt.h <mach.h> + gktclose.x gkt.com gkt.h + gktclws.x gkt.h gkt.com + gktcolor.x gkt.com gkt.h + gktdrawch.x font.com font.h gkt.h <gki.h> <gset.h> <math.h> + gktescape.x + gktfa.x gkt.com gkt.h + gktfaset.x gkt.com gkt.h <gki.h> + gktflush.x gkt.com gkt.h + gktfont.x gkt.com gkt.h <gki.h> <gset.h> + gktgcell.x + gktinit.x gkt.com gkt.h nspp.com <ctype.h> <gki.h> <mach.h> + gktline.x gkt.com gkt.h <gset.h> + gktmfopen.x gkt.h <fset.h> <knet.h> <mach.h> + gktopen.x gkt.com gkt.h <gki.h> + gktopenws.x gkt.com gkt.h nspp.com <error.h> <gki.h> <mach.h> + gktpcell.x gkt.com gkt.h <gki.h> <gset.h> + gktpl.x gkt.com gkt.h <gki.h> + gktplset.x gkt.com gkt.h <gki.h> + gktpm.x gkt.com gkt.h <gki.h> + gktpmset.x gkt.com gkt.h <gki.h> + gktreset.x gkt.com gkt.h <gset.h> <gki.h> + gkttx.x gkt.com gkt.h <gki.h> <gset.h> <math.h> + gkttxset.x gkt.com gkt.h <gki.h> <gset.h> + pixel0.f + pixels.f + t_nsppkern.x <error.h> <gki.h> + tran16.f + writeb.x gkt.h <error.h> <mach.h> gkt.com + ; diff --git a/sys/gio/nsppkern/nspp.com b/sys/gio/nsppkern/nspp.com new file mode 100644 index 00000000..e3cac846 --- /dev/null +++ b/sys/gio/nsppkern/nspp.com @@ -0,0 +1,40 @@ +# NSPP.COM -- The nspp system plot package common block. + +int mmajx ,mmajy ,mminx ,mminy ,mxlab ,mylab +int mflg ,mtype ,mxa ,mya ,mxb ,myb +int mx ,my ,mtypex ,mtypey +real xxa ,yya , xxb ,yyb ,xxc ,yyc +real xxd ,yyd , xfactr ,yfactr ,xadd ,yadd +real xx ,yy + +# XX declared integer some places in nspp code !!! +# on a VAX this works, but what if float not same size as int ??? + +int mfmtx[3] ,mfmty[3] ,mumx ,mumy +int msizx ,msizy ,mxdec ,mydec ,mxor ,mop[19] +int mname[19] ,mxold ,myold ,mxmax ,mymax +int mxfac ,myfac ,modef ,mf2er ,mshftx ,mshfty +int mmgrx ,mmgry ,mmnrx ,mmnry ,mfrend ,mfrlst +int mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin +int mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto +int mxysto ,mprint ,msybuf[360] ,mncpw ,minst +int mbufa ,mbuflu ,mfwa[12] ,mlwa[12] +int mipair ,mbprs[16] ,mbufl ,munit ,mbswap + +real small + +common /sysplt/ mmajx ,mmajy ,mminx ,mminy ,mxlab ,mylab, + mflg ,mtype ,mxa ,mya ,mxb ,myb, + mx ,my ,mtypex ,mtypey ,xxa ,yya, + xxb ,yyb ,xxc ,yyc ,xxd ,yyd, + xfactr ,yfactr ,xadd ,yadd ,xx ,yy, + mfmtx ,mfmty ,mumx ,mumy, + msizx ,msizy ,mxdec ,mydec ,mxor ,mop, + mname ,mxold ,myold ,mxmax ,mymax, + mxfac ,myfac ,modef ,mf2er ,mshftx ,mshfty, + mmgrx ,mmgry ,mmnrx ,mmnry ,mfrend ,mfrlst, + mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin, + mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto, + mxysto ,mprint ,msybuf ,mncpw ,minst, + mbufa ,mbuflu ,mfwa ,mlwa, + mipair ,mbprs ,mbufl ,munit ,mbswap ,small diff --git a/sys/gio/nsppkern/pixel0.f b/sys/gio/nsppkern/pixel0.f new file mode 100644 index 00000000..df42b150 --- /dev/null +++ b/sys/gio/nsppkern/pixel0.f @@ -0,0 +1,58 @@ + subroutine pixel0(dx1,dy1,n1,dx2,dy2,n2) + common /sysplt/ mmajx ,mmajy ,mminx ,mminy ,mxlab ,mylab , + 1 mflg ,mtype ,mxa ,mya ,mxb ,myb , + 2 mx ,my ,mtypex ,mtypey ,xxa ,yya , + 3 xxb ,yyb ,xxc ,yyc ,xxd ,yyd , + 4 xfactr ,yfactr ,xadd ,yadd ,xx ,yy , + 5 mfmtx(3) ,mfmty(3) ,mumx ,mumy , + 6 msizx ,msizy ,mxdec ,mydec ,mxor ,mop(19), + 7 mname(19) ,mxold ,myold ,mxmax ,mymax , + 8 mxfac ,myfac ,modef ,mf2er ,mshftx ,mshfty , + 9 mmgrx ,mmgry ,mmnrx ,mmnry ,mfrend ,mfrlst , + + mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin , + 1 mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto , + 2 mxysto ,mprint ,msybuf(360) ,mncpw ,minst , + 3 mbufa ,mbuflu ,mfwa(12) ,mlwa(12) , + 4 mipair ,mbprs(16) ,mbufl ,munit ,mbswap , + 5 small + data ipixop / 10/ + mbpair = ior(ishift(ior(192, ipixop), 8), 12) + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + xx = dx1 + yy = dy1 + call dtran16 + mx1 = mx + mbpair = mx + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + my1=my + mbpair=my + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + mbpair=n1 + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + xx = dx2 + yy = dy2 + call dtran16 + mbpair=mx + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + mbpair=my + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + mbpair=n2 + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + if(n1*n2*(mx1*my-mx*my1) .ne. 0) return + call uliber(0,35h vectors not independent in pixel0.,35) + call perror + end diff --git a/sys/gio/nsppkern/pixels.f b/sys/gio/nsppkern/pixels.f new file mode 100644 index 00000000..a7b5e039 --- /dev/null +++ b/sys/gio/nsppkern/pixels.f @@ -0,0 +1,74 @@ + subroutine pixels(x0,y0,ni,nj,inten) + integer*2 inten(1) +c assume inten is a linear array rather than 2-d. This is a change +c from the original code. +c assume nj == 1 + common /sysplt/ mmajx ,mmajy ,mminx ,mminy ,mxlab ,mylab , + 1 mflg ,mtype ,mxa ,mya ,mxb ,myb , + 2 mx ,my ,mtypex ,mtypey ,xxa ,yya , + 3 xxb ,yyb ,xxc ,yyc ,xxd ,yyd , + 4 xfactr ,yfactr ,xadd ,yadd ,xx ,yy , + 5 mfmtx(3) ,mfmty(3) ,mumx ,mumy , + 6 msizx ,msizy ,mxdec ,mydec ,mxor ,mop(19), + 7 mname(19) ,mxold ,myold ,mxmax ,mymax , + 8 mxfac ,myfac ,modef ,mf2er ,mshftx ,mshfty , + 9 mmgrx ,mmgry ,mmnrx ,mmnry ,mfrend ,mfrlst , + + mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin , + 1 mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto , + 2 mxysto ,mprint ,msybuf(360) ,mncpw ,minst , + 3 mbufa ,mbuflu ,mfwa(12) ,mlwa(12) , + 4 mipair ,mbprs(16) ,mbufl ,munit ,mbswap , + 5 small + data ipixop / 10/ + mbpair = ior(ishift(ior(192, ipixop + 1), 8), 8) + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + xx = x0 + yy = y0 + call tran16 + mbpair = mx + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + mbpair=my + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + mbpair=ni + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + mbpair=nj + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + nni = max0(1,(ni+iand(ni,1))) + nnj = max0(1,nj) + kmax=nni*nnj + k=0 + do 200 j=1,nnj + do 100 i=1,nni + if(mod(k,254).ne.0) goto 90 + mbpair = ior(ishift(ior(192, ipixop+2),8), min0(254,kmax-k)) + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + mbpair = 0 + 90 ik = iand ( i, 1) +c +c 14Nov85 mod so that arguments to ishift are of same type + itmp = inten(i) + mbpair = ior (ishift(iand(itmp,255),8*ik),mbpair) +c mbpair = ior (ishift(iand(inten(i),255),8*ik),mbpair) +c + if ( ik .ne. 0 ) go to 95 + mipair = mipair + 1 + mbprs(mipair) = mbpair + if (mipair .ge. 16) call flushb + mbpair = 0 + 95 k = k + 1 + 100 continue + 200 continue + return + end diff --git a/sys/gio/nsppkern/t_nsppkern.x b/sys/gio/nsppkern/t_nsppkern.x new file mode 100644 index 00000000..69a5ec27 --- /dev/null +++ b/sys/gio/nsppkern/t_nsppkern.x @@ -0,0 +1,67 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <gki.h> + +# NSPPKERN -- Graphics kernel for the NCAR System Plot Package graphics +# interface. + +procedure t_nsppkern() + +int fd, list +pointer gki, sp, fname, devname +int dev[LEN_GKIDD], deb[LEN_GKIDD] +int debug, verbose, gkiunits +bool clgetb() +int clpopni(), clgfil(), open(), btoi() +int gki_fetch_next_instruction() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (devname, SZ_FNAME, TY_CHAR) + + # Open list of metafiles to be decoded. + list = clpopni ("input") + + # Get parameters. + call clgstr ("device", Memc[devname], SZ_FNAME) + if (clgetb ("generic")) { + debug = NO + verbose = NO + gkiunits = NO + } else { + debug = btoi (clgetb ("debug")) + verbose = btoi (clgetb ("verbose")) + gkiunits = btoi (clgetb ("gkiunits")) + } + + # Open the graphics kernel. + call gkt_open (Memc[devname], dev) + call gkp_install (deb, STDERR, verbose, gkiunits) + + # Process a list of metacode files, writing the decoded metacode + # instructions on the standard output. + + while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) { + # Open input file. + iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) { + call erract (EA_WARN) + next + } + + # Process the metacode instruction stream. + while (gki_fetch_next_instruction (fd, gki) != EOF) { + if (debug == YES) + call gki_execute (Mems[gki], deb) + call gki_execute (Mems[gki], dev) + } + + call close (fd) + } + + call gkp_close() + call gkt_close() + call clpcls (list) + call sfree (sp) +end diff --git a/sys/gio/nsppkern/tran16.f b/sys/gio/nsppkern/tran16.f new file mode 100644 index 00000000..e0503d57 --- /dev/null +++ b/sys/gio/nsppkern/tran16.f @@ -0,0 +1,64 @@ + subroutine tran16 + common /sysplt/ mmajx ,mmajy ,mminx ,mminy ,mxlab ,mylab , + 1 mflg ,mtype ,mxa ,mya ,mxb ,myb , + 2 mx ,my ,mtypex ,mtypey ,xxa ,yya , + 3 xxb ,yyb ,xxc ,yyc ,xxd ,yyd , + 4 xfactr ,yfactr ,xadd ,yadd ,xx ,yy , + 5 mfmtx(3) ,mfmty(3) ,mumx ,mumy , + 6 msizx ,msizy ,mxdec ,mydec ,mxor ,mop(19), + 7 mname(19) ,mxold ,myold ,mxmax ,mymax , + 8 mxfac ,myfac ,modef ,mf2er ,mshftx ,mshfty , + 9 mmgrx ,mmgry ,mmnrx ,mmnry ,mfrend ,mfrlst , + + mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin , + 1 mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto , + 2 mxysto ,mprint ,msybuf(360) ,mncpw ,minst , + 3 mbufa ,mbuflu ,mfwa(12) ,mlwa(12) , + 4 mipair ,mbprs(16) ,mbufl ,munit ,mbswap , + 5 small +c ray bovet patch to avoid small integers being set to 0 + integer xx,yy +c + logical intt + equivalence (zz,mz),(temp,itemp) +c ray bovet patch to avoid small integers being set to 0 +c zz = xx + mz = xx + if (intt(zz)) go to 102 + if (mtypex .eq. 0) go to 101 + if (zz .le. 0.0) + 1 call uliber (0,35h0negative argument with log scaling,35) + zz = amax1(zz,small) + mz = 2.0*(xfactr*alog10(zz)+xadd) + go to 103 + 101 mz = 2.0*(xfactr*zz+xadd) + go to 103 + 102 mz = ishift(mz,mshftx+1) + 103 mx = max0(0,min0(65535,mz-1)) +c ray bovet patch to avoid small integers being set to 0 +c zz = yy + mz = yy + if (intt(zz)) go to 105 + if (mtypey .eq. 0) go to 104 + if (zz .le. 0.0) + 1 call uliber (0,35h0negative argument with log scaling,35) + zz = amax1(zz,small) + mz = 2.0*(yfactr*alog10(zz)+yadd) + go to 106 + 104 mz = 2.0*(yfactr*zz+yadd) + go to 106 + 105 mz =ishift(mz,mshfty+1) + 106 my = max0(0,min0(65535,mz-1)) + return +C + entry DTRAN16 +C + zz = xx + if(intt(zz) .or. (zz .eq. 0.0)) goto 203 + mz = 2.0 * xfactr * zz + 203 mx = max0(-127,min0(127,mz)) + zz = yy + if(intt(zz) .or. (zz .eq. 0.0)) goto 206 + mz = 2.0 * yfactr * zz + 206 my = max0(-127,min0(127,mz)) + return + end diff --git a/sys/gio/nsppkern/writeb.x b/sys/gio/nsppkern/writeb.x new file mode 100644 index 00000000..dfcd82bb --- /dev/null +++ b/sys/gio/nsppkern/writeb.x @@ -0,0 +1,40 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <error.h> +include "gkt.h" + +.help writeb +.nf ___________________________________________________________________________ +WRITEB -- Write an NCAR metacode record. Always write a full record +regardless of the buffer length; any data beyond buflen is undefined. +If the buffer length is passed as zero, the metafile standard wants us to +write a full (zeroed) record and backspace over it, to signify end of +metafile if the physical metafile is subsequently closed. Instead of +writing the EOF record here, we leave that to the FIO close routine +for the graphics device. +.endhelp ______________________________________________________________________ + +procedure writeb (metacode_buffer, buflen, mbunit) + +int metacode_buffer # LOC pointer to metacode buffer +int buflen # number of words of metacode data +int mbunit # FIO file descriptor !! from nspp common !! + +int dummy[1], offset +int loci() +include "gkt.com" + +begin + if (buflen <= 0) + return + + # Standard NCAR pointer technique for accessing integer arrays. This + # assumes alignment of integer variables. Convert to use IRAF + # pointers if this causes problems. + + offset = metacode_buffer - loci (dummy) + 1 + + iferr (call write (mbunit, dummy[offset], SZ_MFRECORD)) + call erract (EA_FATAL) +end diff --git a/sys/gio/nsppkern/x_nsppkern.x b/sys/gio/nsppkern/x_nsppkern.x new file mode 100644 index 00000000..4b54cba2 --- /dev/null +++ b/sys/gio/nsppkern/x_nsppkern.x @@ -0,0 +1,3 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +task nsppkern = t_nsppkern 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 |