Transactor/Transactor_25_1988_Transactor_Publishing.d64/demo3.4.tk

Commodore BASIC | 2023-02-26 | 6KB | 431 lines

100 sys700 ;run assembler
110 ;
120 ;  < < <  graphics  v1.0  > > >
130 ; copyright 1988 by robert huehn
140 ; high speed graphic routines
150 ; jan 1988
160 ;
170 ;zpage pseudo registers
180 r0 =$02
190 r1 =$04
200 r2 =$06
210 r3 =$08
220 r4 =$0a
230 r5 =$0c
240 r6 =$0e
250 r7 =$10
260 r8 =$12
270 r9 =$14
280 ;
290 *=$9000
295 jmp demo
300 ;jump table
310 bmon jmp ibmon
320 bmoff jmp ibmoff
330 bmclr jmp ibmclr
340 txclr jmp itxclr
350 plot jmp iplot
360 draw jmp xdraw
370 ;
380 bitab =* ;pixel masks
390 .byte 128,64,32,16,8,4,2,1
400 lotab =* ;base addresses
410 hitab =*+1
420 .word $a000,$a140,$a280,$a3c0
430 .word $a500,$a640,$a780,$a8c0
440 .word $aa00,$ab40,$ac80,$adc0
450 .word $af00,$b040,$b180,$b2c0
460 .word $b400,$b540,$b680,$b7c0
470 .word $b900,$ba40,$bb80,$bcc0
480 .word $be00
490 ;
500 ;turn on bit map at $a000
510 ibmon =*
520 lda $dd00
530 and #$30
540 ora #$01
550 sta $dd00
560 lda #$3b
570 sta $d011
580 lda #$38
590 sta $d018
600 rts
610 ;
620 ;back to normal text
630 ibmoff =*
640 lda $dd00
650 and #$30
660 ora #$03
670 sta $dd00
680 lda #$1b
690 sta $d011
700 lda #$15
710 sta $d018
720 rts
730 ;
740 ;clear bit map $a000-bf40
750 ibmclr =*
760 lda #0
770 ldx #250
780 cl1 sta $9fff,x
790 sta $a0f9,x
800 sta $a1f3,x
810 sta $a2ed,x
820 sta $a3e7,x
830 sta $a4e1,x
840 sta $a5db,x
850 sta $a6d5,x
860 sta $a7cf,x
870 sta $a8c9,x
880 sta $a9c3,x
890 sta $aabd,x
900 sta $abb7,x
910 sta $acb1,x
920 sta $adab,x
930 sta $aea5,x
940 sta $af9f,x
950 sta $b099,x
960 sta $b193,x
970 sta $b28d,x
980 sta $b387,x
990 sta $b481,x
1000 sta $b57b,x
1010 sta $b675,x
1020 sta $b76f,x
1030 sta $b869,x
1040 sta $b963,x
1050 sta $ba5d,x
1060 sta $bb57,x
1070 sta $bc51,x
1080 sta $bd4b,x
1090 sta $be45,x
1100 dex
1110 bne cl1
1120 rts
1130 ;
1140 ;set bit map colour at $8c00
1150 itxclr =*
1160 lda #$bf
1170 ldx #250
1180 col1 sta $8bff,x
1190 sta $8cf9,x
1200 sta $8df3,x
1210 sta $8eed,x
1220 dex
1230 bne col1
1240 rts
1250 ;
1260 ;fast line draw
1270 idraw =*
1280 ;passed:
1290 x1 =r0
1300 y1 =r1
1310 x2 =r2
1320 y2 =r3
1330 ;altered:
1340 dx =r4   ;delta x
1350 dy =r5   ;delta y
1360 xi =r5+1 ;l/r flag
1370 yi =r6   ;u/d flag
1380 base =r7 ;base of pixel addr
1390 m =r6+1  ;pixel mask
1400 c =r8    ;count
1410 r =r9    ;
1420 ldx #0   ;xinc=right
1430 ldy #0   ;yinc=down
1440 lda x2   ;calculate dx=x2-x1
1450 sec
1460 sbc x1
1470 sta dx
1480 lda x2+1
1490 sbc x1+1
1500 sta dx+1
1510 bcs dr1
1520 dex          ; dx<0, xinc=left
1530 lda #1
1540 sbc dx
1550 sta dx
1560 lda #0
1570 sbc dx+1
1580 sta dx+1
1590 dr1 lda y2   ;dy=y2-y1
1600 sec
1610 sbc y1
1620 bcs dr2
1630 dey          ;dy<0, yinc=up
1640 eor #$ff     ;dy=abs(dy)
1650 adc #1
1660 dr2 sta dy
1670 stx xi
1680 sty yi
1690 lda y1       ;plot (x1,y1)
1700 and #7
1710 tay
1720 eor y1
1730 lsr
1740 lsr
1750 tax
1760 lda x1
1770 and #$f8
1780 adc lotab,x
1790 sta base     ;save base
1800 lda hitab,x
1810 adc x1+1
1820 sta base+1
1830 lda x1
1840 and #7
1850 tax
1860 lda bitab,x
1870 sta m        ;save mask
1880 ora (base),y
1890 sta (base),y
1900 lda dx+1
1910 bne dri
1920 lda dx       ;(dx>=dy)
1930 cmp dy
1940 bcs dri
1950 jmp drii
1960 dri =*       ;case i -1<slope<1
1970 lda dx+1
1980 sta c+1      ;c=dx
1990 lsr
2000 sta r+1      ;r=dx/2
2010 lda dx
2020 sta c
2030 ror
2040 sta r
2050 lda c
2060 ora c+1
2070 beq dr9      ;if single point
2080 dr3 lda xi
2090 bmi dr4
2100 lsr m        ;right
2110 bcc dr5
2120 ror m
2130 lda base
2140 adc #8
2150 sta base
2160 bcc dr5
2170 inc base+1
2180 bne dr5
2190 dr4 asl m    ;left
2200 bcc dr5
2210 rol m
2220 lda base
2230 sbc #7
2240 sta base
2250 bcs dr5
2260 dec base+1
2270 dr5 lda r    ;r=r+dy
2280 clc
2290 adc dy
2300 sta r
2310 bcc dr6
2320 inc r+1
2330 dr6 sec
2340 sbc dx
2350 tax
2360 lda r+1
2370 sbc dx+1
2380 bcc dr8
2390 stx r        ;r>=dx,
2400 sta r+1      ;r=r-dx
2410 lda yi
2420 bmi dr7
2430 iny ;down
2440 cpy #8
2450 bcc dr8
2460 ldy #0
2470 lda base
2480 adc #$3f
2490 sta base
2500 lda base+1
2510 adc #1
2520 bcc dr18
2530 dr7 dey ;up
2540 bpl dr8
2550 ldy #7
2560 lda base
2570 sbc #$40
2580 sta base
2590 lda base+1
2600 sbc #1
2610 dr18 sta base+1
2620 dr8 lda (base),y
2630 ora m
2640 sta (base),y ;plot (x,y)
2650 dec c
2660 bne dr3
2670 dec c+1
2680 beq dr3      ;next
2690 dr9 rts
2700 drii =*      ; -1>slope>1
2710 lda dy
2720 beq dr15     ;single point
2730 sta c        ;c=dy
2740 lsr
2750 sta r        ;r=dy/2
2760 dr10 lda yi
2770 bmi dr11
2780 iny ;down
2790 cpy #8
2800 bcc dr12
2810 ldy #0
2820 lda base
2830 adc #$3f
2840 sta base
2850 lda base+1
2860 adc #1
2870 bcc dr19
2880 dr11 dey     ;up
2890 bpl dr12
2900 ldy #7
2910 sec
2920 lda base
2930 sbc #$40
2940 sta base
2950 lda base+1
2960 sbc #1
2970 dr19 sta base+1
2980 dr12 ldx #0
2990 lda r        ;r=r+dx
3000 clc
3010 adc dx
3020 sta r
3030 bcs dr16
3040 inx
3050 sec
3060 dr16 sbc dy
3070 bcs dr17
3080 dex
3090 beq dr14
3100 dr17 sta r   ;r>=dy, r=r-dy
3110 lda xi
3120 bmi dr13
3130 lsr m ;right
3140 bcc dr14
3150 ror m
3160 lda base
3170 adc #8
3180 sta base
3190 bcc dr14
3200 inc base+1
3210 bne dr14
3220 dr13 asl m   ;left
3230 bcc dr14
3240 rol m
3250 lda base
3260 sbc #7
3270 sta base
3280 bcs dr14
3290 dec base+1
3300 dr14 lda (base),y
3310 ora m
3320 sta (base),y ;plot (x,y)
3330 dec c
3340 bne dr10     ;next
3350 dr15 rts
3360 ;
3370 ;fast plot
3380 iplot =*
3390 ;passed:
3400 xc =r0
3410 yc =r1
3420 ;altered:
3430 ;base =r7
3440 ptemp =r6+1
3450 lda yc
3460 and #7
3470 sta ptemp
3480 eor yc
3490 lsr
3500 lsr
3510 tax
3520 lda hitab,x
3530 adc xc+1
3540 sta base+1
3550 lda lotab,x
3560 sta base
3570 lda xc
3580 and #7
3590 tax
3600 eor xc
3610 adc ptemp
3620 tay
3630 lda (base),y
3640 ora bitab,x
3650 sta (base),y
3660 rts
3670 ;
3680 ; show-off demo
5000 demo =*
5010 lda #$36
5020 sta 1
5030 jsr bmon
5040 jsr bmclr
5050 jsr txclr
5060 lda #0
5070 sta x1
5080 sta x1+1
5090 sta y1
5100 sta x2+1
5110 lda #$9f
5120 sta x2
5130 lda #$63
5140 sta y2
5150 ;
5160 lp1 =*
5170 jsr draw
5180 ldx x1
5190 inx
5200 stx x1
5210 bne lp2
5220 inc x1+1
5230 bne lp1
5240 ;
5250 lp2 =*
5260 cpx #$3f
5270 bne lp1
5280 ldx x1+1
5290 beq lp1
5300 ;
5310 lp3 =*
5320 jsr draw
5330 ldx y1
5340 inx
5350 stx y1
5360 cpx #$c7
5370 bne lp3
5380 jsr draw
5390 ;
5400 lp4 =*
5410 dec x1
5420 jsr draw
5430 ldx x1
5440 bne lp4
5450 dec x1+1
5460 beq lp4
5470 inc x1+1
5480 ;
5490 lp5 =*
5500 jsr draw
5510 dec y1
5520 bne lp5
5530 lpw lda 197
5540 cmp #60
5550 bne lpw
5560 jsr bmoff
5570 lda #$37
5580 sta 1
5590 rts
5600 ;
5610 xdraw =*
5620 lda #4
5630 inc $fb
5640 bit $fb
5650 bne xd
5660 rts
5670 ;
5680 xd =*
5690 jmp idraw