! EDWIN driver for the Datatype X5A Colour Graphics terminal !############################################################################ !# # !# 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 ! Edwin Colour Map const byte array cmap (0:15) = '0', '?', '2', '1', '4', '6', '8', '3', '5','9',':',';','<','=','7','>' const byte array fmap (1:16) = '0', '8', '9', ':', ';', '<', '=', '>', '5', '7', '?', '6', '4', '3', '2', '1' own string (17) array Fill Def (8:15) = "8??000000??000000", "98888888888888888", ":8844221188442211", ";1122448811224488", "<8855225588552255", "=??888888??888888", ">0042000000004200", "?55::55::55::55::" ! Control characters const integer GRAPHMODE = 29 const integer ALPHAMODE = 31 const integer ERASE SCREEN = 12 const integer off = 0,on = 1 ! Device own integer fill = off, filling = off own integer wx = 0 own integer wy = 0 own integer palette = 1 own integer mask = 1 own integer mode change = us own integer updated = off own integer xor mode = 0; ! Screen information own integer MODE = 0; !0 if alphamode own integer SX = 0; !Current device position own integer SY = 0 own integer XR = 1023; !Right hand side of device window own integer XL = 0, YB = 0 , YT = 760 own integer VIS = 0; !0 if CVP inside VW own integer OR = 1; !Default or color own integer xcheck own byte integer TCS = 13; ! True char size. routine SWAP (integername A, B) integer C c = a; a = b; b = c end routine num(integer y) integer hiy,loy hiy = y >> 5 loy = y - hiy << 5 hiy = hiy + 32 loy = loy + 96 ttput(hiy) ttput(loy) end routine fill on integer TO fill = on TO = Filling if TO > 0 start ttput(esc) ttput('M') ttput('P') ttput(fmap(to)) finish ttput(esc); ttput('L'); ttput('P'); ttput(gs) end routine fill off fill = off ttput(us); ttput(esc); ttput('L'); ttput('E') mode = 0 end routine force mode(integer x) switch modesw(0:3) fill off if mode = 3 and x # 3 -> modesw(x) modesw(0):ttput(us) ;! Graphics Alpha Mode -> label modesw(1):ttput(graphmode) ;! Graphics Vector mode -> label modesw(2): ;! Dot Mode ttput(fs) -> label modesw(3): ;! Polygon Mode if mode # 3 start fill on finish label: mode = x end routine xor on ttput(esc) ttput(nak) xor mode = 1 end routine g mode if updated = on start updated = off ttput(gs) ttput(mode change) if mode change # 0 finish end routinespec reset palettes external routine SET COLOUR MAP alias "EDWIN___X_MAP" (integer INDEX, RED, BLUE, GREEN) g mode force mode(0) if mode # 0 if index # -1 start ttput(esc) ttput('$') ttput('0'+index) ttput(red+'0') ttput(green+'0') ttput(blue+'0') else reset palettes finish end !%external %routine SET PALETTE INTENSITY %alias "EDWIN_X5A_SET_PALETTE" (%integer red, blue, green) ! g mode ! force mode(0) %if mode # 0 ! ttput (esc) ! ttput (']') ! ttput ('M') ! ttput ('0'+red) ! ttput ('0'+green) ! ttput ('0'+blue) !%end routine reset palettes set colour map (0, 0, 0, 0) set colour map (1, 0, 0, 15) set colour map (2, 0, 15, 0) set colour map (3, 0, 15, 15) set colour map (4, 15, 0, 0) set colour map (5, 8, 0, 8) set colour map (6, 15, 15, 0) set colour map (7, 8, 8, 8) set colour map (8, 15, 0, 15) set colour map (9, 8, 0, 15) set colour map (10, 8, 15, 8) set colour map (11, 8, 15, 15) set colour map (12, 15, 0, 8) set colour map (13, 12, 0, 12) set colour map (14, 15, 15, 8) set colour map (15, 15, 15, 15) end routine UPDATE switch modes (0:5) ->modes(mode) modes(0):mode change = us;->modes(5) modes(1):mode change = 0 ;->modes(5) modes(2):mode change = fs;->modes(5) modes(3):mode change = 0 ;->modes(5) modes(4):mode change = us modes(5): updated = on TTPUT (ALPHA MODE) ttput(can) FLUSH OUTPUT end external routine X5A alias "EDWIN___X" (integer COM, X, Y) switch SW(0:MAX COM) routine PUT CHAR ! Put out a text character properly. if MODE#0 START TTPUT(us) mode = 0; updated = on ; mode change = 0 finish TTPUT (X) SX=SX+TCS VIS = 1 if SX>XR end routine GOTO(integer X,Y); !Code up coordinates and send to TTY constinteger HI=32,LY=96,LX=64,ENH=7 ttput (y>>5&31!hi); ttput (y&31!ly) ttput (x>>5&31!hi); ttput (x&31!lx) end routine write colour(integer palette no) ttput(esc) ttput('%') ttput(cmap(palette no&15)) if xor mode = off start ttput(esc) ttput(']') ttput('S') if or = on then ttput(cmap(palette no & 15)) else ttput('?') else xor on finish palette = palette no end routine or mode (integer on or off) integer mode store mode store = mode force mode(0) if mode # 0 if on or off>=0 and on or off <= 2 start if on or off = 2 then on or off = 1 ttput(esc) ttput('M') ttput('S') ttput('0'+ on or off) if on or off = 1 then or = on else or = off xor mode = 0 write colour(palette) else xor on finish force mode(mode store) if mode store # 0 end routine CHANGE ATTRIBUTE (integer WHAT, TO) switch SW(0:ATT MAXIMUM) -> SW(WHAT) SW(0): ! Change current write colour xcheck = 0 if xor mode = on then or mode(on) and xcheck = 1 write colour(TO) xor on if xcheck = 1 return SW(1): ! Select Line style TO = 0 unless 0<=TO<=8 ttput(esc) if TO < 5 start ttput('`'+TO) else ttput('M') ttput('V') ttput('`'+TO) finish return SW(2): ! Select Character size ttput(esc) if TO<=7 start ttput ('9') finish else if TO<=11 start ttput ('8') finish else if TO <=13 start ttput ('7') else ttput ('6') finish return SW(9): ! Select Colour Mode or mode (TO) return SW(10): ! Select Fill Pattern Filling = to Filling = 1 if Filling > 16 if Filling > 0 start ttput(esc) ttput('M') ttput('P') ttput(fmap(Filling)) finish return SW(*): end routine Clear Screen ttput(gs); ttput(esc);ttput(']');ttput('S');ttput('?') ttput(esc); ttput (ff){;ttput(cr) SX=0; SY=0; VIS=0; MODE=0 change attribute (0, palette) end g mode unless 4<=com<=6 -> SW(COM) SW(0): ! Initialise DEV DATA_NAME = "a Datatype X5A terminal" DEV DATA_DVX = 1023 DEV DATA_DVY = 767 DEV DATA_MVX = 1023 DEV DATA_MVY = 767 DEV DATA_MAX COLOUR = 15 TTMODE (1) Palette = 1 Clear Screen reset palettes for Com = 8, 1, 15 cycle TTPUT (Esc) TTPUT ('M') TTPUT ('D') TTPUT (Charno(Fill Def(Com), X)) for X = 1, 1, 17 TTPUT ('E') repeat return SW(1): !Terminate UPDATE TTPUT (cr) TTPUT (10) FLUSH OUTPUT TTMODE (0) return SW(2): ! Update UPDATE return SW(3): ! New frame Clear Screen return SW(4): ! Move Abs TTPUT (GRAPH MODE) GOTO (X,Y) SX=X; SY=Y; VIS=0 MODE = 1 if mode # 3 return SW(5): ! Line Abs if MODE=0 start TTPUT (GRAPH MODE) GOTO (SX,SY) finish GOTO (X,Y) MODE = 1 if MODE # 3 SX=X; SY=Y; VIS=0 return SW(6): ! Character PUT CHAR if VIS=0 return SW(7): ! Attribute Change CHANGE ATTRIBUTE (x, Y) return SW(8): ! Lower window bounds settings XL = X; YB = Y return SW(9): ! Upper window bounds XR=X; YT = Y return SW(10): force mode (x) return SW(11): ! Colour Change for compatibilty change attribute (9, x) return sw(12): wx=x; wy=y return sw(13): ! Flash Fill rectangle SWAP (WX, X) if WX > X SWAP (WY, Y) if WY > Y return if WX > XR or X < XL or WY > YT or Y < YB WX = XL if WX < XL WY = YB if WY < YB X = XR if X > XR Y = YT if Y > YT ! Box now clipped into the screen. if filling > 1 start fill on ttput(graphmode) goto(wx,wy) goto(wx,y) goto(x,y) goto(x,wy) goto(wx,wy) fill off else ttput(graphmode) goto(wx,wy) ttput(esc) ttput(stx) goto(x,y) ttput(esc) ttput(etx) ttput(gs) finish SX=X; SY=Y; VIS=0; mode = 1 return sw(14): ! Draw Circle fill on if Filling # 0 ttput(esc); ttput('e'); num(x) ttput('E'); ! End of data if fill = on then fill off ttput(gs); ! Return to graphics mode mode = 1 return sw(15): ! Draw Ellipse ttput(esc); ttput('e') num(wx); num(wy) num(x); num(y) ttput('E'); ! End of data if fill = on then fill off ttput(gs); ! Return to graphics mode mode = 1 return SW(*): end external routine X SAM alias "EDWIN___X_SAM" (integer name BUT, X, Y) signal 14, 8 end external routine X REQ alias "EDWIN___X_REQ" (integer name CH, X, Y) G MODE FLUSH OUTPUT TEK INPUT (CH, X, Y, SUB) UPDATE MODE = 0 end !%externalroutine set fill(%integer what) ! %if what<0 %or what>1 %then %signal 14,3 %else X5A(7,11,what) !%end !%externalroutine f set fill(%integername p) ! set fill(p) !%end !%externalroutine set fill style(%integer type) ! %if type<0 %or type>7 %then %signal 14,3 %else X5A(7,10,type) !%end !%externalroutine f set fill style(%integername type) ! set fill style(type) !%end !%externalroutine set screen mode(%integer type) ! %if type<0 %or type>3 %then %signal 14,3 %elsestart ! %if updated=on %then gmode ! X5A(10,type,0) %if type#mode ! %finish !%end !%externalroutine f set screen mode(%integername type) ! set screen mode (type) !%end !%externalroutine ellipse(%integer xaxis,yaxis,start angle,finish angle,fill) ! %if fill=1 %then set fill (1) ! X5A(12,xaxis,start angle) ! X5A(15,finish angle,yaxis) !%end !%externalroutine f ellipse(%integername xaxis,yaxis,start angle,finish angle,fill) ! ellipse(xaxis,yaxis,startangle,finish angle,fill) !%end !%externalroutine video blank(%integer i) ! %integer flag ! flag=0 ! %if i<0 %or i> 3 %then %signal 14,3 %elsestart ! %if updated = on %then g mode %and flag = 1 ! ttput(esc);ttput('v');ttput(i) ! update ! gmode %if flag = 0 ! %finish !%end !%externalroutine f videoblank (%integername i) ! video blank(i) !%end end of file