64'er 1988 January/64er_Magazin_88-01_1988_Markt__Technik_de_Side_B.d64/spriteanim.src

Commodore BASIC | 2022-10-26 | 20KB | 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