64'er 1988 January

home *** CD-ROM | disk | FTP | other *** search

/ 64'er 1988 January / 64er_Magazin_88-01_1988_Markt__Technik_de_Side_B.d64 / spriteanim.src (.txt) < prev next >

Wrap

Commodore BASIC | 1988-01-01 | 19.3 KB | 1,407 lines

100 print = $ffd2 110 get = $ffe4 120 load = $ffd5 130 save = $ffd8 140 input2 = $ffcf 150 v = $d000 160 clrscr = $e544 170 home = $e566 180 ivect = $0314 190 irq0 = $ea31 200 offirq = $febc 210 vram = $0288 220 cia2 = $dd00 230 spoint = $a3f8 240 cia1 = $dc00 250 mccalc = $0097 260 spnr = $00fc 270 colour = $0287 280 revers = $00c7 290 esprite = $a800 300 espriteh = $a840 310 colour0 = $b03f 320 colour1 = $b07f 330 colour2 = $b0bf 340 colour3 = $b0ff 350 colour4 = $b13f 360 mc = $b17f 370 paintcol = $006a 380 countl = $00cc 390 counth = $00cd 400 cursy = $00d1 410 cursx = $00d3 420 coly = $00f3 430 curson = $0002 440 xpos = $006e 450 ypos = $006f 460 lotab = $00d9 470 hitab = $ecf0 480 irq2 = $ea61 490 fspeed = $00fd 500 fcount = $00fe 510 xtemp = $00cc 520 ytemp = $00cd 530 seqtab = $b400 540 input = $ffcf 550 fpiccnt = $0069 560 name = $02c0 570 intprint = $bdcd 580 rbutton = $006d 590 nmivect = $0318 600 normnmi = $fe47 610 newnmi = $fec1 620 *=$8000 630 lda #<newnmi 640 sta nmivect 650 lda #>newnmi 660 sta nmivect+1 670 lda #0 680 sta mc 690 sta colour3 700 tax 710 sc sta $b000,x 720 sta $b100,x 730 sta $b200,x 740 sta $b300,x 750 inx 760 bne sc 770 ldy #16 780 sty seqtab+$4f 790 dey 800 ldx #$cf 810 stabinit txa 820 sta seqtab,y 830 dex 840 dey 850 bpl stabinit 860 lda #11 870 sta colour0 880 lda #1 890 sta colour1 900 lda #12 910 sta colour2 920 lda #7 930 sta colour4 940 lda #$80 950 sta 650 960 lda #$36 970 sta 1 980 lda #$a0 990 sta vram 1000 lda #1 1010 sta cia2 1020 begin *=* 1030 ldx #0 1040 sprnrp lda sprnr,x 1050 jsr print 1060 inx 1070 cmp #$d 1080 bne sprnrp 1090 ldy #4 1100 jsr spritebg 1110 ldy #18 1120 jsr spritebg 1130 sei 1140 lda #<irq1 1150 sta ivect 1160 lda #>irq1 1170 sta ivect+1 1180 ldy #$24 1190 vl lda victab,y 1200 sta v,y 1210 dey 1220 bpl vl 1230 ldx #7 1240 lda #$c7 1250 spl sta spoint,x 1260 sec 1270 sbc #1 1280 dex 1290 bpl spl 1300 jsr colset 1310 cli 1320 jmp choose 1330 colset lda colour1 1340 ldy #7 1350 cols sta v+$27,y 1360 dey 1370 bpl cols 1380 lda colour2 1390 sta v+$25 1400 lda colour3 1410 sta v+$26 1420 lda mc 1430 sta v+$1c 1440 rts 1450 spritebg *=* 1460 ldx #0 1470 jsr printat 1480 lda colour0 1490 sta $286 1500 ldy #16 1510 spbg ldx #6 1520 b(NULL)ut lda bgasc,x 1530 jsr print 1540 dex 1550 bpl b(NULL)ut 1560 dey 1570 bne spbg 1580 ldy #8 1590 sprst ldx #6 1600 rstout lda rstasc,x 1610 jsr print 1620 dex 1630 bpl rstout 1640 dey 1650 bne sprst 1660 rts 1670 bgasc .asc " [146] " 1680 rstasc .asc " [146][185][185][185] " 1690 victab *=* 1700 .byt $20,$52,$48,$52,$70,$52,$98,$52 1710 .byt $c0,$52,$e8,$52,$10,$52,$38,$52 1720 .byt $c0,$1b,$80,$00,$00,$ff,$08,$00 1730 .byt $84,$0f,$01,$00,$00,$00,$00,$00 1740 .byt $00,$00,$00,$00,$00 1750 irq1 *=* 1760 lda v+$19 1770 sta v+$19 1780 bmi raster 1790 lda cia1+$d 1800 cli 1810 jmp irq0 1820 raster *=* 1830 ldy #$f 1840 sy lda v,y 1850 eor #$52^($52+112) 1860 sta v,y 1870 dey 1880 dey 1890 bpl sy 1900 ldx #7 1910 np lda spoint,x 1920 eor #8 1930 sta spoint,x 1940 dex 1950 bpl np 1960 lda v+$12 1970 eor #$80 1980 and #$80 1990 sta v+$12 2000 jmp offirq 2010 choose *=* 2020 ldx #0 2030 sc0 jsr invert 2040 sc1 txa 2050 pha 2060 jsr get 2070 pla 2080 tax 2090 cpy #"" 2100 bne nright 2110 jsr invert 2120 inx 2130 jmp sc0 2140 nright cpy #"" 2150 bne nleft 2160 jsr invert 2170 dex 2180 jmp sc0 2190 nleft cpy #"[133]" 2200 bne sc1 2210 jsr invert 2220 stx spnr 2230 txa 2240 and #3 2250 tay 2260 lda stabl,y 2270 sta $fa 2280 lda stabh,x 2290 sta $fb 2300 ldy #$3e 2310 sco0 lda ($fa),y 2320 sta esprite,y 2330 dey 2340 bpl sco0 2350 jmp screen 2360 stabl *=* 2370 .byt $00,$40,$80,$c0 2380 stabh *=* 2390 .byt $b0,$b0,$b0,$b0,$b1,$b1,$b1,$b1 2400 .byt $b2,$b2,$b2,$b2,$b3,$b3,$b3,$b3 2410 invert *=* 2420 txa 2430 and #$f 2440 tax 2450 and #3 2460 tay 2470 lda stabl,y 2480 sta $fa 2490 lda stabh,x 2500 sta $fb 2510 ldy #$3e 2520 inv lda ($fa),y 2530 eor #$ff 2540 sta ($fa),y 2550 dey 2560 bpl inv 2570 inx 2580 stx $a008 2590 dex 2600 rts 2610 sprnr *=* 2620 .asc "[147]sprite:" 2630 .byt $d 2640 text *=* 2650 .asc "[147] **** sprite-animator v1.0 ****" 2660 .byt $8d 2670 .asc " by ingolf koch (mcmlxxxvii)" 2680 .byt $d 2690 frame *=* 2700 .byt 26,3 2710 .asc "[213][192][192][192][192][192][192][192][192][192][192][201]" 2720 .byt $8d 2730 .asc "[221] [146][221] [146][221]" 2740 .byt $8d 2750 .asc "[221] [146][221] [146][221]" 2760 .byt $8d 2770 .asc "[221] [146][221][185][185][185][146][221]" 2780 .byt $8d 2790 .asc "[221] [146][221] [146][221]" 2800 .byt $8d 2810 .asc "[221] [146][221] [146][221]" 2820 .byt $8d 2830 .asc "[221][183][183][183][183][183][183][221][185][185][185][146][221]" 2840 .byt $8d 2850 .asc "[202][192][192][192][192][192][192][192][192][192][192][203]" 2860 .byt $d 2870 border *=* 2880 .byt 26,12 2890 .asc "sprite: " 2900 .wor $8d8d,$8d8d,$8d8d,$8d8d 2910 .asc "colours:" 2920 .byt $8d 2930 .asc " 1234" 2940 .byt $8d 2950 .asc " " 2960 .byt $d 2970 printat *=* 2980 lda #"" 2990 jsr print 3000 py dey 3010 bmi px 3020 lda #"" 3030 jsr print 3040 jmp py 3050 px dex 3060 bmi pend 3070 lda #"" 3080 jsr print 3090 jmp px 3100 pend rts 3110 screen *=* 3120 lda #0 3130 sta v+$15 3140 sta v+$1a 3150 sta xpos 3160 sta ypos 3170 sta curson 3180 jsr normirq 3190 ldx #0 3200 tl lda text,x 3210 jsr print 3220 inx 3230 cmp #$d 3240 bne tl 3250 ldx frame 3260 stx $fd 3270 ldy frame+1 3280 jsr printat 3290 ldy #2 3300 sty v+$10 3310 fl lda frame,y 3320 jsr print 3330 iny 3340 cmp #$8d 3350 bne nsr 3360 ldx $fd 3370 jsr px 3380 jmp fl 3390 nsr cmp #$d 3400 bne fl 3410 ldx border 3420 stx $fd 3430 ldy border+1 3440 jsr printat 3450 ldy #2 3460 dl lda border,y 3470 jsr print 3480 iny 3490 cmp #$8d 3500 bne nsrd 3510 ldx $fd 3520 jsr px 3530 jmp dl 3540 nsrd cmp #$d 3550 bne dl 3560 ldx #1 3570 ldy #2 3580 jsr printat 3590 lda #"" 3600 jsr print 3610 ldx #23 3620 lda #"[164]" 3630 ro jsr print 3640 dex 3650 bpl ro 3660 lda #$d 3670 jsr print 3680 ldy #$14 3690 nz lda #"[167]" 3700 jsr print 3710 lda #"" 3720 sta revers 3730 ldx #$17 3740 lda #"[208]" 3750 sx jsr print 3760 dex 3770 bpl sx 3780 lda #0 3790 sta revers 3800 lda #"[165]" 3810 jsr print 3820 lda #$d 3830 jsr print 3840 dey 3850 bpl nz 3860 lda #" " 3870 jsr print 3880 ldx #$17 3890 lda #"[163]" 3900 ru jsr print 3910 dex 3920 bpl ru 3930 lda #$a0 3940 sta spoint 3950 sta spoint+1 3960 lda #1 3970 sta v+$17 3980 sta v+$1d 3990 sta paintcol 4000 lda #$f0 4010 sta v 4020 lda #$28 4030 sta v+2 4040 lda #$52 4050 sta v+1 4060 sta v+3 4070 lda #3 4080 sta v+$15 4090 sta fspeed 4100 sta fcount 4110 sei 4120 lda #<irq2 4130 sta ivect 4140 lda #>irq2 4150 sta ivect+1 4160 cli 4170 lda #1 4180 sta countl 4190 display jsr displspr 4200 jsr pcolinv 4210 jmp getloop 4220 displspr *=* 4230 jsr colset 4240 lda #3*40+1 4250 sta coly 4260 lda #$d8 4270 sta coly+1 4280 lda mc 4290 and #$42 4300 ora #$81 4310 sta mccalc 4320 lda paintcol 4330 tax 4340 lda $a364,x 4350 and #$7f 4360 sta $a364,x 4370 txa 4380 and mccalc 4390 sta paintcol 4400 ldy #3 4410 pcolset tya 4420 jsr colcalc 4430 sta $db8c,y 4440 dey 4450 bpl pcolset 4460 ldy #20 4470 ldx #0 4480 sline tya 4490 pha 4500 ldy #0 4510 esprreg txa 4520 pha 4530 lda esprite,x 4540 ldx #7 4550 byteout pha 4560 and mccalc 4570 and #$c0 4580 beq col0 4590 eor #$c0 4600 bne col0 4610 clc 4620 adc #$c0 4630 col0 stx $fa 4640 tax 4650 lda colour0,x 4660 ldx $fa 4670 jsr setmccol 4680 pla 4690 asl 4700 iny 4710 dex 4720 bit mc 4730 bpl nmcdispl 4740 asl 4750 dex 4760 nmcdispl cpx #0 4770 bpl byteout 4780 pla 4790 tax 4800 inx 4810 cpy #24 4820 bcc esprreg 4830 lda coly 4840 clc 4850 adc #40 4860 sta coly 4870 lda coly+1 4880 adc #0 4890 sta coly+1 4900 pla 4910 tay 4920 dey 4930 bpl sline 4940 lda #4*40+27 4950 sta coly 4960 lda #$d8 4970 sta coly+1 4980 ldx #6 4990 backgr ldy #9 5000 lda colour0 5010 backset sta (coly),y 5020 backd dey 5030 cpy #6 5040 beq backd 5050 cpy #0 5060 bpl backset 5070 lda coly 5080 clc 5090 adc #40 5100 sta coly 5110 lda coly+1 5120 adc #0 5130 sta coly+1 5140 dex 5150 bne backgr 5160 ldx spnr 5170 inx 5180 stx $a202 5190 rts 5200 colcalc *=* 5210 asl 5220 asl 5230 asl 5240 asl 5250 asl 5260 asl 5270 tax 5280 lda #>colour0 5290 adc #0 5300 sta cincload 5310 sta cincsave 5320 cincload = *+2 5330 lda colour0,x 5340 rts 5350 ;**** editor **** 5360 crampnt *=* 5370 pha 5380 ldx xpos 5390 ldy ypos 5400 inx 5410 stx cursx 5420 iny 5430 iny 5440 iny 5450 lda hitab,y 5460 sta cursy 5470 sta coly 5480 lda lotab,y 5490 and #3 5500 ora vram 5510 sta cursy+1 5520 and #3 5530 ora #$d8 5540 sta coly+1 5550 pla 5560 rts 5570 getloop *=* 5580 ldx cia1 5590 cpx #$7f 5600 beq cursctrl 5610 jsr cnorm 5620 txa 5630 u lsr 5640 bcs d 5650 jsr up 5660 d lsr 5670 bcs l 5680 jsr down 5690 l lsr 5700 bcs r 5710 jsr left 5720 r lsr 5730 bcs b 5740 jsr right 5750 b jsr crampnt 5760 lsr 5770 bcs cursctrl 5780 jsr button 5790 cursctrl *=* 5800 dec countl 5810 bne getc 5820 jsr crampnt 5830 lda #5 5840 sta countl 5850 ldy cursx 5860 lsr curson 5870 lda colour 5880 bcs cwrt 5890 inc curson 5900 lda (coly),y 5910 sta colour 5920 lda colour4 5930 cwrt jsr setmccol 5940 getc jsr get 5950 cmp #"!" 5960 bcc nocol 5970 cmp #"&" 5980 bcs noinc 5990 sec 6000 sbc #"!" 6010 jsr colcalc 6020 adc #1 6030 and #15 6040 cincsave = *+2 6050 sta colour0,x 6060 jsr cnorm 6070 jmp display 6080 noinc cmp #"1" 6090 bcc nocol 6100 cmp #"5" 6110 bcs nocol 6120 selectc sec 6130 sbc #"1" 6140 pha 6150 jsr pcolinv 6160 pla 6170 and mccalc 6180 and #$03 6190 sta paintcol 6200 jsr pcolinv 6210 jmp getloop 6220 nocol ldy #17 6230 keytest cmp cmdtab,y 6240 beq found 6250 dey 6260 bpl keytest 6270 jsr loop 6275 jmr getloop 6280 found tax 6290 lda ctabh,y 6300 pha 6310 lda ctabl,y 6320 pha 6330 jsr cnorm 6340 txa 6350 rts 6360 loop ldx #$30 6380 lpy dey 6390 bne lpy 6400 dex 6410 bne lpy 6420 rts 6430 cnorm lda #1 6440 sta countl 6450 lda #0 6460 sta curson 6470 lda colour 6480 ldy cursx 6490 setmccol *=* 6500 sta (coly),y 6510 bit mc 6520 bpl nsmc 6530 iny 6540 sta (coly),y 6550 nsmc rts 6560 pcolinv *=* 6570 ldx paintcol 6580 lda $a364,x 6590 eor #$80 6600 sta $a364,x 6610 rts 6620 cmdtab *=* 6630 .asc "xi[136]f+-cenrmts[204][211][196][195]" 6640 ctabl *=* 6650 .byt <exit-1,<chome-1,<invers-1,<multi-1,<film-1 6660 .byt <ufilm-1,<dfilm-1,<clrspr-1,<exchspr-1,<newspr-1 6670 .byt <rollspr-1,<mirror-1,<turnspr-1,<sequence-1 6680 .byt <loadspr-1,<savespr-1,<dir-1,<command-1 6690 ctabh *=* 6700 .byt >exit-1,>chome-1,>invers-1,>multi-1,>film-1 6710 .byt >ufilm-1,>dfilm-1,>clrspr-1,>exchspr-1,>newspr-1 6720 .byt >rollspr-1,>mirror-1,>turnspr-1,>sequence-1 6730 .byt >loadspr-1,>savespr-1,>dir-1,>command-1 6740 up *=* 6750 ldy ypos 6760 dey 6770 bpl u1 6780 ldy #20 6790 sty ypos 6800 jmp left 6810 u1 sty ypos 6820 rts 6830 left *=* 6840 pha 6850 lda mc 6860 and #3 6870 eor #$ff 6880 lsr 6890 and xpos 6900 sbc #1 6910 bcs l1 6920 adc #24 6930 sta xpos 6940 pla 6950 jmp up 6960 l1 sta xpos 6970 pla 6980 rts 6990 right *=* 7000 pha 7010 lda mc 7020 and #3 7030 lsr 7040 eor #$ff 7050 and xpos 7060 adc #1 7070 cmp #24 7080 bcc r1 7090 sbc #24 7100 sta xpos 7110 pla 7120 jmp down 7130 r1 sta xpos 7140 pla 7150 rts 7160 down *=* 7170 ldy ypos 7180 iny 7190 cpy #21 7200 bcc d1 7210 ldy #0 7220 sty ypos 7230 jmp right 7240 d1 sty ypos 7250 rts 7260 exit *=* 7270 jsr suretest 7280 ;ldy #24 7290 ;ldx #1 7300 ;jsr printat 7310 jsr normirq 7320 lda #<normnmi 7330 sta nmivect 7340 lda #>normnmi 7350 sta nmivect+1 7360 cli 7370 lda #0 7380 sta 650 7390 sta v+21 7400 lda #4 7410 sta vram 7420 lda #$14 7430 sta v+$18 7440 lda #3 7450 sta cia2 7460 lda #$37 7470 sta 1 7480 lda #"[153]" 7490 jsr print 7500 jmp clrscr 7510 normirq *=* 7520 sei 7530 lda #<irq0 7540 sta ivect 7550 lda #>irq0 7560 sta ivect+1 7570 rts 7580 chome *=* 7590 lda #0 7600 sta xpos 7610 sta ypos 7620 jmp getloop 7630 invers *=* 7640 ldx #$3e 7650 invl lda esprite,x 7660 eor #255 7670 sta esprite,x 7680 dex 7690 bpl invl 7700 jmp display 7710 multi *=* 7720 lda #$ff 7730 asl mc 7740 adc #0 7750 sta mc 7760 jsr displspr 7770 jsr pcolinv 7780 jmp chome 7790 film *=* 7800 lda #$28 7810 sta v+4 7820 lda #6 7830 sta v+$10 7840 lda #$6a 7850 sta v+5 7860 lda v+$15 7870 eor #%100 7880 sta v+$15 7890 lda #0 7900 sta fpiccnt 7910 sei 7920 lda ivect 7930 eor #<(irq2^irq3) 7940 sta ivect 7950 lda ivect+1 7960 eor #>(irq2^irq3) 7970 sta ivect+1 7980 cli 7990 jmp getloop 8000 ufilm *=* 8010 dec fspeed 8020 lda #1 8030 sta fcount 8040 jmp getloop 8050 dfilm *=* 8060 inc fspeed 8070 lda #1 8080 sta fcount 8090 jmp getloop 8100 irq3 *=* 8110 dec fcount 8120 bne fok0 8130 lda fspeed 8140 sta fcount 8150 ldy fpiccnt 8160 lda seqtab,y 8170 tax 8180 and #15 8190 cmp spnr 8200 php 8210 txa 8220 plp 8230 bne nesp 8240 ldx #$a0 8250 nesp stx spoint+2 8260 iny 8270 cpy seqtab+$4f 8280 bcc endflm 8290 ldy #0 8300 endflm sty fpiccnt 8310 fok0 jmp irq2 8320 button *=* 8330 lda ypos 8340 asl 8350 adc ypos 8360 sta $fa 8370 lda xpos 8380 pha 8390 lsr 8400 lsr 8410 lsr 8420 clc 8430 adc $fa 8440 tay 8450 pla 8460 and #7 8470 tax 8480 lda mccalc 8490 and #$c0 8500 cpx #0 8510 beq nmaskrl 8520 maskrl lsr 8530 dex 8540 bne maskrl 8550 nmaskrl pha 8560 lda paintcol 8570 lsr 8580 bcc col0set 8590 bit mc 8600 bpl col0set 8610 eor #1 8620 col0set rol 8630 tax 8640 pla 8650 pha 8660 and mask,x 8670 sta $fa 8680 pla 8690 eor #$ff 8700 and esprite,y 8710 ora $fa 8720 sta esprite,y 8730 lda paintcol 8740 jsr colcalc 8750 sta colour 8760 setend jmp cnorm 8770 mask *=* 8780 .byt $00,$ff,$55,$aa 8790 clrspr *=* 8800 jsr suretest 8810 ldx #63 8820 lda #0 8830 espcl sta esprite,x 8840 dex 8850 bpl espcl 8860 jmp display 8870 sure *=* 8880 .asc "[146]! sure ?" 8890 clrmess *=* ; y=length 8900 pha 8910 lda #"" 8920 mclr jsr print 8930 dey 8940 bpl mclr 8950 pla 8960 rts 8970 messpos *=* 8980 ldx #26 8990 ldy #16 9000 jmp printat 9010 suretest *=* 9020 pha 9030 jsr messpos 9040 lda #"" 9050 jsr print 9060 pla 9070 jsr print 9080 sureout iny 9090 lda sure,y 9100 jsr print 9110 cmp #"?" 9120 bne sureout 9130 surein jsr get 9140 beq surein 9150 ldy #8 9160 jsr clrmess 9170 cmp #"y" 9180 beq endsure 9190 pla 9200 pla 9210 jmp getloop 9220 endsure rts 9230 exchspr *=* 9240 jsr sprtnr 9250 bcc noexc 9260 sta spnr 9270 adc #0 9280 sta $a202 9290 noexc jmp getloop 9300 spnrtxt .asc "def a-p,cr" 9310 sprtnr *=* 9320 jsr messpos 9330 ldy #0 9340 spnrout lda spnrtxt,y 9350 jsr print 9360 iny 9370 cmp #"r" 9380 bne spnrout 9390 spnrin jsr get 9400 beq spnrin 9410 cmp #13 9420 clc 9430 beq cret 9440 cmp #"a" 9450 bcc spnrin 9460 cmp #"q" 9470 bcs spnrin 9480 sec 9490 sbc #1 9500 and #15 9510 cret php 9520 ldy #9 9530 jsr clrmess 9540 plp 9550 rts 9560 withdef .asc "with def ?" 9570 newspr *=* 9580 jsr suretest 9590 jsr messpos 9600 ldy #0 9610 wthdfout lda withdef,y 9620 jsr print 9630 iny 9640 cmp #"?" 9650 bne wthdfout 9660 wthdfin jsr get 9670 beq wthdfin 9680 cmp #"n" 9690 beq nodef 9700 cmp #"y" 9710 bne wthdfin 9720 lda spnr 9730 tax 9740 and #3 9750 tay 9760 lda stabl,y 9770 sta $fa 9780 lda stabh,x 9790 sta $fb 9800 ldy #$3e 9810 sprdef lda esprite,y 9820 sta ($fa),y 9830 dey 9840 bpl sprdef 9850 nodef jmp begin 9860 udlr .asc "roll joy/cr:" 9870 rollspr *=* 9880 jsr messpos 9890 ldy #0 9900 udlrout lda udlr,y 9910 jsr print 9920 iny 9930 cmp #":" 9940 bne udlrout 9950 udlrin lda cia1 9960 pha 9970 and #$10 9980 sta rbutton 9990 pla 10000 lsr 10010 pha 10020 bcs rolld 10030 ldy #2 10040 upha lda esprite,y 10050 pha 10060 dey 10070 bpl upha 10080 iny 10090 ldx #3 10100 rcopyu lda esprite,x 10110 sta esprite,y 10120 inx 10130 iny 10140 cpx #$3f 10150 bcc rcopyu 10160 upla pla 10170 ldx rbutton 10180 bne ucopy 10190 txa 10200 ucopy sta esprite,y 10210 iny 10220 cpy #$3f 10230 bcc upla 10240 rolld *=* 10250 pla 10260 lsr 10270 pha 10280 bcs rolll 10290 ldy #$3e 10300 dpha lda esprite,y 10310 pha 10320 dey 10330 cpy #$3c 10340 bcs dpha 10350 ldx #$3e 10360 rcopyd lda esprite,y 10370 sta esprite,x 10380 dex 10390 dey 10400 bpl rcopyd 10410 ldy #0 10420 dpla pla 10430 ldx rbutton 10440 bne dcopy 10450 txa 10460 dcopy sta esprite,y 10470 iny 10480 cpy #3 10490 bcc dpla 10500 rolll *=* 10510 pla 10520 lsr 10530 pha 10540 bcs rollr 10550 lda mc 10560 sta $fb 10570 rrlloop ldx #$3f 10580 rlinelft ldy #3 ; 3 bytes 10590 clc 10600 rl rol esprite-1,x 10610 dex 10620 dey 10630 bne rl 10640 tya 10650 ldy rbutton 10660 beq nolcopy 10670 rol 10680 nolcopy ora esprite+2,x 10690 sta esprite+2,x 10700 txa 10710 bne rlinelft 10720 inc $fb 10730 beq rrlloop 10740 rollr *=* 10750 pla 10760 lsr 10770 bcs rollcr 10780 lda mc 10790 sta $fb 10800 lrlloop ldx #0 10810 rlinergt ldy #3 ; 3 bytes 10820 clc 10830 rr ror esprite,x 10840 inx 10850 dey 10860 bne rr 10870 tya 10880 ldy rbutton 10890 beq norcopy 10900 ror 10910 norcopy ora esprite-3,x 10920 sta esprite-3,x 10930 cpx #$3f 10940 bcc rlinergt 10950 inc $fb 10960 beq lrlloop 10970 rollcr *=* 10980 jsr displspr 10990 jsr get 11000 cmp #13 11010 beq endroll 11020 ldx #$f4 ; speed 11030 rloop iny 11040 bne rloop 11050 inx 11060 bne rloop 11070 jmp udlrin 11080 endroll *=* 11090 ldy #11 11100 jsr clrmess 11110 jmp display+3 11120 horvert .asc "h[146]or/v[146]ert/cr ?" 11130 mirror *=* 11140 jsr messpos 11150 ldy #0 11160 hvout lda horvert,y 11170 jsr print 11180 iny 11190 cmp #"?" 11200 bne hvout 11210 hvin jsr get 11220 beq hvin 11230 cmp #"h" 11240 bne vert 11250 ldx #$3e 11260 hstore lda esprite,x 11270 pha 11280 dex 11290 bpl hstore 11300 ldx #$3e 11310 horcopy pla 11320 sta esprite-2,x 11330 dex 11340 pla 11350 sta esprite,x 11360 dex 11370 pla 11380 sta esprite+2,x 11390 dex 11400 bpl horcopy 11410 bmi endhv 11420 vert cmp #"v" 11430 bne hvcr 11440 ldx #$3e 11450 vshft ldy #7 11460 vlsr lsr esprite,x 11470 bit mc 11480 bpl nmcmirr 11490 php 11500 lsr esprite,x 11510 rol 11520 dey 11530 plp 11540 nmcmirr rol 11550 dey 11560 bpl vlsr 11570 pha 11580 dex 11590 bpl vshft 11600 inx 11610 vcopy pla 11620 sta esprite+2,x 11630 inx 11640 pla 11650 sta esprite,x 11660 inx 11670 pla 11680 sta esprite-2,x 11690 inx 11700 cpx #$3f 11710 bcc vcopy 11720 bcs endhv 11730 hvcr cmp #13 11740 bne hvin 11750 endhv ldy #12 11760 jsr clrmess 11770 jmp display 11780 turnspr *=* 11790 bit mc 11800 bpl tsprite 11810 jmp getloop 11820 tsprite jsr suretest 11830 ldy #$3e 11840 rcopy lda esprite,y 11850 sta espriteh,y 11860 lda #0 11870 sta esprite,y 11880 dey 11890 bpl rcopy 11900 iny 11910 sty ytemp 11920 tspr ldx #0 11930 turn asl espriteh+2,x 11940 rol espriteh+1,x 11950 rol espriteh,x 11960 stx xtemp 11970 ldx ytemp 11980 ror esprite,x 11990 ror esprite+1,x 12000 ror esprite+2,x 12010 ldx xtemp 12020 inx 12030 inx 12040 inx 12050 cpx #$3d 12060 bcc turn 12070 stx xtemp 12080 ldy ytemp 12090 iny 12100 iny 12110 iny 12120 sty ytemp 12130 cpy #$3d 12140 bcc tspr 12150 jmp display 12160 seqmess .asc "[147]enter sequence (max 79 steps) :" 12170 .byt $d 12180 sequence *=* 12190 ldy #0 12200 sty v+$15 12210 seqout lda seqmess,y 12220 jsr print 12230 iny 12240 cmp #$d 12250 bne seqout 12260 ldy #0 12270 stabout lda seqtab,y 12280 sec 12290 sbc #$c0-"a" 12300 jsr print 12310 iny 12320 cpy seqtab+$4f 12330 bcc stabout 12340 lda #"[157]" ; crsr_ 12350 stabback jsr print 12360 dey 12370 bne stabback 12380 jsr normirq 12390 cli 12400 stabin jsr input 12410 cmp #$d 12420 beq endstab 12430 sec 12440 sbc #"a" 12450 cmp #16 12460 bcs endstab 12470 adc #$c0 12480 sta seqtab,y 12490 iny 12500 cpy #$4f 12510 bcc stabin 12520 endstab sty seqtab+$4f 12530 jmp screen 12540 loadspr *=* 12550 jsr param 12560 ldx #$00 12570 ldy #$b0 ; load from $b000 12580 lda #0 12590 jsr load 12600 jmp begin 12610 savespr *=* 12620 jsr param 12630 lda #$00 12640 sta $fa 12650 lda #$b0 ; save from $b000 12660 sta $fb 12670 lda #$fa 12680 ldx #$50 12690 ldy #$b4 ; to $b450 12700 jsr save 12710 jmp screen 12720 filename .asc "[147]enter filename / return : " 12730 .byt $d 12740 param *=* 12750 ldy #0 12760 sty v+$15 12770 nameout lda filename,y 12780 jsr print 12790 iny 12800 cmp #$d 12810 bne nameout 12820 jsr normirq 12830 cli 12840 ldy #0 12850 namein jsr input 12860 cmp #$d 12870 beq endname 12880 sta name,y 12890 iny 12900 cpy #18 12910 bne namein 12920 endname tya ; length 12930 jsr nametest 12940 bne namedef 12950 pla 12960 pla 12970 jmp screen 12980 namedef ldx #<name 12990 ldy #>name 13000 jsr $fdf9 ; def name 13010 lda #$7f ; lfn 13020 ldx $ba ; device 13030 ldy #0 ; sec.adr 13040 sty $286 13050 jmp $fe00 ; set par 13060 nametest *=* 13070 cmp #1 13080 bne endntest 13090 ldx name 13100 cpx #" " 13110 endntest rts 13120 dirtext .asc "[147]>$0" 13130 dir *=* 13140 ldy #0 13150 sty v+$15 13160 dirout lda dirtext,y 13170 jsr print 13180 iny 13190 cmp #"0" 13200 bne dirout 13210 lda #$7f ; lfn 13220 ldx #8 ; device 13230 ldy #0 ; sec.adr 13240 jsr $ffba 13250 lda #2 13260 ldx #<dirtext+3 13270 ldy #>dirtext+3 13280 jsr $ffbd 13290 jsr $ffc0 ; open127,8,0,"$0,p,r" 13300 bcs direrror 13310 ldx #$7f 13320 jsr $ffc6 ; chkin 13330 jsr get 13340 jsr get ; start.adr 13350 newline lda #$d 13360 jsr print 13370 jsr get 13380 tax 13390 jsr get 13400 bne noenddir 13410 cpx #0 13420 beq enddir 13430 noenddir lda #$37 13440 sta 1 ; basic on 13450 jsr get 13460 tax 13470 jsr get 13480 jsr intprint 13490 lda #$36 13500 sta 1 ; basic off 13510 readline jsr get 13520 jsr print 13530 bne readline 13540 beq newline 13550 enddir jsr $ffcc ; clrch 13560 jsr waitkey 13570 direrror lda #$7f 13580 jsr $ffc3 13590 jmp screen 13600 waitkey *=* 13610 sei 13615 jsr loop 13620 ldx #$fe 13630 stx cia1 13640 dex 13650 waitcr cpx cia1+1 13660 bne waitcr 13670 cli 13680 rts 13690 comtext .asc "[147]enter disk-command :" 13700 .byt $d 13710 command *=* 13720 ldy #0 13730 sty v+$15 13740 comout lda comtext,y 13750 jsr print 13760 iny 13770 cmp #$d 13780 bne comout 13790 jsr normirq 13800 cli 13810 ldy #0 13820 comin jsr input 13830 sta name,y 13840 cmp #$d 13850 beq endcom 13860 iny 13870 cpy #$28 13880 bcc comin 13890 endcom tya 13900 jsr nametest 13910 bne strdef 13920 lda #0 13930 strdef ldx #<name 13940 ldy #>name 13950 jsr $ffbd 13960 lda #$7f 13970 ldx #8 13980 ldy #15 13990 jsr $ffba 14000 jsr $ffc0 ; open1,8,15,comstr 14010 bcs comerror 14020 lda #$d 14030 jsr print 14040 ldx #$7f 14050 jsr $ffc6 14060 diskerr jsr get 14070 jsr print 14080 bit $90 14090 bvc diskerr 14100 jsr $ffcc 14110 jsr waitkey 14120 comerror lda #$7f 14130 jsr $ffc3 14140 jmp screen