! Edwin driver for Tek 41XX and 42XX series terminals. !############################################################################ !# # !# This is a module from the EDWIN Graphics Package, which was developed # !# in the Department of Computer Science, at Edinburgh University, from # !# 1978 to the present day, release 5 of EDWIN in October 1984. # !# # !# The principal author of the EDWIN Graphics Package was J Gordon Hughes, # !# while working for the Edinburgh University Computer Sceince Department. # !# Parts of EDWIN have been produced by many different people, too many # !# too mention, working for different departments of Edinburgh and Leeds # !# Universities. # !# # !# This module is regarded as being in the public domain, and the authors # !# and accept no responsibility regarding the uses to which the software # !# will be put. # !# # !############################################################################ from Edwin include Device from Edwin include Icodes from Imp include Ascii, Lognames own short Model = 4105 { Options 4105 or all others (driver better) } ! Modes, Graph mode determines if text screen visible ! Line mode is =3 if polygon expected, <0 if doing a polygon own short Graph Mode = False, Line Mode = 0 ! current graphics colour, current mode, cur style, cur fill own integer cur col = 1, omode = 0, cur style = 0, cur fill = -1, real col = 1 own integer real fill = -1 own byte array Fill Map (1:16) = 0,4,7,11,8,1,5,14,12,6,10,9,2,3,13,16 ! current graphics position (may be outside window) own integer lastx = 0, lasty = 0 ! window delimiters own integer x min = 0, y min = 0, x max = 4095, y max = 3071 ! charcter sizes, width in pixels and height in Terminal Space Units own integer tcs = 5, tsu = 61 ! flags if move required before writing text or drawing, text direction own integer move pending = FALSE, cur dir = -1 {forces initial setup} routine Add (integer a, b) TTput (Esc); TTput (A); TTput(B) end ! coords - send <X,Y> coords in correct format routine coords(integer x, y) const integer TOP5 = 7, INT5 = 2, SR2 = 2 const integer HIYMARKER = 32, LOYMARKER = 96, EXTRAMARKER = 96 const integer HIXMARKER = 32, LOXMARKER = 64 const integer HIMASK = 127 , LOMASK = 3 integer HIY, LOY, HIX, LOX, extra HIY = Y>>TOP5 ; Y = Y & HIMASK ; HIY = HIY ! HIYMARKER LOY = Y>>INT5 ; Y = Y & LOMASK ; LOY = LOY ! LOYMARKER HIX = X>>TOP5 ; X = X & HIMASK ; HIX = HIX ! HIXMARKER LOX = X>>INT5 ; X = X & LOMASK ; LOX = LOX ! LOXMARKER extra = EXTRAMARKER ! X ! (Y << SR2) TTput(HIY); TTput(extra); TTput(LOY); TTput(HIX); TTput(LOX) end {coords} ! drawto - drawto line from current postion to x, y routine drawto(integer x, y) ! draw Add ('L', 'G') coords(x,y) end {drawto} ! domove - move from current position to x, y routine domove(integer x, y) ! move Add ('L', 'F') coords(x,y) move pending = FALSE end ! send int - send integer in correct format routine send int(integer int) const integer HI6 = 10, INT6 = 4, HiMARKER = 64 const integer LoMARKER = 32, SIGNMARKER = 16 const integer Hi1MASK = 1023, Hi2MASK = 15 integer HiI1, HiI2, LoI if int >= 0 start LoI = LoMARKER ! SIGNMARKER else LoI = LoMARKER finish int = -int if int < 0 HiI1 = int>>HI6 ; int = int & Hi1MASK ; HiI1 = HiI1 ! HiMARKER HiI2 = int>>INT6 ; int = int & Hi2MASK ; HiI2 = HiI2 ! HiMARKER LoI = int ! LoI if HiI1 > HiMARKER then TTput(HiI1) if HiI2 > HIMARKER then TTput(HiI2) TTput (LoI) end {send int} !%own %short Segment Open = False, Last Segment = -1 ! !%external %routine Open Tek Segment %alias "EDWIN_OPEN_TEK_SEGMENT" (- ! %integer Number, Mode) ! %own %integer Last Mode = 0 ! %if Last Segment > 0 %start ! Add ('S', 'C') ! Add ('R', 'F'); Send int (2) ! Add ('S', 'M'); Send int (Last Segment) ! %if Last Mode = 0 %start ! Send int (1) ! %else ! Send int (4) ! %finish ! %finish ! Add ('R', 'F'); Send int (0) ! Add ('S', 'E'); Send int (Number) ! Segment Open = True ! Last Segment = Number ! Last Mode = Mode !%end ! set colour map - routine to allow attributes of logical colour ! index to be changed. routine SET COLOUR MAP(integer index, hue, lightness, saturation) if (0 <= index <= 7) and (-32768 <= hue <= 32768) and c (0 <= lightness <= 100) and c (0 <= saturation <= 100) start ! set surface colour map Add ('T', 'G') ! 1 = surface No. (only one ), 4 = No. of array elements TTput('1') ; TTput('4') send int(index) send int(hue) ; send int(lightness) ; send int(saturation) finish end {set colour map} ! set colours - setup default colour map routine set colours set colour map(0,0,0,0) { black } set colour map(1,0,100,0) { white } set colour map(2,0,50,100) { blue } set colour map(3,240,50,100) { green } set colour map(4,120,50,100) { red } set colour map(5,300,50,100) { cyan } set colour map(6,180,50,100) { yellow } set colour map(7,0,65,0) { grey } end {set colours} external routine T41XX alias "EDWIN___U" (integer com, x, y) routine SWAP (integer name A, B) integer C C = A; A = B; B = C end ! used to hold corner of box own integer wx, wy, mx, my string (63) Type St switch sw(0:MAX COM) ! put char - write one char to output routine put char do move(lastx, lasty) if move pending = TRUE ! graphic text (1 char) Add ('L', 'T'); TTput ('1'); TTPUT (x) end {put char} ! change attribute - change attribute x to y routine change attribute (integer x, y) switch sw(0:ATT maximum) return unless 0 <= x <= ATT maximum -> sw(x) sw(att colour): if Model = 4105 start y = 1 unless 0 <= y <= 7 real col = y cur fill = -y else y = 1 unless 0 <= y <= 4 real col = y if y>0 start Add ('R', 'A'); send int (y) y = 1 cur fill = real fill else Add ('R', 'A'); send int (-1) y = 0 cur fill = 0 finish finish cur col = y ! set line index Add ('M','L'); send int(y) ! select fill pattern Add ('M','P'); send int(cur fill) ! select text colour Add ('M', 'T'); send int(y) return sw(att line style): y = 0 unless 0 <= y <= 7 return if Cur style = y Cur style = y ! set line style Add ('M','V'); TTput(y+'0') return sw(att char size): !? tsu = 13*y !? %if 1 <= tsu <= 87 %start !? tsu = 61 ; tcs = 5 !? %finish %else %if 88 <= tsu <= 148 %start !? tsu = 122 ; tcs = 10 !? %else !? tsu = 183 ; tcs = 15 !? %finish !? ! set graphtext size !? Add ('M','C'); TTput ('0'); sendint(tsu); TTput ('0') !? tsu = (tsu*5)//7 + 10 {convert height to width} return sw(att char rot): ! char orientation !? %if y = curdir %then %return !? curdir = y !? ! Set Graphtext rotation !? Add ('M','R'); sendint(y); sendint(0) return sw(att char quality): ! Would be the MQ command on non-4105 displays, but they default ! to high quality, so there seems no reason to change it. return sw(att char slant): Add ('M', 'A') and sendint(y) if Model#4105 return sw(att colour mode): omode = Y return sw(att shade mode): ! select fill pattern if Model = 4105 start Add ('M','P') and send int(y+1) if y>1 else y = 1 unless 1<=y<=16 Cur fill = Fill map (y) Cur fill = -cur col if cur fill = 0 or Model = 4105 Real Fill = cur fill Add ('M', 'P'); send int (cur fill) finish return sw(*): ! ignore the rest end {change attribute} ! new frame - clear graphics screen routine new frame ! page Add ('R', 'A'); send int (-1) ! %if Last Segment # -1 %start ! Add ('R', 'F'); send int (0) { Fix up level 0 } ! Add ('S', 'K'); send int (-1) { Delete all segments } ! Add ('R', 'F'); send int (2) { back to normal } ! Last Segment = -1 ! %finish TTput (esc); TTPUT (FF) lastx = 0 ; lasty = 0 Change Attribute (0,real col) Add ('M', 'V') and TTPUT (cur style+'0') if cur style # 0 end {new frame} -> sw(com) sw(0): ! initialise Model = X DEV DATA_NAME = "a Tektronix ".ItoS(Model,0)." terminal" Dev Data_Type = Model DEV DATA_DVX = 4095 DEV DATA_DVY = 3071 DEV DATA_MVX = 4095 DEV DATA_MVY = 3071 DEV DATA_MAX COLOUR = 7 DEV DATA_MAX STYLES = 7 !? DEV DATA_NUM CHAR SIZES = 255 !? %if Model = 4105 %start !? DEV DATA_NUM CHAR ROTS = 4 !? %else !? DEV DATA_NUM CHAR SLANTS = 255 !? DEV DATA_NUM CHAR ROTS = 255 !? %finish Type St = "EDWIN_".ItoS (Model,0) if TRANSLATE(TYPEST)#TYPEST start SET DEVICE (TYPEST) finish TTMODE (1) ! select code tek, reset parameters Add ('%', '!'); sendint (0) ! Cancel (ie. Reset parameters) Add ('K', 'C') TTPUT (0) for X=1,1,200 Flush Output { To allow KC command to settle down } ! Set Flagging mode (to use ^S & ^Q) Add ('N', 'F'); sendint(1) ! set window add ('R','W'); coords(0,0) ; coords(Dev Data_DVX,Dev Data_DVY) new frame wx = X MIN ; wy = Y MIN ! Set dialog area to 30 lines add ('L', 'L'); send int (30) ! clear dialog area add ('L','Z') ! set dialog background transparent add ('L','I'); send int(1); send int(0); send int(0) ! set dialog area invisible Add ('L', 'V'); send int(0) ! set cursor speed add ('I','J'); send int(7); send int(3) if Model > 4105 start ! Set to have 4 surfaces add ('R', 'D'); send int (4) send int (1); send int (1); send int (1); send int (1) ! Set colour mode to RGB add ('T', 'M'); send int (1); send int (3) ! Set surface colour maps add ('T', 'G'); send int (1); send int (4); send int (1); send int (100); send int (100); send int (100) add ('T', 'G'); send int (2); send int (4); send int (1); send int (0); send int (0); send int (100) add ('T', 'G'); send int (3); send int (4); send int (1); send int (0); send int (100); send int (0) add ('T', 'G'); send int (4); send int (4); send int (1); send int (100); send int (0); send int (0) else set colours finish Graph mode = True return sw(1): ! terminate ! Set dialog area to 24 lines add ('L', 'L'); send int (24) ! Set dialog area visible Add ('L', 'V'); send int (1) if Model=4105 start ! Cancel (reset) add ('K','C') Flush Output ! The above seems to need to settle down, hence TTPUT (0) for x=1,1,200 Flush Output ! code ansi, NB. Must be last command, as stops others working! Add ('%','!'); sendint (1) else ! Reset power-up state Add ('K', 'V') finish Flush Output TTmode (0) Graph Mode = False return sw(2): ! update ! Add ('S', 'C') %and Segment Open = False %if Segment Open = True ! Set dialog area visible Add ('L', 'V'); send int (1) ! Reset modes ! Add ('K', 'C') ! FLUSH OUTPUT ! ! The above seems to need to settle down, hence ! TTPUT (0) %for x=1,1,200 FLUSH OUTPUT Graph mode = False return sw(3): ! new frame new frame Flush Output ! set dialog area invisible Add ('L', 'V'); send int(0) Graph mode = True return sw(4): ! move abs if Line Mode = 3 start ! The opening point of a polygon Add ('L', 'P'); Coords (x, y); send int (0) move pending = False Line Mode = -1 { Polygon is now active } else move pending = True finish lastx = x ; lasty = y return sw(5): ! line abs if Line mode = 2 { Point mode } start Add ('L', 'H'); coords (x, y) { NB. Assuming default MM state } else domove(lastx, lasty) if move pending = True drawto(x, y) finish lastx = x ; lasty = y return sw(6): ! output char put char return sw(7): ! change attribute change attribute (x, y) return sw(8): ! lower window bounds if x > 4095 start X MIN = 4095 finish else if x < 0 start X MIN = 0 else X MIN = X finish if y > 3071 start Y MIN = 3071 finish else if y < 0 start Y MIN = 0 else Y MIN = y finish return sw(9): ! upper window bounds ! make sure any commands with old window done first if x > 4095 start X MAX = 4095 finish else if x < 0 start X MAX = 0 else X MAX = x finish if y > 3071 start Y MAX = 3071 finish else if y < 0 start Y MAX = 0 else Y MAX = y finish if Model#4105 start ! Set viewport add ('R','V'); coords(Xmin, YMin); coords(Xmax, Ymax) finish ! set window add ('R','W'); coords(Xmin, YMin); coords(Xmax, Ymax) return sw(10): ! Mode, ie, points, lines, polygons etc. Add ('L', 'E') if Line mode < 0 { ie. in a polygon } X = 1 unless 0 <= X <= 3 Line Mode = X return sw(11): ! was Overwrite mode change attribute (att colour mode, x) return sw(12): ! lower box bounds wx = X; wy = y return sw(13): ! upper box bounds & draw box SWAP (WX, X) if WX > X SWAP (WY, Y) if WY > Y return if WX > X MAX or X < X MIN or WY > Y MAX or Y < Y MIN WX = X MIN if WX < X MIN WY = Y MIN if WY < Y MIN X = X MAX if X > X MAX Y = Y MAX if Y > Y MAX ! Box now clipped into the screen. ! begin panel add ('L','P'); coords(wx,wy); send int(0) drawto(x,wy) ; drawto(x,y) ; drawto(wx,y) ! end panel add ('L','E') lastx = x ; lasty = y return sw(*): ! ignore rest end {T4105} ! T CURSOR - return state & x,y coords of cursor external routine T1 CURSOR alias "EDWIN___U_REQ"(integer name state,x,y) const integer TO4095 = 2, HI = 5, MASK = 31 integer t ! enable 4010 GIN mode TTput(ESC); TTput(SUB) Flush Output ! get report state = TTREAD x = ((TTREAD & MASK)<<HI + (TTREAD & MASK))<<TO4095 y = ((TTREAD & MASK)<<HI + (TTREAD & MASK))<<TO4095 t = TTREAD end {T1 CURSOR} end of file