! EDWIN driver for 4010 series Tektronix storage tubes and Tektronix 4662 plotters.
! With Frigs for Westward 1015 and 2015
!############################################################################
!# #
!# 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 Lognames
! Control characters
const integer NUL = 0
const integer DC1 = 17; ! Invokes cursor on 4002.
const integer SUB = 26; ! Invokes cursor on later models.
const integer ESCAPE = 27
const integer GRAPHMODE = 29
const integer ALPHAMODE = 31
const integer ERASE SCREEN = 12
const integer PLOTTER = 'A'
const integer BLOCK SIZE = 255
const integer BYPASS = NL
! Device
own integer TYPE = 4012
own integer INVOKE CURSOR
! Screen information
own integer AMODE = 0 { Advanced mode for 4014
own integer MODE = 0 { 0 if alphamode
own integer SX = 0, SY = 0 { Current device position
own integer XL = 0 { Left hand side of device window
own integer XR = 1023 { Right hand side of device window
own integer YB = 0 { Bottom side of device window
own integer YT = 1023 { top side of device window
own integer VIS = 0 { 0 if CVP inside VW
own integer TCS = 13 { char size.
own byte COLOUR = 1 { To optimise pen change requests }
own integer CHARS SENT = 0, CHECK SUM = 0 { For the plotter }
own integer NUMBER OF PAD CHARS = 960 { For after newframe }
routine ADD WITH NO CS (integer I)
string (7) ST
ST = ITOS (I, 0)
TTPUT (CHARNO (ST, I)) for I = 1, 1, LENGTH(ST)
end
routine TO PLOT WITH NO CS (integer I)
TTPUT (ESCAPE); TTPUT (PLOTTER); TTPUT (I)
end
routine PON
TO PLOT WITH NO CS ('E')
! TO PLOT WITH NO CS ('(')
end
routine POFF
! TO PLOT WITH NO CS (')')
! ADD WITH NO CS (CHECK SUM)
! TTPUT (NL)
TO PLOT WITH NO CS ('F'); TTPUT (NL)
FLUSH OUTPUT
! Ignore the response
! CHARS SENT = TTREAD %until CHARS SENT # BYPASS
! CHARS SENT = TTREAD %until CHARS SENT = BYPASS
CHECK SUM = 0
CHARS SENT = 0
end
routine PUT (integer S)
TTPUT (S)
if TYPE=4662 start
CHARS SENT = CHARS SENT + 1
CHECK SUM = CHECK SUM + S
CHECK SUM = CHECK SUM - 4095 if CHECK SUM > 4095
if CHARS SENT > BLOCK SIZE - 5 start
POFF; PON
finish
finish
end
routine ADD (integer I)
string (7) ST
ST = ITOS (I,0)
PUT (CHARNO(ST, I)) for I = 1, 1, LENGTH(ST)
end
routine PAD (integer SYM, NO)
integer I
PUT (SYM) for I = 1,1,NO
end
routine SET ALPHA MODE
PAD (NUL, 4)
PUT (ALPHAMODE)
MODE = 0
end
routine ESC PLUS (integer CH)
PUT (ESCAPE); PUT (CH)
end
routine TO PLOT (integer CH)
ESC PLUS (PLOTTER)
PUT (CH)
end
routine UPDATE
SET ALPHA MODE
TTPUT (25) if TCS=24 and TYPE=4002
FLUSH OUTPUT
end
external routine T4000 alias "EDWIN___T" (integer COM, X, Y)
own integer WX, WY
string (63) TYPE ST
switch SW(0:MAX COM)
routine SWAP (integer name A, B)
integer C
C = A; A = B; B = C
end
routine WAIT (string (255) message)
POFF
OPER MESSAGE (MESSAGE)
! Ignore the response
! S = TTREAD %until S # BYPASS
! S = TTREAD %until S = BYPASS
PON
end
routine PUT CHAR
! Put out a text character properly.
UPDATE if MODE#0
PUT (X)
PUT (NUL)
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
if amode#0 start
ttput (((y>>7)&31)!hi) {HIY}
ttput (((y&3)<<2)!(x&3)!118) {XLOY..extra byte for increased accuracy}
ttput (((y>>2)&31)!ly) {LOY}
ttput (((x>>7)&31)!hi) {HIX}
ttput (((x>>2)&31)!lx) {LOX}
finish else start
ttput (y>>5&31!hi); ttput (y&31!ly)
ttput (x>>5&31!hi); ttput (x&31!lx)
finish
end
routine CHANGE ATTRIBUTE
switch SW(0:ATT MAXIMUM)
SET ALPHA MODE if TYPE=4662 and MODE#0
return unless 0<=X<=ATT MAXIMUM
-> SW(X)
SW(att colour):
return if COLOUR = Y
WAIT ("Change to pen number ".itos(Y,0)." and press CALL") if TYPE=4662
return
SW(att Line style):
Y = 0 unless 0<=Y<=4
if TYPE=1015 or TYPE=2015 or TYPE=4014 start
ESC PLUS (Y+96)
finish
return
SW(att Char size):
TCS = 13
if TYPE = 2015 or TYPE = 4014 start
if Y < 8 then ESC PLUS (';') and TCS=7 else start
if Y < 10 then ESC PLUS(':') and TCS=9 else start
if Y < 13 then ESC PLUS ('9') and TCS=13 c
else ESC PLUS ('8') and TCS=14
finish
finish
finish else if TYPE = 4002 start
if Y>23 then TCS=24 else TCS=12
MODE = 1; ! To ensure we set this
finish else if TYPE = 4662 start
TO PLOT ('I'); ADD (Y); PUT (','); ADD (Y*2)
finish
return
SW(att Char rot):
if TYPE=4662 start
TO PLOT ('J'); ADD (Y)
finish
return
SW(att Char font):
if TYPE=4226 and 0<=Y<=6 start
TO PLOT ('T'); ADD (Y+'0')
finish
return
SW(*): ! All other attributes ignored
end
-> SW(COM)
SW(0): ! Initialise
TYPE = X
TYPE ST = ITOS (TYPE, 0)
if TYPE = 1015 or TYPE = 2015 start
DEV DATA_NAME = "a Westward ".TYPEST
else
DEV DATA_NAME = "a Tektronix ".TYPEST
finish
DEV DATA_DVX = 1023
DEV DATA_DVY = 767
DEV DATA_MVX = 1023
DEV DATA_MVY = 767
TYPEST = "EDWIN_".TYPEST
if TRANSLATE(TYPEST)#TYPEST start
SET DEVICE (TYPEST)
finish
TYPE ST = "EDWIN_".ItoS(Type,0)."_DELAY"
if TRANSLATE(TYPEST)#TYPEST start
begin
on 3,4,9 start
Oper Message ("Invalid setting for EDWIN_".ItoS(Type,0)."_DELAY")
signal 14, 1
finish
Number of Pad Chars = S to I (Type St)
end
finish
TTMODE (1)
if TYPE=4002 then INVOKE CURSOR=DC1 else INVOKE CURSOR=SUB
if TYPE=4662 start
POFF { Incase the last program failed ? }
TO PLOT WITH NO CS ('N') { Reset }
TO PLOT WITH NO CS ('H'); ADD WITH NO CS (BLOCK SIZE)
TO PLOT WITH NO CS ('U'); TTPUT (BYPASS)
PON
! AMODE = 1 { Use full resolution }
finish
ESC PLUS ('1') if TYPE = 1015 or TYPE = 2015
return
SW(1): ! Terminate
if TYPE=4662 start
POFF
else
SET ALPHA MODE
TTPUT (13); TTPUT (10)
ESC PLUS (';') if TYPE=4014
TTPUT (24); ! Resets ADM terminals
ESC PLUS ('2') if TYPE = 1015 or TYPE = 2015
finish
FLUSH OUTPUT
TTMODE (0)
AMODE = 0 { Incase we come back }
return
SW(2): ! Update
UPDATE
return
SW(3): ! New frame
if TYPE=4662 start
WAIT ("Enter a new sheet of paper and press CALL")
finish else start
ESC PLUS (ERASE SCREEN)
PAD (NUL, Number of Pad Chars)
finish
SX = 0; SY = 0; MODE = 0
return
SW(4): ! Move Abs
PUT (GRAPH MODE)
MODE = 1
SW(5): ! Line Abs
if MODE=0 start
PUT (GRAPH MODE)
GOTO (SX, SY)
finish
GOTO (X, Y)
SX = X; SY = Y; MODE = 1; VIS = 0
return
SW(6): ! Character
PUT CHAR if VIS=0
return
SW(7): ! Attribute Change
CHANGE ATTRIBUTE
return
SW(8): ! Lower window bounds
XL = X; YB = Y
return
SW(9): ! Upper window bounds
XR = X; YT = Y
AMODE = 1 if TYPE=4014 and (X>1023 or Y>1023)
return
SW(10): ! ??
return
SW(11): ! Was overwrite mode
return
SW(12): ! Lower box bounds
WX = X; WY = Y
return
SW(13): ! Upper box bounds
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.
T4000 (4, Wx, Wy)
T4000 (5, Wx, y)
T4000 (5, x,y)
T4000 (5, x, Wy)
T4000 (5, Wx, wy)
return
SW(*):
end
external routine T REQ alias "EDWIN___T_REQ" (integer name CH, X, Y)
signal 14, 8 if TYPE = 4662 or TYPE = 4006
SET ALPHA MODE
TEK INPUT (CH, X, Y, INVOKE CURSOR)
end
end of file