get "bcpl.head"
//outgoing procedures
external
[InitDisplay
ResetDisplay
ShowButton
RemoveButton
SetDisplayMode
GetButtonHit
GetRectangle
]
//display modes
manifest
[LowBank = 0
HighBank = 1
TextDisplay = 2
]
//incoming procedures
external [ BitBlt]
static
[RectBLT;ButtonBLT;SaveBLT;
Buttons;ButtonX;ButtonY;
SavedButtons;Screen;SavedDCB
DisplayLen=800
]
manifest
[MouseX = #424
MouseY = #425
MouseButtons = #177030
EmulatorBank = #177740
DWTBank = #177751
Red = 4
Yellow = 1
Blue = 2
]
structure BBTable :
[unused1bit 10
srcaltbit
destaltbit
sourcetypebit 2
operationbit 2
unusedword
dbcaword
dbmrword
dlxword
dtyword
dwword
dhword
sbcaword
sbmrword
slxword
styword
gray0word
gray1word
gray2word
gray3word
]
let InitDisplay() be
[Screen=GetFixed(38*DisplayLen+5)
Screen=Screen+(Screen&1)
SavedDCB=@#420
Screen!0=0
Screen!1=38
Screen!2=Screen+4
Screen!3=DisplayLen/2
Screen=Screen+4
RectBLT = GetFixed((size BBTable/16)*3+1)
if RectBLT eq 0 then CallSwat("memory overflow")
RectBLT=RectBLT+(RectBLT&1)
ButtonBLT = RectBLT+(size BBTable)/16
SaveBLT = ButtonBLT+(size BBTable)/16
RectBLT>>BBTable.unused1 = 0
RectBLT>>BBTable.srcalt = false
RectBLT>>BBTable.destalt = true
RectBLT>>BBTable.sourcetype = 3//gray block
RectBLT>>BBTable.operation = 2//invert
RectBLT>>BBTable.unused = 0
RectBLT>>BBTable.dbca = Screen
RectBLT>>BBTable.dbmr = 38
RectBLT>>BBTable.gray0 = -1
RectBLT>>BBTable.gray1 = -1
RectBLT>>BBTable.gray2 = -1
RectBLT>>BBTable.gray3 = -1
ResetDisplay()
ButtonBLT>>BBTable.unused1 = 0
ButtonBLT>>BBTable.srcalt = false
ButtonBLT>>BBTable.destalt = true
ButtonBLT>>BBTable.sourcetype = 0//bitmap
ButtonBLT>>BBTable.operation = 0//replace
ButtonBLT>>BBTable.unused = 0
ButtonBLT>>BBTable.dbca = Screen
ButtonBLT>>BBTable.dbmr = 38
ButtonBLT>>BBTable.dw = 64
ButtonBLT>>BBTable.dh = 64
ButtonBLT>>BBTable.sbmr = 4
ButtonBLT>>BBTable.slx = 0
ButtonBLT>>BBTable.sty = 0
SaveBLT>>BBTable.unused1 = 0
SaveBLT>>BBTable.srcalt = true
SaveBLT>>BBTable.destalt = false
SaveBLT>>BBTable.sourcetype = 0//bitmap
SaveBLT>>BBTable.operation = 0//replace
SaveBLT>>BBTable.unused = 0
SaveBLT>>BBTable.sbca = Screen
SaveBLT>>BBTable.sbmr = 38
SaveBLT>>BBTable.dw = 64
SaveBLT>>BBTable.dh = 64
SaveBLT>>BBTable.dbmr = 4
SaveBLT>>BBTable.dlx = 0
SaveBLT>>BBTable.dty = 0
InitButtons()
ShowButton(0,64,700)
ShowButton(1,128,700)
ShowButton(2,192,700)
ShowButton(3,256,700)
ShowButton(4,384,700)
@#420=Screen-4
]
and XorBox(xStart,yStart,xEnd,yEnd) be
[RectBLT>>BBTable.dlx = xStart
RectBLT>>BBTable.dty = yEnd
RectBLT>>BBTable.dw = xEnd-xStart
RectBLT>>BBTable.dh = 1
BitBlt(RectBLT)
RectBLT>>BBTable.dty = yStart
BitBlt(RectBLT)
RectBLT>>BBTable.dw = 1
RectBLT>>BBTable.dh = yEnd-yStart
BitBlt(RectBLT)
RectBLT>>BBTable.dlx = xEnd
BitBlt(RectBLT)
]
and ResetDisplay() be
[RectBLT>>BBTable.dlx = 0
RectBLT>>BBTable.dty = 0
RectBLT>>BBTable.dw = 608
RectBLT>>BBTable.dh = DisplayLen
RectBLT>>BBTable.operation = 3 //erase
BitBlt(RectBLT)//zero one bank
@EmulatorBank = @EmulatorBank xor 1
BitBlt(RectBLT)//zero other bank
@EmulatorBank = @EmulatorBank xor 1
RectBLT>>BBTable.operation = 2 //invert
]
and SetDisplayMode(mode) be
[switchon mode into
[case LowBank:
Screen!-4 = 0
Screen!-1 = 404
@EmulatorBank = 0
@DWTBank = 0
endcase
case HighBank:
Screen!-4 = 0
Screen!-1 = 404
@EmulatorBank = 1
@DWTBank = 4
endcase
case TextDisplay:
Screen!-4 = SavedDCB
Screen!-1 = 350
@EmulatorBank = 0
@DWTBank = 0
endcase
]
]
and ShowButton(number,x,y;numargs na) be
[switchon na into
[case 1: x = (ButtonX!number)𒿑
case 2: y = ButtonY!number
default: endcase
]
SaveBLT>>BBTable.slx = x
SaveBLT>>BBTable.sty = y
SaveBLT>>BBTable.dbca = SavedButtons!number
BitBlt(SaveBLT)
ButtonBLT>>BBTable.dlx = x
ButtonBLT>>BBTable.dty = y
ButtonBLT>>BBTable.sbca = Buttons!number
BitBlt(ButtonBLT)
ButtonX!number = x
ButtonY!number = y
]
and RemoveButton(number) be
[if ButtonX!number ls 0 then return//not displayed
ButtonBLT>>BBTable.dlx = ButtonX!number
ButtonBLT>>BBTable.dty = ButtonY!number
ButtonBLT>>BBTable.sbca = SavedButtons!number
BitBlt(ButtonBLT)
ButtonX!number = (ButtonX!number) % #100000
]
and GetButtonHit() = valof
[let rslt = -1
for i=0 to 4 do ShowButton(i)
while Endofs(keys) do
[for i=0 to 4 do
[let x=ButtonX!i
if x ls 0 then loop
let y=ButtonY!i
ButtonBLT>>BBTable.dlx = x
ButtonBLT>>BBTable.dty = y
ButtonBLT>>BBTable.sbca = Buttons!i
ButtonBLT>>BBTable.sourcetype = 1//complement source
while (@MouseX ge x)&(@MouseX le (x+64))&
(@MouseY ge y)&(@MouseY le (y+64))&Endofs(keys) do
[BitBlt(ButtonBLT)
if (@MouseButtons&7) ne 7 then
[until (@MouseButtons&7) eq 7 do [ ]
rslt=i;break
]
]
ButtonBLT>>BBTable.sourcetype = 0//normal
BitBlt(ButtonBLT)
if rslt ge 0 then resultis rslt
] //for all buttons
] //until key hit
resultis -1
]
and GetRectangle(rect) be
[while (@MouseButtons&7) eq 7 do [ ]
let xStart=@MouseX;let yStart=@MouseY
let xEnd=xStart+1;let yEnd=yStart+1
until (@MouseButtons&Blue) eq 0 do
[XorBox(xStart,yStart,xEnd,yEnd)
XorBox(xStart,yStart,xEnd,yEnd)
if (@MouseButtons&Red) eq 0 then //change box size
[let x=@MouseX;let y=@MouseY
test x gr xStart then xEnd=x or xStart=x
test y gr yStart then yEnd=y or yStart=y
]
if (@MouseButtons&Yellow) eq 0 then //move box
[let dx=@MouseX-xStart;let dy=@MouseY-yStart
xStart=xStart+dx;yStart=yStart+dy
xEnd=xEnd+dx;yEnd=yEnd+dy
]
unless Endofs(keys) do break
]
rect!0=xStart;rect!1=yStart
rect!2=xEnd;rect!3=yEnd
]
and InitButtons() be
[Buttons=Allocate(sysZone,5*4+5*64*4)
ButtonX=Buttons+5
ButtonY=ButtonX+5
SavedButtons=ButtonY+5
SavedButtons!0=SavedButtons+5
SavedButtons!1=SavedButtons!0+64*4
SavedButtons!2=SavedButtons!1+64*4
SavedButtons!3=SavedButtons!2+64*4
SavedButtons!4=SavedButtons!3+64*4
Buttons!0 = table
[0;0;0;0
32767;-1;-1;-2;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
22015;-1;-1;-170;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;16128;0;426;
21888;24960;0;342;
27264;24960;0;426;
21888;24591;7743;342;
27264;15385;-19655;-32342;
21888;1840;1841;-32426;
27264;-15952;7985;-32342;
21888;-15952;13105;-32426;
27264;24985;-19663;-32342;
21888;16143;8113;-32426;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27391;-1;-1;-86;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
32767;-1;-1;-2;
0;0;0;0
]
Buttons!1 = table
[0;0;0;0
32767;-1;-1;-2;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
22015;-1;-1;-170;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27267;-512;0;426;
21888;1536;0;342;
27264;3072;0;426;
21888;6204;7742;-7850;
27264;12390;13115;-20054;
21888;24771;25011;12630;
27264;-16189;25011;12714;
21889;-32573;25011;12630;
27267;102;13107;12714;
21891;-452;7731;12630;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27391;-1;-1;-86;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
32767;-1;-1;-2;
0;0;0;0
]
Buttons!2 = table
[0;0;0;0
32767;-1;-1;-2;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
22015;-1;-1;-170;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27267;-2048;0;426;
21891;3072;0;-16042;
27267;3072;0;-15958;
21891;3184;-1935;-3754;
27267;-1831;-29480;-15958;
21891;3469;-32372;-16042;
27267;3580;-1540;-15958;
21891;3456;3456;-16042;
27267;3277;-29492;-15958;
21891;3192;-1928;29014;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;16256;0;426;
21888;12480;0;342;
27264;12480;0;426;
21888;12510;3982;342;
27264;12531;7067;426;
21888;16263;12721;-32426;
27264;12319;12735;-32342;
21888;12339;12720;342;
27264;12339;7065;-32342;
21888;12319;-28785;342;
27264;0;384;426;
21888;0;12672;342;
27264;0;7936;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27391;-1;-1;-86;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
32767;-1;-1;-2;
0;0;0;0
]
Buttons!3 = table
[0;0;0;0
32767;-1;-1;-2;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
22015;-1;-1;-170;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;14432;0;426;
21888;15456;0;342;
27264;15456;0;426;
21888;13923;-29492;342;
27264;13926;-13108;426;
21888;13164;26616;342;
27264;13167;-6152;426;
21888;12780;2040;342;
27264;12774;25392;426;
21888;12515;-15568;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;8128;0;426;
21888;6240;0;342;
27264;6240;0;426;
21888;6255;1991;342;
27264;6265;-29235;-32342;
21888;8131;-26408;-16042;
27264;6159;-26401;-15958;
21888;6169;-26408;342;
27264;6169;-29236;-15958;
21888;6159;-14393;-32426;
27264;0;192;426;
21888;0;6336;342;
27264;0;3968;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27391;-1;-1;-86;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
32767;-1;-1;-2;
0;0;0;0
]
Buttons!4 = table
[0;0;0;0
32767;-1;-1;-2;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
22015;-1;-1;-170;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;384;342;
27264;28672;0;-15958;
21888;-9273;7580;-16042;
27264;29549;-16970;-15958;
21888;7023;-20066;-16042;
27264;-9364;15798;-15958;
21888;29639;-25186;-16042;
27264;768;0;426;
21888;768;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;3072;342;
27388;0;-16384;426;
21985;-18545;-4889;-24746;
27385;-18466;-12873;-9814;
21985;-18728;-12874;-8362;
27361;-18722;-12874;-14422;
21984;-2354;-4890;-8362;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27264;0;0;426;
21888;0;0;342;
27391;-1;-1;-86;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
21845;21845;21845;21846;
27306;-21846;-21846;-21846;
32767;-1;-1;-2;
0;0;0;0
]
]