home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 60
/
060.d81
/
color.chase.pal
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
3KB
|
167 lines
100 sys700
110 ;
120 .opt oo
130 ;
140 ; 'color chaser', by scott e. resh
150 ;
160 ;
170 ; code will be at $c000 (49152)
180 ;
190 lcmem = $d800 - 40
200 r0l = $fb
210 r0h = r0l + 1
220 r1l = r0h + 1
230 r1h = r1l + 1
240 bkgrnd = $d021
250 ;
260 ;
270 jmp init ;
280 jmp past ;
290 ;
300 ;
310 init ldx #3 ; copy values to
320 l1 lda r0l,x ; local storage
330 sta local,x ;
340 dex ;
350 bpl l1 ;
360 ;
370 lda r1l ; if either length = 0,
380 beq ooh ; then exit, else ok
390 lda r1h ;
400 bne ok1 ;
410 ;
420 ooh rts ; return to basic
430 ;
440 ok1 dec column ;
450 dec row ;
460 ;
470 clc ;
480 lda xc ; if x+column>39 then error
490 adc column ;
500 cmp #40 ;
510 bcs ooh ;
520 lda yc ; if y+row>24 then error
530 adc row ;
540 cmp #25 ;
550 bcs ooh ;
560 ;
570 lda #>lcmem ; init colormem pntr
580 sta r0h ;
590 lda #<lcmem ;
600 sta r0l ;
610 ldx yc ; x = row count
620 ;
630 clc ; add in row offset
640 l2 lda #40 ; to colormem pointer
650 adc r0l ;
660 sta r0l ;
670 bcc ok2 ;
680 inc r0h ;
690 clc ;
700 ok2 dex ;
710 bpl l2 ;
720 ;
730 lda xc ; add in x-coord to
740 adc r0l ; colormem pointer
750 sta r0l ;
760 bcc ok3 ;
770 inc r0h ;
780 ok3 lda r0l ; preserve base pntr
790 sta temp ;
800 lda r0h ;
810 sta temp+1 ;
820 ;
830 ldy #0 ; fetch color seed value
840 lda (r0l),y ;
850 sta mainc ;
860 ;
870 ;==================================
880 ;
890 past lda temp ; init colormem pntr
900 sta r0l ;
910 lda temp+1 ;
920 sta r0h ;
930 ;
940 lda mainc ; init color value for
950 sta color ; this round
960 ;
970 dec mainc ; update color value
980 ; (note: change 'dec' to 'inc' to
990 ; move colors counter-clockwise)
1000 ;
1010 lda bkgrnd ; fetch backgrnd color
1020 and #15 ; for 'cfetch' routine
1030 sta btemp ;
1040 ;
1050 ldy #0 ;
1060 ldx column ; # characters across
1070 ;
1080 l3 jsr fcolor ; move color left to
1090 sta (r0l),y ; right along the top
1100 iny ;
1110 dex ;
1120 bpl l3 ;
1130 ;
1140 ldx row ;
1150 dex ;
1160 ldy column ;
1170 ;
1180 l4 lda r0l ; move color 'down'
1190 clc ; along the right side
1200 adc #40 ;
1210 sta r0l ;
1220 bcc nc1 ;
1230 inc r0h ;
1240 nc1 jsr fcolor ;
1250 sta (r0l),y ;
1260 dex ;
1270 bne l4 ;
1280 ;
1290 ldx column ;
1300 txa ;
1310 clc ;
1320 adc #40 ;
1330 tay ;
1340 ;
1350 dl jsr fcolor ; move the color
1360 sta (r0l),y ; right to left along
1370 dey ; the bottom
1380 dex ;
1390 bpl dl ;
1400 ;
1410 ldy #0 ;
1420 ldx row ;
1430 dex ;
1440 ;
1450 final jsr fcolor ; move the color
1460 sta (r0l),y ; 'up' along the
1470 lda r0l ; left column
1480 sec ;
1490 sbc #40 ;
1500 sta r0l ;
1510 bcs nborrow ; dec r0h only if a
1520 dec r0h ; 'borrow' cond. exists
1530 nborrow dex
1540 bne final
1550 ;
1560 rts ; return to basic
1570 ;
1580 fcolor lda color ; 'fetch color'
1590 inc color ; routine, gets next
1600 and #15 ; color (won't allow
1610 cmp btemp ; background color)
1620 beq fcolor ;
1630 rts ;
1640 ;
1650 local .byte 0,0,0,0
1660 ;
1670 xc = local
1680 yc = local+1
1690 column = local+2
1700 row = local+3
1710 ;
1720 temp .word 0
1730 color .byte 0
1740 mainc .byte 0
1750 btemp .byte 0