! EDWIN driver for the CHARLES (Minter) 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
! Control characters
const integer ETX = 3
const integer ESC = 27
const integer CR = 13
const byte integer array EDWIN COLS (0:15) = 0, 15, 4, 1, 2, 6, 8, 5, 3, 7, 9, 10, 11, 12, 13, 14
! Screen information
own integer COLOUR SELECT MODE = 0 { 0 => EDWIN colours, #0 => actual regs.
own integer CMODE = 0 { 0=>display, 1=> Console active
own integer RMODE = 0 { 0 text, 1 lines, 2 dots, 3 sheets
own integer MODE = -1 { 0 if alphamode
own integer SX = 0 { Current device position
own integer SY = 0
own integer XL = 0
own integer XR = 511 { Right hand side of device window
own integer YB = 0
own integer YT = 511
own integer VIS = 0 { 0 if CVP inside VW
own byte TCS = 5 { True char size.
own byte CCS = 1 { Current colour selected.
own byte CCM = 0 { Current Colour mode
routine DON
! Display on
TTPUT (ESC); TTPUT ('*'); CMODE = 0
end
routine cbyte(integer val, nbytes)
! Charles control byte protocol - 1 to 4 bytes, but only 2 for now.
TTPUT(8_100 ! ((NBYTES-1)<<3) ! (VAL & 7))
TTPUT(8_40 + (VAL>>3 & 63)) if NBYTES>1
TTPUT(0)
end
routine DBYTE (integer VAL, NBYTES)
! Charles data byte protocol - 1 to 4 bytes
integer I
TTPUT(8_40 ! (VAL & 31))
VAL=VAL>>5
TTPUT(8_40 + (VAL & 63)) and VAL=VAL>>6 for I = 1, 1, N BYTES - 1
TTPUT(0)
end
routine POINT (integer X, Y)
DBYTE(X, 2); DBYTE(Y, 2)
end
routine UPDATE
if CMODE=0 start
TTPUT (ETX) if MODE=0
CBYTE (7, 2) if MODE=3
TTPUT (13)
FLUSH OUTPUT
finish
MODE = -1
CMODE = 1
end
routine END MODE
! End to Text or Poly modes
TTPUT (ETX) if MODE=0
CBYTE (7, 2) if MODE=3
MODE = -1
end
external routine END POLY SHEET alias "EDWIN_CHARLES_END_SHEET"
CBYTE (6, 2) if MODE = 3
end
external routine SET COLOUR MAP alias "EDWIN___C_MAP" (integer ADR, RED, BLUE, GREEN)
! red, blue, green combination for this address in color map
ADR = EDWIN COLS(ADR) if COLOUR SELECT MODE = 0
DON if CMODE=1
END MODE
CBYTE (3, 2);! load colormap command
DBYTE ((BLUE<<12) ! (GREEN<<8) ! (RED<<4) ! ADR, 3); ! 3 bytes of data
end
external routine CHAS alias "EDWIN___C" (integer COM, X, Y)
own integer WX, WY
switch SW(0:MAX COM)
routine SWAP (integer name A, B)
integer C
C = A; A = B; B = C
end
routine PUT CHAR
! Put out a text character properly.
return if VIS # 0
DON if CMODE=1
if MODE#0 start
CBYTE (8_43, 1); ! Move to start of text
POINT (SX, SY)
CBYTE (8_46, 1); ! Enter text mode
MODE=0
finish
TTPUT (X)
SX = SX + TCS
VIS = 1 if SX>XR
end
routine DRAW LINE(integer FX, FY, TX, TY, V)
!Draw visible line from virtual coordinates (FX, FY) to (TX, TY).
!But if V = 0 just move to (TX, TY).
const integer array CODE(0:4)= 8_43, 8_44, 8_45, 5, 4
const integer array LC(0:4) = 1, 1, 1, 2, 2
! Command codes for TEXT, LINE, DOT, POLY, BOX modes respectivly.
DON if CMODE=1
TTPUT (ETX) if MODE=0; ! ETX to end text mode
CBYTE (7, 2) if MODE=3 and RMODE#3
if V#0 start
if MODE#RMODE start
CBYTE (8_43, 1) and POINT (FX, FY) if RMODE=1 and MODE#1
! Above line fixes bug in Charles which causes move to be drawn.
CBYTE (CODE(RMODE), LC(RMODE))
POINT (FX, FY) if 0 < RMODE < 4
finish
if MODE = 3 start; ! Possible need to clip polygons
finish
POINT (TX, TY)
MODE = RMODE
finish else MODE=-1
SX=TX; SY=TY; !Remember new position
end
routine CHANGE ATTRIBUTE (integer WHAT, TO)
switch AS (0:ATT MAXIMUM)
DON if CMODE=1
END MODE
-> AS (WHAT)
AS(att colour):
CCS = TO
TO = EDWIN COLS(TO) if COLOUR SELECT MODE = 0
CBYTE (8_20 ! TO, 2)
return
AS(att char size):
if TO<7 start
CBYTE(8_40, 2) and TCS=5
finish else if TO<11 start
CBYTE(8_41, 2) and TCS=10
else
CBYTE(8_42, 2) and TCS=15
finish
return
AS(att colour mode):
CBYTE (to, 2) and ccm=to if 0<=to<=3
return
AS(*): ! All other attributes ignored
end
-> SW(COM)
SW(0): ! Initialise
DEV DATA_NAME = "a Charles Terminal"
DEV DATA_DVX = 511
DEV DATA_DVY = 511
DEV DATA_MVX = 511
DEV DATA_MVY = 511
DEV DATA_ARF = 125
DEV DATA_MAX COLOUR = 15
TTMODE (1)
DON
COLOUR SELECT MODE = -1; ! This sets the true device registers
SET COLOUR MAP (0, 0, 0, 0)
SET COLOUR MAP (1, 0, 0, 10)
SET COLOUR MAP (2, 10, 0, 0)
SET COLOUR MAP (3, 6, 0, 6)
SET COLOUR MAP (4, 0, 10, 0)
SET COLOUR MAP (5, 0, 8, 6)
SET COLOUR MAP (6, 5, 8, 0)
SET COLOUR MAP (7, 3, 5, 5)
SET COLOUR MAP (8, 14, 0, 14)
SET COLOUR MAP (9, 0, 0, 15)
SET COLOUR MAP (10, 15, 0, 0)
SET COLOUR MAP (11, 10, 1, 10)
SET COLOUR MAP (12, 3, 15, 3)
SET COLOUR MAP (13, 6, 10, 12)
SET COLOUR MAP (14, 12, 10, 6)
SET COLOUR MAP (15, 15, 15, 15)
COLOUR SELECT MODE = Y
CHANGE ATTRIBUTE (att colour, 0)
RMODE = 2; ! Gives invisable dot at the origin, to fix charles bug.
DRAW LINE (0, 0, 0, 0, 1)
CHANGE ATTRIBUTE (att colour, 1)
CHANGE ATTRIBUTE (att Char size, 6)
RMODE = 1 ; ! Line mode by default.
return
SW(1): !Terminate
UPDATE
TTMODE (0)
return
SW(2): ! Update
UPDATE
return
SW(3): ! New frame
DON if CMODE=1
END MODE
CBYTE (1, 1)
CHANGE ATTRIBUTE (att colour, ccs) { Restore colour }
CHANGE ATTRIBUTE (att char size, tcs) { Restore character size }
CHANGE ATTRIBUTE (att colour mode, ccm) { Restore colour mode }
SX = 0; SY = 0; MODE = -1; VIS = 0
return
SW(4): ! Move Abs
VIS = 0
if MODE#3 then DRAW LINE (SX, SY, X, Y, 0) else DRAW LINE (SX, SY, X, Y,1)
return
SW(5): ! Line Abs
VIS = 0
DRAW LINE (SX, SY, X, Y, 1)
return
SW(6): ! Character
PUT CHAR if VIS=0
return
SW(7): ! Attribute Change
CHANGE ATTRIBUTE (X, Y)
return
SW(8): ! Set lower window settings
XL = X; YB = Y
return
SW(9): ! Set upper window bounds
XR = X; YT = Y
return
SW(10): ! Mode change
END MODE
RMODE = X if 0<=X<=4
return
SW(11): ! Set Colour replacement mode (old entry point)
change attribute (att colour mode, X)
return
SW(12): ! Lower box bounds
WX = X; WY = Y
return
SW(13): ! Upper box bounds, and do box
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.
DON if CMODE = 1
ENDMODE
RMODE = 4
CHAS (5, WX, WY)
CHAS (5, X, Y)
RMODE = 1
return
SW(*):
end
routine GET CO (integer name X)
integer I, J
I = TTGET
J = TTGET
X = (J&31) <<5 ! (I&31)
end
external routine C SAM alias "EDWIN___C_SAM" (integer name BUT, X, Y)
integer E
DON if CMODE=1
CBYTE (12, 2) { Flush the Queue }
CBYTE (10, 2) { Get the state }
UPDATE
! now get data back.
BUT = TTGET until BUT=ESC
GET CO (X)
GET CO (Y)
BUT = TTGET&31
E = TTGET until E=CR
end
external routine C REQ alias "EDWIN___C_REQ" (integer name BUT, X, Y)
integer E
DON if CMODE = 1
END MODE
CBYTE (13, 2); ! Set the mouse position
POINT (SX, SY)
CBYTE (12, 2); ! Flush the Queue
CBYTE (11, 2); ! Get the button change.
UPDATE
! now get cursor back.
BUT = TTGET until BUT=ESC
GET CO (X)
GET CO (Y)
BUT = TTGET&31
E = TTGET until E=CR
end
end of file