! EDWIN driver for the BBC Macro (native mode)
from Edwin include Device
from Edwin include Icodes
record format Point fm (integer x, y)
const integer MAX IN BUF = 35
own integer BBC MODE = 2
! Mode 0 = 640 x 256 @ 2 cols
! Mode 1 = 320 x 256 @ 4 cols
! Mode 2 = 160 x 256 @ 16 cols
! Screen information
own integer SX = 0
own integer SY = 0
own integer XL = 0
own integer XR = 1279; !Right hand side of device window
own integer YB = 0
own integer YT = 1023
own integer VIS = 0; !0 if CVP inside VW
own integer OMODE = 0 { Overwrite mode
own integer CCOL = 7 { White as Current Colour
routine SWAP (integer name A, B)
integer C
C = A; A = B; B = C
end
routine COORDS (integer X, Y)
TTPUT (X&255)
TTPUT ((X>>8)&255)
TTPUT (Y&255)
TTPUT ((Y>>8)&255)
end
routine PLOT (integer COM, X, Y)
TTPUT (25)
TTPUT (COM)
COORDS (X, Y)
end
routine DO COLOUR
TTPUT (18)
TTPUT (OMODE)
CCol = 1 if BBC Mode = 0 and CCol > 1
TTPUT (CCOL)
end
external routine Set Mode alias "EDWIN_BBC_MODE" (integer MODE)
BBC MODE = MODE & 7
end
routine spec initialise cursor ; ! the thing that starts up the trackerball
routine spec reset interrupt vector
constant integer dev call = 1, cursor call = 2
own integer last call = dev call
routine set xor
ttput(18) ; ttput(3) ; ttput(7)
end
routine XOR Cursor(integer X,Y)
const short array X Arm ( 1: 4 ) = -30, 30, 0, 0
const short array Y Arm ( 1: 4 ) = 0, 0, -30, 30
integer I
for I = 1, 1, 4 cycle
Plot(4,X,Y)
Plot(1,X Arm(I),Y Arm(I))
repeat
Flush Output
end
own integer last x = -1, last y = -1
routine line (integer x1, y1, x2, y2)
plot (4, x1, y1); plot (5, x2, y2)
end
routine triangle (integer x1, y1, x2, y2, x3, y3)
PLOT (84, x1, y1)
PLOT (84, x2, y2)
PLOT (85, x3, y3)
end
routine FILL (integer xl, yb, xr, yt)
SWAP (xl, xr) if xl > xr
SWAP (yb, yt) if yb > yt
xr = xr + 1 if xr = xl
yt = yt + 1 if yt = yb
TTPUT (24); COORDS (xl, yb); COORDS (xr, yt)
TTPUT (18); TTPUT (OMODE); TTPUT (128 + CCOL)
TTPUT (16) { Clear }
DO COLOUR
TTPUT (26)
end
external routine BBC alias "EDWIN___B" (integer COM, X, Y)
const integer array COLMAP (0:7) = 0 { black } ,
7 { white } ,
4 { blue } ,
2 { green } ,
1 { red } ,
5 { magenta } ,
3 { yellow } ,
6 { cyan }
own integer WX, WY, Nlines = 0, Lmode=0
record format Data Fm (record (point fm) p, record (Data Fm) name Next)
own record (Data fm) name Point List == 0
own record (Data fm) name Next point == 0
switch SW (0:MAX COM)
include "Polyfill.abc"
routine draw lines
record (Data fm) name PP
record (point fm) array pts (1:nlines+1)
integer i
return if Point List == Nil
if nlines <= 1 start
Line (point list_p_x, point list_p_y,
point list_p_x, point list_p_y)
else if nlines = 2
Line (point list_p_x, point list_p_y,
point list_next_p_x, point list_next_p_y)
else
pp == point list
for I = 1, 1, Nlines cycle
pts(i) = pp_p
pp == pp_next
repeat
nlines = nlines + 1
pts(nlines) = pts(1)
POLY fill (nlines, Pts)
finish
nlines = 0
end
routine circle(integer x, y, r)
integer d, e, s, da, db, dda, ddb, odb, odda, oddb
e = 1
s = 0
while e<r cycle
e = e<<1
s = s+1
repeat
d = e>>1
da = r<<s-d
dda = r
db = d
ddb = 0
cycle
odda = dda
oddb = ddb
cycle
odb = db
db = db+da>>s
da = da-odb>>s
dda = da>>s
repeat until odda#dda
ddb = db>>s
line(x-ddb,y+odda,x+ddb,y+odda)
fill(x-odda,y+oddb,x+odda,y+ddb)
fill(x-odda,y-oddb,x+odda,y-ddb)
line(x-ddb,y-odda,x+ddb,y-odda)
repeat until db>=da
end
constant integer char com = 6
own integer last com = 0
if last call = cursor call start
xor cursor(last x,last y)
do colour
last call = dev call
finish
draw lines if nlines # 0 and (com = 10 or COM < 5)
if last com = char com and com # char com start
last com = com
plot(4, SX, SY)
ttput(4)
! restore cursor to correct position
else if com # char com
last com = com
finish
-> SW(COM)
SW(0): ! Initialise
! Valid numbers are 16_BBC, 16_BBC0, 16_BBC1, 16_BBC2
BBC MODE = X & 15
BBC MODE = 0 unless 0<=BBC MODE<=2
Point List == New (point list)
point List_next == Nil
DEV DATA_NAME = "an Acorn workstation"
DEV DATA_DVX = 1279
DEV DATA_DVY = 1023
DEV DATA_MVX = 1279
DEV DATA_MVY = 1023
DEV DATA_MAX COLOUR = 7
TTPUT (22); TTPUT (BBC MODE)
TTPUT (23); TTPUT(1); TTPUT(0); TTPUT(0); TTPUT(0); TTPUT(0); TTPUT(0);
TTPUT (0); TTPUT(0); TTPUT(0) ; !turn cursor off (IGF)
CCOL = 7
OMODE = 0
LMODE = 0
DO COLOUR
initialise cursor
return
SW(1): ! Terminate
TTPUT (22)
TTPUT (0)
TTPUT (23); TTPUT(1); TTPUT(1); TTPUT(0); TTPUT(0); TTPUT(0); TTPUT(0);
TTPUT (0); TTPUT(0); TTPUT(0) ; !turn cursor back on again (IGF)
FLUSH OUTPUT
reset interrupt vector
return
SW(2): ! Update
FLUSH OUTPUT
return
SW(3): ! Newframe
TTPUT (22); TTPUT (BBC MODE)
return
SW(4): ! Move
PLOT (COM, X, Y)
SX = X; SY = Y
return
SW(5): ! Line
if Lmode >= 0 start
PLOT (COM+LMODE, X, Y)
else
if Nlines = 0 start
point list_p_x = sx; point list_p_y = sy
Next point == point list
Nlines = 1
finish
return if x=sx and y=sy
Nlines = Nlines + 1
if Next point_next == Nil start
Next point_next == New (Next point)
Next point == Next point_next
Next point_next == Nil
else
Next point == next point_next
finish
next point_p_x = x; next point_p_y = y
finish
SX = X; SY = Y
return
SW(6): ! Char
! Move to the bottom of the character by adding 32 to Y
plot (4, sx, sy+32)
ttput (5); ttput (x); ttput(4)
sx = sx + 16
plot (4, sx, sy)
return
SW(7): ! Attribute
if x=att colour start
if 0<=Y<=7 start
CCOL = COL MAP (Y)
else
CCOL = 7
finish
DO COLOUR
finish else if x=att line style start
if y=1 start
LMODE = 16
else
LMODE = 0
finish
finish else if x=att colour mode start
! y=0 => Replace
! y=1 => Or { EDWIN Uses 2 }
! y=2 => And { EDWIN Uses 1 }
! y=3 => Xor
! y=4 => Invert
if 0<=y<=4 start
if y=1 or y=2 start
y = y !! 3 { swap 1 & 2 }
finish
OMODE = y
else
OMODE = 0
finish
DO COLOUR
finish
return
SW(8): ! Lower window bounds
XL = X; YB = Y
return
SW(9): ! Upper window bounds
XR = X; YT = Y
return
SW(10): ! Line modes
if X=2 start { Point plot only }
LMODE = 64
else if X=3
LMODE = -1
else
LMODE = 0
finish
return
SW(11): ! Overwrite mode (old entry point)
Y = X; X = att colour mode; -> sw(7)
SW(12): ! Remember lower box bounds
WX = X; WY = Y
return
SW(13): ! Upper box bounds & do the 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.
Fill (wx, wy, x, y)
return
SW(14): ! Circle
circle (sx, sy, x)
return
SW(15): ! Area fill
triangle (integer (y), integer (y+4),
integer (y+8), integer (y+12),
integer (y+16), integer (y+20))
if x=4 start
triangle (integer (y+16), integer (y+20),
integer (y+24), integer (y+28),
integer (y), integer (y+4))
finish
! %for com = 1, 1, x*2 %cycle
! write (integer(y), 1)
! y = y + 4
! %repeat
! newline
SW(*):
end
!**************************************************************************
! The above bit is host independent, the following is for networked hosts,
! using the BBC as a terminal, and then follows the code for using the BBC
! when a 32016 processor is connected.
!
!**************************************************************************
!
! REMOTE HOST SPECS:
!%external %routine Sample %alias "EDWIN___B_SAM" (%integer %name i,x,y)
! %signal 14, 8
!%end
!
!%external %routine Cursor %alias "EDWIN___B_REQ" ( %integername Char, X, Y )
! %signal 14, 8
!%end
!%end %of %file
!**************************************************************************
!
! 32016 SPECS:
external routine draw dots alias "EDWIN_DRAW_DOTS" (integer lx,ly,hx,hy,gap)
integer dummy omode = omode, dummy ccol = ccol
integer i,j,k,lx1,ly1,hx1,hy1
from edwin include specs
routine draw vertical lines
lx1 = lx ; ly1 = ly
map to device coords(lx1,ly1)
hx1 = hx ; hy1 = hy
map to device coords(hx1,hy1)
i = lx
while i <= hx cycle
j = i ; ly1 = ly
map to device coords(j,ly1)
line(j,ly1,j,hy1)
i = i + gap
repeat
end
! do vertical lines
ccol = 1
omode = 0
do colour
draw vertical lines
!
! now do horizontal lines in black
!
i = ly
ccol = 0
do colour
while i <= hy cycle
j = i ; lx1 = lx
map to device coords(lx1,j)
line(lx1,j,hx1,j)
i = i + gap
! j = i + 1 ; lx1 = lx
! map to device coords(lx1,j)
! i = i + gap
! k = i - 1 ; hx1 = hx
! map to device coords(hx1,k)
! k = k - 1; j = j + 1
! fill(lx1,j,hx1,k)
repeat
!
! now invert the vertical lines
!
omode = 4
do colour
draw vertical lines
omode = dummy omode
ccol = dummy ccol
do colour
end
constant integer tkbyte = 6
constant integer TK word = 7
record format iop fm (integer ad,byte v)
constant integer assemble address = 16_2F00
constant integer reset address = 16_2FA1
constant integer max 6502 = 179
constant integer array code 6502 (0 : 179) = -
{2F00} 16_4C, 16_C, 16_2F, 16_0, 16_0, 16_0, 16_0, 16_7, 16_0,
{2F09} 16_0, 16_0, 16_0, 16_78, 16_AD, 16_5, 16_2, 16_C9,
{2F11} 16_C0, 16_90, 16_1D, 16_8D, 16_9, 16_2F, 16_AD, 16_4,
{2F19} 16_2, 16_8D, 16_8, 16_2F, 16_A9, 16_33, 16_8D, 16_4,
{2F21} 16_2, 16_A9, 16_2F, 16_8D, 16_5, 16_2, 16_A9, 16_98,
{2F29} 16_8D, 16_6E, 16_FE, 16_A9, 16_0, 16_8D, 16_62, 16_FE,
{2F31} 16_58, 16_60, 16_8A, 16_48, 16_AD, 16_6D, 16_FE, 16_29,
{2F39} 16_18, 16_D0, 16_6, 16_68, 16_A5, 16_FC, 16_6C, 16_8,
{2F41} 16_2F, 16_AE, 16_60, 16_FE, 16_48, 16_29, 16_10, 16_F0,
{2F49} 16_1D, 16_8A, 16_29, 16_8, 16_F0, 16_B, 16_EE, 16_3,
{2F51} 16_2F, 16_D0, 16_13, 16_EE, 16_4, 16_2F, 16_4C, 16_67,
{2F59} 16_2F, 16_CE, 16_3, 16_2F, 16_AD, 16_3, 16_2F, 16_C9,
{2F61} 16_FF, 16_D0, 16_3, 16_CE, 16_4, 16_2F, 16_68, 16_29,
{2F69} 16_8, 16_F0, 16_1D, 16_8A, 16_29, 16_10, 16_F0, 16_B,
{2F71} 16_EE, 16_5, 16_2F, 16_D0, 16_13, 16_EE, 16_6, 16_2F,
{2F79} 16_4C, 16_89, 16_2F, 16_CE, 16_5, 16_2F, 16_AD, 16_5,
{2F81} 16_2F, 16_C9, 16_FF, 16_D0, 16_3, 16_CE, 16_6, 16_2F,
{2F89} 16_68, 16_AA, 16_A5, 16_FC, 16_40, 16_48, 16_8, 16_C9,
{2F91} 16_4, 16_D0, 16_8, 16_AD, 16_60, 16_FE, 16_29, 16_7,
{2F99} 16_8D, 16_7, 16_2F, 16_28, 16_68, 16_6C, 16_A, 16_2F,
{2FA1} 16_A9, 16_0, 16_8D, 16_6E, 16_FE, 16_AD, 16_8, 16_2F,
{2FA9} 16_8D, 16_4, 16_2, 16_AD, 16_9, 16_2F, 16_8D, 16_5,
{2FB1} 16_2, 16_60, 16_0
byte fn read io(integer ad)
record(iop fm) io
io_ad = ad
* addr _ io,2
* movqd _ #5,1
* svc _ #TK word
result = io_v
end
routine write io(integer ad,byte v)
record(iop fm) io
io_ad = ad
io_v = v
* addr _ io,2
* movqd _ #6,1
* svc _ #TK word
end
routine osbyte {Call OB2 With R} ( integer Which, integer name X, Y )
* MovD _ Which, 1
* MovD _ 0(X), 2
* MovD _ 0(Y), 3
* Svc _ #TK Byte
* MovZBD _ 2, 0(X)
* MovZBD _ 3, 0(Y)
end
own integer char = 0
!
! >> Try <<
!
! Try and extract a character from the given buffer
!
predicate Try ( integer Buff )
integer z
! zero for the keyboard
* MovD _ # 16_91, 1
* MovD _ Buff, 2
{H}* MovQD _ #0, 3
* SVC _ # TK BYTE
!H!* BCS _ No
* MOVZBD _ 3, z
char = z
{H}false if Char = 0
Char = Char&127 if Buff # 0
true
end
routine dump 6502 code
integer i
for i = 0,1,max 6502 cycle
write io(assemble address + i,code 6502(i))
repeat
end
routine initialise cursor
integer i = 0,j = 0
dump 6502 code
write io(16_0200,assemble address & 16_FF)
write io(16_0201,(assemble address >> 8) & 16_FF) {set up user vector to
{point to init code
osbyte(16_88,i,j) {execute initialise code in BBC micro}
end
routine reset interrupt vector
integer i = 0, j = 0
write io(16_0200,reset address & 16_FF)
write io(16_0201,(reset address >> 8) & 16_FF)
osbyte (16_88,i,j) {execute reset code in BBC micro}
end
own integer joy stick = 1
external routine joystick present alias "BBC_JOYSTICK" ( integer joy)
joy stick = joy if 0 <= joy <= 1
end
constant integer x addr = 16_2F03,
y addr = 16_2F05,
button addr = 16_FE60 {user VIA Port B}
routine cursor keys(integer name i,x,y)
const byte array X Inc {offset by 1} ( 16_88: 16_8B ) = 0, 2, 1, 1
const byte array Y Inc {offset by 1} ( 16_88: 16_8B ) = 1, 1, 0, 2
integer Scaler
scaler = 2 ;! slow movement unless the cursor is down
if try(0) and char <= 127 then i = char
if 16_98+4 <= Char <= 16_9B+4 then Char = Char-4
if 16_98 <= Char <= 16_9B start
Scaler = 15 ; Char = Char-16
finish
if 16_88+4 <= Char <= 16_8B+4 then Char = Char-4
if 16_88 <= Char <= 16_8B start
X = X + (X Inc(Char) - 1)*Scaler
Y = Y + (Y Inc(Char) - 1)*Scaler
x = rem(x + 1280,1280) ; y = rem(y + 1032,1032)
if joystick = 1 start
write io(x addr,x & 255)
write io(x addr + 1,(x >> 8) & 255)
write io(y addr,y & 255)
write io(y addr + 1,(y >> 8) & 255)
finish
finish
!
! draw the cross
!
if last call = dev call start
set xor
last call = cursor call
xor cursor(last x,last y) ;! draw in the original position
finish
if last x # x or last y # y start
! refresh only if necessary
xor cursor(last x,last y) ;! draw off the old position
xor cursor(x,y) ;! draw on the new position
last x = x ; last y = y
finish
end
external routine cursor alias "EDWIN___B_SAM" (integer name i,x,y)
byte b,b1
constant integer array convert buttons(1:4) = 4,1,3,2
short a
if joystick = 1 start
!
! get the cursor position
!
select output(0)
b = read io(x addr)
b1 = read io(x addr + 1)
a = (b1 << 8) ! b
x = a ;! convert from short to long integer
!
! Do wrap round stuff
!
if x > 1280 start
write io (x addr,0)
write io (x addr+1,0)
x = 0
finish
if x < 0 start
write io (x addr,16_FF)
write io (x addr+1,16_04)
x=1279
finish
b = read io(y addr)
b1 = read io(y addr + 1)
a = (b1 << 8) ! b
y = a
if y > 1024 start
write io (y addr,0)
write io (y addr+1,0)
y = 0
finish
if y < 0 start
write io (y addr,16_FF)
write io (y addr+1,16_03)
y=1024
finish
!
! get buttons
!
b = ¬(read io(button addr)) & 7
i = b
i = convert buttons(i) if 1 <= i <= 4 ; ! change value from acorn to wc no
finish
cursor keys(i,x,y)
end
external routine BC alias "EDWIN___B_REQ" ( integername Char, X, Y )
X = SX; Y = SY
BBC (4, SX, SY)
Flush OUTPUT
char = 0
cycle
if joystick = 1 start
cursor(char,x,y)
else
cursor keys(char,x,y)
finish
exit if 0 < Char <= 127
repeat
SX = X ; SY = Y ; last x = x ; last y = y
end
end of file