! EDWIN driver for the HP plotter range.
from Edwin include Device
from Edwin include Icodes
!%from Imp %include Predef { On non-Lattice systems }
from Imp include Maths
! Control characters
const integer ETX = 3
const integer ESC =27
const integer DEL = 127
! The following should be an external integer spec to the UTILITY module.
const integer BUFF SIZE = 251
! Screen information
own integer PLOT ACTIVE = FALSE; ! FALSE => using terminal, TRUE => PLOTTER active
own integer LAST COM = 0; ! Used to optimise lines in the HP protocol
own integer SX = 0; ! Current device position
own integer SY = 0
own integer XL = 0, YB = 0; ! Lower window bounds.
own integer YT = 25 * 400; ! Upper device window bound.
own integer XR = 40 * 400; ! Right hand side of device window
own byte CUR COL = 1; ! Current colour.
own byte PM = FALSE; ! Pending move.
own byte PC = FALSE; ! Pending colour change.
own byte LOW QUAL = TRUE; ! Character Quality, FALSE => proportional spaced sets
own byte NEWFRAMED = FALSE; ! TRUE => NEW FRAME done
own byte TEXT MODE = FALSE; ! TRUE while in text mode
own integer INBUFF = 32; ! This is the initialisation code
! Configuration parameters -
const integer MAX ATTRIBUTE = 8
const integer MAX COLOUR = 16
const integer MAX LINE = 6
const integer NUM HP = 7
const byte NUM PENS = 8
const integer X BASE = 0
const integer Y BASE = 500
const integer MAX X = 16000
const integer MAX Y = 10900 { Having lost 500 for JCL
own string (15) array COLOUR NAME (1:MAX COLOUR) =
"black", "blue", "green", "red", "purple", "orange", "lime green", "brown",
"turquoise", "gold", "pen 11", "pen 12", "pen 13", "pen 14", "pen 15", "pen 16"
own byte array SLOT USED (0:MAX COLOUR) = 0, 1, 3, 4, 2, 5, 6, 8, 7, 1(*)
const byte array LINE STYLE MAP (0:MAX LINE) = '0', '1', '5', '2', '3', '4', '6'
const real array LINE STYLE LEN (0:MAX LINE) = 0.0, 0.4, 2.5, 1.0, 1.5, 2.0, 2.0
routine ADD (integer ONE, TWO)
TTPUT (';')
TTPUT (ONE)
TTPUT (TWO)
end
routine ADD STR (string (255) STR)
integer I
TTPUT (CHARNO(STR,I)) for I = 1, 1, LENGTH(STR)
end
routine HP OUT NUM (integer I)
ADD STR (ITOS (I, 0))
end
routine HP LINE (integer X, Y); ! Go the the current X Y point
own byte PATH COUNT = 0
if LAST COM = DEV LINE then TTPUT (',') else start
ADD ('P', 'D')
return if SX=X and SY=Y; ! Just a point
ADD ('P', 'R')
PATH COUNT = 0
finish
PATH COUNT = (PATH COUNT + 1) & 7
TTPUT (NL) if PATH COUNT = 0
HP OUT NUM (X - SX)
TTPUT (',')
HP OUT NUM (Y - SY)
LAST COM = DEV LINE
end
! Protocol Handling routines
routine HP INSTRUCTION (integer WHICH)
TTPUT (ESC); TTPUT ('.'); TTPUT (WHICH)
end
routine END TEXT MODE
TTPUT (ETX)
TEXT MODE = FALSE
end
routine RESERVE (integer N)
! Test to see if N chars. will fit in the buffer
TTPUT (NL)
end
routine POF
RESERVE (BUFF SIZE); ! force out anything which is present.
TTPUT (';')
HP INSTRUCTION (')')
TTPUT (13)
FLUSH OUTPUT
PLOT ACTIVE = FALSE
end
routine CHECK PLOTTING AND NO TEXT
END TEXT MODE if TEXT MODE = TRUE
end
routine SET GRAPHICS LIMITS (integer LX, LY, HX, HY)
CHECK PLOTTING and NO TEXT
ADD ('I', 'P')
HP OUT NUM (LX); TTPUT (','); HP OUT NUM (LY); TTPUT (',')
HP OUT NUM (HX); TTPUT (','); HP OUT NUM (HY)
ADD ('S', 'C')
TTPUT ('0'); TTPUT (','); HP OUT NUM (HX-LX); TTPUT (',')
TTPUT ('0'); TTPUT (','); HP OUT NUM (HY-LY)
ADD ('I', 'W')
HP OUT NUM (LX); TTPUT (','); HP OUT NUM (LY); TTPUT (',')
HP OUT NUM (HX); TTPUT (','); HP OUT NUM (HY)
end
routine FULL GRAPHICS LIMITS
SET GRAPHICS LIMITS (XBASE, YBASE, MAX X+XBASE, MAX Y+YBASE)
end
routine CHECK FOR PENDING COLOURS AND MOVES
integer I
routine COLOUR (integer I)
I = I - NUM PENS while I > NUM PENS
ADD ('S', 'P'); TTPUT (I + '0')
end
if PC=TRUE or PM=TRUE start
TTPUT (NL)
ADD ('P', 'U')
COLOUR (SLOT USED (CUR COL)) if PC=TRUE
ADD ('P', 'A'); HP OUT NUM (SX)
TTPUT (','); HP OUT NUM (SY)
finish
PC = FALSE
PM = FALSE
end
routine UPDATE
if PLOT ACTIVE=TRUE start
RESERVE (10)
PC = TRUE
PM = TRUE
CHECK FOR PENDING COLOURS AND MOVES
POF
finish
end
routine NEW FRAME
integer OLD COL, SYM
on 9 start
CUR COL = OLD COL; SX = XL; SY = YB; PM = TRUE; PC = TRUE
signal 9
finish
SX = XR; SY = YT; PM = TRUE; ! Goto the edge.
OLD COL = CUR COL; ! remember current colour.
PC = TRUE; CUR COL = 0; ! Drop pen
NEW FRAMED = TRUE
! Restore default state after newframe.
CUR COL = OLD COL; SX = XL; SY = YB; PM = TRUE; PC = TRUE
end
external routine HPPLOT alias "EDWIN___O" (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 NEW HP ATTRIBUTE (integer X, Y)
const string (5) array ANGLE (0: 7) = "1,0", "1,1", "0,1", "-1,1", "-1,0", "-1,-1", "0,-1", "1,-1"
switch AS (0:MAX ATTRIBUTE)
-> AS (X)
AS(0): ! Colour
Y = 1 unless 0<=Y<=MAX COLOUR
CUR COL = Y
PC = TRUE
return
AS(1): ! Line style
ADD ('L', 'T')
if 0<Y<=MAX LINE start
TTPUT (LINE STYLE MAP (Y))
TTPUT (',')
ADD STR (RtoS(LINE STYLE LEN (Y), 0, 3))
finish
return
AS(2): ! Char size
ADD ('S', 'I'); ADD STR (Rtos(Y/600,0,3).",".RtoS (Y/450,0,3))
return
AS(3): ! Char rot
ADD ('D', 'I'); ADD STR (ANGLE(((Y+22)//45)&7))
return
AS(4): ! Char Quality (<2 => low quality, 5' tolerance, >2 => highest quality.
return
AS(5): ! Char Font
Y = 0 unless 0 <= Y <= 5
ADD ('C', 'A')
TTPUT ('1') if LOW QUAL # TRUE
TTPUT (Y + '0')
ADD ('C', 'S')
TTPUT ('1') if LOW QUAL # TRUE
TTPUT (Y + '0')
return
AS(6): ! Char slant
ADD ('S', 'L')
TTPUT ('-') if Y<0
ADD STR (RtoS(TAN(|Y| / DtoR), 0, 3)) if Y#0
return
AS(7): ! Intensity
return
AS(8): ! Speed
Y = 36 unless 1<=Y<=36
ADD ('V', 'S'); HP OUT NUM (Y)
end
END TEXT MODE if LAST COM = DEV CHAR and COM#DEV CHAR
LAST COM = COM if COM # DEV LINE
! select output (0); write (com,1); write (x,1); write (y,1); newline
-> SW (COM)
SW(0): ! Initialise
DEV DATA_NAME = "a network HP plotter"
DEV DATA_DVX = 40*400
DEV DATA_DVY = 28*400
DEV DATA_MVX = 40*400
DEV DATA_MVY = 28*400
DEV DATA_UNITS PER CM = 400
DEV DATA_MAX COLOUR = 8
DEV DATA_NUM CHAR SIZES = 255
if VIEWING=0 start
VIEWING = NON TERMINAL DEFAULT
Open Output (viewing, "DRAWING.HP")
finish
ADD STR ("HP7220T-".UINFS(1)."00".UINFS(1)." 2
")
ADD ('P', 'U'); ADD ('I', 'N')
SET GRAPHICS LIMITS (0, 0, 40*400, 28*400)
ADD STR ("
;PU;SP1;PU;PA0,600;PD;PR0,-100,100,0;SI0.2,0.3;PU;PA0,300;")
! Black pen, Move abs (0, 0), char size 0.2 cm, and draw start mark.
ADD STR ("
LB ".DATE." ".TIME." ".UINFS(1)." (".UINFS(10).") ".UINFS(2))
TTPUT (ETX)
INBUFF = 32
SX = XL; SY = YB; PM = TRUE
NEW FRAMED = FALSE
return
SW(1): ! Terminate
FULL GRAPHICS LIMITS
ADD STR (";PU;PA16000,0;")
TTPUT (NL)
FLUSH OUTPUT
CLOSE OUTPUT
return
SW(2): ! Update
UPDATE
return
SW(3): ! Newframe
NEWFRAME
return
SW(4): ! Move Abs
NEW FRAME if NEW FRAMED # TRUE
SX = X - XL; SY = Y - YB; PM = TRUE
return
SW(5): ! Line Abs
NEW FRAME if NEW FRAMED # TRUE
CHECK FOR PENDING COLOURS AND MOVES
X = X - XL; Y = Y - YB
HP LINE (X, Y)
SX = X; SY = Y
return
SW(6): ! Character
NEW FRAME if NEWFRAMED # TRUE
if TEXT MODE # TRUE start
CHECK FOR PENDING COLOURS AND MOVES
ADD ('L', 'B')
TEXT MODE = TRUE
finish
TTPUT (X)
return
SW(7): ! New attribute
return if X > MAX ATTRIBUTE
NEW HP ATTRIBUTE (X, Y)
return
SW(8): ! Lower window bounds
X = 0 if X<0
XL = X
Y = 0 if Y<0
YB = Y
return
SW(9): ! Upper window bounds
X = MAXX if X > MAXX
XR = X
Y = MAXY if Y > MAXY
YT = Y
TTPUT (NL)
SET GRAPHICS LIMITS (XL+XBASE, YB+YBASE, X+XBASE, Y+YBASE)
TTPUT (NL)
return
SW(10): SW(11): return { ignore mode settings }
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.
! DO IT<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
return
SW(14): { Hardware circles }
{ X is the Radius, and Y is used as a temp }
RESERVE (20)
CHECK FOR PENDING COLOURS AND MOVES
ADD ('C', 'I'); HP OUT NUM (X)
return
SW(15): return
end
external routine HP C ARC alias "EDWIN_NHP_C_ARC" (integer RAD, integer IA, FA)
integer OX, OY
RESERVE (20)
OX = SX; OY = SY
SX = SX + INT (RAD * COS (IA / DtoR)); SY = SY + INT (RAD * SIN (IA / DtoR)); PM = TRUE
NEWFRAME if NEWFRAMED # TRUE
CHECK PLOTTING AND NO TEXT
CHECK FOR PENDING COLOURS AND MOVES
ADD ('P', 'D')
ADD ('A', 'R')
HP OUT NUM (OX-SX); TTPUT (','); HP OUT NUM (OY-SY); TTPUT (',')
FA = FA - 360 if FA > IA
HP OUT NUM (FA-IA)
ADD ('P', 'U')
SX = OX; SY = OY; PM = TRUE
end
external routine HP AC ARC alias "EDWIN_NHP_AC_ARC" (integer RAD, integer IA, FA)
integer OX, OY
RESERVE (20)
OX = SX; OY = SY
SX = SX + INT (RAD * COS (IA / DtoR)); SY = SY + INT ( RAD * SIN (IA / DtoR)); PM = TRUE
NEWFRAME if NEWFRAMED # TRUE
CHECK PLOTTING AND NO TEXT
CHECK FOR PENDING COLOURS AND MOVES
ADD ('P', 'D')
ADD ('A', 'R')
HP OUT NUM (OX-SX); TTPUT (','); HP OUT NUM (OY-SY); TTPUT (',')
FA = FA + 360 if FA<IA
HP OUT NUM (FA-IA)
ADD ('P', 'U')
SX = OX; SY = OY; PM = TRUE
end
end of file