-
Notifications
You must be signed in to change notification settings - Fork 0
/
sped_reformat.bas
709 lines (709 loc) · 31.4 KB
/
sped_reformat.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
10 REM Sprite editor for the Agon Light and Console 8 by Assif (robogeekoid)
11 REM NOTE: Requires VDP version 2.0.0+ for the bitmap backed sprite function
12 REM Thanks to discord user eightbitswide for the joystick code
15 VERSION$="v0.15"
20 ON ERROR GOTO 10000
25 DIM graphics 1024 : REM memory for file load
27 MB%=&40000
30 MODE 8
35 ISEXIT=0 : SW%=320 : SH%=240
37 REM ----- config in sped.ini -----
40 CONFIG_SIZE=1 : CONFIG_JOY=0 : CONFIG_TYPE=0
42 CONFIG_JOYDELAY=20
44 DIM FEXT$(3) : FEXT$(1)=".rgb" : FEXT$(2)=".rgba" : FEXT$(2)=".dat"
50 PROCconfig("sped.ini")
52 IF CONFIG_SIZE=2 THEN W%=8 : H%=8 ELSE W%=16 : H%=16
55 REM --------------------------------
57 GRIDX%=8 : GRIDY%=16 : REM Grid position
60 GRIDCOL%=8 : CURSCOL%=15
65 SCBOXX%=170 : SCBOXY%=148 : REM shortcut box pos
70 DIM CL%(64) : DIM RGB%(64*3) : DIM REVLU%(64) : PROCloadLUT
75 DIM BSTAB%(3,3) : PROCloadBitshiftTable
80 PALX%=8 : PALY%=146 : PALW%=16 : PALH%=4 : REM palette x/y,w/h
82 COL%=1 : REM selected palette colour
84 PX%=0 : PY%=0 : REM position
86 BFstate%=0 : DIM BFrect%(4) : REM block fill
100 DIM KEYG(4), KEYP(4) : REM in order left, right, up down
105 KEY_SET=32 : KEY_DEL=127 : PROCsetkeys
110 FLINE%=24 : REM FLINE is line on which filename appears
115 F$=STRING$(20," ")
120 DIM SKey%(9) : FOR I%=0 TO 9 : SKey%=-1 : NEXT I%
130 REM multi-bitmap sprite setup
135 NumBitmaps% = 7 : BM% = 0 : REM current bitmap
140 NSF% = 1 : SF%=0 : REM Number of sprite frames and current frame
144 SpriteDelay%=10 : Ctr%=SpriteDelay%
146 LoopType%=0 : REM 0=left to right loop, 1=ping-pong
148 LoopDir%=1
150 REM Calc positions of sprite frame frames
155 SPX%=150 : SPY%=18 : REM sprite x/y position on screen
157 BBOXX%=150 : BBOXY%=42 : REM top-left of bitmap boxes
160 DIM BMX%(NumBitmaps%), BMY%(NumBitmaps%)
165 FOR I%=0 TO NumBitmaps%-1 : BMX%(I%)=BBOXX% + 24*I% : BMY%(I%)=BBOXY% : NEXT
170 REM declare data for grid
175 DIM G%(W%*H%, NumBitmaps%)
180 PROCdrawScreen
182 COLOUR 15 : PRINT TAB(12,FLINE%);"LOADING";
185 PROCcreateSprite(W%,H%)
190 FOR B%=0 TO NumBitmaps%-1
195 FOR I%=0 TO W%*H%-1 : G%(I%, B%)=0 : NEXT I%
200 NEXT B%
210 FOR B%=0 TO NumBitmaps%-1 : PROCupdateBitmapFromGrid(B%) : NEXT
220 REM PROCupdateScreenGrid(BM%)
230 COLOUR 15 : PRINT TAB(12,FLINE%);" ";
240 REM Main Loop
250 REPEAT
260 key=INKEY(0)
265 IF CONFIG_JOY=1 JOY=GET(158) : BUTTON=GET(162) ELSE JOY=0 : BUTTON=0
267 IF CONFIG_JOY=0 AND key=-1 GOTO 600
270 IF key=-1 AND JOY=255 AND BUTTON=247 GOTO 600 : REM skip to Until
280 PROCgridCursor(0) : PROCblockCursor(0)
290 IF key = ASC("x") OR key=ASC("X") ISEXIT=1 : REM x=exit
295 IF ISEXIT=1 THEN yn$=FNinputStr("Are you sure (y/N)"): IF yn$<>"Y" AND yn$<>"y" THEN ISEXIT=0
300 REM grid cursor movement
310 IF key = KEYG(0) AND PX%>0 THEN PX%=PX%-1 : REM left
320 IF key = KEYG(1) AND PX%<(W%-1) THEN PX%=PX%+1 : REM right
330 IF key = KEYG(2) AND PY%>0 THEN PY%=PY%-1 : REM up
340 IF key = KEYG(3) AND PY%<(H%-1) THEN PY%=PY%+1 : REM down
341 REM joystick movement
342 IF JOY>0 AND (JOY AND 223)=JOY AND PX%>0 THEN PX%=PX%-1 : TIME=0: REPEATUNTILTIME>CONFIG_JOYDELAY : REM LEFT
343 IF JOY>0 AND (JOY AND 127)=JOY AND PX%<(W%-1) THEN PX%=PX%+1 : TIME=0: REPEATUNTILTIME>CONFIG_JOYDELAY : REM RIGHT
344 IF JOY>0 AND (JOY AND 253)=JOY AND PY%>0 THEN PY%=PY%-1 : TIME=0 : REPEATUNTILTIME>CONFIG_JOYDELAY : REM UP
345 IF JOY>0 AND (JOY AND 247)=JOY AND PY%<(H%-1) THEN PY%=PY%+1 : TIME=0 : REPEATUNTILTIME>CONFIG_JOYDELAY :REM DOWN
350 REM colour select movement
360 IF (key = KEYP(0) OR key=KEYP(0)-32) AND COL%>0 THEN PROCselectPaletteCol(COL%-1) : REM left
370 IF (key = KEYP(1) OR key=KEYP(1)-32) AND COL%<63 THEN PROCselectPaletteCol(COL%+1) : REM right
380 IF (key = KEYP(2) OR key=KEYP(2)-32) AND COL%>(PALW%-1) THEN PROCselectPaletteCol(COL%-PALW%) : REM up
390 IF (key = KEYP(3) OR key=KEYP(3)-32) AND COL%<(63-PALW%) THEN PROCselectPaletteCol(COL%+PALW%) : REM down
400 REM space = set colour, backspace = delete (set to 0), f=fill to current col
410 IF key = 32 OR key = 13 THEN PROCsetCol(PX%,PY%,COL%)
415 IF BUTTON=215 THEN PROCsetCol(PX%,PY%,COL%)
420 IF key = 127 THEN PROCsetCol(PX%,PY%,0)
430 IF key = ASC("c") OR key=ASC("C") THEN PROCclearGrid(0, BM%)
440 IF key = ASC("f") OR key=ASC("F") THEN PROCclearGrid(COL%, BM%)
450 IF key = ASC("p") OR key=ASC("P") THEN PROCpickCol
455 IF key = ASC("b") OR key=ASC("B") THEN PROCblockFill
460 REM V=save L=load
470 IF key = ASC("l") OR key=ASC("L") THEN PROCloadSaveFile(0)
480 IF key = ASC("v") OR key=ASC("V") THEN PROCloadSaveFile(1) : REM V=saVe file
490 IF key = ASC("e") OR key = ASC("E") THEN PROCexport
495 REM M,N select bitmap
500 IF key = ASC("m") OR key=ASC("M") THEN BM%=(BM%+1) MOD NumBitmaps% : PROCdrawBitmapBoxes : PROCupdateScreenGrid(BM%)
510 IF key = ASC("n") OR key=ASC("N") THEN BM%=(BM%-1) : IF BM%<0 THEN BM%=NumBitmaps%-1
520 IF key = ASC("n") OR key=ASC("N") THEN PROCdrawBitmapBoxes : PROCupdateScreenGrid(BM%)
530 IF key = ASC("k") OR key=ASC("K") THEN PROCsetShortcutKey
535 REM Palette shortcut key, frames select and Loop/cycle type
540 IF key >= ASC("1") AND key <= ASC("9") THEN IF SKey%(key-48)>=0 THEN PROCselectPaletteCol(SKey%(key-48))
550 IF key = ASC("r") OR key = ASC("R") THEN PROCsetFrames
560 IF key = ASC("o") OR key = ASC("O") THEN PROCtoggleLoopType
565 IF key = ASC("i") OR key = ASC("I") THEN PROCsetLoopSpeed
570 PROCshowFilename("")
580 PROCgridCursor(1) : PROCblockCursor(1)
600 REM Nokey GOTO comes here
610 PROCshowSprite
620 UNTIL ISEXIT = 1
630 GOTO 10000
695 END
699 REM ------ Static Screen Update Functions ---------------
700 DEF PROCprintTitle
705 COLOUR 54:PRINT TAB(0,0);"SPRITE EDITOR";
710 COLOUR 20:PRINT TAB(14,0);"for the Agon ";
715 COLOUR 8:PRINT TAB(35,0);VERSION$;
720 GCOL 0,15 : MOVE 0,10 : DRAW 320,10
730 ENDPROC
750 DEF PROCdrawScreen
751 REM draw screen - titles, instructions.
755 LOCAL I%
760 CLS : VDU 23,0,192,0 : REM turn off logical screen scaling
765 VDU 23, 1, 0 : REM disable text cursor
770 PROCdrawGrid(W%,H%,GRIDX%,GRIDY%)
772 PROCdrawPalette(PALX%,PALY%)
774 PROCselectPaletteCol(COL%)
776 PROCgridCursor(1)
778 PROCdrawBitmapBoxes
779 PROCsetupChars
780 PROCprintTitle
782 PROCprintHelp
784 PROCshowFilename("")
786 COLOUR 15
795 ENDPROC
800 DEF PROCprintHelp
810 GCOL 0,15 : MOVE 0,26*8-4 : DRAW 320,26*8-4
820 COLOUR 21 : PRINT TAB(0,26);"Cursor"; :COLOUR 19:PRINT TAB(7,26);"Move";
830 COLOUR 21 : PRINT TAB(0,27);"WASD "; :COLOUR 19:PRINT TAB(7,27);"Colour";
840 COLOUR 21 : PRINT TAB(0 ,28);"Space"; :COLOUR 19:PRINT TAB(7,28);"Set";
850 COLOUR 21 : PRINT TAB(0, 29);"Backsp";:COLOUR 19:PRINT TAB(7,29);"Unset";
855 COLOUR 21 : PRINT TAB(16,26);"B"; :COLOUR 19:PRINT TAB(18,26);"Block fill";
860 COLOUR 21 : PRINT TAB(16,27);"P"; :COLOUR 19:PRINT TAB(18,27);"Pick";
870 COLOUR 21 : PRINT TAB(16,28);"F"; :COLOUR 19:PRINT TAB(18,28);"Fill";
880 COLOUR 21 : PRINT TAB(16,29);"C"; :COLOUR 19:PRINT TAB(18,29);"Clear";
890 COLOUR 21 : PRINT TAB(29,26);"X"; :COLOUR 19:PRINT TAB(32,26);"eXit";
900 COLOUR 21 : PRINT TAB(29,27);"V"; :COLOUR 19:PRINT TAB(32,27);"saVe";
910 COLOUR 21 : PRINT TAB(29,28);"L"; :COLOUR 19:PRINT TAB(32,28);"Load";
920 COLOUR 21 : PRINT TAB(29,29);"E"; :COLOUR 19:PRINT TAB(32,29);"Export";
930 COLOUR 7 : FOR I%=1 TO 9 : PRINT TAB((SCBOXX% DIV 8) -1 +I%*2,SCBOXY% DIV 8 +1 );I% : NEXT
940 COLOUR 8 : PRINT TAB((SCBOXX% DIV 8) +1,SCBOXY% DIV 8 +4);"Shortcut K=set";
950 PROCrect(SCBOXX%, SCBOXY%-2,16*9,39,7)
960 COLOUR 21 : PRINT TAB(19,10);"N M"; :COLOUR 19:PRINT TAB(23,10);"Select bitmap";
970 COLOUR 21 : PRINT TAB(19,11);"R"; :COLOUR 19:PRINT TAB(23,11);"Num frames";
975 COLOUR 21 : PRINT TAB(19,12);"O"; :COLOUR 19:PRINT TAB(23,12);"Loop type";
977 COLOUR 54 : PRINT TAB(38,12);CHR$(240)
980 COLOUR 21 : PRINT TAB(19,13);"I"; :COLOUR 19:PRINT TAB(23,13);"Loop speed";
995 ENDPROC
1000 DEF PROCdrawGrid(w%,h%,x%,y%)
1010 REM drawgrid in GRIDCOL%
1020 GCOL 0,GRIDCOL%
1030 FOR Y%=0 TO h%
1040 PLOT 4, x%, y%+Y%*8
1045 PLOT 5, x%+w%*8, y%+Y%*8
1050 NEXT Y%
1060 FOR X%=0 TO w%
1070 PLOT 4, x%+X%*8, y%
1075 PLOT 5, x%+X%*8, y%+h%*8
1080 NEXT
1090 ENDPROC
1100 DEF PROCdrawBitmapBoxes
1105 REM bitmap boxes, highlight selected
1110 FOR S%=0 TO NumBitmaps%-1
1120 IF S% = BM% THEN gc%=CURSCOL% ELSE gc%=GRIDCOL%
1130 PROCrect(BMX%(S%)-2, BMY%(S%)-2, W%+3, H%+3, gc%)
1135 IF S% < NSF% THEN COLOUR 1 ELSE COLOUR 8
1140 PRINT TAB(1+(BBOXX% DIV 8) + 3*S%, BBOXY% DIV 8 + 3);S%+1;
1150 NEXT
1155 ENDPROC
1160 DEF PROCsetkeys
1161 REM set the keys used for movment. Put in proc for future customisation opts
1170 KEYG(0)=8 : KEYG(1)=21 : KEYG(2)=11 : KEYG(3)=10
1180 KEYP(0)=97 : KEYP(1)=100 : KEYP(2)=119 : KEYP(3)=115
1190 ENDPROC
1200 DEF PROCdrawPalette(x%,y%)
1205 REM draw palette colours - I% across, J% down
1210 LOCAL I%,J%, C%
1215 C%=0
1220 FOR J%=0 TO PALH%-1
1230 FOR I%=0 TO PALW%-1
1240 PROCfilledRect(1+x%+I%*10,1+y%+J%*10,6,6,C%)
1245 C%=C%+1
1250 NEXT I%
1260 NEXT J%
1270 ENDPROC
1300 DEF PROCselectPaletteCol(c%)
1310 REM select colour in palette - move the white select box
1315 REM unselect previous colour
1320 x% = COL% MOD PALW% : y% = COL% DIV PALW% : REM horizontal
1330 PROCrect(PALX%+x%*10, PALY%+y%*10, 8, 8, 0)
1335 REM select new colour
1340 COL%=c%
1350 x% = COL% MOD PALW% : y% = COL% DIV PALW% : REM horizontal
1360 PROCrect(PALX%+x%*10, PALY%+y%*10, 8, 8, 15)
1365 PROCprintColour(27,2)
1370 ENDPROC
1400 DEF PROCpickCol
1410 LOCAL col%
1420 col% = G%(PX%+PY%*W%, BM%)
1430 PROCselectPaletteCol(col%)
1440 ENDPROC
1450 DEF PROCgridCursor(switch%)
1455 REM draw gridcursor
1460 LOCAL col%
1465 IF BFstate%>0 THEN ENDPROC
1470 col%=GRIDCOL% : REM off
1480 IF switch%=1 THEN col%=CURSCOL% : REM on
1490 PROCrect(GRIDX%+PX%*8, GRIDY%+PY%*8, 8, 8, col%)
1495 ENDPROC
1500 DEF PROCprintColour(x%,y%)
1505 REM print colour
1510 LOCAL clu%
1520 clu%=CL%(COL%)
1530 PRINT TAB(x%,y%);SPC(6);
1540 COLOUR 15: PRINT TAB(x%,y%);"COL ";COL%;
1565 REM hex
1570 COLOUR 9 : PRINT TAB(x%+7,y%);"00";
1572 COLOUR 9 : PRINT TAB(x%+7,y%);~RGB%(clu%*3);
1575 COLOUR 10: PRINT TAB(x%+9,y%);"00";
1577 COLOUR 10: PRINT TAB(x%+9,y%);~RGB%(1+clu%*3);
1580 COLOUR 12: PRINT TAB(x%+11,y%);"00";
1582 COLOUR 12: PRINT TAB(x%+11,y%);~RGB%(2+clu%*3);
1585 COLOUR 15
1590 ENDPROC
1599 REM ------ Grid/Bitmap Update Functions -----------------
1600 :
1602 REM SCREEN Grid DATA Grid Bitmap Sprite
1604 REM SetCol --> update --> update --> refresh
1605 REM update <-- Load/Clear --> update --> refresh
1650 DEF PROCsetCol(x%,y%,c%)
1655 REM set colour in screen grid AND Data Grid G%
1660 G%(x%+y%*W%, BM%)=c%
1670 PROCfilledRect(1+GRIDX%+x%*8, 1+GRIDY%+y%*8, 6, 6, c%)
1680 PROCupdateBitmapPixel(BM%, x%, y%, c%)
1690 ENDPROC
1700 DEF PROCclearGrid(col%, bmap%)
1701 REM clear grid to a colour (Screen and Data Grids)
1702 REM update of bitmap must be done separately
1710 LOCAL i%, j%
1720 FOR i%=0 TO W%-1
1725 FOR j%=0 TO H%-1
1730 G%(i%+j%*W%, bmap%)=col%
1735 NEXT j%
1740 NEXT i%
1745 REM fast clear all cells
1750 PROCfilledRect(GRIDX%,GRIDY%, W%*8,H%*8,col%)
1760 PROCdrawGrid(W%,H%,GRIDX%,GRIDY%)
1770 PROCupdateBitmapFromGrid(bmap%)
1790 ENDPROC
1800 DEF PROCupdateScreenGrid(bmap%)
1801 REM Update the screen grid from data grid G%() for given bitmap
1805 LOCAL col%
1810 FOR I%=0 TO W%*H%-1
1820 col%=G%(I%, bmap%)
1830 x%=I% MOD W% : y%=I% DIV W%
1840 PROCfilledRect(1+GRIDX%+x%*8, 1+GRIDY%+y%*8, 6, 6, col%)
1850 NEXT I%
1890 ENDPROC
1900 DEF PROCupdateBitmapFromGrid(bmap%)
1905 REM update bitmap from its data drid
1906 REM TODO speed up - use memory and precomputed lookup?
1910 LOCAL clu%
1920 VDU 23,27,0,bmap% : REM Select bitmap n
1924 REM Use Adjust Buffer API
1925 VDU 23,0,&A0,bmap%+&FA00;5,&C2,0;W%*H%*4;
1930 FOR I%=0 TO W%*H%-1
1935 clu%=CL%(G%(I%, bmap%)) : REM lookup RGB index
1940 VDU RGB%(clu%*3), RGB%(clu%*3+1), RGB%(clu%*3+2), 255
1945 NEXT
1950 PROCupdateSpriteBitmap(bmap%)
1990 ENDPROC
2000 DEF PROCupdateBitmapPixel(bmap%, x%, y%, c%)
2005 REM update a single bitmap pixel
2010 LOCAL clu%
2020 VDU 23,27,0,bmap% : REM Select bitmap n
2025 REM Use Adjust Buffer API
2030 VDU 23,0,&A0,bmap%+&FA00;5,&C2,(x%+y%*W%)*4;4;
2040 clu%=CL%(c%) : REM lookup RGB index
2050 VDU RGB%(clu%*3), RGB%(clu%*3+1), RGB%(clu%*3+2), 255
2060 PROCupdateSpriteBitmap(bmap%)
2090 ENDPROC
2099 REM ------ Sprite Functions -----------------------------
2100 DEF PROCcreateSprite(w%,h%)
2102 REM setup the sprite and bitmap. Clear both grids
2105 LOCAL B%
2110 FOR B%=0 TO NumBitmaps%-1
2115 VDU 23,27,0,B% : REM Select bitmap bmnum%
2120 VDU 23,27,2,w%;h%;0;0; : REM create empty (black) bitmap
2125 NEXT B%
2130 VDU 23,27,4,0 : REM Select sprite 0
2135 VDU 23,27,5 : REM Clear frames for current sprite
2140 FOR B%=0 TO NumBitmaps%-1
2145 VDU 23,27,6,B% : REM Add bitmap n as a frame of sprite
2150 NEXT B%
2160 VDU 23,27,11 : REM Show the sprite
2165 VDU 23,27,7,1 : REM activate 1 sprite
2170 VDU 23,27,13,SPX%; SPY%; : REM display sprite
2190 ENDPROC
2200 DEF PROCupdateSpriteBitmap(bmap%)
2205 REM display bitmap and update sprite with bitmap
2210 VDU 23,27,0,bmap%
2220 VDU 23,27,3,BMX%(bmap%);BMY%(bmap%); : REM draw bitmap
2230 VDU 23,27,15: REM Refresh the sprites
2240 ENDPROC
2250 DEF PROCtoggleLoopType
2252 REM loop type : 0=left to right loop, 1=ping-pong
2254 LoopType%=1-LoopType% : LoopDir%=1 : SF%=0
2256 COLOUR 54 : PRINT TAB(38,12);CHR$(240+LoopType%)
2260 ENDPROC
2270 DEF PROCsetLoopSpeed
2275 LS=FNinputInt("Loop Speed (1-99)")
2280 IF LS>0 AND LS<100 THEN SpriteDelay%=LS
2290 ENDPROC
2300 DEF PROCshowSprite
2305 REM show sprite animation
2307 REM update frame number every SpriteDelay% screen refreshes
2308 REM loop type : 0=left to right loop, 1=ping-pong
2310 Ctr% = Ctr% - 1
2320 IF Ctr%=0 THEN SF%=SF%+LoopDir%
2322 IF Ctr%=0 AND LoopType%=0 AND SF%=NSF% THEN SF%=0
2324 IF Ctr%=0 AND LoopType%=1 AND (SF%=NSF%-1 OR SF%=0) THEN LoopDir%=LoopDir% * -1
2328 IF Ctr%=0 THEN Ctr%=SpriteDelay%
2330 VDU 23,27,10,SF% : REM select frame
2340 *FX 19 : REM wait for refresh
2345 VDU 23,27,15 : REM update sprites
2390 ENDPROC
2399 REM ------ Set shortcut keys, Frames etc. ----------------
2400 DEF PROCsetShortcutKey
2410 K = FNinputInt("Shortcut (1-9):")
2430 IF K >= 1 AND K <= 9 THEN SKey%(K) = COL% : PROCfilledRect(SCBOXX%+K*16-10,SCBOXY%+14,6,6,COL%)
2490 ENDPROC
2500 DEF PROCsetFrames
2510 K = FNinputInt("Num Frames to Show:")
2530 IF K >= 1 AND K <= NumBitmaps% THEN NSF%=K : SF%=0
2540 PROCdrawBitmapBoxes
2550 ENDPROC
2999 REM ------ File Handling --------------------------------
3000 DEF PROCshowFilename(fn$)
3005 REM just display filename in status bar
3010 GCOL 0,15 : MOVE 0,FLINE%*8-4 : DRAW 320,FLINE%*8-4
3020 PRINT TAB(0,FLINE%);SPC(40);
3030 COLOUR 31 : PRINT TAB(0,FLINE%);"FILE:";TAB(6,FLINE%);fn$;
3090 ENDPROC
3100 DEF PROCloadSaveFile(SV%)
3105 REM ask for a filename and load/save the data in RGB raw format with no headers
3106 REM ask if they want to load/save multiple frames
3110 fmt% = FNinputInt("Format 1)RGB888 2)RGBA8888 3)RGBA2222")
3120 IF fmt%<1 OR fmt%>3 THEN ENDPROC
3130 yn$ = FNinputStr("Multiple Frames (y/N)")
3140 IF yn$ = "y" OR yn$ = "Y" THEN PROCmultiple(SV%, fmt%) : ENDPROC
3150 F$ = FNinputStr("Enter filename:")
3160 IF SV%=1 THEN PROCsaveDataFile(F$, BM%, fmt%) ELSE PROCloadDataFile(F$, BM%, fmt%)
3170 PROCshowFilename(F$)
3190 ENDPROC
3200 DEF PROCmultiple(SV%, fmt%)
3205 LOCAL Prefix$, NumFrames%, N%
3210 Prefix$ = FNinputStr("Enter prefix:")
3220 NumFrames% = FNinputInt("Enter num frames:")
3240 IF NumFrames% <1 OR NumFrames% > NumBitmaps% THEN COLOUR 1 : PRINT TAB(32,FLINE%);"Invalid" : ENDPROC
3250 FOR N%=0 TO NumFrames%-1
3255 @%=&01000202
3260 F$ = Prefix$ + STR$(N%+1) + FEXT$(fmt%)
3265 @%=&90A
3270 COLOUR 7 : PRINT TAB(22,FLINE%);F$;
3275 IF SV%=1 THEN PROCsaveDataFile(F$, N%, fmt%) ELSE PROCloadDataFile(F$, N%, fmt%)
3280 NEXT N%
3284 BM%=0 : PROCdrawBitmapBoxes
3286 IF SV%=0 THEN BM%=0 : PROCupdateScreenGrid(BM%) : NSF%=NumFrames% : SF%=0 : PROCdrawBitmapBoxes
3290 ENDPROC
3300 DEF PROCloadDataFile(f$, b%, fmt%)
3301 REM this loads file to internal memory and copies it out to the sprite
3302 LOCAL col%, I%, IND%
3305 PROCshowFilename(f$)
3310 FHAN%=OPENIN(f$)
3315 IF FHAN% = 0 THEN COLOUR 1:PRINT TAB(32,FLINE%);"No file"; : ENDPROC
3320 IF fmt%=1 sz%=(W%*H%*3)
3321 IF fmt%=2 sz%=(W%*H%*4)
3322 IF fmt%=3 sz%=(W%*H%*1)
3325 FLEN%=EXT#FHAN% : IF FLEN%<>sz% THEN COLOUR 1:PRINT TAB(32,FLINE%);"Invalid";: CLOSE#FHAN%: ENDPROC
3330 COLOUR 10:PRINT TAB(36,FLINE%);"ok";
3335 CLOSE#FHAN%
3340 LSTR$="LOAD " + f$ + " " + STR$(MB%+graphics)
3345 OSCLI(LSTR$) : PRINT TAB(24,FLINE%);"LOADED";
3350 IF fmt%=1 THEN PROCloadDataFile8bit(f$, b%, 0)
3355 IF fmt%=2 THEN PROCloadDataFile8bit(f$, b%, 1)
3360 IF fmt%=3 THEN PROCloadDataFile2bit(f$, b%)
3365 PRINT TAB(24,FLINE%);"COPIED";
3370 PROCdrawGrid(W%,H%,GRIDX%,GRIDY%)
3380 PROCupdateBitmapFromGrid(b%)
3390 ENDPROC
3400 DEF PROCloadDataFile8bit(f$, b%, alpha%)
3405 IF alpha%=1 THEN datw%=4 ELSE datw%=3
3410 FOR I%=0 TO (W%*H%)-1
3420 DATR% = ?(graphics+I%*datw%+0) DIV 85
3425 DATG% = ?(graphics+I%*datw%+1) DIV 85
3430 DATB% = ?(graphics+I%*datw%+2) DIV 85
3440 IND% = DATR% * 16 + DATG% * 4 + DATB% : REM RGB colour as index
3450 col% = REVLU%(IND%) : REM Reverse lookup of RGB colour to BBC Colour code
3460 G%(I%, b%) = col% : x%=I% MOD W% : y%=I% DIV W%
3465 PROCfilledRect(1+GRIDX%+x%*8, 1+GRIDY%+y%*8, 6, 6, col%)
3470 NEXT I%
3490 ENDPROC
3500 DEF PROCloadDataFile2bit(f$, b%)
3510 FOR I%=0 TO (W%*H%)-1
3520 DATR% = ?(graphics+I%) AND &03
3525 DATG% = (?(graphics+I%) AND &0C) DIV 4
3530 DATB% = (?(graphics+I%) AND &30) DIV 16
3540 IND% = DATR% * 16 + DATG% * 4 + DATB% : REM RGB colour as index
3550 col% = REVLU%(IND%) : REM Reverse lookup of RGB colour to BBC Colour code
3560 G%(I%, b%) = col% : x%=I% MOD W% : y%=I% DIV W%
3565 PROCfilledRect(1+GRIDX%+x%*8, 1+GRIDY%+y%*8, 6, 6, col%)
3570 NEXT I%
3590 ENDPROC
3650 DEF PROCsaveDataFile(f$, b%, fmt%)
3660 IF fmt%=1 THEN PROCsaveDataFile8bit(f$, b%, 0)
3670 IF fmt%=2 THEN PROCsaveDataFile8bit(f$, b%, 1)
3680 IF fmt%=3 THEN PROCsaveDataFile2bit(f$, b%)
3690 ENDPROC
3700 DEF PROCsaveDataFile8bit(f$, b%, alpha%)
3701 REM save raw data to a file. RGB or RGBA 8bit format with no header.
3705 LOCAL I%, RGBIndex%, h%
3710 h% = OPENOUT(f$)
3720 FOR I%=0 TO (W%*H%)-1
3730 RGBIndex% = CL%(G%(I%, b%)) : REM lookup the RGB colour index for this colour
3740 BPUT#h%, RGB%(RGBIndex%*3)
3742 BPUT#h%, RGB%(RGBIndex%*3+1)
3744 BPUT#h%, RGB%(RGBIndex%*3+2)
3746 IF alpha%=1 THEN BPUT#h%, &FF
3750 NEXT
3760 CLOSE#h%
3790 ENDPROC
3800 DEF PROCsaveDataFile2bit(f$, b%)
3801 REM save raw data to a file. RGBA2222 format with no header.
3805 LOCAL I%, RGBIndex%, h%
3810 h% = OPENOUT(f$)
3820 FOR I%=0 TO (W%*H%)-1
3830 RGBIndex% = CL%(G%(I%, b%)) : REM lookup the RGB colour index for this colour
3832 DATR% = RGB%(RGBIndex%*3) AND &03
3834 DATG% = RGB%(RGBIndex%*3+1) AND &03
3836 DATB% = RGB%(RGBIndex%*3+2) AND &03
3840 out% = &C0 OR DATB%*16 OR DATG%*4 OR DATR%
3845 BPUT#h%, out%
3850 NEXT
3860 CLOSE#h%
3890 ENDPROC
3900 DEF PROCexportData8bit(f$, b%, ln%, alpha%)
3906 PPL%=8
3910 SS$=STRING$(250," ")
3915 SS$=STR$(ln%)+" REM "+f$+" "+STR$(W%)+"x"+STR$(H%)+" "
3920 IF alpha%=1 THEN SS$=SS$+" 4 bytes pp RGBA" ELSE SS$=SS$+" 3 bytes pp RGB"
3922 SS$=SS$+" bitmap num "+STR$(b%+1)
3925 ln%=ln%+10
3930 h% = OPENUP(f$) : IF h%=0 THEN h% = OPENOUT(f$) ELSE PTR#h%=EXT#h%
3935 FOR I%=0 TO (W%*H%)-1
3940 IF I% MOD PPL% = 0 THEN PROCprintFileLine(h%,SS$) : SS$=STR$(ln%)+" DATA " : ln%=ln%+10
3945 RGBIndex% = CL%(G%(I%, b%)) : REM lookup the RGB colour index for this colour
3950 FOR J%=0 TO 2
3955 IF RGB%(RGBIndex%*3+J%)=0 THEN SS$ = SS$+"0" ELSE SS$ = SS$+"&"+STR$~(RGB%(RGBIndex%*3+J%))
3960 IF J%<2 THEN SS$=SS$+","
3964 NEXT J%
3966 IF alpha%=1 THEN SS$=SS$+",&FF"
3970 IF I% MOD PPL% < (PPL%-1) THEN SS$=SS$+","
3975 NEXT I%
3980 PROCprintFileLine(h%, SS$)
3985 CLOSE#h%
3990 ENDPROC
4000 DEF PROCexportData2bit(f$,b%,ln%)
4002 LOCAL PIX%,PPL%,SS$,I%,J%,col%
4004 PIX%=0
4006 PPL%=16
4010 SS$=STRING$(250," ")
4015 SS$=STR$(ln%)+" REM "+f$+" "+STR$(W%)+"x"+STR$(H%)+" 1 byte pp RGBA2222"
4022 SS$=SS$+" bitmap num "+STR$(b%+1)
4025 ln%=ln%+10
4030 h% = OPENUP(f$) : IF h%=0 THEN h% = OPENOUT(f$) ELSE PTR#h%=EXT#h%
4035 FOR I%=0 TO (W%*H%)-1
4040 IF I% MOD PPL% = 0 THEN PROCprintFileLine(h%,SS$) : SS$=STR$(ln%)+" DATA " : ln%=ln%+10
4045 RGBIndex% = CL%(G%(I%, b%)) : REM lookup the RGB colour index for this colour
4047 PIX%=0
4050 FOR J%=0 TO 3
4055 col%=RGB%(RGBIndex%*3+J%) AND 3 : REM convert colour 8bit to 2 bit
4060 PIX%=PIX% OR BSTAB%(col%,J%) : REM bitshift colour and add to final value
4066 NEXT J%
4067 IF RGBIndex%>0 THEN PIX%=PIX% OR &C0 : REM alpha=1
4068 IF PIX%=0 THEN SS$=SS$+"0" ELSE SS$=SS$+"&"+STR$~(PIX%)
4070 IF I% MOD PPL% < (PPL%-1) THEN SS$=SS$+","
4075 NEXT I%
4080 PROCprintFileLine(h%, SS$)
4085 CLOSE#h%
4090 ENDPROC
4100 DEF PROCexport
4105 LOCAL frames% : frames%=1
4110 fmt% = FNinputInt("Format 1)RGB888 2)RGBA8888 3)RGBA2222")
4115 IF fmt%<1 OR fmt%>3 THEN ENDPROC
4120 yn$ = FNinputStr("Multiple Frames (y/N)")
4125 IF yn$ = "y" OR yn$ = "Y" THEN mult%=1 ELSE mult%=0
4130 IF mult%=1 THEN frames% = FNinputInt("Num frames")
4134 IF mult%=1 AND (frames%<1 OR frames%>NumBitmaps%) THEN COLOUR 1:PRINT TAB(32,FLINE%);"Invalid" : ENDPROC
4136 IF mult%=1 THEN bmfrm%=0 : bmto%=frames%-1 ELSE bmfrm%=BM% : bmto%=BM%
4140 F$ = FNinputStr("Enter filename:")
4145 IF F$ = "" THEN PROCshowFilename(F$) : ENDPROC
4150 Line% = FNinputInt("Line number:")
4160 FOR bmid%=bmfrm% TO bmto%
4165 COLOUR 10:PRINT TAB(32,FLINE%);"bm=";STR$(bmid%+1);
4170 IF fmt%=1 THEN PROCexportData8bit(F$, bmid%, Line%, 0): Line%=Line%+20*W%+10
4172 IF fmt%=2 THEN PROCexportData8bit(F$, bmid%, Line%, 1): Line%=Line%+20*W%+10
4174 IF fmt%=3 THEN PROCexportData2bit(F$,bmid%,Line%): Line%=Line%+10*W%+10
4180 NEXT bmid%
4182 COLOUR 10:PRINT TAB(36,FLINE%);"ok";
4185 PROCshowFilename(F$)
4190 ENDPROC
4200 DEF PROCprintFileLine(FH%, S$)
4210 REM dos line endings
4220 PRINT#FH%,S$ : BPUT#FH%,10
4230 ENDPROC
5000 REM ------- Generic Functions ------------
5005 REM PROCfilledRect draw a filled rectangle
5010 DEF PROCfilledRect(x%,y%,w%,h%,c%)
5011 REM assume screen scaling OFF
5012 REM update for basic 3.00, use 85 to plot a triangle, or 101 to plot a filled rect
5020 GCOL 0,c%
5030 MOVE x%,y%
5040 REM MOVE x%+w%,y% : PLOT 85, x%+w%, y%+h%
5050 REM MOVE x%, y%+h% : PLOT 85, x%, y%
5055 PLOT 101, x%+w%, y%+h%
5060 ENDPROC
5100 DEF PROCrect(x%,y%,w%,h%,c%)
5110 REM PROCrect draw a rectangle. assume screen scaling is OFF
5120 GCOL 0,c%
5130 MOVE x%,y%
5140 DRAW x%+w%,y%
5150 DRAW x%+w%, y%+h%
5160 DRAW x%, y%+h%
5170 DRAW x%, y%
5180 ENDPROC
5200 DEF FNinputStr(prompt$)
5210 PRINT TAB(0,FLINE%);SPC(40);
5220 COLOUR 31 : PRINT TAB(0,FLINE%);prompt$; : COLOUR 15 : INPUT s$
5230 =s$
5250 DEF FNinputInt(prompt$)
5260 PRINT TAB(0,FLINE%);SPC(40);
5270 COLOUR 31 : PRINT TAB(0,FLINE%);prompt$; : COLOUR 15 : INPUT i%
5280 =i%
5300 DEF PROCconfig(conf_file$)
5305 VDU 23,0,192,0,23,1,0
5310 PROCreadConfigFile(conf_file$)
5320 REPEAT
5322 ret%=FNdoconfig(conf_file$)
5324 CLS
5326 UNTIL ret%=1
5330 IF CONFIG_SIZE=2 THEN W%=8:H%=8 ELSE W%=16:H%=16
5335 ENDPROC
5340 DEF FNdoconfig(conf_file$)
5342 LOCAL in_str$, in_int%, l%
5344 PROCprintTitle : l%=4
5346 l%=FNprintConfig(l%) : l%=l%+1
5350 PRINT TAB(0,l%); :COLOUR 15: PRINT "C"; : COLOUR 21: PRINT" to configure, ";
5355 COLOUR 15:PRINT "RETURN";:COLOUR 21:PRINT" to continue.";:COLOUR 15: INPUT in_str$
5360 IF in_str$<>"c" AND in_str$<>"C" THEN =1
5365 l%=l%+2 : in_int%=FNinputOpts2(l%,"Sprite Size",1,"16x16","8x8")
5370 IF in_int%=2 THEN CONFIG_SIZE=2 ELSE CONFIG_SIZE=1
5375 l%=l%+1 : in_int%=FNinputOpts2(l%,"Joystick",2,"Yes","No")
5380 IF in_int%=1 THEN CONFIG_JOY=1 ELSE CONFIG_JOY=0
5385 l%=l%+2 : in_int%=FNinputOpts2(l%, "Type",1,"Bitmaps","Sprite sheet")
5390 IF in_int%=2 THEN CONFIG_TYPE=2 ELSE CONFIG_TYPE=1
5395 =0
5400 DEF FNprintConfig(line%)
5410 COLOUR 21: PRINT TAB(0,line%);"Sprite Size : "; : COLOUR 19
5420 IF CONFIG_SIZE=2 THEN PRINT "8x8" ELSE PRINT "16x16"
5425 line%=line%+1
5430 COLOUR 21: PRINT TAB(0,line%);"Joystick : "; : COLOUR 19
5440 IF CONFIG_JOY=1 THEN PRINT "Enabled" ELSE PRINT "Disabled"
5445 line%=line%+1
5450 IF CONFIG_JOY=1 THEN COLOUR 21 : PRINT "Joy Delay : ";:COLOUR 19 : PRINT ;CONFIG_JOYDELAY;: line%=line%+1
5460 COLOUR 21: PRINT TAB(0,line%);"Editing type : "; : COLOUR 19
5470 IF CONFIG_TYPE=2 THEN PRINT "Sprite Sheet" ELSE PRINT "Bitmaps"
5480 line%=line%+1
5490 =line%
5500 DEF PROCreadConfigFile(f$)
5510 ch%=OPENIN(f$)
5515 COLOUR 7 : PRINT TAB(0,2);f$;": "; : IF ch%=0 THEN COLOUR 9:PRINT "No file"; : ENDPROC
5520 REPEAT
5525 skip=0 : epos=0
5530 INPUT#ch%,s$
5535 IF MID$(s$,1,1)="#" skip=1
5540 IF skip=0 THEN r%=INSTR(s$,CHR$(&0A)) IF r%>0 THEN s$=MID$(s$,r%+1)
5545 IF skip=0 THEN epos=INSTR(s$,"=")
5550 IF skip=0 AND epos>0 THEN var$=MID$(s$,1,epos-1) : val$=MID$(s$,epos+1)
5555 IF skip=0 AND epos>0 THEN PROCsetConfigVar(var$, val$)
5560 UNTIL EOF#ch%
5585 CLOSE#ch%
5590 ENDPROC
5600 DEF PROCsetConfigVar(var$, val$)
5610 REM PRINT "VAR:";var$;" VAL:";val$
5620 IF var$="JOY" THEN CONFIG_JOY=VAL(val$)
5625 IF var$="SIZE" THEN CONFIG_SIZE=VAL(val$)
5630 IF var$="TYPE" THEN CONFIG_TYPE=VAL(val$)
5635 IF var$="JOYDELAY" THEN CONFIG_JOYDELAY=VAL(val$)
5640 IF var$="FEXT1" THEN FEXT$(1)=val$
5642 IF var$="FEXT2" THEN FEXT$(3)=val$
5644 IF var$="FEXT3" THEN FEXT$(3)=val$
5690 ENDPROC
5700 DEF FNinputOpts2(line%,base$,hili%,opt1$,opt2$)
5710 COLOUR 21: PRINT TAB(0,line%);base$;" ";
5720 IF hili%=1 THEN COLOUR 15
5725 PRINT "1) ";opt1$;" ";
5727 COLOUR 21
5730 IF hili%=2 THEN COLOUR 15
5735 PRINT "2) ";opt2$;" ";
5780 COLOUR 15 : INPUT in%
5790 =in%
5800 DEF PROCsetupChars
5810 VDU 23,240,0,&20,&40,&FF,&40,&20,0,0 : REM left arrow
5820 VDU 23,241,0,&24,&42,&FF,&42,&24,0,0 : REM bidirectional
5840 ENDPROC
5899 REM ------- block fill -----------------------
5900 DEF PROCblockFill
5910 IF BFstate%=0 THEN BFstate%=1
5920 IF BFstate%=1 THEN BFrect%(0)=PX% : BFrect%(1)=PY% : BFrect%(2)=PX% : BFrect%(3)=PY%
5930 IF BFstate%=2 THEN BFrect%(2)=PX% : BFrect%(3)=PY%
5940 IF BFstate%=2 THEN PROCdoBlockFill : PROCblockCursor(0)
5960 BFstate% = BFstate%+1 : IF BFstate%=3 THEN BFstate%=0
5995 ENDPROC
6000 DEF PROCdoBlockFill
6005 IF BFrect%(2) < BFrect%(0) THEN stepx%=-1 ELSE stepx%=1
6006 IF BFrect%(3) < BFrect%(1) THEN stepy%=-1 ELSE stepy%=1
6010 FOR y%=BFrect%(1) TO BFrect%(3) STEP stepx%
6020 FOR x%=BFrect%(0) TO BFrect%(2) STEP stepy%
6030 G%(x%+W%*y%, BM%)=COL%
6035 PROCfilledRect(1+GRIDX%+x%*8, 1+GRIDY%+y%*8, 6, 6, COL%)
6040 NEXT x% : NEXT y%
6050 PROCupdateBitmapFromGrid(BM%)
6095 ENDPROC
6100 DEF PROCblockCursor(switch%)
6105 LOCAL col%, xdiff%, ydiff%, x0%,y0%,x1%,y1%
6107 IF BFstate%=0 THEN ENDPROC
6110 BFrect%(2)=PX% : BFrect%(3)=PY% : REM new curs pos
6115 x0%=BFrect%(0) : y0%=BFrect%(1) : x1%=BFrect%(2) : y1%=BFrect%(3)
6120 IF BFrect%(0) > BFrect%(2) THEN BFstate%=0 : PROCgridCursor(1) :ENDPROC
6125 IF BFrect%(1) > BFrect%(3) THEN BFstate%=0 : PROCgridCursor(1) :ENDPROC
6130 xdiff% = x1%-x0%
6135 ydiff% = y1%-y0%
6140 IF switch%=0 THEN col%=GRIDCOL% ELSE col%=COL%
6150 PROCrect(GRIDX%+x0%*8, GRIDY%+y0%*8, 8*(xdiff%+1), 8*(ydiff%+1), col%)
6160 ENDPROC
8000 REM ------- Colour lookup Functions ------------
8005 :
8010 DEF PROCloadLUT
8011 REM Load the RGB Look up table
8012 REM CL%() is BBC Col to RGBIndex
8013 REM RGB%() is a packed array of the RGB colours
8014 REM REVLU%() is a reverse lookup table to get the colour
8020 LOCAL I%
8025 RESTORE 8210
8030 FOR I%=0 TO 63
8040 READ CL%(I%)
8050 NEXT
8060 FOR I%=0 TO 63
8070 READ RGB%(I%*3),RGB%(I%*3+1),RGB%(I%*3+2),REVLU%(I%)
8080 NEXT
8090 ENDPROC
8200 REM Colour mapping to RGB
8210 DATA &00, &20, &08, &28, &02, &22, &0A, &2A
8220 DATA &15, &30, &0C, &3C, &03, &33, &0F, &3F
8230 DATA &01, &04, &05, &06, &07, &09, &0B, &0D
8240 DATA &0E, &10, &11, &12, &13, &14, &16, &17
8250 DATA &18, &19, &1A, &1B, &1C, &1D, &1E, &1F
8260 DATA &21, &23, &24, &25, &26, &27, &29, &2B
8270 DATA &2C, &2D, &2E, &2F, &31, &32, &34, &35
8280 DATA &36, &37, &38, &39, &3A, &3B, &3D, &3E
8300 REM - RGB colours with a reverse map
8310 DATA &00, &00, &00, 0, &00, &00, &55, 16, &00, &00, &AA, 4, &00, &00, &FF, 12
8320 DATA &00, &55, &00, 17, &00, &55, &55, 18, &00, &55, &AA, 19, &00, &55, &FF, 20
8330 DATA &00, &AA, &00, 2, &00, &AA, &55, 21, &00, &AA, &AA, 6, &00, &AA, &FF, 22
8340 DATA &00, &FF, &00, 10, &00, &FF, &55, 23, &00, &FF, &AA, 24, &00, &FF, &FF, 14
8350 DATA &55, &00, &00, 25, &55, &00, &55, 26, &55, &00, &AA, 27, &55, &00, &FF, 28
8360 DATA &55, &55, &00, 29, &55, &55, &55, 8, &55, &55, &AA, 30, &55, &55, &FF, 31
8370 DATA &55, &AA, &00, 32, &55, &AA, &55, 33, &55, &AA, &AA, 34, &55, &AA, &FF, 35
8380 DATA &55, &FF, &00, 36, &55, &FF, &55, 37, &55, &FF, &AA, 38, &55, &FF, &FF, 39
8390 DATA &AA, &00, &00, 1, &AA, &00, &55, 40, &AA, &00, &AA, 5, &AA, &00, &FF, 41
8400 DATA &AA, &55, &00, 42, &AA, &55, &55, 43, &AA, &55, &AA, 44, &AA, &55, &FF, 45
8410 DATA &AA, &AA, &00, 3, &AA, &AA, &55, 46, &AA, &AA, &AA, 7, &AA, &AA, &FF, 47
8420 DATA &AA, &FF, &00, 48, &AA, &FF, &55, 49, &AA, &FF, &AA, 50, &AA, &FF, &FF, 51
8430 DATA &FF, &00, &00, 9, &FF, &00, &55, 52, &FF, &00, &AA, 53, &FF, &00, &FF, 13
8440 DATA &FF, &55, &00, 54, &FF, &55, &55, 55, &FF, &55, &AA, 56, &FF, &55, &FF, 57
8450 DATA &FF, &AA, &00, 58, &FF, &AA, &55, 59, &FF, &AA, &AA, 60, &FF, &AA, &FF, 61
8460 DATA &FF, &FF, &00, 11, &FF, &FF, &55, 62, &FF, &FF, &AA, 63, &FF, &FF, &FF, 15
8500 REM lookup table for BitShift for RGBA2222 (don't have nice bit-shift operators)
8510 DEF PROCloadBitshiftTable
8515 LOCAL col%,comp%
8520 RESTORE 8610
8530 FOR comp%=0 TO 3
8540 FOR col%=0 TO 3
8550 READ BSTAB%(col%,comp%)
8560 NEXT col%
8570 NEXT comp%
8595 ENDPROC
8600 REM bitshift lookup
8610 DATA 0,1,2,3, 0,4,8,&0C, 0,&10,&20,&30, 0,&40,&80,&C0
10000 REM ------------ Error Handling -------------
10010 VDU 23, 0, 192, 1 : REM turn on normal logical screen scaling
10020 VDU 23, 1, 1 : REM enable text cursor
10025 @%=&90A
10030 COLOUR 15
10040 IF ISEXIT=0 PRINT:REPORT:PRINT " @ line ";ERL:END
10050 PRINT : PRINT "Goodbye"