0100     .OPT NO LIST
0110 ;-----------------------
0120 ;
0130 ;Scrolling Screen Editor
0140 ;for SNOWPLOW!
0150 ;
0160 ;by: Barry Kolbe
0170 ;and Bryan Schappel
0180 ;
0190 ;-----------------------
0200 ;
0210     *=  0
0220 PASS .= PASS+1
0230     .IF PASS=1
0240       .INCLUDE #D:SYSEQU.M65
0250       .ENDIF 
0260 ICP =   $3F
0270 SCNMEM = $9000
0280 PMB =   $8000
0290 MYPMB = $8400
0300 P1MEM = MYPMB+$0100
0310 CHSET = PMB
0320 TXTWIN = $8B00
0330 CHRLN1 = TXTWIN+40
0340 CHRLN2 = TXTWIN
0350 TXLN =  TXTWIN+120
0360 STSLN = TXTWIN+80
0370 SC2 =   SCNMEM+128
0380 SC3 =   SC2+128
0390 SC4 =   SC3+128
0400 SC5 =   SC4+128
0410 SC6 =   SC5+128
0420 SC7 =   SC6+128
0430 SC8 =   SC7+128
0440 SC9 =   SC8+128
0450 SC10 =  SC9+128
0460 BCKUP = $7FC0
0470 ;
0480     *=  $80
0490 X1      1
0500 X2      1
0510 X3      1
0520 PGT     1
0530 CREG     1
0540 PXP     2
0550 PYP     1
0560 NYP     1
0570 DRX     2
0580 DRY     2
0590 NPTS     1
0600 INITAB
0610 SPRT     1
0620 LRCRS     1
0630 LRSCRL     1
0640 UDSCRL     1
0650 UDCRS     1
0660 XPOS     1
0670 YPOS     1
0680 PCHR     1
0690 CXPOS     1
0700 LRADD     1
0710 UDADD     1
0720 XERXFLG     1
0730 KCHRS     10
0740 DBH     1
0750 DBV     1
0760 YH2     1
0770 YH3     1
0780 DLIDX     1
0790 IL      2
0800 JL      2
0810 ;
0820 ;Display List
0830 ;
0840     *=  $7F80
0850 DL1 .BYTE $70,$70,$70
0860     .BYTE $45
0870 SL1 .WORD SCNMEM
0880     .BYTE $45
0890     .WORD SC2
0900     .BYTE $45
0910     .WORD SC3
0920     .BYTE $45
0930     .WORD SC4
0940     .BYTE $45
0950     .WORD SC5
0960     .BYTE $45
0970     .WORD SC6
0980     .BYTE $45
0990     .WORD SC7
1000     .BYTE $45
1010     .WORD SC8
1020     .BYTE $45
1030     .WORD SC9
1040     .BYTE $45
1050     .WORD SC10
1060     .BYTE $C4
1070     .WORD TXTWIN
1080     .BYTE $82,$82,$02,$41
1090     .WORD DL1
1100     .OPT LIST
1110     .OPT NO LIST
1120 ;
1130 ;Display List Interrupt
1140 ;
1150     *=  $3000
1160 BEGIN JMP STRT
1170 DLI PHA 
1180     LDA #$E0
1190     STA CHBASE
1200     LDA #$0A
1210     STA COLPF1
1220     TXA 
1230     PHA 
1240     LDX DLIDX
1250     LDA DLICL,X
1260     STA COLPF2
1270     LDA #0
1280     STA COLBK
1290     STA WSYNC
1300     INC DLIDX
1310     PLA 
1320     TAX 
1330     PLA 
1340     RTI 
1350 ;
1360 ;Start of Program
1370 ;
1380 STRT LDY #50
1390 MDL LDA DL1,Y
1400     STA BCKUP,Y
1410     DEY 
1420     BPL MDL
1430 RSTRT JSR CLRSCN
1440 RBEG JSR CLRTXT
1450     JSR SETSTS
1460     JSR PLRMEM
1470     JSR SETPMG
1480     JSR CLRPM
1490     JSR DEFPLR
1500     LDA #6
1510     LDY # <VBI
1520     LDX # >VBI
1530     JSR SETVBV
1540 ;
1550     LDA # >DL1
1560     STA SDLSTL+1
1570     LDA # <DL1
1580     STA SDLSTL
1590     JSR INIT
1600     JSR SHWCRS
1610     JSR SHWXY
1620     JSR CHRCRS
1630 ;
1640 ;Try Stick
1650 ;
1660 CHKSTK LDA STICK0
1670     CMP #$0F
1680     BEQ AKEY
1690     JSR GENMOV
1700     JSR TIME
1710     JMP CHKSTK
1720 AKEY LDA CH
1730     JSR SWITCH
1740     BCC AKEY
1750     CMP #$FF
1760     BEQ TRYTRG
1770     LDX #$FF
1780     STX CH
1790     LDY #14
1800 CKCMP CMP CMKEY,Y
1810     BEQ GTCM
1820     DEY 
1830     BPL CKCMP
1840     BMI TRYTRG
1850 GTCM TYA 
1860     ASL A
1870     TAX 
1880     LDA CMTAB,X
1890     STA JMPOF+1
1900     LDA CMTAB+1,X
1910     STA JMPOF+2
1920     JSR CLRLN1
1930 JMPOF JSR $FFFF
1940     JSR CLRLN1
1950     JSR SHWXY
1960     JMP AKEY
1970 TRYTRG LDA STRIG0
1980     BNE CHKSTK
1990     JSR PLOT
2000     JMP CHKSTK
2010 ;
2020 ;Immed. Vblank
2030 ;
2040 VBI LDY #4
2050 VBI1 LDA COLOR0,Y
2060     STA COLPF0,Y
2070     DEY 
2080     BPL VBI1
2090     LDA # >CHSET
2100     STA CHBASE
2110     INY 
2120     STY DLIDX
2130     JMP SYSVBV
2140 ;
2150 ;General Move Routine
2160 ;
2170 GENMOV CMP #7   ;right?
2180     BNE TLF
2190     JMP MVRT
2200 ;
2210 ;Timer
2220 ;
2230 TIME JSR DELAY
2240     JSR SHWXY
2250     LDA #0
2260     STA ATRACT
2270     RTS 
2280 ;
2290 TLF CMP #11     ;left?
2300     BNE TUP
2310     JMP MVLF
2320 ;
2330 ;Move Up
2340 ;
2350 TUP CMP #14
2360     BNE TDN
2370 UP1 LDA UDCRS
2380     BEQ AA3     ;scrol?
2390     DEC UDCRS
2400     DEC YPOS
2410     LDA NYP
2420     SEC 
2430     SBC #16
2440     STA NYP
2450 TU1 JMP UPDN
2460 AA3 LDA UDSCRL
2470     BEQ NOUD
2480     DEC UDSCRL
2490     DEC YPOS
2500     JSR SCRUP
2510 NOUD RTS 
2520 ;
2530 ;Move Down
2540 ;
2550 TDN CMP #13
2560     BNE TUR
2570 DN1 LDA UDCRS
2580     CMP #9
2590     BEQ AA4     ;scroll?
2600     INC UDCRS
2610     INC YPOS
2620     LDA NYP
2630     CLC 
2640     ADC #16
2650     STA NYP
2660     JMP TU1
2670 AA4 LDA UDSCRL
2680     CMP #9
2690     BEQ NOUD
2700     INC UDSCRL
2710     JSR SCRDN
2720     INC YPOS
2730     RTS 
2740 ;Up-Right
2750 TUR CMP #6
2760     BNE TDR
2770     JSR MVRT
2780     JMP UP1
2790 ;Down-Right
2800 TDR CMP #5
2810     BNE TUL
2820     JSR MVRT
2830     JMP DN1
2840 ;Up-Left
2850 TUL CMP #10
2860     BNE TDL
2870     JSR MVLF
2880     JMP UP1
2890 ;Down-Left
2900 TDL CMP #9
2910     BNE NST
2920     JSR MVLF
2930     JSR DN1
2940 NST RTS 
2950 ;
2960 ;Move Up and Down
2970 ;
2980 UPDN JSR PLRMEM
2990     JSR ERSPLR
3000     LDA NYP
3010     STA PYP
3020     JMP PUTPLR
3030 ;
3040 ;Erase Player
3050 ;
3060 ERSPLR LDA #0
3070     LDY PYP
3080     LDX #15
3090 EML STA (IL),Y
3100     INY 
3110     DEX 
3120     BPL EML
3130     RTS 
3140 ;
3150 ;Set up Player Memory
3160 ;
3170 PLRMEM LDA # >MYPMB
3180     STA IL+1
3190     LDA #0
3200     STA IL
3210     RTS 
3220 ;
3230 ;Move Right
3240 ;
3250 MVRT LDA LRCRS
3260     CMP #39
3270     BNE AA1
3280     LDA #1
3290     STA LRADD
3300     LDA LRSCRL
3310     CMP #88     ;end scrn
3320     BEQ NOLR
3330     INC LRSCRL
3340     INC XPOS
3350     JSR SCRLR
3360 NOLR RTS 
3370 AA1 INC LRCRS
3380     INC XPOS
3390     LDA PXP
3400     CLC 
3410     ADC #4
3420     STA PXP
3430 MV1 LDA PXP
3440     STA HPOSP0
3450     RTS 
3460 ;
3470 ;Move Left
3480 ;
3490 MVLF LDA LRCRS
3500     BEQ AA2
3510     DEC LRCRS
3520     LDA PXP
3530     SEC 
3540     SBC #4
3550     STA PXP
3560     DEC XPOS
3570     JMP MV1
3580 AA2 LDA LRSCRL
3590     BEQ NOLR
3600     DEC LRSCRL
3610     DEC XPOS
3620     LDA #$FF
3630     STA LRADD
3640     JMP SCRLR
3650 ;
3660 ;Close IOCB
3670 ;
3680 CLOSE STX X1
3690     LDA #12
3700     STA ICCOM,X
3710     JSR CIOV
3720     LDX X1
3730     RTS 
3740 ;
3750 ;Set up PMG
3760 ;
3770 SETPMG LDA #62
3780     STA SDMCTL
3790     LDA #1
3800     STA GPRIOR
3810     LDA #3
3820     STA GRACTL
3830     LDA # >PMB
3840     STA PMBASE
3850     LDA #$6C
3860     STA PCOLR0
3870     LDA #0
3880     STA SIZEP0
3890     STA SIZEP1
3900     RTS 
3910 ;
3920 ;Clear P/M area
3930 ;
3940 CLRPM LDA # >MYPMB
3950     STA IL+1
3960     LDA #0
3970     STA IL
3980 CA2 LDY #0
3990 CA1 STA (IL),Y
4000     INY 
4010     BNE CA1
4020     RTS 
4030 ;
4040 ;Define Players
4050 ;
4060 DEFPLR LDY #$20
4070     STY NYP
4080     STY PYP
4090     JSR PLRMEM
4100     JSR PUTPLR
4110     LDA #$2E
4120     STA HPOSP0
4130     STA PXP
4140     RTS 
4150 ;
4160 ;Put Player on screen
4170 ;
4180 PUTPLR LDY PYP
4190     LDX #0
4200 DF1 LDA PL0DEF,X
4210     STA (IL),Y
4220     INX 
4230     INY 
4240     CPX #16
4250     BNE DF1
4260     RTS 
4270 ;
4280 ;Delay Loop
4290 ;
4300 DELAY LDX #0
4310     STX RTCLOK
4320 YLP1 LDX RTCLOK
4330     CPX #4
4340     BNE YLP1
4350     RTS 
4360 ;
4370 DLICL .BYTE $92,$42,$04
4380 NBF .BYTE "000 "
4390 A2I .BYTE $40,$00,$20,$60
4400 PL0DEF .BYTE $FF,$C3,$C3,$C3
4410     .BYTE $C3,$C3,$C3,$C3
4420     .BYTE $C3,$C3,$C3,$C3
4430     .BYTE $C3,$C3,$C3,$FF
4440 P1DEF .BYTE $FC,$C6,$C6,$C6
4450     .BYTE $C6,$C6,$C6,$FC
4460 ;
4470 ;Show Char Set
4480 ;
4490 SHWCRS LDX SPRT
4500     INX 
4510     TXA 
4520     ASL A
4530     ASL A
4540     ASL A
4550     ASL A
4560     ASL A
4570     TAX 
4580     DEX 
4590     TXA 
4600     LDY #31
4610 SH1 STA CHRLN1+4,Y
4620     STA CHRLN2+4,Y
4630     DEX 
4640     TXA 
4650     DEY 
4660     BPL SH1
4670     RTS 
4680 ;
4690 ;Init Memory
4700 ;
4710 INIT LDY #25
4720     LDA #0
4730 INILP STA INITAB,Y
4740     DEY 
4750     BPL INILP
4760 ;set up 128
4770     LDY #0
4780     TYA 
4790     STA M128L
4800     LDA # >SCNMEM
4810     STA M128H
4820 TLP LDA M128L,Y
4830     CLC 
4840     ADC #128
4850     STA M128L+1,Y
4860     LDA M128H,Y
4870     ADC #0
4880     STA M128H+1,Y
4890     INY 
4900     CPY #33
4910     BNE TLP
4920     JSR OPNKEY
4930     LDA # >CHSET
4940     STA CHBAS
4950     LDA #192
4960     STA NMIEN
4970     LDA # >DLI
4980     STA VDSLST+1
4990     LDA # <DLI
5000     STA VDSLST
5010     RTS 
5020 ;
5030 ;Plot a Character
5040 ;
5050 PLOT LDX YPOS
5060     LDA M128L,X
5070     STA JL
5080     LDA M128H,X
5090     STA JL+1
5100     LDA PCHR
5110     LDY XPOS
5120     STA (JL),Y
5130     RTS 
5140 ;
5150 STSCRL LDA # >SL1
5160     STA JL+1
5170     LDA # <SL1
5180     STA JL
5190     RTS 
5200 ;
5210 ;Scroll Left/right
5220 ;
5230 SCRLR JSR STSCRL
5240     LDY #0
5250 SLR LDA (JL),Y
5260     CLC 
5270     ADC LRADD
5280     STA (JL),Y
5290     INY 
5300     INY 
5310     INY 
5320     CPY #30
5330     BNE SLR
5340     RTS 
5350 ;
5360 ;Scroll Down
5370 ;
5380 SCRDN LDY #0
5390 SQ1 LDA SL1+4,Y
5400     STA SL1+1,Y
5410     LDA SL1+3,Y
5420     STA SL1,Y
5430     INY 
5440     INY 
5450     INY 
5460     CPY #27
5470     BNE SQ1
5480     LDA SL1+24
5490     CLC 
5500     ADC #$80
5510     STA SL1+27
5520     LDA SL1+25
5530     ADC #0
5540     STA SL1+28
5550     RTS 
5560 ;
5570 ;Scroll Up
5580 ;
5590 SCRUP LDY #27
5600 SUP1 LDA SL1-3,Y
5610     STA SL1,Y
5620     LDA SL1-2,Y
5630     STA SL1+1,Y
5640     DEY 
5650     DEY 
5660     DEY 
5670     BNE SUP1
5680     LDA SL1
5690     SEC 
5700     SBC #$80
5710     STA SL1
5720     LDA SL1+1
5730     SBC #0
5740     STA SL1+1
5750     RTS 
5760 ;
5770 ;Clear Screen
5780 ;
5790 CLRSCN LDA # >SCNMEM
5800     STA IL+1
5810     LDA #0
5820     STA IL
5830     LDX #9      ;10 pages
5840 CS1 LDY #$FF
5850 CSLP STA (IL),Y
5860     DEY 
5870     CPY #$FF
5880     BNE CSLP
5890     INC IL+1
5900     DEX 
5910     BPL CS1
5920     RTS 
5930 ;
5940 ;Character Cursor
5950 ;
5960 CHRCRS LDY #$FF ;erase
5970     LDA #0
5980 CR1 INY 
5990     STA P1MEM,Y
6000     CPY #$FF
6010     BNE CR1
6020 ;define playr
6030     LDY #200
6040     LDX #0
6050 CR2 LDA P1DEF,X
6060     STA P1MEM,Y
6070     INY 
6080     INX 
6090     CPX #8
6100     BNE CR2
6110     LDA #ICP
6120     STA HPOSP0+1
6130     STA PXP+1
6140     LDA #$4D
6150     STA PCOLR1
6160     RTS 
6170 ;
6180 ;Move Character Cursor
6190 ;
6200 KSELECT LDX # <CHRMES
6210     LDA # >CHRMES
6220     JSR PRINT
6230 MVCRS LDA STICK0
6240     CMP #$0F
6250     BNE BH
6260     JMP CKTRG2
6270 BH  CMP #7      ;rt?
6280     BNE ML
6290     LDA CXPOS
6300     CMP #31
6310     BEQ BB
6320     INC CXPOS
6330     LDA PXP+1
6340     CLC 
6350     ADC #4
6360     JMP BF
6370 BB  LDA #0
6380     STA CXPOS
6390     LDA #ICP
6400     BNE BF
6410 ;
6420 ML  CMP #11     ;lef?
6430     BNE MU
6440     LDA CXPOS
6450     BEQ BE
6460     DEC CXPOS
6470     LDA PXP+1
6480     SEC 
6490     SBC #4
6500 BF  STA PXP+1
6510     STA HPOSP0+1
6520     JMP SLOW
6530 BE  LDA #31
6540     STA CXPOS
6550     LDA #187
6560     BNE BF
6570 ;up
6580 MU  CMP #14
6590     BNE MD
6600     LDA SPRT
6610     BEQ BC
6620     DEC SPRT
6630 DOC JSR SHWCRS
6640     JMP SLOW
6650 BC  LDA #3
6660     STA SPRT
6670     BNE DOC
6680 ;
6690 MD  CMP #13
6700     BNE CKTRG2
6710     INC SPRT
6720     LDA SPRT
6730     CMP #4
6740     BNE DOC
6750     LDA #0
6760     STA SPRT
6770     BEQ DOC
6780 ;
6790 CKTRG2 LDA STRIG0
6800     BNE SJ
6810     JSR CLICK
6820     JSR DELAY
6830 CTR LDA STRIG0
6840     BEQ CTR
6850     LDX SPRT
6860     INX 
6870     TXA 
6880     ASL A
6890     ASL A
6900     ASL A
6910     ASL A
6920     ASL A
6930     CLC 
6940     ADC CXPOS
6950     SEC 
6960     SBC #32
6970     STA PCHR
6980     JMP DELAY
6990 SLOW JSR DELAY
7000 SJ  JMP MVCRS
7010 ;
7020 ;Print Text  x=lo,a=hi
7030 ;
7040 PRINT STX IL
7050     STA IL+1
7060     LDY #$FF
7070 MLP INY 
7080     LDA (IL),Y
7090     STA TXLN+2,Y
7100     BPL MLP
7110     AND #$7F
7120     STA TXLN+2,Y
7130     RTS 
7140 ;
7150 CHRMES .SBYTE "Choose character"
7160 COLMES .SBYTE "Color register 0-4"
7170 DRWMES .SBYTE "Draw mode"
7180 BLKMES .SBYTE "Block fill"
7190 FNTMES .SBYTE "Loading font"
7200 DEFMES .SBYTE "Define block"
7210 STPMES .SBYTE "Copy block"
7220 ;
7230 ;clearline
7240 ;
7250 CLRLN1 LDY #39
7260     LDA #0
7270 CN1 STA TXLN,Y
7280     DEY 
7290     BPL CN1
7300     RTS 
7310 ;
7320 ;Clear Text Window
7330 ;
7340 CLRTXT LDY #160
7350     LDA #0
7360 CTLP STA TXTWIN,Y
7370     DEY 
7380     CPY #$FF
7390     BNE CTLP
7400     RTS 
7410 ;
7420 ;colors
7430 ;
7440 COLORS LDX # <COLMES
7450     LDA # >COLMES
7460     JSR PRINT
7470 CKEY LDA CH
7480     LDX #$FF
7490     CMP #$FF
7500     BEQ CKEY
7510     CMP #$1C    ;out
7520     BEQ CA
7530     LDY #4
7540 CMS CMP CLRKEY,Y
7550     BEQ CCC
7560     DEY 
7570     BPL CMS
7580     BMI CKEY
7590 CA  STX CH
7600     RTS 
7610 CCC LDA CLREG,Y ;offset
7620     STA CREG    ;save it
7630     JSR CLRLN1
7640 ;Change Register
7650     LDX # <REGMES
7660     LDA # >REGMES
7670     JSR PRINT
7680     JSR DISREG
7690     LDY CREG
7700     LDA COLOR0,Y
7710     PHA 
7720     AND #$F0
7730     STA X2
7740     PLA 
7750     AND #$0F
7760     STA X3
7770 CSTK LDA STICK0
7780     CMP #7      ;rt
7790     BNE CLF
7800     LDA X2
7810     CLC 
7820     ADC #16
7830     STA X2
7840     JMP SCOLR
7850 CLF CMP #11
7860     BNE CUP
7870     LDA X2
7880     SEC 
7890     SBC #16
7900     STA X2
7910     JMP SCOLR
7920 CUP CMP #14
7930     BNE CDN
7940     INC X3
7950     INC X3
7960     LDA X3
7970     AND #$0F
7980     STA X3
7990     JMP SCOLR
8000 CDN CMP #13
8010     BNE CSTG
8020     DEC X3
8030     DEC X3
8040     LDA X3
8050     AND #$0F
8060     STA X3
8070 SCOLR LDA X2
8080     ORA X3
8090     LDY CREG
8100     STA COLOR0,Y
8110     JSR DISREG
8120     JSR DELAY
8130 CSTG LDA STRIG0
8140     BNE CSTK
8150 CC2 LDA STRIG0
8160     BNE CC2
8170     RTS 
8180 ;
8190 CLRKEY .BYTE $32,$1F,$1E,$1A,$18
8200 CLREG .BYTE 0,1,2,3,4
8210 ;
8220 ;Show X/Y Position
8230 ;
8240 SHWXY LDA XPOS
8250     LDX #10
8260     JSR RJUST
8270     LDA YPOS
8280     LDX #16
8290     JSR RJUST
8300 ;
8310 ;Show character
8320 ;
8330     LDY YPOS
8340     JSR WHER
8350     LDY XPOS
8360     LDA (JL),Y
8370     STA STSLN+22
8380 ;
8390 NOERM LDY #3
8400 NLP LDA NOM,Y
8410     STA STSLN+31,Y
8420     DEY 
8430     BPL NLP
8440     RTS 
8450 ;
8460 ;Right justify a number
8470 ;
8480 RJUST STA FR0
8490     LDA #0
8500     STA FR0+1
8510     TXA 
8520     PHA 
8530     JSR IFP
8540     JSR FASC
8550     LDY #2
8560     LDA #'0
8570 RJ1 STA NBF,Y
8580     DEY 
8590     BPL RJ1
8600     LDY #$FF
8610 RJ2 INY 
8620     LDA (INBUFF),Y
8630     BPL RJ2
8640     AND #$7F
8650     STA (INBUFF),Y
8660     INY 
8670     TYA 
8680     EOR #3
8690     AND #3
8700     TAX 
8710     LDY #0
8720 RJ3 LDA (INBUFF),Y
8730     STA NBF,X
8740     INY 
8750     INX 
8760     CPX #3
8770     BNE RJ3
8780     LDY #3
8790     PLA 
8800     TAX 
8810 RJ4 LDA NBF,Y
8820     AND #$1F
8830     STA STSLN,X
8840     DEX 
8850     DEY 
8860     BPL RJ4
8870     RTS 
8880 ;
8890 ;Set up Status Line
8900 ;
8910 SETSTS LDY #39
8920     LDA #0
8930 STLP STA STSLN,Y
8940     DEY 
8950     BPL STLP
8960     LDY #24
8970 STLX LDA SLD,Y
8980     STA STSLN+5,Y
8990     DEY 
9000     BPL STLX
9010     JMP SHWXY
9020 SLD .SBYTE "X:000 Y:000 CHAR:  "
9030     .SBYTE "Error:"
9040 ;
9050 WHER LDA M128L,Y
9060     STA JL
9070     LDA M128H,Y
9080     STA JL+1
9090     RTS 
9100 ;
9110 DRAW LDA #$FF
9120     STA NPTS
9130     LDA # >DRWMES
9140     LDX # <DRWMES
9150     JSR PRINT
9160 DRG JSR GETTWO
9170     BCS DRP
9180 DODRW LDA DRX
9190     CMP DRX+1
9200     BEQ DUD     ;up/dn
9210     LDA DRY
9220     CMP DRY+1
9230     BNE DRP
9240     LDA DRX+1
9250     CMP DRX
9260     BCS DR5
9270     PHA 
9280     LDA DRX
9290     STA DRX+1
9300     PLA 
9310     STA DRX
9320 DR5 JSR DRLR
9330     JMP DRG
9340 DRP LDA #$FF
9350     STA CH
9360     RTS 
9370 ;
9380 ;Up and Down
9390 DUD LDA DRY+1
9400     CMP DRY
9410     BEQ DRP
9420     BCS UYOK
9430     PHA 
9440     LDA DRY
9450     STA DRY+1
9460     PLA 
9470     STA DRY
9480 UYOK JSR DWUD
9490     JMP DRP
9500 ;
9510 ;Do Up/Down Draw
9520 DWUD LDY DRY+1
9530 DDB JSR WHER
9540     LDY DRX
9550     LDA PCHR
9560     STA (JL),Y
9570     DEC DRY+1
9580     LDY DRY+1
9590     CPY DRY
9600     BNE DDB
9610     JSR WHER
9620     LDY DRX
9630     LDA PCHR
9640     STA (JL),Y
9650     RTS 
9660 ;
9670 ;Draw left and right
9680 DRLR LDY DRY
9690     JSR WHER
9700     LDY DRX+1
9710     LDA PCHR
9720 DR7 STA (JL),Y
9730     DEY 
9740     CPY DRX
9750     BNE DR7
9760     STA (JL),Y
9770 DR8 RTS 
9780 ;
9790 ;Click Speaker
9800 ;
9810 CLICK LDA #0
9820     STA CONSOL
9830     RTS 
9840 ;
9850 BLOCK LDA #$FF
9860     STA NPTS
9870     LDA # >BLKMES
9880     LDX # <BLKMES
9890     JSR PRINT
9900     JSR GETTWO
9910     BCC BAB
9920 BAC RTS 
9930 BAB LDA DRX+1
9940     CMP DRX
9950     BEQ BAC
9960     BCC BAC
9970     LDA DRY+1
9980     CMP DRY
9990     BEQ BAC
010000   BCC BAC
010010   INC DRY+1
010020 BAD JSR DRLR
010030   INC DRY
010040   LDA DRY
010050   CMP DRY+1
010060   BNE BAD
010070   BEQ BAC
010080 ;
010090 ;Get two screen Positions
010100 GETTWO LDA #$FF
010110   STA NPTS
010120 GTWO LDA CH
010130   CMP #$1C
010140   BNE DRS
010150   LDA #$FF
010160   STA CH
010170   SEC 
010180   RTS 
010190 DRS LDA STICK0
010200   CMP #$0F
010210   BEQ DRU
010220   JSR GENMOV
010230   JSR TIME
010240 DRU LDA STRIG0
010250   BNE GTWO
010260   JSR CLICK
010270 REL LDA STRIG0
010280   BEQ REL
010290   INC NPTS
010300   LDY NPTS
010310   LDA XPOS
010320   STA DRX,Y
010330   LDA YPOS
010340   STA DRY,Y
010350   LDA NPTS
010360   CMP #1
010370   BEQ GOM
010380   JMP GTWO
010390 GOM CLC 
010400   RTS 
010410 CMTAB .WORD KSELECT
010420   .WORD COLORS
010430   .WORD DRAW
010440   .WORD BRIGHT
010450   .WORD BLOCK
010460   .WORD FONT
010470   .WORD LOADM
010480   .WORD SAVEM
010490   .WORD QUIT
010500   .WORD CLRMAP
010510   .WORD RESTART
010520   .WORD HOME
010530   .WORD DEFINE
010540   .WORD XEROX
010550   .WORD DEFKEY
010560 ;
010570 CMKEY .BYTE $05,$12,$3A,$0A
010580   .BYTE $15,$38,$00,$3E,$2F
010590   .BYTE $B6,$B9,$39,$25
010600   .BYTE $16,$2D
010610 ;k c d q clr ^h h m x t
010620 ;
010630 ;Change Luminance of Player
010640 ;
010650 BRIGHT LDA PCOLR0
010660   EOR #$0E
010670   STA PCOLR0
010680   RTS 
010690 ;
010700 ;Load Font
010710 ;
010720 FONT LDX # <FNTMES
010730   LDA # >FNTMES
010740   JSR PRINT
010750   JSR GTNAME
010760   BCC FAA
010770   RTS 
010780 FAA LDX #$10
010790   JSR CLOSE
010800   LDA #3
010810   STA ICCOM,X
010820   LDA # >FNAME
010830   STA ICBAH,X
010840   LDA # <FNAME
010850   STA ICBAL,X
010860   LDA #0
010870   STA AUX2,X
010880   LDA #4
010890   STA AUX1,X
010900   JSR CIOV
010910   BPL FAB
010920 FAC STY X2
010930   JMP IOERR
010940 FAB LDA #7
010950   STA ICCOM,X
010960   LDA # >CHSET
010970   STA ICBAH,X
010980   LDA #0
010990   STA ICBAL,X
011000   LDA #4
011010   STA ICBLH,X
011020   LDA #0
011030   STA ICBLL,X
011040   JSR CIOV
011050   STY X2
011060   BMI IOERR
011070   LDX #$10
011080   JSR CLOSE
011090   JMP NOERM
011100 ;
011110 IOERR LDX #$10
011120   JSR CLOSE
011130   JSR ZFR0
011140   LDA X2
011150   LDX #34
011160   JSR RJUST
011170   JMP GETKEY
011180 ;
011190 ;Open keyboard
011200 ;
011210 OPNKEY LDX #$20
011220   JSR CLOSE
011230   LDA #3
011240   STA ICCOM,X
011250   LDA # >KDEV
011260   STA ICBAH,X
011270   LDA # <KDEV
011280   STA ICBAL,X
011290   LDA #0
011300   STA AUX2,X
011310   LDA #4
011320   STA AUX1,X
011330   JMP CIOV
011340 ;
011350 NOM .SBYTE +$80,"None"
011360 KDEV .BYTE "K:",EOL
011370 ;
011380 ;Get a Key from CIO
011390 GETKEY LDA #0
011400   LDX #$20
011410   STA ICBLL,X
011420   STA ICBLH,X
011430   LDA #7
011440   STA ICCOM,X
011450   JMP CIOV
011460 ;
011470 ;Get filename
011480 ;
011490 GTNAME LDY #0
011500   TYA 
011510 GT1 STA TXLN+18,Y
011520   INY 
011530   CPY #13
011540   BNE GT1
011550   LDA #$24
011560   STA TXLN+16
011570   LDA #$1A
011580   STA TXLN+17
011590   LDX #0
011600 INLP STX X3
011610   LDA #$3F
011620   STA TXLN+18,X ;cursor
011630   LDA #0
011640   STA 694
011650   LDA #64
011660   STA 702
011670   JSR GETKEY
011680   LDX X3
011690   CMP #$1B
011700   BNE GT2
011710   SEC 
011720   RTS 
011730 GT2 CMP #$9B
011740   BEQ INEOL
011750   AND #$7F
011760   CMP #$20
011770   BCC INLP
011780   CMP #126
011790   BNE INEXT
011800   CPX #0
011810   BEQ INLP
011820   DEX 
011830   LDA #0
011840   STA TXLN+18,X
011850   STA TXLN+19,X
011860   BEQ INLP
011870 ;
011880 INEXT CMP #96
011890   BEQ INLP
011900   CMP #123
011910   BCS INLP
011920   CPX #13
011930   BEQ INLP
011940   PHA 
011950   STA FNAME+2,X
011960   ROL A
011970   ROL A
011980   ROL A
011990   ROL A
012000   AND #3
012010   TAY 
012020   PLA 
012030   AND #$9F
012040   ORA A2I,Y
012050   STA TXLN+18,X
012060   INX 
012070   BNE INLP
012080 ;
012090 INEOL STA FNAME+2,X
012100   CLC 
012110   RTS 
012120 ;
012130 ;Show color register
012140 ;
012150 DISREG LDY CREG
012160 RGD LDA CRG1,Y
012170   STA TXLN+11
012180   LDA CRG2,Y
012190   STA TXLN+12
012200   LDA COLOR0,Y
012210   PHA 
012220   AND #$F0
012230   LSR A
012240   LSR A
012250   LSR A
012260   LSR A
012270   JSR HEX
012280   STA TXLN+19
012290   PLA 
012300   AND #$0F
012310   JSR HEX
012320   STA TXLN+27
012330   RTS 
012340 ;
012350 HEX TAX 
012360   LDA HEXB,X
012370   RTS 
012380 ;
012390 HEXB .SBYTE "0123456789ABCDEF"
012400 ;
012410 CRG1 .SBYTE "00111"
012420 CRG2 .SBYTE "89012"
012430 REGMES .SBYTE " Color: 7   Hue:$   Lum:$"
012440 ;
012450 ;Load a Map
012460 LOADM LDA #4  ;read
012470   STA X2
012480   LDA #7
012490   STA PGT
012500   LDA # >LODMES
012510   LDX # <LODMES
012520 INLOD JSR PRINT
012530   JSR GTNAME
012540   BCC NMOK
012550   RTS 
012560 NMOK LDX #$10
012570   JSR CLOSE
012580   LDA X2
012590   STA AUX1,X
012600   LDA #3
012610   STA ICCOM,X
012620   LDA # >FNAME
012630   STA ICBAH,X
012640   LDA # <FNAME
012650   STA ICBAL,X
012660   LDA #0
012670   STA AUX2,X
012680   JSR CIOV
012690   BPL RWOK
012700   STY X2
012710 RWER JMP IOERR
012720 RWOK LDX #$10
012730   LDA # >SCNMEM
012740   STA ICBAH,X
012750   LDA # <SCNMEM
012760   STA ICBAL,X
012770   LDA #0
012780   STA ICBLL,X
012790   LDA #10
012800   STA ICBLH,X
012810   LDA PGT
012820   STA ICCOM,X
012830   JSR CIOV
012840   STY X2
012850   BMI RWER
012860   LDX #$10
012870   JSR CLOSE
012880   JMP NOERM
012890 ;
012900 ;Save a map
012910 ;
012920 SAVEM LDA #8  ;write
012930   STA X2
012940   LDA #11
012950   STA PGT
012960   LDA # >SAVMES
012970   LDX # <SAVMES
012980   JMP INLOD
012990 ;
013000 ;quit
013010 QUIT LDA # >QUTMES
013020   LDX # <QUTMES
013030   JSR PRINT
013040   JSR SURE
013050   BCS NOQ
013060   PLA 
013070   PLA 
013080   JSR MOVEB
013090   LDA #0
013100   STA HPOSP0
013110   STA HPOSP0+1
013120   LDA #6
013130   LDY # <SYSVBV
013140   LDX # >SYSVBV
013150   JSR SETVBV
013160   JMP WARMSV
013170 NOQ RTS 
013180 ;
013190 ;Clear Map
013200 CLRMAP LDA # >SURMES
013210   LDX # <SURMES
013220   JSR PRINT
013230   JSR SURE
013240   BCS ERT
013250   JSR CLRSCN
013260 ERT RTS 
013270 ;
013280 ;sure?
013290 SURE LDA CH
013300   LDX #$FF
013310   CMP #$23
013320   BEQ NO
013330   CMP #$2B
013340   BNE SURE
013350   STX CH
013360   CLC 
013370   RTS 
013380 NO STX CH
013390   SEC 
013400   RTS 
013410 LODMES .SBYTE "Loading file"
013420 SAVMES .SBYTE "Saving file"
013430 SURMES .SBYTE "CLEAR! Are you sure Y/N"
013440 QUTMES .SBYTE "QUIT! Are you sure Y/N"
013450 ;
013460 ;restart
013470 RESTART JSR MOVEB
013480   PLA 
013490   PLA 
013500   JMP RSTRT
013510 ;
013520 ;home
013530 HOME JSR MOVEB
013540   PLA 
013550   PLA 
013560   JMP RBEG
013570 ;
013580 ;Get Display List back
013590 MOVEB LDY #50
013600 MDLB LDA BCKUP,Y
013610   STA DL1,Y
013620   DEY 
013630   BPL MDLB
013640   RTS 
013650 ;
013660 ;Define block
013670 DEFINE LDA # >DEFMES
013680   LDX # <DEFMES
013690   JSR PRINT
013700   LDA #$FF
013710   STA NPTS
013720   JSR GETTWO
013730   BCC DFJ
013740 DFR RTS 
013750 DFJ LDA DRY+1
013760   SEC 
013770   SBC DRY
013780   CMP #10
013790   BCS DFR
013800   TAX         ;keep
013810   LDA DRX+1
013820   SEC 
013830   SBC DRX
013840   CMP #10
013850   BCS DFR
013860   STA DBH
013870   STX DBV
013880   LDA #0
013890   STA YH3
013900   LDA DRX
013910   STA YH2
013920   INC DRX+1
013930   INC DRY+1
013940 DFK LDY DRY
013950   JSR WHER
013960 DFL LDY YH2
013970   LDA (JL),Y
013980   LDY YH3
013990   STA DEFBLK,Y
014000   INC YH3
014010   INC YH2
014020   LDA YH2
014030   CMP DRX+1
014040   BNE DFL
014050   LDA DRX
014060   STA YH2
014070   INC DRY
014080   LDA DRY
014090   CMP DRY+1
014100   BNE DFK
014110   LDA #1
014120   STA XERXFLG ;set flag
014130   RTS 
014140 ;
014150 ;xerox
014160 XEROX LDA XERXFLG ;chk if
014170   BNE XEROX1  ;block defined
014180   RTS 
014190 XEROX1 LDA # >STPMES
014200   LDX # <STPMES
014210   JSR PRINT
014220 XST LDA STICK0
014230   CMP #$0F
014240   BEQ XKY
014250   JSR GENMOV
014260   JSR TIME
014270 XKY LDA CH
014280   CMP #$1C
014290   BNE XTRG
014300   LDA #$FF
014310   STA CH
014320   RTS 
014330 XTRG LDA STRIG0
014340   BNE XST
014350   JSR CLICK
014360 XT2 LDA STRIG0
014370   BEQ XT2
014380   JSR DELAY
014390   LDA XPOS
014400   STA DRX
014410   STA YH3
014420   CLC 
014430   ADC DBH
014440   STA DRX+1
014450   INC DRX+1
014460   CMP #128
014470   BCC XAA
014480 XAB RTS 
014490 XAA LDA YPOS
014500   STA DRY
014510   CLC 
014520   ADC DBV
014530   STA DRY+1
014540   INC DRY+1
014550   CMP #18
014560   BCS XAB
014570 ;do xerox
014580   LDA #0
014590   STA YH2
014600 XLQ LDY DRY
014610   JSR WHER
014620 XLP LDY YH2
014630   LDA DEFBLK,Y
014640   LDY YH3
014650   STA (JL),Y
014660   INC YH3
014670   INC YH2
014680   LDA YH3
014690   CMP DRX+1
014700   BNE XLP
014710   LDA DRX
014720   STA YH3
014730   INC DRY
014740   LDA DRY
014750   CMP DRY+1
014760   BNE XLQ
014770   RTS 
014780 ;
014790 ;Define a key
014800 DEFKEY JSR KSELECT
014810   LDA # >KEYMES
014820   LDX # <KEYMES
014830   JSR PRINT
014840 DKEY LDA CH
014850   CMP #$FF
014860   BEQ DKEY
014870   CMP #$1C
014880   BNE DKO
014890   RTS 
014900 DKO LDY #9
014910 DK2 CMP KEYK,Y
014920   BEQ DK3
014930   DEY 
014940   BPL DK2
014950   BMI DKEY
014960 DK3 LDA PCHR
014970   STA KCHRS,Y
014980   RTS 
014990 ;
015000 KEYMES .SBYTE "  Define 1-0               "
015010 ;
015020 KEYK .BYTE $1F,$1E,$1A,$18
015030   .BYTE $1D,$1B,$33,$35
015040   .BYTE $30,$32
015050 ;
015060 ;Switch keys
015070 ;
015080 SWITCH LDY #9
015090 SW1 CMP KEYK,Y
015100   BEQ SW2
015110   DEY 
015120   BPL SW1
015130   SEC 
015140   RTS 
015150 SW2 LDA KCHRS,Y
015160   STA PCHR
015170   LDA #$FF
015180   STA CH
015190   CLC 
015200   RTS 
015210 FNAME .BYTE "D:"
015220 ;
015230       15
015240 M128L     36
015250 M128H     36
015260 DEFBLK     120
015270   *=  $02E0
015280   .WORD BEGIN