{###################################}
{# Copyright (C) 1987 #}
{# Lattice Logic Limited #}
{# 9, Wemyss Place #}
{# Edinburgh EH3 6DH #}
{# Scotland #}
{# #}
{# All rights reserved #}
{###################################}
! This module contains the support routines for the scrdrive package and
! edwin device driver for the definicon board's interface with the famous
! GEM package
from Imp include DOS end of list
from Imp include ASCII end of list
from Imp include LogNames end of list
from Imp include MCode end of list
from Edwin include Consts end of list
from Edwin include GemConst end of list
from LL include Common end of list
string(255) function Env String(string(31) Name, string(255) Variable)
string(255) Value
Value = Translate(Name."_".Variable)
result = Value if Value # Name."_".Variable
Value = Translate("LL_".Variable)
result = Value if Value # "LL_".Variable
result = ""
end
integer function Env Integer(string(31) Name, string(255) Variable,
integer Default)
on event * start
result = Default
finish
Variable = Env String(Name, Variable)
result = Default if Variable = ""
result = S To I(Variable)
end
integer function Env Switch(string(31) Name, string(255) Variable,
integer Exist, Not Exist)
Variable = Env String(Name, Variable)
result = Exist if Variable # ""
result = Not Exist
end
{##############################################}
{# #}
{# Basic GEM Driver #}
{# #}
{##############################################}
external string(31) spec Fname
constant integer Screen Device = 1
constant integer Metafile Device = 31
own integer Current Device
constant integer Max Vertices = 127
constant integer Max Ints = 128
record format Gem Parm Fm(integer Contrl,
Intin,
Ptsin,
Intout,
Ptsout)
record format Gem Control Fm(short array C(0:11) or
short Opcode,
Ptsin Len,
Ptsout Len,
Intin Len,
Intout Len,
Sub Function,
Handle)
record format Gem Integer Fm(short array X(0: Max Ints-1))
record format Gem Vertice Fm(short array X(0: Max Vertices*2-1))
record format Gem Fm(record(Gem Parm Fm) Parm,
record(Gem Control Fm) Contrl,
short array Parms(0: 511),
record(Gem Vertice Fm) Ptsin, Ptsout,
record(Gem Integer Fm) Intin, Intout)
own record(Gem Fm) Gem = 0
own integer Gem Buffer Size = 0
own integer Gem Addr = 0,
Gem Log,
MFDB Log,
MFDB Addr
own short name Opcode,
Ptsin Len,
Ptsout Len,
Intin Len,
Intout Len
own short array name Ptsin,
Ptsout,
Intin,
Intout,
PA
own record(Gem Parm Fm) name PB
!
! Keyboard type ahead held in a sort of circular buffer
!
! Nothing to read if read ptr=add ptr
! If buffer full add ptr will push read ptr on one
!
own integer escape char
external byte integer spec int flag alias "IMP___INT_FLAG"
constant integer Max Type Ahead = 63 {must be a power of two-1}
own byte array Buffer(0: Max Type Ahead)
own integer add ptr=0
own integer read ptr=0
routine Advance(integer name Ptr)
Ptr = (Ptr+1) & Max Type Ahead
end
routine Add To Buffer(byte Char)
Buffer(Add Ptr) = Char
Advance(Add Ptr)
Advance(Read Ptr) if Read Ptr = Add Ptr
end
integer function Top Of Buffer
result = -1 if Read Ptr = Add Ptr
integer I = Buffer(Read Ptr)
Advance(Read Ptr)
result=i
end
routine Clear Buffer
Read Ptr = Add Ptr
end
external routine do check alias "G_CK_INT"
constant integer zero flag=64
record(Int Regs Fm) Regs
Regs=0
Regs_Ah<-Dos Fn Direct Console IO
Regs_Dl<-16_FF {wanting input}
Int86(Dos Int Function Request,Regs)
if regs_flags&zero flag=0 start
if regs_al=escape char start
int flag=1
Clear Buffer
else
Add To Buffer(regs_al)
finish
finish
end
routine check interrupt
constant integer max cycle=50
own integer cycle=max cycle
return if current device#screen device
!
! test for attempted interrupt every max cycles calls of the routine
!
cycle=cycle-1
return if cycle>0
cycle=max cycle
do check
end
predicate Interested In Return Values(integer Opcode)
false if 2<=Opcode<=11 or Opcode=114 or 122<=Opcode<=123
true
end
routine copy arrays {load parameters into gem parameter block}
integer j,p=ptsin len*2
PB_Intin=PB_ptsin+p*2 {2*2 bytes per vertice parameter}
PB_ptsout=PB_intin+intin len*2 {2 bytes per integer parameter}
PB_intout=PB_ptsout+40 {+max ptsout len*4}
pa(j)=ptsin(j) for j=0,1,p-1
pa(p+j)=intin(j) for j=0,1,intin len-1
gem buffer size=size of(PB)+size of(gem_contrl)+p*2+intin len*2
gem buffer size=gem buffer size+130 if interested in return values(opcode)
end {+max ptsout len*4+max intout len*2}
routine copy back arrays {copy gem P.B. back into data structure}
integer i,j
i=intin len+ptsin len*2
ptsout(j)=pa(i+j) for j=0,1,ptsout len*2-1
i=intin len+ptsin len*2+20 {+max ptsout*2}
intout(j)=pa(i+j) for j=0,1,intout len-1
end
routine Initialise Gem
own byte array MFDB(1:20)=0(*)
return if Gem Addr # 0
Opcode == Gem_Contrl_Opcode
Ptsin == Gem_Ptsin_X
Ptsout == Gem_Ptsout_X
Intin == Gem_Intin_X
Intout == Gem_Intout_X
Ptsin Len == Gem_Contrl_Ptsin Len
Ptsout Len == Gem_Contrl_Ptsout Len
Intin Len == Gem_Contrl_Intin Len
Intout Len == Gem_Contrl_Intout Len
PA == Gem_Parms
PB == Gem_Parm
Gem Log = Mal 86(Size Of(Gem) + 20) {Allocate memory for GEM parameters}
Gem Addr = (Gem Log>>12) & 16_FFFF0 + (Gem Log & 16_FFFF)
MFDB Log = Gem Log + Size Of(Gem) {The last 20 bytes holds a MFDB}
MFDB Addr = Gem Addr + Size Of(Gem) {for scrolling raster operations}
To86(MFDB(1), MFDB addr, 20) {MFDB is zero for physical dev}
PB_Contrl = Gem Log + Addr(Gem_Contrl) - Addr(Gem)
PB_Ptsin = Gem Log + Addr(Gem_Parms) - Addr(Gem)
Escape Char = Env Integer(Fname, "ESCAPE_CHAR", 'Y'-'A'+1)
Int Flag = 0
end
own integer mouse addr
own byte retf=16_cb,original byte=16_55
routine Do Gem
record(Int Regs Fm) Regs=0
Regs_Ds<-Gem Log>>16
Regs_Dx<-Gem Log&16_FFFF
Regs_Cx<-16_0473
Copy Arrays
to86(retf,mouse addr,1) unless interested in return values(opcode)
To86(Byte(Addr(Gem)),Gem Addr,Gem buffer size)
Int86(16_EF,Regs)
if interested in return values(opcode) start
Fr86(Gem Addr,Byte(Addr(Gem)),Gem buffer size)
copy back arrays
else
to86(original byte,mouse addr,1)
finish
Intin Len=0
Ptsin Len=0
check interrupt
end
!
! set up the cursor so that it is displayed as much as possible
!
routine cursor status(integer onoff)
own integer status=hide cursor
return if status=onoff
status=onoff
opcode=status
ptsin len=0
intin len=1
intin(0)=1
do gem
end
routine gem command(short opc)
! make sure that the cursor is off if something is being drawn,
! otherwise it doesn't matter
!
cursor status(hide cursor) unless interested in return values(opc)
Opcode=opc
end
routine Add Ptsin(integer I,J)
integer P=Ptsin Len*2
Ptsin(P)<-I
Ptsin(P+1)<-J
Ptsin Len=Ptsin Len+1
end
routine add ptsin array(integer pts, integer array name xs,ys)
integer i,p=Ptsin Len*2
for i=1,1,pts cycle
ptsin(p)<-xs(i)
ptsin(p+1)<-ys(i)
p=p+2
repeat
ptsin len=ptsin len+pts
end
routine Add Intin(integer I)
Intin(Intin Len)<-I
Intin Len=Intin Len+1
end
routine Add String(byte name C Str)
integer A = Addr(C Str)
while Byte(A) # 0 and Intin Len <= Max Ints cycle
Intin(Intin Len) = Byte(A)
Intin Len = Intin Len+1
A = A+1
repeat
end
integer function clength(byte name cstr)
integer i=0,a=addr(cstr)
i=i+1 while byte(a+i)#0
result=i
end
{##############################################}
{# #}
{# EDWIN package support #}
{# #}
{##############################################}
constant integer CGA = 200,
EGA = 350,
VGA = 480
constant integer Meta Width = 3800 {Not what you might expect from the}
constant integer Meta Height = 2570 {documentation, but then what's new?}
constant integer System Text Face = 1
constant integer Software Text Face = 2
external integer function spec Imp Creat alias "IMP_CREAT" -
(string(255) Name, integer Mode)
dynamic integer spec Errno alias "errno"
constant integer Open Mode Write = 1
own integer Current Text Face
own integer Graphics Standard
own integer GEM Version
!
! Scrdrive package support. Remember to compile with the correct
! definicon map file
!
external integer spec Off Y alias "OffY"
external integer Letter X alias "LetterX"
external integer Letter Y alias "LetterY"
external integer Win X alias "WinX"
external integer Win Y alias "WinY"
external integer Max X alias "MaxX"
external integer Max Y alias "MaxY"
external integer Cur X alias "CurX"
external integer Cur Y alias "CurY"
external integer spec Char X alias "CharX"
external integer spec Char Y alias "CharY"
external integer Char Fixed alias "CharFixed"
constant integer Default = 1, Background = 0
record format Environment Fm(integer array Variable(1:5) or
integer Char Size,
Line Style,
Fill Mode,
Colour,
Raster Op)
own record(Environment Fm) Current, Actual
own integer Variable Char Size
own integer real colours
own integer screen aspect ratio
own integer initialised edwin=0
external routine spec Edwin Line Style alias "EDWIN_DD_STYLE"(integer Style)
external routine spec Edwin Colour alias "EDWIN_DD_COL"(integer mode)
external routine spec Edwin Mode alias "EDWIN_DD_MODE"(integer mode)
external routine spec Edwin Fill alias "EDWIN_DD_FILL"(integer mode)
external routine spec Edwin Clear alias "EDWIN_DD_CLEAR"
own integer Prev Dev, Prev Handle, Prev Mouse Addr, Prev Screen Size
own integer Screen File Descriptor, Nul File Descriptor
own integer Pts=0
own integer array Line X(0:Max Vertices-1)
own integer array Line Y(0:Max Vertices-1)
from Edwin include Gem Hatch
own integer array Line Map(0:7) = 2_1111111111111111,
2_1100110011001100,
2_1111111110011100,
2_1100000011000000,
2_0001111000011110,
2_1010111111111010,
2_1110011111111100,
2_1110001110001110
constant integer Red Col = 16_00030000
constant integer Blu Col = 16_00000003
constant integer Gre Col = 16_00000300
constant integer Whi Col = 16_00030303
constant integer Bla Col = 16_00000000
constant integer Yel Col = 16_00030300
constant integer Mag Col = 16_00030003
constant integer Cya Col = 16_00000303
external integer array C Map(0:7) = Bla Col, Red Col, Yel Col, Yel Col,
Cya Col, Cya Col, Cya Col, Whi Col
external integer MonoChrome = 0 ,
BackGround Col = 0,
ForeGround Col = 1,
Text Col = 2,
HighLight Col = 4
external integer array P map(0:15)=0,1,4,3,2,7,6,5,8,9,10,11,12,13,14,15
own string(127) fill pattern bitmap
own integer Fill Type, Fonts, Extents Flag
external routine Load Colours
integer i
for i=0, 1, 7 cycle
Gem Command(Set Colour Representation)
Add Intin(P Map(i))
Add Intin(333 * ( C Map(PMap(i)) >>16))
Add Intin(333 * (( C Map(PMap(i)) >>8 ) & 16_FF))
Add Intin(333 * ( C Map(PMap(i)) &16_FF))
Do Gem
repeat
end
external routine Read Environment For alias "RD_ENV"(string(31) Name)
string(16) Red Map, Green Map, Blue Map
string(255) colour
integer Map Length, i
if Real Colours > 2 start
if Name = "WAVE" start
!
! This is a frig to get the highlight col into slot 1 of the colour map.
! The xor function always results in the colour in slot one
!
i = C map(PMap(Foregroundcol))
C Map(PMap(Foregroundcol)) = C map(PMap(Highlightcol))
C Map(PMap(Highlightcol)) = i
i = foregroundcol
foregroundcol = highlightcol
highlightcol = i
Load Colours
else if Name = "EXERT"
Load Colours
else
Backgroundcol = 0
Textcol = 1
Foregroundcol = 1
Highlightcol = 1
Red Map <- Env String(Name, "RED___INTENSITY")
Green Map <- Env String(Name, "GREEN_INTENSITY")
Blue Map <- Env String(Name, "BLUE__INTENSITY")
Map Length = Length(Red Map)
Map Length = Length(Green Map) if Length(Green Map) < Map Length
Map Length = Length(Blue Map) if Length(Blue Map) < Map Length
for i=0, 1, Map Length-1 cycle
Gem Command(Set Colour Representation)
Add Intin(PMap(i))
Add Intin(333 * (Char No(Red Map, i+1)-'0'))
Add Intin(333 * (Char No(Green Map, i+1)-'0'))
Add Intin(333 * (Char No(Blue Map, i+1)-'0'))
Do Gem
repeat
finish
finish
Variable Char Size = Env Switch(Name, "VAR_CHAR_SIZE", 1, 0)
Extents Flag = '`'{Env Integer(Name, "EXTENTS_FLAG", '`')
Current_Char Size = Env Integer(Name, "CHAR_HEIGHT", 30)
Current_Char Size = (Current_Char Size*72) // (25400//Screen Aspect Ratio)
Current Text Face = Env Switch(Name, "FIXED_FONT", System Text Face,
Software Text Face)
Current Text Face = System Text Face if Fonts = 0
Gem Command(Set Text Face)
Add Intin(Current Text Face)
Do Gem
end
external routine Edwin Initialise alias "EDWIN_DD_INIT"-
(integer name Max X, Max Y, integer Dev)
record(Int Regs Fm) Regs=0
routine Open Screen
constant integer array meta xl(1:2)=660,520
constant integer array meta yl(1:2)=32410,32630
constant integer array meta xh(1:2)=10060,4550
constant integer array meta yh(1:2)=26590,30100
short Mouse Segment, Mouse Offset
integer i
Actual_Variable(i) = -1 for i=1, 1, 5
Gem Command(Open Workstation)
Add Intin(Current Device)
Add Intin(1) {Line type}
Add Intin(0) {Polyline colour}
Add Intin(1) {Marker type}
Add Intin(0) {Marker colour}
Add Intin(Current Text face)
Add Intin(0) {Text colour}
Add Intin(2) {fill interior style}
Add Intin(8) {fill style index}
Add Intin(0) {Fill colour}
Add Intin(2) {Raster coords}
Do Gem
stop if Gem_Contrl_Handle = 0
Max X = Intout(0)
Max Y = Intout(1)
Win X = Max X
Win Y = Max Y
Char Fixed = 0
Real Colours = Intout(13)
MonoChrome = 1 if Real Colours < 3
Graphics Standard = CGA
Graphics Standard = EGA if Max Y >= 300
Graphics Standard = VGA if Max Y >= 480
if GEM Version = 3 start
Screen Aspect Ratio = (100*Max Y)//Graphics Standard
else
if Real Colours > 2 start
Screen Aspect Ratio = 100
else
Screen Aspect Ratio = 200
finish
finish
Gem Command(Fill Rectangle)
Add Ptsin(0, 0)
Add Ptsin(Win X, Win Y)
Do Gem
Gem Command(Exchange Cursor Change Vector) {Ugly repulsive fix}
Do Gem {for the EGA card}
Mouse Offset = Gem_Contrl_C(9) {basically prevents}
Mouse Segment = Gem_Contrl_C(10) {a mouse interrupt}
Gem Command(Exchange Cursor Change Vector) {being serviced while}
Gem_Contrl_C(7) = Mouse Offset {a drawing operation}
Gem_Contrl_C(8) = Mouse Segment {is being executed.}
Do Gem
Mouse Addr = Mouse Segment<<4 + Mouse Offset
Fr 86(Mouse Addr, Original Byte, 1)
Gem Command(Load Fonts)
Add Intin(0)
Do Gem
Fonts = Intout(0)
Gem Command(Set Polyline Line Type)
Add Intin(7)
Do Gem
if current device=metafile device start
!
! use an escape command to change the name of the output file
! from the standard gemfile.gem filename to productname.gem
! eg draft.gem or cifview.gem
!
gem command(escape)
gem_contrl_sub function=100
charno(fname,length(fname)+1)=0
add string(charno(fname,1))
do gem
gem command(escape)
gem_contrl_sub function=99
add intin(0)
add intin(meta width)
add intin(meta height)
do gem
gem command(escape)
gem_contrl_sub function=99
add intin(1)
add intin(meta xl(prev screen size))
add intin(meta yl(prev screen size))
add intin(meta xh(prev screen size))
add intin(meta yh(prev screen size))
do gem
finish
end
routine Redirect Stdout To NUL
own integer Initialised Descriptors = 0
if Initialised Descriptors = 0 start
Initialised Descriptors = 1
Nul File Descriptor = Imp Creat("NUL", Open Mode Write)
if Nul File Descriptor <= 0 start
Select Output(0)
Print String("Error opening NUL: is ".I To S(Errno, 0).Snl)
stop
finish
!
! take note of original screen file handle before it is redirected
!
Regs_Ah <- Dos Fn Duplicate a File Handle
Regs_Bx <- 1
Int86(Dos Int Function Request, Regs)
Screen File Descriptor = Regs_AX
finish
Regs_Ah <- Dos Fn Force a Duplicate of a Handle
Regs_Bx <- Nul File Descriptor
Regs_Cx <- 1
Int86(Dos Int Function Request, Regs)
end
GEM Version = Env Integer("GEM", "VER_NO", 1)
if Initialised Edwin # 0 and Dev = 'D' start
Max X = Win X
Max Y = Win Y
return
finish
if Dev = 'G' start {trying to produce a metafile}
!
! remember previous values
!
Prev Screen Size = Screen Aspect Ratio
Prev Mouse Addr = Mouse Addr
Prev Dev = Current device
Prev Handle = Gem_Contrl_Handle
Current Device = Metafile Device
else
Current Device = Screen Device
!
! First thing to do is to disable control c interrupts because
! gem doesn't start up again after a control c interrupt
!
*MOVD_#31,R0
*SVC
!
Redirect Stdout To NUL {so the ^C doesn't get echoed to the screen}
! {and mess up the display}
finish
Initialised Edwin = 1
Initialise Gem
Open Screen
Read Environment For(Fname)
Current_Raster Op = Replace Mode {This is how EDWIN will be started up}
Current_Colour = Default
Current_Fill Mode = Outline
Current_Line Style = Normal Lines
Edwin Clear
end
predicate Environment Changed
true if Current_Char Size # Actual_Char Size
true if Current_Colour # Actual_Colour
true if Current_Fill Mode # Actual_Fill Mode
true if Current_Line Style # Actual_Line Style
true if Current_Raster Op # Actual_Raster Op
false
end
routine Implement Environment
routine Set Char Size
Actual_Char Size = Current_Char Size
Gem Command(Set Character Height Points Mode)
Add Intin(Current_Char Size)
Do Gem
Letter X = Pts Out(0)
Letter Y = Pts Out(1)
Char X = Pts Out(2)
Char X = (Char X*4)//5 if GEM Version = 3 and Current Text Face # 1
Char Y = Pts Out(3)
Off Y = Char Y-Letter Y+1
Char Fixed = 1
end
routine Set Colour
integer Colour = Current_Colour
Actual_Colour = Current_Colour
Colour = 1 if Colour > Real Colours-1
Gem Command(Set Fill Colour Index)
Add Intin(PMap(Colour))
Do Gem
Gem Command(Set Text Colour Index)
Add Intin(PMap(Colour))
Do Gem
Gem Command(Set Polyline Colour Index)
Add Intin(PMap(Colour))
Do Gem
end
routine Set Fill Style
constant integer Max Mode = 15
integer Mode = Current_Fill Mode
integer i
Actual_Fill Mode = Current_Fill Mode
Mode = 1 if Mode > Max Mode
Gem Command(Set Fill Interior Style)
if Mode > 1 start
Add Intin(4)
Do Gem
Gem Command(Set User Defined Fill Pattern)
Add Intin(Hatch Bitmap(Mode*16 + i)) for i=0, 1, 15
else
Add Intin(Mode)
finish
Do Gem
end
routine Set Line Style
Actual_Line Style = Current_Line Style
Gem Command(Set User Defined Line Style Pattern)
Add Intin(Line Map(Current_Line Style))
Do Gem
end
routine Set Write Mode
constant integer array Op Map(Replace Mode: Invert Mode) = 1,4,2,3,3
Actual_Raster Op = Current_Raster Op
Gem Command(Set Writing Mode)
Add Intin(Op Map(Current_Raster Op))
Do Gem
end
routine Set Perimeter
Gem Command(Set Fill Perimeter Visibility)
if (Current_Raster Op = Replace Mode or
Current_Raster Op = Or Mode) and
Current_Colour # 0 start
Add Intin(1)
else
Add Intin(0)
finish
Do Gem
end
Set Char Size unless Current_Char Size = Actual_Char Size
Set Colour unless Current_Colour = Actual_Colour
Set Fill Style unless Current_Fill Mode = Actual_Fill Mode
Set Line Style unless Current_Line Style = Actual_Line Style
Set Write Mode unless Current_Raster Op = Actual_Raster Op
Set Perimeter
end
routine do line
integer i
return if Pts = 0
Gem Command(Polyline)
Add Ptsin(Line X(i), Line Y(i)) for i=0, 1, Pts-1
Do Gem
Pts = 0
end
routine Flush Line
Do Line
Implement Environment if Environment Changed
end
routine Flush Environment
return unless Environment Changed
Do Line
Implement Environment
end
external routine Edwin Update alias "EDWIN_DD_UPDATE"
Flush Line
return if Current Device = Metafile Device
Gem Command(Update Workstation)
Do Gem
end
external routine Edwin Rectangle alias "EDWIN_DD_RECT"(integer LX,LY,HX,HY)
Flush Environment
Gem Command(GDP)
Gem_Contrl_Sub Function = Bar
Add Ptsin(LX, LY)
Add Ptsin(HX, HY)
Do Gem
end
external routine Edwin Clear alias "EDWIN_DD_CLEAR"
record(Environment Fm) Copy = Current
return if Current Device # Screen Device
Flush Line
Edwin Fill(Solid)
Edwin Mode(Replace Mode)
Edwin Colour(Background)
Edwin Rectangle(0, 0, Win X, Win Y)
Current = Copy
end
external routine edwin dot alias "EDWIN_DD_DOT"(integer X, Y)
Flush Environment
Gem Command(Polymarker)
Add Ptsin(X, Y)
Do Gem
end
external routine Edwin Line alias "EDWIN_DD_LINE"(integer OX, OY, NX, NY)
routine Start Line
Line X(0) = OX
Line Y(0) = OY
Line X(1) = NX
Line Y(1) = NY
Pts = 2
end
Flush Environment
unless Pts = 0 start
if Line X(Pts-1)=OX and Line Y(Pts-1)=OY and Pts<Max Vertices start
Line X(Pts) = NX
Line Y(Pts) = NY
Pts = Pts+1
else if Line X(Pts-1)=NX and Line Y(Pts-1)=NY and Pts<Max Vertices
Line X(Pts) = OX
Line Y(Pts) = OY
Pts = Pts+1
else
Flush Line
Start Line
finish
else
Start Line
finish
end
external routine Edwin Polygon alias "EDWIN_DD_POLY"-
(integer Count, integer array name XS, YS)
integer Seg = Count, Last Seg = 1, i
Flush Environment
Seg = Max Vertices if Seg > Max Vertices
cycle
if Current_Fill Mode = Outline or Count > Max Vertices start
Gem Command(Polyline)
else
Gem Command(Filled Area)
finish
Add Ptsin(XS(i), YS(i)) for i=Last Seg, 1, Seg
Do Gem
exit if Seg = Count
Last Seg = Seg
Seg = Seg+Max Vertices-1
Seg = Count if Seg>Count
repeat
end
external routine Edwin Circle alias "EDWIN_DD_CIRCLE"(integer X, Y, Rad)
Flush Environment
Gem Command(GDP)
Gem_Contrl_Sub Function = Circle
Add Ptsin(X, Y)
Add Ptsin(0, 0)
Add Ptsin(Rad,0)
Do Gem
end
external routine Edwin Text alias "EDWIN_DD_TEXT" -
(integer SX, SY, byte name Ch)
integer Len = C Length(Ch)
integer function Physical Width(byte name Ch)
Gem Command(Inquire Text Extent)
Add String(Ch)
Do Gem
result = Pts Out(4)
end
Flush Environment
if Ch = Extents Flag start
Ch == Byte(Addr(Ch)+1)
Len = Len-1
Char X = 0
cycle
Char X = Char X+Physical Width(Ch)
exit unless Len > Max Ints
Ch == Byte(Addr(Ch)+Max Ints)
Len = Len-Max Ints
repeat
else
cycle
Gem Command(Text)
Add Ptsin(SX, SY)
Add String(Ch)
Do Gem
exit unless Len > Max Ints
Ch == Byte(Addr(Ch)+Max Ints)
SX = SX + Physical Width(Ch)
Len = Len-Max Ints
repeat
finish
end
external routine Edwin Char Size alias "EDWIN_DD_CHAR"(integer Size)
return unless Variable Char Size = 1
Current_Char Size = (Size*Screen Aspect Ratio)//100
end
external routine Edwin Line Style alias "EDWIN_DD_STYLE"(integer Style)
Current_Line Style = Style
end
external routine Edwin Colour alias "EDWIN_DD_COL"(integer Colour)
Current_Colour = Colour
end
external routine Edwin Mode alias "EDWIN_DD_MODE"(integer Mode)
Current_Raster Op = Mode
end
external routine Edwin Fill alias "EDWIN_DD_FILL"(integer Mode)
Current_Fill Mode = Mode
end
routine Get Input(integer name State, X, Y, integer Req)
own integer Last X = 500, Last Y = 400, Last Button = 0
integer Key
signal 14, 6 if Current Device # Screen Device
Flush Line
Cursor Status(Show Cursor)
cycle
Key = Top Of Buffer {read type ahead before looking for new stuff}
Key = BDos(Dos Fn Direct Console IO, 255) if Key < 0
if Key = Escape Char start
Int Flag = 1
Key = 0
finish
Gem Command(Sample Mouse Button State)
Do Gem
Key = 1 if Last Button = 0 and Int Out(0) # 0
Last Button = Int Out(0)
repeat until Key # 0 or Req = 0
Last X = Pts Out(0)
Last Y = Pts Out(1)
State = Key {input from the keyboard}
State = 4 if Int Out(0) = 1 {left button}
State = 1 if Int Out(0) = 2 {middle button}
State = 2 if Int Out(0) = 4 {right button}
X = Last X
Y = Win Y-Last Y
end
external routine Sample alias "EDWIN___B_SAM"(integer name state,x,y)
Get Input(State, X, Y, 0)
end
external routine Cursor alias "EDWIN___B_REQ"(integer name state,x,y)
Get Input(State, X, Y, 1)
end
external routine edwin term alias "EDWIN_DD_TERM"
record(Int Regs Fm) Regs=0
short mouse segment,mouse offset
return if initialised edwin=0
flush line
gem command(close workstation)
do gem
if prev dev=0 start
initialised edwin=0
prev dev=0
prev handle=0
gem_contrl_handle=0
current device=0
Regs_Ah <- Dos Fn Force a Duplicate of a Handle
Regs_Bx <- screen file descriptor
Regs_Cx <- 1
Int86(Dos Int Function Request,Regs)
else
current device=prev dev
prev dev=0
gem_contrl_handle=prev handle
prev handle=0
!
! put back all the old defaults
!
gem command(extended inquire)
add intin(0) ;! get the open workstation values
do gem
Winx=intout(0)
Winy=intout(1)
real colours=intout(13)
current_char size=0
mouse addr=prev mouse addr
fr86(mouse addr,original byte,1)
screen aspect ratio=prev screen size
finish
end
{##############################################}
{# #}
{# SCRDRIVE package support #}
{# #}
{##############################################}
own integer Graphics Mode = 0
own integer Graphics Offset = 0
external routine Set Up Scrdrive alias "SET_SCRD"
Edwin Fill(1)
Cur X = 0
Cur Y = 0
Max X = (Win X//Char X) - 1
Max X = 250 if Max X > 250
Max Y = (Win Y//CharY) - 1
Max Y = 250 if Max Y > 250
Graphics Offset = (Char Y//10) + 1
end
external routine Init Screen alias "InitScreen"(integer X, Y)
! ignore parameters to begin with. May contain data about window
! sizing and positioning
!
Edwin Initialise(Cur X, Cur Y, 'D')
Set Up Scrdrive
end
external routine Kill Window alias "KillWindow"
Edwin Term
Initialised Edwin = 0
end
external integer function TT Get alias "TTGet"
integer Char
Char = Top Of Buffer
Char = BDos(Dos Fn Console Input Without Echo, 0) if Char < 0
result = US if Char = 0
result = Char
end
external integer function X TT Get alias "EDWIN_SCREEN_TTGET"
result = TT Get
end
external routine Move To alias "MoveTo"(integer X, Y)
if X > Max X then X = Max X else if X < 0 then X = 0
if Y > Max Y then Y = Max Y else if Y < 0 then Y = 0
Cur X = X
Cur Y = Y
end
external routine X Move To alias "SCR_MOVE_TO"(integer X, Y)
Move To(X, Y)
end
external routine Down Line alias "DownLine"
Cur Y = Cur Y+1 if Cur Y < Max Y
end
external routine Up Line alias "UpLine"
Cur Y = Cur Y-1 if Cur Y > 0
end
external routine Home alias "Home"
Cur X = 0
Cur Y = 0
end
routine Graphic Chars(byte name C String)
integer C Ptr, End X
routine Vertical Line(integer X, Y)
X = X*Char X + Char X//2
Y = Y*Char Y
Edwin Line(X, Y+Graphics Offset, X, Y+Char Y-Graphics Offset)
end
routine Glitch(integer X, Y)
X = X*Char X + Char X//2
Y = (Y+1)*Char Y
Edwin Line(X, Y-Graphics Offset, X, Y-Char Y//2)
end
return if Graphics Mode = 0
if C Length(C String) < 2 start
End X = (Cur X+1)*Char X {Overwriting current cursor position}
else
End X = Win X {Overwriting to end of line}
finish
Edwin Mode(Replace Mode)
Edwin Colour(Background Col)
Edwin Rectangle(Cur X*Char X, Cur Y*Char Y + (Graphics Offset-1),
End X, (Cur Y+1)*Char Y - (Graphics Offset-1))
Edwin Colour(Foreground col)
Edwin Line(Cur X*Char X, Cur Y*Char Y + Char Y//2,
End X, Cur Y*Char Y + Char Y//2)
C Ptr = Addr(C String)
cycle
if C String = 'w' start
Glitch(Cur X, Cur Y)
else if C String # 'q'
Vertical Line(Cur X, Cur Y)
finish
C Ptr = C Ptr+1
Cur X = Cur X+1
C String == Byte(C Ptr)
repeat until C String = 0
end
external routine TT String alias "TTString"(byte name s)
integer a=addr(s),i=addr(s),j
integer len=clength(s)
integer sx=cur x*char x
integer sy=(cur y+1)*char y-OffY
Flush Environment
Gem Command(Set Writing Mode)
Add Intin(1) {make sure it's replace mode}
Do Gem
if Graphics Mode=1 and not ('a'<=s<='z') start
! not graphics characters, so print them out
a=a+1 while not ('a'<=byte(a)<='z')
!
! print out the characters
!
gem command(text)
add ptsin(sx,sy)
add intin(byte(j)) for j=i,1,a
do gem
curx=curx+a-i
Graphic Chars(byte(a))
else if Graphics Mode=1
Graphic Chars(s)
else
Edwin Colour(Text Col)
Edwin Text(sx,sy,s)
move to(curx+len,cury)
finish
end
external routine TT Put alias "TTPut"(integer x)
byte array cstr(0:1)
if x=8 start {backspace}
move to(curx-1,cury) if CurX>0
return
finish
cstr(0)=x
cstr(1)=0
ttstring(cstr(0))
end
external routine XTTPut alias "TTPUT"(integer X)
TT Put(X)
end
routine Scr Cursor
integer x,y
x=cur x*char x
y=(cur y+1)*char y
Edwin Fill(1)
Edwin Mode(4)
Edwin Rectangle(x,y,x+letterx,y-chary)
Edwin Mode(Replace Mode)
end
external routine Draw Cursor alias "DrawCursor"
Scr Cursor
end
external routine Delete Cursor alias "DeleteCursor"
Scr Cursor
end
external routine Rectangle alias "Rectangle"(integer X, Y, W, H)
record(Environment Fm) Copy = Current
Edwin Mode(Replace Mode)
Edwin Fill(4)
Edwin Colour(Foreground Col)
Edwin Rectangle(X, Y+Off Y, X+W-1, Y+Off Y+H)
Current = Copy
end
external routine Draw Line alias "DrawLine"(integer X, Y, X1, Y1)
record(Environment Fm) Copy = Current
Edwin Mode(Replace Mode)
Edwin Fill(1)
Edwin Colour(Foreground Col)
Edwin Line(X, Y+Off Y, X1, Y1+Off Y)
Current = Copy
end
routine Draw Dotted Line (integer X, Y1, Y2, Style)
record(Environment Fm) Copy = Current
Edwin Line Style(Style)
Edwin Mode(3)
Edwin Line(X, Y1+Off Y, X, Y2+Off Y)
Edwin Update
Current = Copy
end
external routine Draw Cursor Line alias "Draw_C_L"(integer X, Y1, Y2)
Draw Dotted Line(X, Y1, Y2, 4)
end
external routine Draw Marker Line alias "Draw_M_L"(integer X, Y1, Y2)
Draw Dotted Line(X, Y1, Y2, 3)
end
external routine Flush Output alias "FlushOutput"
Edwin Update
end
external routine Clear Screen alias "ClearScreen"
Edwin Clear
end
routine Clear Space(integer Y1, Y2)
record(Environment Fm) Copy = Current
Edwin Fill(1)
Edwin Colour(Background Col)
Edwin Mode(Replace Mode)
Edwin Rectangle(0, Y1*Char Y, Win X, Y2*Char Y)
Current = Copy
end
external routine Clear Line alias "ClearLine"
Clear Space(Cur Y, Cur Y+1)
end
external routine Scroll alias "Scroll"(integer LLn, HLn, By)
record(Environment Fm) Copy = Current
integer Erase Line
Gem Command(Copy Raster Opaque)
Gem_Contrl_C(7) <- MFDB Log & 16_FFFF
Gem_Contrl_C(8) <- MFDB Log >> 16
Gem_Contrl_C(9) <- MFDB Log & 16_FFFF
Gem_Contrl_C(10) <- MFDB Log >> 16
Add Intin(3) {Replace what is there}
HLn = HLn+1
if By < 0 start
Add Ptsin(0, (LLn-By)*Char Y)
Add Ptsin(Win X, HLn*Char Y)
Add Ptsin(0, LLn*Char Y)
Add Ptsin(Win X, (HLn+By)*Char Y)
Erase Line = HLn
else
Add Ptsin(0, LLn*Char Y)
Add Ptsin(Win X, (HLn-By)*Char Y)
Add Ptsin(0, (LLn+By)*Char Y)
Add Ptsin(Win X, HLn*Char Y)
Erase Line = LLn
finish
Do Gem
Clear Space(Erase Line, Erase Line+By)
Edwin Colour(ForegroundCol)
end
external routine Scroll Up alias "ScrollUp"(integer N)
Scroll(0, Max Y, -N)
end
external routine Scroll Down alias "ScrollDown"(integer N)
Scroll(0, Max Y, N)
end
external routine Set Intensity alias "SetIntensity"(integer LoHi)
own integer Highlight = 0,
Hold Colour,
Foregroundsave,
Textsave
return if LoHi = Highlight
Highlight = LoHi
Gem Command(Set Graphic Text Special Effects)
Add Intin(LoHi)
Do Gem
if LoHi = 1 start
Hold Colour = Current_Colour
Edwin Colour(Highlight Col)
Foregroundsave = ForeGroundCol
Textsave = TextCol
TextCol = HighlightCol
ForeGroundCol = HighlightCol
else
Edwin Colour(Hold Colour)
ForeGroundCol = Foregroundsave
TextCol = Textsave
finish
end
external routine X Set Intensity alias "SCR_SET_INTENSITY"(integer LoHi)
Set Intensity(LoHi)
end
external routine Set Graphics alias "SetGraphics"(integer Mode)
Graphics Mode = Mode
end
! Revision:
! Rev 1 11/11/86 UJ 1) Proportionally spaced text is now
! produced by this device driver. A
! software font is now used in place
! of the original, fixed font.
! 2) Text sizing is carried out to the
! nearest multiple of the basic text
! size. The sizing info. is held in
! /lbin/llenv.d, in LL_CHAR_HEIGHT.
! Rev 2 18/11/86 UJ The fill paterns produced by this
! driver can be the standard Versatec
! patterns if the Env variable
! LL_POLY_FILL exists. If it names a file
! containing 14 16x16 bitmaps arranged as
! 16 integers, then this will be used to
! define the fill patterns.
! Rev 3 UJ EDWIN line drawing routine modified so
! that individual lines are compiled into
! polylines in order to save on metafile
! space.
! Rev 4 UJ Character sizing can be varied through
! EDWIN if the environmental variable
! <filename>_VAR_CHAR_SIZE exists. Initial
! character size is set with the variable
! <filename)_CHAR_SIZE. If the proportional
! text is not wanted, the variable
! <filename>_FIXED_FONT should exist.
! Rev 4 UJ The environmental variables RED___INTENSITY
! GREEN_INTENSITY and BLUE__INTENSITY define
! the colour map for the device. Digit values
! should be 0-3.
! Rev 5 UJ Whole module tidied up in order to speed
! up execution and reduce code size.
! Rev 6 23/06/88 IRG Added routine Draw Marker Line
!
! Rev 7 5/08/88 AET Added code for colour control
! Rev 8 20/oct/88 JGH Removed minimium char size test
! Removed suppression of variable line styles
! Rev 9 16/Jan/89 JGH Fixed code for Sample, no longer same as REQ!
end of file