! EDWIN 5.2 Sept 1985
!############################################################################
!# #
!# 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 Imp include Connect
from Imp include Lognames
from Imp include Maths
from Edwin include consts
from Edwin include icodes
from Edwin include specs
external integer fn spec MULDIV alias "EDWIN___MUL_DIV" (integer A, B, C)
from Edwin include charspec
! Global Data for the EDWIN library -
external record (DEVICE DATA FM) DEV DATA alias "EDWIN___DEVICE_DATA" = 0
external record (DEVICE DATA FM) map D DATA alias "EDWIN_DEVICE_DATA"
result == record(addr(DEV DATA))
end
external integer VIEWING alias "EDWIN___VIEWING" = 0
external integer STORING alias "EDWIN___STORING" = -1
external integer CLIPPING alias "EDWIN___CLIPPING" = 0
! These three variables are set up by the device drivers for Draft (curse)
external integer Font Width alias "CharX"
external integer Font Height alias "CharY"
external integer Font Descender alias "OffY"
!%include "EDCONFIG"
! control
const integer Max Int = 16_7FFFFFF { NB: 4 bits saved for multiplications }
own integer VIS = 0; ! Current Char visibility
own integer DEVICE CHAR SIZE = 12
own integer array ATTRIBUTES (0:15) = -1 (*)
const integer array DEF ATTRIBUTES (0:15) = { Colour } 1,
{ Line Style } 0,
{ Char size } 12,
{ Char rot } 0,
{ Char quality } 0,
{ Char font } 0,
{ Char slant } 0,
{ Maker size } 7,
{ Speed (max) } 0,
{ Colour mode } 0,
{ Shade mode } 0,
{ Chord step } 15,
{ Char Mirror } 0,
{ Att 13 } 0,
{ Att 14 } 0,
{ Aspect ratio } 1
! Screen information
own integer XO = 0; ! Origin (bottom left) of device window
own integer YO = 0
own integer XS = 1023; ! Size of device window
own integer YS = 1023
own integer CX = 0; ! Current virtual position
own integer CY = 0
own integer XV = 1023; ! Size of virtual window
own integer YV = 1023
own integer XL = 0; ! Origin of virtual window (Left edge)
own integer XR = 1023; ! (Right edge)
own integer YB = 0; ! (Bottom edge)
own integer YT = 1023; ! (Top edge)
own integer OWXL=0, OWXR=1023, OWYB=0, OWYT=1023
! Old Window bounds for aspect ratioing retrospectivly.
routine SWOP (integer name A,B)
integer C
C=A; A=B; B=C
end
external routine MAP TO DEVICE COORDS alias "EDWIN_MAP_TO_DCS" (integer name X, Y)
X = MUL DIV (X-XL, XS, XV) + XO
Y = MUL DIV (Y-YB, YS, YV) + YO
end
external routine MAP TO VIRTUAL COORDS alias "EDWIN_MAP_TO_VCS" (integer name X, Y)
X = MUL DIV (X-XO, XV, XS) + XL
Y = MUL DIV (Y-YO, YV, YS) + YB
end
routine VECTOR (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).
own integer OTX = 0, OTY = 0
MAP TO DEVICE COORDS (FX,FY)
MAP TO DEVICE COORDS (TX,TY)
if V#0 start
DRIVE DEVICE (Dev move, FX, FY) if OTX#FX or OTY#FY
DRIVE DEVICE (Dev Line, TX, TY)
else
DRIVE DEVICE (Dev Move, TX, TY)
finish
OTX = TX
OTY = TY
end
external routine CLIP alias "EDWIN___CLIP" (integer TX, TY, V)
! Draw a vector (visible if V#0) to virtual position (TX,TY)
! but only that part of it (if any) which lies within the virtual window
integer F, T, FX, FY
constinteger LEFT = 1, RIGHT = 2, ABOVE = 4, BELOW = 8
integer fn CODE (integer X, Y)
! Set one bit for each of the conditions that (X,Y) lies
! above, below, to the left, or to the right of window
integer C
C = 0
C = LEFT if X<XL
C = RIGHT if X>XR
C = C + ABOVE if Y>YT
C = C + BELOW if Y<YB
result = c
end
FX=CX; FY=CY; ! Let FROM be current position
CX=TX; CY=TY; ! Update current position to TO
return if VIEWING<0
VECTOR (FX,FY,TX,TY,V) and return if CLIPPING<0
T=CODE (TX,TY)
VIS = T; ! Remember whether inside window for CHARS
cycle
F = CODE (FX,FY)
return if F&T#0; ! Both endpoints outside window (same side)
if F+T=0 start; ! Both endpoints inside window
VECTOR (FX,FY,TX,TY,V); ! So draw the line and it's over with
return
finish
if F=0 start; ! FROM is inside window: swop FROM and TO
SWOP(F,T); SWOP(FX,TX); SWOP(FY,TY)
finish
! Now FROM is outside and TO is either inside or outside
! So shift FROM along the line FROM/TO until it comes
! to lie on the window's edge.
if F&LEFT#0 start
FY=MUL DIV(TY-FY,XL-FX,TX-FX)+FY; FX=XL
else
if F&RIGHT#0 start
FY=MUL DIV(TY-FY,XR-FX,TX-FX)+FY; FX=XR
else
if F&ABOVE#0 start
FX=MUL DIV(TX-FX,YT-FY,TY-FY)+FX; FY=YT
else
if F&BELOW#0 start
FX=MUL DIV(TX-FX,YB-FY,TY-FY)+FX; FY=YB
finish
finish
finish
finish
repeat
end
external routine PDF INSERT alias "EDWIN___PDF_INSERT" (integer A, X, Y)
! Insert instruction into display file
switch IS (0:15)
integer OOS
return if STORING < 0
OOS = OUTPUT STREAM
SELECT OUTPUT (STORING)
Write (A, 1)
-> IS (A&15)
IS(0): IS(1): IS(2): IS(3): IS(4): IS(5): { Two Values to be output
IS(6): IS(7): IS(8): IS(13):
WRITE (X, 1); WRITE (Y, 1)
-> Done
IS(14): IS(15): { Output X value
WRITE (X, 1)
Done:
IS(9): IS(10): IS(11): IS(12): { No other values
NEWLINE
SELECT OUTPUT (OOS)
end
external routine SET ATTRIBUTE alias "EDWIN___SET_ATTRIBUTE" (integer WHAT, TO)
return if ATTRIBUTES(WHAT) = TO
ATTRIBUTES(WHAT) = TO
if WHAT=Att Char Size start
DEVICE CHAR SIZE = MUL DIV (TO, XS, XV)
TO = DEVICE CHAR SIZE
finish
DRIVE DEVICE (Dev Attribute, WHAT, TO)
end
external routine GET ATTRIBUTE alias "EDWIN___GET_ATTRIBUTE" (integer CODE, integer name VAL)
VAL = ATTRIBUTES (CODE)
end
routine CHAR OFFSET (integer name XO, YO)
! Update XO and YO with the relative movements caused by the character
long real R
integer SIZE, ROT
ROT = ATTRIBUTES (Att Char Rot)
SIZE = ATTRIBUTES (Att Char size)
SIZE = -SIZE if Attributes (Att Char Mirror) & Mirror in Y Axis # 0
if Rot = 0 start
XO = SIZE
YO = 0
else
R = Rot/DtoR
XO = round (size * Cos(r))
YO = round (size * Sin(r))
finish
end
routine DO ASPECT
integer MD, MV, N, ARF
ARF = DEV DATA_ARF
ARF = 100 if ARF = 0
MD = round ((Float(100000)*Float(YS)) / (Float(ARF)*Float(XS)))
MV = MUL DIV (1000, |YT-YB|, |XR-XL|)
if MD#MV start
if MD>MV start
N = (MUL DIV(MD,|XR-XL|,1000)+YB - YT)//2
YB = YB - N
YT = YT + N
else
N = (MUL DIV(1000,|YT-YB|,MD)+XL - XR)//2
XL = XL - N
XR = XR + N
finish
finish
end
own integer MARKER SCALE = 1
const integer Anti Rounding = 1000
external routine SET MARKER SIZE alias "EDWIN_SET_MARK_SIZE" (integer S)
S = 1 unless 0 < S < 256
PDF INSERT ((Att Marker Size << 8 ! S) << 4 ! PDF Attribute, 0, 0)
MARKER SCALE = S
end
routine spec INTERPRET (integer PC, SIZE, Rot, Mirror)
external routine MARKER alias "EDWIN___MARKER" (integer N)
const integer array MK(0:10) = '.', 'O', '#', 'A', 'X', '*', '+', '>', '<', '^', 'V'
integer scale
! This draws a marker at the current position.
return unless 0<=N<=10
DRIVE DEVICE (Dev Char, MK(N), 0) and return if DEV DATA_Dev no = VT100
if Dev Data_Units per cm > 0 start
SCALE = Trunc(Marker Scale * Anti Rounding * -
(DEV DATA_X Units per cm/40 + 0.5))
else
SCALE = Marker Scale * Anti Rounding
finish
INTERPRET (CHARPDF(2000-N*2), MUL DIV(SCALE, XV, XS), 0, 0)
end
routine INTERPRET (integer PC, SIZE, Rot, Mirror)
! Interpret instructions in display file starting
! at (relative) PC until an END instruction is found
! Codes are 0 LINEA 1 MOVEA 2 MARKERA
! 3 LINER 4 MOVER 5 MARKERR
! 6 SUBPIC 7 END 8 WINDOW
! 9 CHAR 10 ATTRIBUTES 11 END
integer WORD, CODE, X, Y, Z, P, SSAVE, LSAVE, CSIZE, ACTIVE, OX, OY
long real SinR, CosR
switch C (0:15)
ACTIVE = FALSE
if Rot # 0 start
Sin R = Sin (Rot/DtoR)
Cos R = Cos (Rot/DtoR)
finish
cycle
WORD = CHARPDF(PC); PC=PC+1
CODE=WORD&15
if CODE<=5 start; !Draw, Move, Marker
ACTIVE = TRUE
X = CHARPDF (PC); PC = PC + 1
if WORD&16=0 start; !Long form
Y = CHARPDF (PC); PC = PC + 1
finishelsestart; !Short form
Y=X&255; X=X>>8&255
X=X!!(¬255) if X&128#0
Y=Y!!(¬255) if Y&128#0
finish
if CODE>=3 start; !Relative
!Change the scale
X = X*SIZE
Y = Y*SIZE
X = -X if Mirror & Mirror in Y Axis # 0
Y = -Y if Mirror & Mirror in X Axis # 0
if Rot # 0 start
Z = Round (X*CosR - Y*SinR)
Y = Round (X*SinR + Y*CosR)
X = Z
finish
X = Round(X/Anti Rounding) + CX
Y = Round(Y/Anti Rounding) + CY
CODE=CODE-3; !Map to absolute codes
finish
finish
->C(CODE)
C(0): CLIP (X, Y, 1); continue { Line }
C(1): CLIP (X, Y, 0); continue { Move }
C(2): CLIP (X, Y, 0); MARKER(WORD>>12&15)
repeat
C(*): signal 14, 5
C(12):
end
!*******************************************************************
!* *
!* U S E R R O U T I N E S *
!* *
!*******************************************************************
external routine TERMINATE EDWIN alias "EDWIN_TERM"
PDF INSERT (PDF Terminate, 0, 0)
DRIVE DEVICE (Dev Terminate, 0, 0)
DEV DATA_DEV NO = -1
end
external routine LINE ABS alias "EDWIN_LINE_ABS" (integer X, Y)
PDF INSERT (PDF Line Abs, X, Y)
CLIP (X, Y, 1)
end
external routine MOVE ABS alias "EDWIN_MOVE_ABS" (integer X, Y)
PDF INSERT (PDF Move Abs, X, Y)
CLIP (X, Y, 0)
end
external routine MARKER ABS alias "EDWIN_MARK_ABS" (integer N, X, Y)
PDF INSERT (N<<12!PDF Mark Abs, X, Y)
CLIP (X, Y, 0)
MARKER (N)
end
external routine LINE REL alias "EDWIN_LINE_REL" (integer DX, DY)
PDF INSERT (PDF Line Rel, DX, DY)
CLIP (DX+CX, DY+CY, 1)
end
external routine MOVE REL alias "EDWIN_MOVE_REL" (integer DX, DY)
PDF INSERT (PDF Move Rel, DX, DY)
CLIP (DX+CX, DY+CY, 0)
end
external routine MARKER REL alias "EDWIN_MARK_REL" (integer N, DX, DY)
PDF INSERT (N<<12!PDF Mark Rel, DX, DY)
CLIP (DX+CX, DY+CY, 0)
MARKER (N)
end
external routine CHARACTER alias "EDWIN_CHAR" (integer SYM)
const integer UNIT = 12
integer FSAVE, SSAVE, LSAVE, SIZE, OX, OY, NX, NY
long real R Size
on 14 start
signal 14, event_sub if event_sub # 14
ATTRIBUTES (Att Char Quality) = 1 { software chars }
-> resume
finish
PDF INSERT (SYM<<4!PDF character, 0, 0)
Resume: { After a hardware character error }
if ATTRIBUTES(Att Char Quality) = 0 start
CHAR OFFSET (NX, NY)
CX = CX + NX
CY = CY + NY
DRIVE DEVICE (Dev Char, SYM, 0) if VIS=0
else
if ATTRIBUTES(Att Line Style)#0 start
LSAVE = ATTRIBUTES(Att Line Style)
DRIVE DEVICE(Dev Attribute, Att Line Style, 0)
finish else LSAVE = -1
if ATTRIBUTES(Att Shade Mode)#0 start
FSAVE = ATTRIBUTES(Att Shade Mode)
DRIVE DEVICE(Dev Attribute, Att Shade Mode, 0)
finish else FSAVE = -1
if ATTRIBUTES(Att Char Font)=0 start; ! Normal EDWIN ones
RSize = Float(Attributes(Att Char Size))*Float(Anti Rounding)/12
if R Size > Max Int start
Size = Max Int
else
Size = Round (R Size)
finish
if SIZE > 0 and 32<=SYM<=127 start
OX = CX; OY = CY
if Device Char Size > 2 start
INTERPRET (CHARPDF(2000-(SYM-21)<<1), Size,
Attributes(Att Char Rot), Attributes(Att Char Mirror))
finish
CHAR OFFSET (NX, NY)
CLIP (OX + NX, OY + NY, 0)
finish
else; ! GIMMS characters
SSAVE = STORING; STORING = -1
DRAW CHAR (SYM, Attributes(Att Char Font), Attributes(Att Char Size),
Attributes(Att Char Rot), Attributes(Att Char Mirror))
STORING = SSAVE
finish
DRIVE DEVICE (Dev Attribute, Att Line Style, LSAVE) if LSAVE>=0
DRIVE DEVICE (Dev Attribute, Att Shade Mode, FSAVE) if FSAVE>=0
finish
end
external routine NEW FRAME alias "EDWIN_NEW_FRAME"
PDF INSERT (PDF Newframe, 0, 0)
DRIVE DEVICE (Dev Newframe, 0, 0)
CX = 0
CY = 0
end
external routine UPDATE alias "EDWIN_UPDATE"
DRIVE DEVICE (Dev update, 0, 0)
end
external routine CLIP ON alias "EDWIN_CLIP_ON"
CLIPPING = 0
end
external routine CLIP OFF alias "EDWIN_CLIP_OFF"
CLIPPING = DISABLED
end
external routine STORE ON alias "EDWIN_STORE_ON" (integer STREAM)
STORING = STREAM
end
external routine STORE OFF alias "EDWIN_STORE_OFF"
STORING = DISABLED
end
external routine VIEW ON alias "EDWIN_VIEW_ON" (integer STREAM)
VIEWING = STREAM
end
external routine VIEW OFF alias "EDWIN_VIEW_OFF"
VIEWING = DISABLED
end
external routine WINDOW alias "EDWIN_WINDOW" (integer A, B, C, D)
signal 14, 12 if A>=B or C>=D
XL = A; OWXL = A; XR = B; OWXR = B
YB = C; OWYB = C; YT = D; OWYT = D
PDF INSERT(PDF Window, A, B); PDF INSERT(PDF Window, C, D)
DO ASPECT if ATTRIBUTES(15)#0
XV = XR-XL; YV = YT-YB
VIS = 0
A = ATTRIBUTES(Att Char Size)
return if A <= 0 { No size set up yet, Window having been called from Init }
ATTRIBUTES (Att Char Size) = 0
SET ATTRIBUTE (Att Char Size, A) { Fix device character size for new window }
end
external routine VIEWPORT alias "EDWIN_VIEWPORT" (integer XL, XR, YB, YT)
integer S
return if DEV DATA_DEV NO<=0
! Check that the bounds are valid, trying to make a sensible size if req.
XL = 0 if XL<0
YB = 0 if YB<0
XR = DEV DATA_MVX if XR>DEV DATA_MVX
YT = DEV DATA_MVY if YT>DEV DATA_MVY
signal 14, 13 if XL>=XR or YB>=YT
DRIVE DEVICE (Dev low wb, XL, YB) { Set lower viewport bounds
DRIVE DEVICE (Dev high wb, XR, YT) { Set upper viewport bounds
XO=XL; XS=XR-XL; YO=YB; YS=YT-YB
S = STORING
STORING = DISABLED
WINDOW (OWXL, OWXR, OWYB, OWYT)
STORING = S
end
external routine ASPECT RATIOING alias "EDWIN_ASPECT_RATIO" (integer MODE)
const integer THIS = 15
integer S
MODE = 1 unless MODE = 0
PDF INSERT ((THIS<<8 ! MODE) <<4 ! PDF Attribute, 0, 0)
ATTRIBUTES (THIS) = MODE
S = STORING
STORING = DISABLED
WINDOW (OWXL, OWXR, OWYB, OWYT)
STORING = S
end
external routine INITIALISE FOR alias "EDWIN_INIT" (integer DEVICE TYPE)
integer I
DRIVE DEVICE (Dev initialise, DEVICE TYPE, 0)
VIEW PORT (0, DEV DATA_DVX, 0, DEV DATA_DVY) if DEV DATA_DVX#0
WINDOW (0, 1023, 0, 1023)
ATTRIBUTES (I) = -1 for I = 0, 1, ATT MAXIMUM
SET ATTRIBUTE (I, DEF ATTRIBUTES(I)) for I = 0, 1, ATT MAXIMUM
end
external routine INQUIRE POSITION alias "EDWIN_INQ_POSITION" (integer name X, Y)
X = CX; Y = CY
end
external routine INQUIRE WINDOW alias "EDWIN_INQ_WINDOW" (integer name A, B, C, D)
A = XL; B = XR; C = YB; D = YT
end
external routine INQUIRE VIEWPORT alias "EDWIN_INQ_VIEWPORT" (integer name A, B, C, D)
A = XO; B = XS+XO; C = YO; D = YS+YO
end
external routine REQUEST INPUT alias "EDWIN_REQUEST" (integer name STATE, X, Y)
REQUEST DEVICE (STATE, X, Y)
MAP TO VIRTUAL COORDS (X, Y)
end
external routine SAMPLE INPUT alias "EDWIN_SAMPLE" (integer name STATE, X, Y)
SAMPLE DEVICE (STATE, X, Y)
MAP TO VIRTUAL COORDS (X, Y)
end
external routine AREA INPUT alias "EDWIN_AREA" (integer name XL, YB, XR, YT)
AREA DEVICE (XL, YB, XR, YT)
MAP TO VIRTUAL COORDS (XL, YB)
MAP TO VIRTUAL COORDS (XR, YT)
end
end of file { Unless you want it all together }
include "EDATTRIB"
include "EDTEXT"
include "EDUTILS"
include "EDERRORS"
record format POINT FM (integer X, Y)
include "EDWIN:SHAPES.INC"
include "EDSHAPES"
include "EDREVIEW"
include "EDCIFSUP"
include "EDDEFDEV"
end of file