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
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
|
;
;****************************************************************
;
; EUMEL-SHard Graphikroutinen fuer 6502-Teil.
; Anfang: 20.05.86, Michael Staubermann
; Version 1.2, Mit Incremental-Fill, dicke Striche, COPY-Modus
; Stand: 12.01.87
;
.printx 'GRAFIK65.MAC'
;----------------------------------------------------------------------------
; V A R I A B L E
;----------------------------------------------------------------------------
;
; Konstante
bit_a EQU 2C ; Skip 2 Bytes
; Switches
graphic_mode EQU $C050
text_mode EQU $C051
full_graphics EQU $C052
page_1 EQU $C054
hires_mode EQU $C057
lc_00 EQU $C083
lc_01 EQU $C08B
;----------------------------------------------------------------------------
;
; G R A P H I K Einsprung fuer alle Graphiksubtasks
;
; Eingang: $81 Subtasknummer
; 0 = Move (x, y)
; 1 = Draw (x, y)
; 2 = Testbit (x, y) --> $81
; 3 = Control (on/off, bank, page, or/and/xor,
; patternsource, colour, pattern)
; 4 = Clear (page)
; 5 = Fill (muster)
; 6 = Trans (page a) to (page b)
;
; Ausgang: $81 (Nur bei Testbit)
;
;----------------------------------------------------------------------------
GRAFIK:
lda subtask ; 0 - 6
cmp #7
bcc grafik1
rts ; unerlaubt
grafik1:
asl a
tax
lda gfunct,x
sta 1
lda gfunct+1,x
sta 2 ; 1/2 Sprungadressen
jmp (1) ; Funktion aurufen
gfunct:
dw gmove, gdraw, gtest, gctrl, gclr, gfill, gtrans
;---------------------------------------------------------------------
;
; G M O V E
; Graphikcursor auf Position (x, y) setzen
;
; Eingang: param1 = xpos
; param2 = ypos
;
GMOVE:
lda param1
sta xpos ; LOW xpos
lda param1+1
sta xpos+1 ; HIGH xpos
lda param2
sta ypos ; LOW ypos
lda param2+1
sta ypos+1 ; HIGH ypos
move_x:
lda savepattern
sta pattern
lda savepattern+1
sta pattern+1 ; Linetypepattern auf Anfangswert
rts
;---------------------------------------------------------------------
;
; G D R A W
; Linie zur Position (x, y) zeichen
;
; Eingang: param1 = xpos
; param2 = ypos
;
GDRAW:
IF 0
lda param1
pha ; 'to' Parameter retten
lda param1+1
pha
lda param2
pha
lda param2+1
pha
ENDIF
jsr draw ; draw (xpos,ypos TO param1,param2)
IF 0
pla
sta ypos+1
pla
sta ypos
pla
sta xpos+1
pla
sta xpos
ENDIF
rts
;---------------------------------------------------------------------
;
; G T E S T
; Punkt (x, y) testen
;
; Eingang: param1 = xpos
; param2 = ypos
; Ausgang: param = result = Flags
;
GTEST:
lda param2+1 ; HIGH y
bne ytohigh ; Carry is set
lda param1+1 ; HIGH x
ldx param1 ; LOW x
ldy param2 ; LOW y
jsr calcaddr ; Byteaddresse des Punktes berechnen
ytohigh: lda #$FF ; 255 = Falsche Punktposition
bcs testrts ; Return mit Ergebnis
ldy #00
lda (address),y
php ; Farbbit merken
and bitmask,x ; Pixel ausmaskieren
beq testcolor
lda #01 ; Bit 0 : Zustand des gesuchten Pixels
testcolor: plp
bpl testrts
ora #80 ; Bit 7 : Farbe
testrts: sta result
rts
;---------------------------------------------------------------------
;
; G C T R L
; Verschiede Steuerfunktionen
;
; Eingang: param1 s.u.
; Steuerbits:
; 0: 0 = graphik off
; 1 = graphik on
; 1: 0 = Sichtbare Seite 0
; 1 = Sichtbare Seite 1
; 2: 0 = Bearbeitete Seite 0 (2000..3FFF)
; 1 = Bearbeitete Seite 1 (4000..5FFF)
; 3,4: 0 = OR (Setzen)
; 1 = AND (Loeschen)
; 2 = XOR (Invertieren)
; 3 = COPY (kopieren = loeschen/setzen)
; 5: 0 = Full Graphics display
; 1 = Mixed Graphics display (4 Zeilen Text)
; 6: 0 = param2 ist Linetypepattern
; 1 = savepattern ist Linetypepatt.
; 7: 0 = Violett
; 1 = Gelb
; 8..11 = Strichdicke
;
; param2 ist 16Bit Pattern (falls Bit 6 = 0)
;
GCTRL:
lda param1 ; Steuerbits
and #80 ; Bit 7 = Farbe
sta colormask
lsr param1 ; Bit 0 = Graphik on/off
bcs graphon
lda text_mode
lda page_1
bcc bit12
graphon: lda graphic_mode
lda hires_mode
lda param1 ; Bit 2 = Page
and #01
tax
sta page_1,x ; Page Select
bit12: lsr param1 ; Bit 1 ins Carry
lsr param1 ; Bit 2 ins Carry
bcs page2sel
lda #20
db bit_a
page2sel: lda #40
sta pagebase
lda param1
and #03 ; Bit 3,4 = Bitmode
sta bitmode
lsr param1 ; Bit 3 ins Carry
lsr param1 ; Bit 4 ins Carry
lda param1+1
and #0F
bne setthick
lda #1 ; Default 0: 1 Strich
setthick:
sta thick ; Strichdicke in 8..11
lda param1 ; Bit 5 = full (0) or mixed (1) Graph.
and #01
tax
sta full_graphics,x
lsr param1 ; Bit 5 ins Carry
lsr param1 ; Bit 6 ins Carry
bcs saved
lda param2 ; Parameter 2 (Word) Pattern
sta pattern ; in interne Linepattern kopieren
sta savepattern
lda param2+1
sta pattern+1
sta savepattern+1
bcc ctrlret
saved:
lda pattern ; Internes Savepattern als Workpattern
sta savepattern ; benutzen
lda pattern+1
sta savepattern+1
ctrlret: rts
;---------------------------------------------------------------------
;
; G C L R
; Graphikseite loeschen, bzw. mit einem Bitmuster fuellen
;
; Eingang: param1 = Seite (0..3)
; param2 = Byte (0..255)
;
GCLR:
lda param1
jsr page_addr ; Anfangsaddresse der Page --> A
; y := 0
sta address+1
sty address
ldx #20 ; 32 Pages
lda param2
gclr1:
sta (address),y
iny
bne gclr1
inc address+1
dex
bne gclr1
rts
page_addr:
and #3
asl a
asl a
asl a
asl a
asl a
adc #20 ; + Offset fuer erste Grafikseite
ldy #0
rts
;---------------------------------------------------------------------
;
; G F I L L
; Umrandete Flaeche Fuellen
;
; Eingang: param1 = Nummer des Fuellmusters
;
GFILL:
lda lc_01
lda lc_01 ; Select Page 1 D000..DFFF (Stack)
lda param1
jsr fill
lda lc_00
lda lc_00 ; Select Page 0 D000..DFFF (Spooler)
rts
;---------------------------------------------------------------------
;
; G T R A N S
; Graphikseite in eine andere Grafikseite kopieren
;
; Eingang: param1 = 'from'-Page (0..3)
; param2 = 'to'-Page (0..3)
;
GTRANS:
lda param1
jsr page_addr
sta address+1 ; 'from' - Pagebase
sty address
lda param2
jsr page_addr
sta param1+1
sty param ; 'to' - Pagebase
ldx #20 ; 32 Pages
gtrans1:
lda (address),y
sta (param1),y
iny
bne gtrans1
inc address+1
inc param1+1
dex
bne gtrans1
rts
;--------------------------------------------------------------------------
; Umrandete Graphikflaeche (xpos, ypos) ausfuellen
; Musternummer in A
FILL:
and #0F ; 16 Muster a 64 Bit
asl a ; *8 (8 Bytes pro Muster)
asl a
asl a ; Offset auf Muster
sta olderror+1
lda pagebase
sta olderror ; Merken
lda #wrkpage ; Workpage (alter Inhalt geloescht!)
sta pagebase
jsr fill1 ; ggf POP Returnaddress
lda olderror
sta pagebase ; restoren
rts
fill1:
lda bitmode
and #1
sta creg
lda #2
sta areg+1 ; stackpointer
lda ypos+1
bne fill1d ; Out of Window
ldx xpos
stx xa ; xpos low (fuer Muster)
lda xpos+1
sta xb
ldy ypos
sty ya ; yposlow (fuer Muster)
jsr startxy
bcc fill1c
fill1d: rts ; Ausserhalb oder auf Punkt
fill1c:
ldx #wrkpage
stx address+1
ldx olderror ; Echte Seite
stx link+1
ldx #20 ; 8k
ldy #0
sty address
sty link
fill1b: lda (link),y ; Echte Seite in Arbeitsseite kopieren
sta (address),y ; Arbeitsseite loeschen
iny
bne fill1b
inc address+1
inc link+1
dex
bne fill1b
lda xpos+1
ldx xpos
ldy ypos
jsr startxy
fill2:
ldy creg+1 ; Byte Offset
ldx breg+1 ; Bit Offset
jsr testquick ; Bei (x,y) Punkt gesetzt ?
bcc fill2h ; Punkt gesetzt
jsr poppos
jmp fill2
; (x-1, y) testen
fill2h: lda breg+1
sta dx
lda creg+1
sta dx+1
lda xa
sta xa+1 ; Save xpos
lda xb
sta xb+1
lda xa
bne fill2d2
dec xb
fill2d2: dec xa
jsr decx ; x-1, y bleibt
bcs fill2d
jsr testquick
bcc fill2h
fill2d: lda dx ; Altes x wiederherstellen
sta breg+1 ; (Der letzte Punkt vorm linken
lda dx+1 ; Rand)
sta creg+1
lda xa+1
sta xa
lda xb+1
sta xb
fill4: ; (x, y-1) testen
lda address ; ypos retten
sta dy
lda address+1
sta dy+1
lda breg
sta yb
lda ya ; ypos low
sta ya+1
dec ya
jsr decy ; y-1
bcs fill2a
jsr testquick
bcs fill2a
jsr clrstack ; Hier auch 'pushpos'
fill2a: ; (x, y+1) testen
jsr incy
bcs fill2e
jsr incy
bcs fill2e
inc ya
inc ya
jsr testquick
bcs fill2e
jsr clrstack ; Hier auch 'pushpos'
fill2e: ; Altes y wiederherstellen
lda dy
sta address ; ypos widerherstellen
lda dy+1
sta address+1
lda yb
sta breg
lda ya+1
sta ya
jsr pointquick
inc xa
bne fill2g
inc xb
fill2g: jsr incx
bcs fill2i
jsr testquick
bcc fill4 ; Punkt bei (x+1, y) ?
fill2i: jsr poppos ; Gerettete x/y Pos vom Stack
jmp fill2 ; Damit nochmal (pseudorekursion)
;--------------------------------------------------------------------------
; Hilfsroutinen fuer 'GFILL'
testquick:
lda (address),y
and bitmask,x
beq testquick1 ; Kein Punkt gesetzt
lda #1
testquick1: eor creg ; umdrehen, falls AND/COPY
lsr a ; SEC/CLC
rts
pointquick:
lda ya ; ypos low
and #7
ora olderror+1 ; Offset auf Muster
tay
lda xa
and #7
tax
lda bitmask,x ; xpos Bit
and muster,y ; ypos Byte
sta yb+1 ; 0, wenn kein Punkt gesetzt
ldx breg+1
ldy creg+1
lda (address),y
eor bitmask,x ; Bei OR loeschen, bei AND setzen!
sta (address),y ; Zum Merken in Workpage
; Test, ob auch in echter Seite Punkt
lda yb+1
beq pointquick1 ; Nicht mehr in echter Seite setzen
lda address+1
pha
and #$1F ; Nur 8k Bits
ora olderror ; Echte pagebase
sta address+1
lda (address),y
and #$7F
ora colormask
eor bitmask,x
sta (address),y ; In echter Seite setzen
pla
sta address+1
pointquick1: rts
poppos: ; x/y Pos vom Stack holen
ldx areg+1 ; stackpointer
cpx #2
beq poppos1
dex ; ? ggf beq poppos1
beq poppos1
lda stack+000,x ; xpos
sta breg+1
lda stack+100,x
sta creg+1
lda stack+200,x ; ypos
sta address
lda stack+300,x
sta address+1
lda stack+400,x
sta breg
lda stack+500,x ; xpos low
sta xa
lda stack+600,x ; xpos high
sta xb
lda stack+700,x ; ypos low
sta ya
stx areg+1 ; stackpointer
rts
poppos1:
pla
pla
rts ; Fill verlassen
clrstack: ; Stack aufraeumen und pushpos
ldx #$FE ; creg+1, da Neues startxy gegeben wird
stx yb+1 ; Flag, ob zweites mal clrstack
ldx areg+1 ; stackpointer
clrstack4: dex
lda stack+700,x
cmp ya
bne clrstack3
lda stack+600,x ; (stack)+1 --> temp (in A/Y)
ldy stack+500,x
iny
bne clrstack2
clc
adc #1
clrstack2: cmp xb ; Stacktop = xpos-1 ?
bne clrstack3
cpy xa
bne clrstack3
lda breg+1 ; xpos replacen
sta stack+000,x
lda creg+1
sta stack+100,x
lda xa
sta stack+500,x
lda xb
sta stack+600,x
rts
clrstack3: inc yb+1 ; Flag fuer 2. Durchlauf
bne clrstack4
pushpos: ; xpos/ypos auf Stack bringen
ldx areg+1 ; stackpointer
lda breg+1
sta stack+000,x
lda creg+1
sta stack+100,x
lda address
sta stack+200,x
lda address+1
sta stack+300,x
lda breg
sta stack+400,x
lda xa
sta stack+500,x
lda xb
sta stack+600,x
lda ya
sta stack+700,x
inx
beq pushpos1 ; Stackoverflow
stx areg+1 ; stackpointer
pushpos1: rts
;===========================================================================
; Incremental Adresses
; Belegt breg = rowstartoffset, breg+1 = x-reg = bitoffset
; creg+1 = y-reg = xbyte offset,
; address/address+1 = Byteaddresse
;
; Fuer jede Routine gilt:
; Ausgang: X = Bitoffset, Y = Byteoffset, SEC = Out of Window
; Trat SEC auf, ist die aktuelle Position unveraendert (!)
; Beispiel: jsr incy
; bcs fehler
; lda (address),y
; and bitmask,x
;---------------------------------------------------------------------------
; Start Scan
;
; Eingang: A: HIGH xpos
; X: LOW xpos
; Y: LOW ypos
STARTXY:
cmp #02 ; xpos >= 512 ?
bcc startxy1
startxy2: rts ; Carry is Set
startxy1: cmp #01
bne startxy3 ; xpos < 256
cpx #18 ; xpos >= 280 ?
bcs startxy2 ; Bereichsfehler
startxy3: cpy #$C0 ; ypos >= 192 ?
bcs startxy2
pha ; xpos (HIGH) retten
tya
pha
; adr := rowstart [ypos DIV 8] + (ypos MOD 8) * 1024 + xpos DIV 7
lsr a ; ypos DIV 8
lsr a
lsr a
asl a ; Fuer Tabellenzugriff * 2 (Bit 0 = 0)
tay
sty breg ; rowstart Offset
lda rowstart,y ; Tabelle der Zeilenanfaenge
sta address
lda rowstart+1,y
clc
adc pagebase
sta address+1
pla ; ypos
and #07 ; MOD 8
eor #07 ; y = 0 ist unten links
asl a ; * 4 (* 256)
asl ; Carry is cleared
adc address+1 ; Mikrozeile addieren
sta address+1
pla ; xpos (HIGH) --> Y
tay
txa ; xpos (LOW) --> A
jsr divide7 ; A/Y --> A (Quotient), X (Remainder)
sta creg+1
tay ; y-reg = Byteoffset
stx breg+1 ; Bitoffset
clc ; Carry cleared = ok
rts
;-------------------------------------------------------------------------
; Increment actual y
INCY:
lda address+1
and #1C
beq incy1 ; naechste Mikrozeile
lda address+1
sec
sbc #4
sta address+1
clc ; ok
incy2: ldy creg+1
ldx breg+1
rts
incy1: ldy breg
iny
iny ; naechste Makrozeile
cpy #30 ; tabellenende ?
bcs incy2 ; Fehler, nichts veraendert
sty breg
lda rowstart,y
sta address ; Carry war cleared
lda rowstart+1,y
adc pagebase
adc #1C ; 7. Mikrozeile
sta address+1
bcc incy2 ; Always
;--------------------------------------------------------------------------
; Decrement actual y
DECY:
lda address+1
and #1C
cmp #1C ; 7. Mikrozeile ?
beq decy1 ; naechste Mikrozeile
lda address+1
adc #4
sta address+1
decy2: ldy creg+1
ldx breg+1
rts
decy1: ldy breg ; naechste Makrozeile
sec
beq decy2 ; Out of Window ?
dey
dey
sty breg
lda rowstart,y
sta address
clc
lda rowstart+1,y
adc pagebase
sta address+1
bcc decy2 ; Always
;-------------------------------------------------------------------------
; Increment actual x
INCX:
ldy creg+1
ldx breg+1
cpx #6
bcs incx1
inx
clc
incx2: stx breg+1 ; y schon = creg+1
rts
incx1: inc creg+1
iny
ldx creg+1
cpx #28 ; Out of Window ?
ldx #0
bcc incx2 ; CLC: ok
dec creg+1 ; Wieder Rueckgaengig
rts
;-----------------------------------------------------------------------
; Decrement actual x
DECX:
ldy creg+1
ldx breg+1
beq decx1
dex
decx2: stx breg+1 ; y schon creg+1
rts
decx1: ldx #6
dec creg+1
dey
clc
bpl decx2 ; < 0 ?
sec ; Out of Window !
inc creg+1 ; Alter Zustand
rts
;==========================================================================
; Absolute Adresses
;--------------------------------------------------------------------------
;
; C A L C A D D R
; Berechnet die Addresse eines Pixels
;
; Eingang: A: HIGH xpos
; X: LOW xpos
; Y: ypos
; Ausgang: address,address+1: Addresse des Bytes mit Pixel
; Carry: Set = Pixelpos ausserhalb des Fensters
; X: Bitnummer im addressierten Byte (0..6)
;---------------------------------------------------------------------------
CALCADDR:
cmp #02 ; xpos >= 512 ?
bcc less512
rangeerr: rts ; Carry is Set
less512: cmp #01
bne xposok ; xpos < 256
cpx #18 ; xpos >= 280 ?
bcs rangeerr ; Bereichsfehler
xposok: cpy #$C0 ; ypos >= 192 ?
bcs rangeerr
pha ; xpos (HIGH) retten
tya
pha
; adr := rowstart [ypos DIV 8] + (ypos MOD 8) * 1024 + xpos DIV 7
lsr ; ypos DIV 8
lsr
lsr
asl ; Fuer Tabellenzugriff * 2 (Bit 0 = 0)
tay
lda rowstart,y ; Tabelle der Zeilenanfaenge
sta address
lda rowstart+1,y
clc
adc pagebase
sta address+1
pla ; ypos
and #07 ; MOD 8
eor #07 ; y = 0 ist unten links
asl ; * 4 (* 256)
asl ; Carry is cleared
adc address+1
sta address+1
pla ; xpos (HIGH) --> Y
tay
txa ; xpos (LOW) --> A
jsr divide7 ; A/Y --> A (Quotient), X (Remainder)
clc
adc address
sta address
bcc calcret
inc address+1
clc ; Carry cleared = ok
calcret: rts
;-----------------------------------------------------------------------------
;
; N E G
; Vorzeichenwechsel
; Eingang/Ausgang: A/X (HIGH/LOW)
;-----------------------------------------------------------------------------
NEG: pha
txa
eor #$FF
clc
adc #01
tax
pla
eor #$FF
adc #00
rts
;---------------------------------------------------------------------------
;
; D I V I D E 7
; Division durch 7 mit Rest
; Eingang: A: Low, Y: High (Nur 0 oder 1)
; Ausgang: A: Quotient (Auch in quotient)
; X: Rest
;--------------------------------------------------------------------------
DIVIDE7:
ldx #00 ; Quotient Schieberegister loeschen
stx quotient
ldx #$E0 ; 224 = 7 * 2^5 als Startwert
stx divmask
ldx #06 ; Anzahl Verschiebungen
cpy #01 ; Zahl > 255 ?
bne shiftloop ; Carry is set
inc quotient
adc #1F ; (Zahl MOD 256) + 32
bne shift2loop ; Erste Subtraktion ueberspringen
shiftloop: sec
sbc divmask ; Probeweise subtrahieren
php ; Borrow merken
rol quotient ; Borrow in quotient rotieren
plp
bcs shift2loop
adc divmask ; Falls zuviel subtrahiert wieder add.
shift2loop: lsr divmask ; Dann nur noch die Haelfte subtr.
dex
bne shiftloop
tax ; Rest der Division
lda quotient ; Quotient
rts
;----------------------------------------------------------------------------
;
; P O I N T
; Setzt/Loescht Punkt an bestimmter Position
; Eingang: Position in xpos/ypos
; Linepattern in pattern
; Farbmaske in colormask
; Bitmodus in bitmode
;---------------------------------------------------------------------------
;DOPOINT:
; ldy bitmode
; bpl patternres ; Always
POINT:
ldy bitmode
asl pattern
rol pattern+1
bcs patternset
cpy #03 ; Copymodus
bne pointret ; Keine Aktion
ldy #01 ; Loeschen
bne patternres ; Always
patternset: inc pattern ; 1 links im pattern setzen
patternres: sty tempmode
lda ypos+1
bne pointret
lda xpos+1
ldx xpos
ldy ypos
;MAKEDOT:
jsr calcaddr ; Punktaddresse berechnen
bcs pointret ; Ausserhalb des Bildschirms
ldy #00
lda (address),y
ldy tempmode
bne mode1
mode0: ora bitmask,x ; Modus 0 = setzen
bcc setcolor
mode1: dey
bne mode2
and notbitmask,x ; Modus 1 = loeschen
bcc setcolor
mode2: dey
bne mode0 ; Modus 3 (copy) wie Modus 0
eor bitmask,x ; Modus 2 = invertieren
bcc setcolor
setcolor: ldy #00
and #7F ; Altes Farbbit loeschen
ora colormask ; Farbbit neu setzen
sta (address),y ; Graphikbyte zurueckschreiben
pointret: rts
;-----------------------------------------------------------------------------
; Drawthick zeichnet eine dicke Linie
drawthick:
lda param1
pha
lda param1+1
pha ; to-pos retten
lda param2
pha
lda param2+1
pha
lda savepattern
pha
lda savepattern+1
pha
lda pattern ; Linetype auf Startwert
sta savepattern
lda pattern+1
sta savepattern+1
dec thick
; x- oder y- Richtung feststellen:
; x direction := abs (xto - xfrom) > abs (yto - yfrom)
lda param1
sec
sbc xpos
tax
lda param1+1
sbc xpos+1
bcs drawthick1
jsr NEG ; Absolutwert (A/X)
drawthick1: sta dx+1
stx dx
lda param2
sec
sbc ypos
tax
lda param2+1
sbc ypos+1
bcs drawthick2
jsr NEG ; Absolutwert (A/X)
drawthick2: pha
txa
sec
sbc dx
pla
sbc dx+1 ; Nur das Vorzeichen wichtig
pha ; xdirection, wenn A < 0
; Start- und Endpunkt der mittleren Linie berechnen
bpl drawthick3 ; y direction
; start.x := xfrom - thick x ; to.x := xto + thick x
; start.y := yfrom ; to.y := yto
; thick x : IF xto < xfrom THEN -thick ELSE +thick FI
lda param1
sec
sbc xpos ; xto - xfrom
lda param1+1
sbc xpos+1
bcs drawthick4 ; xto >= xfrom (xto-xfrom >= 0)
; xto < xfrom
lda xpos ; Carry is cleared
adc thick
sta xa ; start.x
lda xpos+1
adc #0
sta xa+1
lda param1 ; to.x
sec
sbc thick
sta xb
lda param1+1
sbc #0
sta xb+1
jmp drawthick5
drawthick4:
lda xpos ; Carry is set
sbc thick
sta xa
lda xpos+1
sbc #0
sta xa+1
lda param1
clc
adc thick
sta xb
lda param1+1
adc #0
sta xb+1
drawthick5:
; start.y := ypos ; to.y := param2
lda ypos
sta ya
lda ypos+1
sta ya+1
lda param2
sta yb
lda param2+1
sta yb+1
jmp drawthick8
drawthick3: ; x direction
; start.x := xfrom ; to.x := xto
; start.y := yfrom - thick y ; to.y := yto + thick y
; thick y : IF yto < yfrom THEN -thick ELSE +thick FI
lda param2
sec
sbc ypos ; yto - yfrom
lda param2+1
sbc ypos+1
bcs drawthick6 ; yto >= yfrom (yto-yfrom >= 0)
; yto < yfrom
lda ypos ; Carry is cleared
adc thick
sta ya ; start.y
lda ypos+1
adc #0
sta ya+1
lda param2 ; to.y
sec
sbc thick
sta yb
lda param2+1
sbc #0
sta yb+1
jmp drawthick7
drawthick6:
lda ypos ; Carry is set
sbc thick
sta ya
lda ypos+1
sbc #0
sta ya+1
lda param2
clc
adc thick
sta yb
lda param2+1
adc #0
sta yb+1
drawthick7:
; start.x := xpos ; to.x := param1
lda xpos
sta xa
lda xpos+1
sta xa+1
lda param1
sta xb
lda param1+1
sta xb+1
;------
; FOR diff FROM -thick TO thick REP drawsingl PER
drawthick8:
ldx thick
lda #0
jsr NEG ; -thick
sta areg+1
stx areg ; = diff
drawthick11:
ldx areg
lda areg+1
bne drawthick9
cpx thick ; > +thick ?
beq drawthick9
bcc drawthick9
; PER ; restore pattern
pla ; x direction
inc thick
pla
sta savepattern+1
sta pattern+1
pla
sta savepattern
sta pattern
pla
sta param2+1 ; To-Pos restoren
pla
sta param2
pla
sta param1+1
pla
sta param1
lda param1
sta xpos
lda param1+1
sta xpos+1
lda param2
sta ypos
lda param2+1
sta ypos+1
rts
; singlevector:
drawthick9:
pla
pha ; xdirection ?
bpl drawthick10 ; y direction
; move (start.x, start.y-diff) ;
; draw (to.x, to.y-diff) ;
lda xa
sta xpos
lda xa+1
sta xpos+1 ; xpos := start.x
lda ya
sec
sbc areg
sta ypos
lda ya+1
sbc areg+1
sta ypos+1 ; ypos := start.y - diff
jsr move_x
lda xb ; xto := to.x
sta param1
lda xb+1
sta param1+1
lda yb ; yto := to.y - diff
sec
sbc areg
sta param2
lda yb+1
sbc areg+1
sta param2+1
jsr drawsglvec ; Linie von x/ypos nach param1/2
jmp drawthick12
drawthick10:
; move (start.x + diff, start.y) ;
; draw (to.x + diff, to.y) ;
lda xa
clc
adc areg
sta xpos ; xpos := start.x + diff
lda xa+1
adc areg+1
sta xpos+1
lda ya ; ypos := start.y
sta ypos
lda ya+1
sta ypos+1
jsr move_x
lda xb
clc
adc areg ; xto := to.x + diff
sta param1
lda xb+1
adc areg+1
sta param1+1
lda yb
sta param2
lda yb+1 ; yto := to.y
sta param2+1
jsr drawsglvec ; Linie von x/ypos nach param1/2
; NEXT diff
drawthick12:
inc areg
bne drawthick13
inc areg+1
drawthick13: jmp drawthick11 ; diff INCR 1
;-----------------------------------------------------------------------------
;
; D R A W
; Linie zwischen zwei Punkten zeichnen
; Eingang: FROM-Position in xpos/ypos
; TO-Position in param1/param2
; Attribute in bitmode,pattern,colormask
;-----------------------------------------------------------------------------
DRAW:
; X-Vektorrichtung bestimmen
; dx := xto - xfrom ; right := sign (dx) ; dx := ABS dx
lda thick
bne draw1
rts ; Unsichtbare Linie
draw1:
cmp #1
beq drawsglvec ; Eine Linie Zeichnen
jmp drawthick
drawsglvec:
ldy #00 ; Vorzeichen fuer right: positiv
lda param1 ; xto (LOW)
sec
sbc xpos ; xfrom (LOW)
tax
lda param1+1 ; xto (HIGH)
sbc xpos+1 ; xfrom (HIGH)
bpl dxpositiv
jsr NEG ; dx := -dx
dey ; Vorzeichen fuer right: negativ
dxpositiv: sta dx+1
stx dx
sty right
; Y-Vektorrichtung bestimmen
; dy := yto - yfrom ; up := sign (dy) ; dy := ABS dy
ldy #00 ; Vorzeichen fuer up: positiv
lda param2 ; yto
sec
sbc ypos ; yfrom
tax
lda param2+1
sbc ypos+1
bpl dypositiv
jsr NEG ; dy := -dy
dey ; Vorzeichen fuer up: negativ
dypositiv: sta dy+1
stx dy
sty up
; init vectorloop
ldx #00
stx olderror
stx olderror+1 ; olderror := 0
ldx #xpos ; xpointer zeigt auf xpos
stx xpointer
ldx #ypos
stx ypointer ; ypointer zeigt auf ypos
; dy > dx ==> dx - dy < 0 ==> Parameter vertauschen
lda dx
sec
sbc dy ; Ergebnis unwichtig, nur Carry
lda dx+1 ; dx (HIGH)
sbc dy+1 ; dy (HIGH)
bpl dy_lsequal_dx
; Parameter vertauschen
lda xpointer ; xpointer und ypointer vertauschen
ldx ypointer
stx xpointer
sta ypointer
lda up ; up und right vertauschen
ldx right
stx up
sta right
lda dx ; dx (LOW) und dy (LOW) vertauschen
ldx dy
stx dx
sta dy
lda dx+1 ; dx (HIGH) und dy (HIGH) vertauschen
ldx dy+1
stx dx+1
sta dy+1
dy_lsequal_dx: ; vector(xpos, ypos, dx, dy, right, up)
; uprighterror := dy - dx ; righterror = dy
lda dy
sec
sbc dx
sta uprighterror
lda dy+1
sbc dx+1
sta uprighterror+1
; Schleife: dx DECR 1
nextpixel: jsr POINT ; POINT (xpos, ypos)
lda dx ; dx = counter = 0 ?
ora dx+1
bne do_one_step
rts ; Ende der Vektorloop
do_one_step:
ldx xpointer ; Referenz auf xpos oder ypos
bit right ; right < 0 ?
bpl rightstep ; sonst leftstep
;leftstep:
lda 0,x ; xpos-Referenz DEC 1
bne xposdec1
dec 1,x ; Highbyte von xpos
xposdec1: dec 0,x ; Lowbyte von xpos
jmp detdirection
rightstep:
inc 0,x
bne detdirection
inc 1,x
detdirection:
; IF abs (olderror + righterror) < abs (olderror + uprighterror)
; THEN do_right_step ELSE do_upright_step FI
; abs (olderror + uprighterror) = abs1
lda olderror
clc
adc uprighterror
tax
lda olderror+1
adc uprighterror+1
bpl abs1positiv
jsr NEG ; abs1 := -abs1 (A=HIGH, Y=LOW)
abs1positiv: stx temporary ; Fuer spaetere Subtraktion merken
sta temporary+1
; abs (olderror + righterror) = abs2
lda olderror
clc
adc righterror
tax
lda olderror+1
adc righterror+1
bpl abs2positiv
jsr NEG ; abs2 := -abs2 (A=HIGH, X=LOW)
abs2positiv:
tay ; abs2 (HIGH) retten
txa ; abs2 (LOW) --> A
sec
sbc temporary ; abs1 (LOW)
tya ; Nur Carrybit wesentlich
sbc temporary+1 ; abs1 (HIGH)
bmi do_right_step
;do_upright_step:
; ypos INCR up
ldx ypointer
bit up ; Vorzeichen von up
bpl yposinc1
lda 0,x ; ypointer enthaelt Offset ab xpos
bne yposdec1
dec 1,x
yposdec1: dec 0,x
jmp xyerror
yposinc1: inc 0,x
bne xyerror
inc 1,x
xyerror:
; olderror INCR uprighterror
lda olderror
clc
adc uprighterror
sta olderror
lda olderror+1
adc uprighterror+1
sta olderror+1
jmp dxdec1
do_right_step:
; olderror INCR righterror
lda olderror
clc
adc righterror
sta olderror
lda olderror+1
adc righterror+1
sta olderror+1
dxdec1:
lda dx
bne dxdec
dec dx+1
dxdec: dec dx
jmp nextpixel ; zum Schleifenanfang
;--------------------------------------------------------------------------
; Muster fuer GFILL:
muster:
.RADIX 2
DB 11111111 ; 0: gefuellt
DB 11111111
DB 11111111
DB 11111111
DB 11111111
DB 11111111
DB 11111111
DB 11111111
DB 10101010 ; 1: Halb
DB 01010101
DB 10101010
DB 01010101
DB 10101010
DB 01010101
DB 10101010
DB 01010101
DB 11111111 ; 2: Waagerecht (grob)
DB 00000000
DB 00000000
DB 00000000
DB 11111111
DB 00000000
DB 00000000
DB 00000000
DB 11111111 ; 3: Waagerecht (fein)
DB 00000000
DB 11111111
DB 00000000
DB 11111111
DB 00000000
DB 11111111
DB 00000000
DB 10001000 ; 4: Senkrecht (grob)
DB 10001000
DB 10001000
DB 10001000
DB 10001000
DB 10001000
DB 10001000
DB 10001000
DB 10101010 ; 5: Senkrecht (fein)
DB 10101010
DB 10101010
DB 10101010
DB 10101010
DB 10101010
DB 10101010
DB 10101010
DB 11111111 ; 6: Gerades Raster (grob)
DB 10001000
DB 10001000
DB 10001000
DB 11111111
DB 10001000
DB 10001000
DB 10001000
DB 11111111 ; 7: Gerades Raster (fein)
DB 10101010
DB 11111111
DB 10101010
DB 11111111
DB 10101010
DB 11111111
DB 10101010
DB 10001000 ; 8: Links Schraffur
DB 00010001
DB 00100010
DB 01000100
DB 10001000
DB 00010001
DB 00100010
DB 01000100
DB 10001000 ; 9: Rechts Schraffur
DB 01000100
DB 00100010
DB 00010001
DB 10001000
DB 01000100
DB 00100010
DB 00010001
DB 10001000 ; 10: Schraeges Gitter
DB 01010101
DB 00100010
DB 01010101
DB 10001000
DB 01010101
DB 00100010
DB 01010101
DB 10101010 ; 11: Punktraster
DB 00000000
DB 10101010
DB 00000000
DB 10101010
DB 00000000
DB 10101010
DB 00000000
DB 11111111 ; 12: Mauer
DB 01000000
DB 01000000
DB 01000000
DB 11111111
DB 00000100
DB 00000100
DB 00000100
DB 00100010 ; 13: Korb
DB 01010101
DB 10001000
DB 10001000
DB 10001000
DB 01010101
DB 00100010
DB 00100010
DB 00000000 ; 14: Wellenlinie
DB 00100010
DB 01010101
DB 10001000
DB 00000000
DB 00100010
DB 01010101
DB 10001000
;usermuster:
DB 10000000 ; 15: User (Default: Zickzack)
DB 01000001
DB 00100010
DB 00010100
DB 00001000
DB 00000000
DB 00000000
DB 00000000
.RADIX 16
;----------------------------------------------------------------------------
; T A B E L L E N
;----------------------------------------------------------------------------
bitmask: db $01, $02, $04, $08, $10, $20, $40, $80
notbitmask: db $FE, $FD, $FB, $F7, $EF, $DF, $BF, $7F
; Graphikzeilenanfaenge, Ypos 0 ist unten
rowstart:
dw 03D0, 0350, 02D0, 0250
dw 01D0, 0150, 00D0, 0050
dw 03A8, 0328, 02A8, 0228
dw 01A8, 0128, 00A8, 0028
dw 0380, 0300, 0280, 0200
dw 0180, 0100, 0080, 0000
.printx 'Ende'
|