*************************
*                       *
*      ARCADE BOARD     *
*                       *
* AMPARCADE INTERPRETER *
*                       *
*************************

* DATE: 10-26-83

* ZERO PAGE
NL EQU $06 ;VRAM TBL ENTRY #
NH EQU $07
ADDRL EQU $08 ;VRAM ADDR
ADDRH EQU $09
BC EQU $19
C EQU $19 ;8080 REG BC
B EQU $1A
DE EQU $1B
E EQU $1B ;8080 REG DE
D EQU $1C
HL EQU $1D
L EQU $1D ;8080 REG HL
H EQU $1E
XPOS EQU $1F ;X POSITION
YPOS EQU $3A ;Y POSITION
HIMEML EQU $73 ;HIMEM PTR
HIMEMH EQU $74
TXTPTL EQU $B8 ;BASIC TEXT PTR
TXTPTH EQU $B9
MCMCOL EQU $D6 ;LORES COL LSN
MCMCOH EQU $D7 ;LORES COL MSN
REG0 EQU $E3
REG1 EQU $EB
REG2 EQU $EC
REG3 EQU $ED
REG4 EQU $EE
REG5 EQU $EF
REG6 EQU $F8
REG7 EQU $F9
REG8 EQU $FA
REG9 EQU $FB
REG10 EQU $FC
REG11 EQU $FD
REG12 EQU $FE
REG13 EQU $FF

* APPLESOFT
AMPLOC EQU $3F5 ;& VECTOR
ERROR EQU $D412
COMBYT EQU $E74C
CHKCOM EQU $DEBE
FRMNUM EQU $DD67
CHKNUM EQU $DD6A
GETADR EQU $E752
PTRGET EQU $DFE3
GIVAYF EQU $E2F2
MOVMF EQU $EB2B
HOME EQU $FC58
LINNUM EQU $50

 ORG $8800

* SETUP: & VECTOR, HIMEM, ETC
SETUP LDY #$02 ;SETUP JMP
SET1 LDA JMPINS,Y ;OP CODE AT
 STA AMPLOC,Y ;& VECTOR
 DEY
 BPL SET1
 JSR SLTFDR ;FIND SLOT
 LDA #<INTER
 STA HIMEML
 LDA #>INTER
 STA HIMEMH ;SET HIMEM
 JSR HOME
 LDX #$00
SET2 LDA SGNON,X
 JSR $FDF0 ;PRINT CHAR
 INX
 CPX #<MSGL-SGNON
 BNE SET2
 RTS
SGNON DFB 141,138
 ASC "ARCADE BOARD "
 ASC "AMPARCADE INTERPRETER"
 DFB 141,138
 ASC "COPYRIGHT (C) 1983"
 DFB 141,138
 ASC "THIRD MILLENNIUM "
 ASC "ENGINEERING CORPORATION"
 DFB 141,138
MSGL EQU *-2
JMPINS JMP INTER  ;PLACE AT & VECTOR

* SLOT FINDER
SLTFDR LDX #$07 ;CHK 7 SLOTS
SLOT1 LDA #$00 ;WR SETUP
 JSR WVREG
 LDA #$40
 JSR WVREG
 LDA #$55 ;WR $55 AND $AA TO
 JSR WVRAM ;1ST 2 VRAM ADDR
 LDA #$AA
 JSR WVRAM
 LDA #$00 ;RD SETUP
 JSR WVREG
 JSR WVREG
 JSR RVRAM ;RD 1ST BYTE
 CMP #$55 ;= DATA WRITTEN?
 BNE NXTSLT ;CHK NEXT SLOT
 JSR RVRAM ;RD 2ND BYTE
 CMP #$AA ;= DATA WRITTEN?
 BNE NXTSLT ;CHK NEXT SLOT
 JSR SOFF ;TURN OFF PSG
 RTS
NXTSLT LDA SNDATA+1
 SEC
 SBC #$10 ;PSG DATA
 STA SNDATA+1
 SBC #$01 ;PSG LATCH ADDR
 STA LTCHAD+1
 SBC #$02 ;WVREG
 STA WVREG+1
 SBC #$01 ;WVRAM
 STA WVRAM+1
 SBC #$01 ;RSTAT
 STA RSTAT+1
 SBC #$01 ;RVRAM
 STA RVRAM+1
 DEX
 BNE SLOT1 ;CHK NEXT SLOT
 BRK  ;NOT FOUND

* INTERPRETER
INTER LDX #$00
 LDY #$00
 STY C ;0 COUNT
ITR1 LDA (TXTPTL),Y ;NEXT CHAR
 STA B ;STORE TEMP
 LDA CMDTBL,X ;CMND TBL NEXT CHAR
 BEQ ITR6 ;IF 0 CMND NOT FOUND
 CMP B ;= & CMND CHAR?
 BNE ITR3 ;IF <> CHK NEXT CMND
 INY  ;ELSE -> NEXT & CMND CHAR
ITR2 INX  ;-> NEXT CMND TBL CHAR
 BNE ITR1 ;256 CHARS ONLY IN CMND TBL
ITR3 AND #$7F ;MSB SET ON LAST CHAR OF CMND
 CMP B
 BEQ ITR7
ITR4 INC C
 LDY #$00
ITR5 LDA #$80
 AND CMDTBL,X
 BNE ITR2
 INX
 BNE ITR5
ITR6 LDX #$10
 JMP ERROR
ITR7 CLC
 INY
 TYA
 ADC TXTPTL
 STA TXTPTL
 BCC ITR8
 INC TXTPTH
ITR8 ASL C
 LDX C
 INX
 LDA SUBTBL,X
 PHA
 DEX
 LDA SUBTBL,X
 PHA
 RTS

* COMMAND TABLE
CMDTBL DCI 'SSPR'
 DCI 'GSPR'
 DCI 'SX'
 DCI 'SY'
 DCI 'GX'
 DCI 'GY'
 DCI 'STIL'
 DCI 'GTIL'
 DCI 'HROW'
 DCI 'VCOL'
 DCI 'HTIL'
 DCI 'VTIL'
 DCI 'FILL'
 DCI 'CSET'
 DCI 'TCOL'
 DCI 'RCST'
 DCI 'RTCL'
 DCI 'TNA'
 DCI 'TNB'
 DCI 'TNC'
 DCI 'NSA'
 DCI 'NSB'
 DCI 'NSC'
 DCI 'ETNA'
 DCI 'ETNB'
 DCI 'ETNC'
 DCI 'ENSA'
 DCI 'ENSB'
 DCI 'ENSC'
 DCI 'VOLA'
 DCI 'VOLB'
 DCI 'VOLC'
 DCI 'MXR'
 DCI 'ENVP'
 DCI 'ENVT'
 DCI 'FILT'
 DCI 'SOFF'
 DCI 'PLT'
 DCI 'SCN'
 DCI 'HLN'
 DCI 'VLN'
 DCI 'COL'
 DCI 'DTIL'
 DCI 'RTIL'
 DCI 'DSPR'
 DCI 'RSPR'
 DCI 'RSTA'
 DCI 'SP'
 DCI 'SC'
 DCI 'GP'
 DCI 'GC'
 DCI 'BCOL'
 DCI 'VREG'
 DCI 'MAG'
 DCI 'GM1A'
 DCI 'GM1B'
 DCI 'GM1C'
 DCI 'GM1D'
 DCI 'GM2'
 DCI 'GM3A'
 DCI 'GM3B'
 DCI 'GM3C'
 DCI 'GM3D'
 DCI 'APVD'
 DCI 'LD'
 DCI 'ULD'
 DFB $00

* CMND ADDR-1
SUBTBL DA SSPR-1
 DA GSPR-1
 DA SX-1
 DA SY-1
 DA GX-1
 DA GY-1
 DA STIL-1
 DA GTIL-1
 DA HROW-1
 DA VCOL-1
 DA HTIL-1
 DA VTIL-1
 DA FILL-1
 DA CSET-1
 DA TCOL-1
 DA RCST-1
 DA RTCL-1
 DA TNA-1
 DA TNB-1
 DA TNC-1
 DA NSA-1
 DA NSB-1
 DA NSC-1
 DA ETNA-1
 DA ETNB-1
 DA ETNC-1
 DA ENSA-1
 DA ENSB-1
 DA ENSC-1
 DA VOLA-1
 DA VOLB-1
 DA VOLC-1
 DA MXR-1
 DA ENVP-1
 DA ENVT-1
 DA FILT-1
 DA SOFF-1
 DA PLT-1
 DA SCN-1
 DA HLN-1
 DA VLN-1
 DA COL-1
 DA DTIL-1
 DA RTIL-1
 DA DSPR-1
 DA RSPR-1
 DA RSTA-1
 DA SP-1
 DA SC-1
 DA GP-1
 DA GC-1
 DA BCOL-1
 DA VREG-1
 DA MAG-1
 DA GM1A-1
 DA GM1B-1
 DA GM1C-1
 DA GM1D-1
 DA GM2-1
 DA GM3A-1
 DA GM3B-1
 DA GM3C-1
 DA GM3D-1
 DA APVD-1
 DA LD-1
 DA ULD-1

********************************
*      BASIC I/O ROUTINES      *
********************************

* RD VDP STATUS
RSTAT LDA $C0F1
 RTS

* RD VRAM
RVRAM LDA $C0F0
 RTS

* WR VREG
WVREG STA $C0F3
 RTS

* WR VRAM
WVRAM STA $C0F2
 RTS

* SET PSG REG #
LTCHAD STA $C0F5
 RTS

* WR DATA TO PSG REG
SNDATA STA $C0F6
 RTS

* VRAM RD SETUP
RDSET JSR RSTAT
 LDA ADDRL
 JSR WVREG
 LDA ADDRH
 JSR WVREG
 RTS

* VRAM WR SETUP
WRSET JSR RSTAT
 LDA ADDRL
 JSR WVREG
 LDA ADDRH
 ORA #$40
 JSR WVREG
 RTS

********************************
*     VDP REGISTER ROUTINES    *
********************************

* INIT VREGS
INIT JSR RSTAT
 BPL INIT
 LDX #$87
INIT1 LDA REGTBL-$80,X
 JSR WVREG
 TXA
 JSR WVREG
 DEX
 BMI INIT1
 RTS

REGTBL EQU *
R0 DFB 0
R1 DFB $C0
NT DFB 0
CT DFB 12
PGT DFB 1
SAT DFB 7
SPGT DFB 2
BDCOLR DFB 0

* SPRITE SIZE & MAG
MAG JSR COMBYT
 TXA
 AND #$03
 STA B ;TEMP STORE
 LDA R1
 AND #$FC
 ORA B
 STA R1
 JMP INIT

* SETUP GM1
GM1A LDA R1
 AND #$03
 ORA #$C0
 STA TBL1A+1
 LDX #$06
GM1A1 LDA TBL1A,X
 STA R0,X
 DEX
 BPL GM1A1
 JMP INIT
TBL1A DFB 0,192,1,30,1,14,0
GM1B LDA R1
 AND #$03
 ORA #$C0
 STA TBL1B+1
 LDX #$06
GM1B1 LDA TBL1B,X
 STA R0,X
 DEX
 BPL GM1B1
 JMP INIT
TBL1B DFB 0,192,5,94,3,46,2
GM1C LDA R1
 AND #$03
 ORA #$C0
 STA TBL1C+1
 LDX #$06
GM1C1 LDA TBL1C,X
 STA R0,X
 DEX
 BPL GM1C1
 JMP INIT
TBL1C DFB 0,192,9,158,5,78,4
GM1D LDA R1
 AND #$03
 ORA #$C0
 STA TBL1D+1
 LDX #$06
GM1D1 LDA TBL1D,X
 STA R0,X
 DEX
 BPL GM1D1
 JMP INIT
TBL1D DFB 0,192,13,222,7,110,6

* SETUP MCM
GM3A LDA R1
 AND #$03
 ORA #$C8
 STA TBL3A+1
 LDX #$06
GM3A1 LDA TBL3A,X
 STA R0,X
 DEX
 BPL GM3A1
 JMP MULCOL ;SET UP NT & PGT
TBL3A DFB 0,200,1,63,1,28,0
GM3B LDA R1
 AND #$03
 ORA #$C8
 STA TBL3B+1
 LDX #$06
GM3B1 LDA TBL3B,X
 STA R0,X
 DEX
 BPL GM3B1
 JMP MULCOL
TBL3B DFB 0,200,5,127,3,60,2
GM3C LDA R1
 AND #$03
 ORA #$C8
 STA TBL3C+1
 LDX #$06
GM3C1 LDA TBL3C,X
 STA R0,X
 DEX
 BPL GM3C1
 JMP MULCOL
TBL3C DFB 0,200,9,191,5,92,4
GM3D LDA R1
 AND #$03
 ORA #$C8
 STA TBL3D+1
 LDX #$06
GM3D1 LDA TBL3D,X
 STA R0,X
 DEX
 BPL GM3D1
 JMP MULCOL
TBL3D DFB 0,200,13,255,7,124,6

* SETUP GM2
GM2 LDA R1
 AND #$03
 ORA #$C0
 STA TBL2+1
 LDX #$06
GMOD2A LDA TBL2,X
 STA R0,X
 DEX
 BPL GMOD2A
 JMP INIT
TBL2 DFB 2,192,6,255,3,54,7

* RET VDP STAT
RSTA JSR CHKCOM
 JSR RSTAT
 TAY
 LDA #$00
 JSR GIVAYF
 JSR PTRGET
 JSR CHKNUM
 TAX
 JSR MOVMF
 RTS

* SET BACKDROP COLOR
BCOL JSR COMBYT
BCOL1 JSR RSTAT
 BPL BCOL1
 TXA
 STA BDCOLR ;NEW BD COLOR
 JSR WVREG
 LDA #$87
 JSR WVREG
 RTS

* DEF VREG
VREG JSR COMBYT ;REG #
 CPX #$08 ;0 - 7 ONLY
 BCS VREG2 ;ERROR
 STX B ;TEMP SAVE
VREG1 JSR COMBYT ;DATA
 TXA
 LDX B
 STA REGTBL,X
 JSR IFCOM
 BNE VREG3
 INX
 CPX #$08 ;0 - 7 ONLY
 BCS VREG2 ;ERROR
 STX B ;TEMP SAVE
 BCC VREG1 ;NEXT DATA
VREG2 LDX #$10
 JMP ERROR
VREG3 JMP INIT

* ENABLE APPLE VIDEO
APVD JSR RSTAT
 LDA #$01
 JSR WVREG
 LDA #$80
 JSR WVREG
 JSR WVREG
 LDA #$81
 JSR WVREG
 LDA #$00
 JSR WVREG
 LDA #$87
 JSR WVREG
 RTS

********************************
*     NAME TABLE ROUTINES      *
********************************

* CONV X,Y TO NT ENTRY N
XYCONV LDA #$00
 STA NH
 LDA YPOS
 ASL A
 ASL A
 ASL A
 ASL A
 ROL NH
 ASL A
 ROL NH
 ADC XPOS
 STA NL

* CALC ADDR OF NT ENTRY N
NTADD LDA NT
 ASL A
 ASL A
 CLC
 ADC NH
 STA ADDRH
 LDA NL
 STA ADDRL
 RTS

* SET TILE PAT (0-255) AT X,Y
STIL JSR COMBYT
 STX XPOS
 JSR COMBYT
 STX YPOS
 JSR XYCONV
 JSR WRSET
 JSR GET16
 LDA LINNUM ;P
 JSR WVRAM
 JSR IFCOM
 BEQ STIL
 RTS

* SET TILES IN COL
VTIL JSR COMBYT
 STX XPOS
 JSR COMBYT
 STX YPOS
 JSR XYCONV
VTIL1 JSR WRSET
 JSR GET16
 LDA LINNUM
 JSR WVRAM
 JSR IFCOM
 BNE VTIL2
 LDA ADDRL
 CLC
 ADC #$20
 STA ADDRL
 LDA #$00
 ADC ADDRH
 STA ADDRH
 JMP VTIL1
VTIL2 RTS

* SET TILES IN ROW
HTIL JSR COMBYT
 STX XPOS
 JSR COMBYT
 STX YPOS
 JSR XYCONV
 JSR WRSET
HTIL1 JSR GET16
 LDA LINNUM
 JSR WVRAM
 JSR IFCOM
 BEQ HTIL1
 RTS

* RET PAT # AT X,Y
GTIL JSR COMBYT
 STX XPOS
 JSR COMBYT
 STX YPOS
 JSR XYCONV
 JSR RDSET
 JSR CHKCOM
 JSR RVRAM
 TAY
 LDA R0
 AND #$02
 BEQ GTIL1
 LDA YPOS
 LSR A
 LSR A
 LSR A ;Y / 8
GTIL1 JSR PUT16
 JSR IFCOM
 BEQ GTIL
 RTS

* ROW OF SAME PAT #
HROW JSR COMBYT
 STX XPOS
 JSR COMBYT
 STX YPOS
 JSR XYCONV
 JSR WRSET
 JSR GET16
 LDA LINNUM
 PHA  ;SAVE PAT #
 JSR WVRAM
 JSR COMBYT ;REPEAT #
 DEX
 BEQ HROW2
 PLA  ;PAT #
HROW1 JSR WVRAM
 DEX
 BNE HROW1
 PHA
HROW2 PLA
 RTS

* COL OF SAME PAT #
VCOL JSR COMBYT
 STX XPOS
 JSR COMBYT
 STX YPOS
 JSR XYCONV
 JSR WRSET
 JSR GET16
 LDA LINNUM
 PHA  ;SAVE PAT #
 JSR WVRAM
 JSR COMBYT ;REPEAT #
 DEX
 BEQ VCOL3
VCOL1 LDA #$20
 CLC
 ADC ADDRL ;NT ADDR 1 ROW DOWN
 STA ADDRL
 BCC VCOL2
 INC ADDRH
VCOL2 JSR WRSET
 PLA  ;PAT #
 JSR WVRAM
 DEX
 PHA  ;SAVE PAT #
 BNE VCOL1
VCOL3 PLA
 RTS

* MCM NT FILL
MCNTFL LDA #$00
 STA NL
 STA NH
 JSR NTADD
 JSR WRSET
 LDY #$00
MCNTF1 LDX #$20 ;32 BYTES / ROW
MCNT2 TYA  ;CALC 1ST DATA BYTE FOR ROW Y
 AND #$FC
 ASL A
 ASL A
 ASL A ;DATA = COL+32*INT(ROW/4)
MCNTF3 JSR WVRAM
 CLC
 ADC #$01 ;INCR DATA BYTE
 DEX  ;DONE WITH ROW?
 BNE MCNTF3
 INY  ;INCR ROW #
 CPY #$18 ;DONE?
 BNE MCNTF1
 RTS

* FILL NT WITH PAT # IN A
FILL LDA #$00
 STA NL
 STA NH
 JSR NTADD
 JSR WRSET
 JSR GET16 ;PAT #
 LDA LINNUM
 LDX #$03
 LDY #$00
FILL1 JSR WVRAM
 DEY
 BNE FILL1
 DEX
 BNE FILL1
 RTS

********************************
*     COLOR TABLE ROUTINES     *
********************************

* CALC ADDR GM1 CT ENTRY N 0-31
CT1ADD LDA #$00
 STA ADDRL
 LDA CT
 LSR A
 ROR ADDRL
 LSR A
 ROR ADDRL
 STA ADDRH
 LDA NL
 CLC
 ADC ADDRL
 STA ADDRL
 RTS

* CALC ADDR GM2 CT ENTRY N 0-767
CT2ADD LDA CT
 AND #$80
 BEQ CT2AD2
 LDA #$04 ;????? MAKE FOR FLEXIBLE???
CT2AD2 CLC
 ADC NH
CT2AD1 STA ADDRH
 LDA NL
 ASL A
 ROL ADDRH
 ASL A
 ROL ADDRH
 ASL A
 ROL ADDRH
 STA ADDRL
 RTS

* DEF GM2 TILE COLOR
TCOL JSR GET16
 LDA LINNUM
 STA NL
 LDA LINNUM+1
 STA NH
 JSR CT2ADD
 JSR WRSET
 LDX #$08
TCOL1 TXA
 PHA
 JSR COMBYT
 TXA
 JSR WVRAM
 PLA
 TAX
 DEX
 BNE TCOL1
 JSR IFCOM
 BEQ TCOL
 RTS

* RET GM2 PAT COLORS
RTCL JSR GET16
 LDA LINNUM
 STA NL
 LDA LINNUM+1
 STA NH
 JSR CT2ADD
RCOL1 JSR RDSET
 LDX #$08
 STX D
RTCL1 JSR RVRAM
 STA C
 JSR CHKCOM
 LDY C
 LDA #$00
 JSR PUT16
 DEC D
 BNE RTCL1
 JSR IFCOM
 BEQ RTCL
 RTS

* DEF GM1 COLOR SET
CSET JSR COMBYT
 STX NL
 JSR CT1ADD
 JSR WRSET
 JSR COMBYT
 TXA
 JSR WVRAM
 JSR IFCOM
 BEQ CSET
 RTS

* RET GM1 COLOR SET
RCST JSR COMBYT
 STX NL
 JSR CT1ADD
 JSR RDSET
 JSR CHKCOM
 JSR RVRAM
 TAY
 LDA #$00
 JSR PUT16
 JSR IFCOM
 BEQ RCST
 RTS

********************************
*   PATTERN GENERATOR TABLE    *
*           ROUTINES           *
********************************

* CALC ADDR PGT ENTRY N 0-767
PGTADD LDA R0
 AND #$02 ;MODE 2?
 PHP
 LDA PGT
 PLP
 BEQ PGTAD1
 AND #$04
 CLC
 ADC NH
PGTAD1 STA ADDRH
 LDA NL
 ASL A
 ROL ADDRH
 ASL A
 ROL ADDRH
 ASL A
 ROL ADDRH
 STA ADDRL
 RTS

* DEF TILE PAT
DTIL JSR CHKCOM
 JSR FRMNUM
 JSR GETADR
 LDA LINNUM
 STA NL
 LDA LINNUM+1
 STA NH
 JSR PGTADD
 JSR WRSET
 LDX #$08
DTIL1 TXA
 PHA
 JSR COMBYT
 TXA
 JSR WVRAM
 PLA
 TAX
 DEX
 BNE DTIL1
 JSR IFCOM
 BEQ DTIL
 RTS

* RET PAT DATA
RTIL JSR GET16
 LDA LINNUM
 STA NL
 LDA LINNUM+1
 STA NH
 JSR PGTADD
 JSR RDSET
 LDX #$08
 STX D
RTIL1 JSR RVRAM
 STA C
 JSR CHKCOM
 LDY C
 LDA #$00
 JSR PUT16
 DEC D
 BNE RTIL1
 JSR IFCOM
 BEQ RTIL
 RTS

* FILL PGT WITH # IN A
FILPGT PHA  ;SAVE #
 LDA #$00 ;N=0
 STA NL
 JSR PGTADD
 JSR WRSET
 LDX #$00 ;256
 LDY #$08 ;8 * 256 = 2048
 PLA  ;FILL VALUE
FILPG1 JSR WVRAM
 DEX
 BNE FILPG1
 DEY
 BNE FILPG1
 RTS

* PLOT MCM POINT X,Y
PLT JSR COMBYT ;X
 TXA
 AND #$3F ;0 - 63 ONLY
 STA XPOS
 JSR COMBYT ;Y
 TXA
 STA YPOS
* ENTRY HERE IF X & Y ALREADY IN XPOS & YPOS
PLT3 LDA YPOS
 AND #$38 ;8*INT(Y/8), 0<Y<63
 ASL A
 ASL A
 STA B
 LDA XPOS
 LSR A
 PHP  ;SAVE CARRY
 CLC
 ADC B ;PAT #
 STA NL
 LDA #$00
 STA NH ;PGT ENTRY
 JSR PGTADD
 LDA YPOS
 AND #$07 ;Y MOD 8
 CLC
 ADC ADDRL
 STA ADDRL
 BCC PLT4
 INC ADDRH
PLT4 JSR RDSET
 JSR RVRAM ;PAT BYTE
 PLP  ;GET BACK CARRY
 BCC PLT1
 AND #$F0
 ORA MCMCOL
 BCS PLT2
PLT1 AND #$F
 ORA MCMCOH
PLT2 PHA  ;SAVE BYTE
 JSR WRSET
 PLA
 JSR WVRAM
 RTS

* RET MCM COLOR AT X,Y
SCN JSR COMBYT ;X
 TXA
 AND #$3F ;0 - 63 ONLY
 STA XPOS
 JSR COMBYT ;Y
 TXA
 STA YPOS
 LDA YPOS
 AND #$38 ;8*INT(Y/8), 0<Y<63
 ASL A
 ASL A
 STA B
 LDA XPOS
 LSR A
 PHP  ;SAVE CARRY
 CLC
 ADC B ;PAT #
 STA NL
 LDA #$00
 STA NH ;PGT ENTRY
 JSR PGTADD
 LDA YPOS
 AND #$07 ;Y MOD 8
 CLC
 ADC ADDRL
 STA ADDRL
 BCC SCN4
 INC ADDRH
SCN4 JSR RDSET
 JSR RVRAM
 PLP  ;GET BACK CARRY
 BCC SCN1
 AND #$0F
 BCS SCN2
SCN1 LSR A
 LSR A
 LSR A
 LSR A ;MOVE TO LSN
SCN2 PHA  ;SAVE BYTE
 JSR CHKCOM
 PLA
 TAY
 LDA #$00
 JSR GIVAYF
 JSR PTRGET
 JSR CHKNUM
 TAX
 JSR MOVMF
 RTS

* MCM HORIZ LINE
HLN JSR COMBYT ;X1
 STX XPOS ;1ST X POS
 JSR COMBYT ;X2
 INX  ;INCR FOR END PTS
 TXA
 SEC
 SBC XPOS ;# OF TIMES TO PLOT
 STA E
 JSR COMBYT ;Y
 STX YPOS
HLN2 JSR PLT3 ;PLOT
 DEC E
 BEQ HLN1
 INC XPOS
 BNE HLN2
HLN1 RTS

* MCM VERT LINE
VLN JSR COMBYT ;Y1
 STX YPOS ;1ST Y POS
 JSR COMBYT ;Y2
 INX  ;INCR FOR END PTS
 TXA
 SEC
 SBC YPOS ;# TIMES TO PLOT
 STA E
 JSR COMBYT ;X
 TXA
 STA XPOS
VLN2 JSR PLT3 ;PLOT
 DEC E
 BEQ VLN1
 INC YPOS
 BNE VLN2
VLN1 RTS

********************************
*    SPRITE ATTRIBUTE TABLE    *
*           ROUTINES           *
********************************

* CALC SAT ENTRY N 0-127
SATADD LDA #$00
 STA ADDRL
 LDA SAT
 LSR A
 ROR ADDRL
 STA ADDRH
 LDA NL
 ASL A
 ASL A
 ADC ADDRL
 STA ADDRL
 RTS

* SET SPRITE ATTR
SSPR JSR COMBYT
 STX NL
 JSR SATADD
 JSR WRSET
 JSR COMBYT ;Y
 TXA
 JSR WVRAM
 JSR COMBYT ;X
 TXA
 JSR WVRAM
 JSR IFCOM
 BNE SSPR1
 JSR COMBYT ;P
 TXA
 JSR WVRAM
 JSR IFCOM
 BNE SSPR1
 JSR COMBYT ;C
 TXA
 JSR WVRAM
 JSR IFCOM
 BEQ SSPR
SSPR1 RTS

* SET SPRITE Y
SY JSR COMBYT ;S
 STX NL
 JSR SATADD
 JSR WRSET
 JSR COMBYT ;Y
 TXA
 JSR WVRAM
 JSR IFCOM
 BEQ SY
 RTS

* GET SPRITE Y
GY JSR COMBYT ;S
 STX NL
 JSR SATADD
 JSR RDSET
 JSR CHKCOM
 JSR RVRAM
 TAY
 LDA #$00
 JSR GIVAYF
 JSR PTRGET
 JSR CHKNUM
 TAX
 JSR MOVMF
 RTS

* SET SPRITE X
SX JSR COMBYT ;S
 STX NL
 JSR SATADD
 INC ADDRL ;NO CARRY
 JSR WRSET
 JSR COMBYT ;X
 TXA
 JSR WVRAM
 JSR IFCOM
 BEQ SX
 RTS

* GET SPRITE X
GX JSR COMBYT ;S
 STX NL
 JSR SATADD
 INC ADDRL
 JSR RDSET
 JSR CHKCOM
 JSR RVRAM
 TAY
 LDA #$00
 JSR GIVAYF
 JSR PTRGET
 JSR CHKNUM
 TAX
 JSR MOVMF
 RTS

* SET SPRITE PAT
SP JSR COMBYT ;S
 STX NL
 JSR SATADD
 INC ADDRL
 INC ADDRL ;NO CARRY
 JSR WRSET
 JSR COMBYT ;PAT #
 TXA
 JSR WVRAM
 JSR IFCOM
 BEQ SP
 RTS

* GET SPRITE PAT #
GP JSR COMBYT ;S
 STX NL
 JSR SATADD
 INC ADDRL
 INC ADDRL
 JSR RDSET
 JSR CHKCOM
 JSR RVRAM
 TAY
 LDA #$00
 JSR GIVAYF
 JSR PTRGET
 JSR CHKNUM
 TAX
 JSR MOVMF
 RTS

* SET SPRITE COLOR
SC JSR COMBYT ;S
 STX NL
 JSR SATADD
 INC ADDRL
 INC ADDRL
 INC ADDRL ;NO CARRY
 JSR WRSET
 JSR COMBYT ;COLOR
 TXA
 JSR WVRAM
 JSR IFCOM
 BEQ SC
 RTS

* GET SPRITE COLOR
GC JSR COMBYT ;S
 STX NL
 JSR SATADD
 INC ADDRL
 INC ADDRL
 INC ADDRL
 JSR RDSET
 JSR CHKCOM
 JSR RVRAM
 TAY
 LDA #$00
 JSR GIVAYF
 JSR PTRGET
 JSR CHKNUM
 TAX
 JSR MOVMF
 RTS

* RET SPR ATTR
GSPR JSR COMBYT
 STX NL
 JSR SATADD
 JSR RDSET
 JSR RVRAM ;Y
 STA B
 JSR CHKCOM
 LDY B
 LDA #$00
 JSR PUT16
 JSR RVRAM ;X
 STA B
 JSR CHKCOM
 LDY B
 LDA #$00
 JSR PUT16
 JSR IFCOM
 BNE GSPR1
 JSR RVRAM ;P
 STA B
 JSR CHKCOM
 LDY B
 LDA #$00
 JSR PUT16
 JSR IFCOM
 BNE GSPR1
 JSR RVRAM ;C
 STA B
 JSR CHKCOM
 LDY B
 LDA #$00
 JSR PUT16
 JSR IFCOM
 BEQ GSPR
GSPR1 RTS

********************************
*   SPRITE PATTERN GENERATOR   *
*        TABLE ROUTINES        *
********************************

* CALC SPGT ENTRY N 0-255
SPGTAD LDA SPGT
 JMP PGTAD1

* DEF SPR PAT
DSPR JSR COMBYT
 STX NL
 JSR SPGTAD
 JSR WRSET
 LDX #$08
DSPR1 TXA
 PHA
 JSR COMBYT
 TXA
 JSR WVRAM
 PLA
 TAX
 DEX
 BNE DSPR1
 JSR IFCOM
 BEQ DSPR
 RTS

* RET SPR PAT DATA
RSPR JSR GET16
 LDA LINNUM
 STA NL
 LDA LINNUM+1
 STA NH
 JSR SPGTAD
 JSR RDSET
 LDX #$08
 STX D
RSPR1 JSR RVRAM
 STA C
 JSR CHKCOM
 LDY C
 LDA #$00
 JSR PUT16
 DEC D
 BNE RSPR1
 JSR IFCOM
 BEQ RSPR
 RTS

********************************
*         PSG ROUTINES         *
********************************

* SET PSG MIXER REG
MXR LDA #$07
 JSR LTCHAD
 JSR COMBYT
 TXA
 ORA #$C0
 STA MIXER
 JSR SNDATA
 RTS

* TONE A FREQ, VOL
TNA JSR CHKCOM
 JSR FRMNUM
 JSR GETADR
 LDA #$00
 JSR LTCHAD
 LDA LINNUM
 JSR SNDATA
 LDA #$01
 JSR LTCHAD
 LDA LINNUM+1
 JSR SNDATA
 LDA #$07
 JSR LTCHAD
 LDA MIXER
 AND #$FE
 STA MIXER
 JSR SNDATA
 JSR IFCOM
 BNE TNA1
 JSR VOLA
 JSR IFCOM
 BEQ TNB
TNA1 RTS

* CH A VOL
VOLA LDA #$08
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA
 RTS

* TONE B FREQ, VOL
TNB JSR CHKCOM
 JSR FRMNUM
 JSR GETADR
 LDA #$02
 JSR LTCHAD
 LDA LINNUM
 JSR SNDATA
 LDA #$03
 JSR LTCHAD
 LDA LINNUM+1
 JSR SNDATA
 LDA #$07
 JSR LTCHAD
 LDA MIXER
 AND #$FD
 STA MIXER
 JSR SNDATA
 JSR IFCOM
 BNE TNB1
 JSR VOLB
 JSR IFCOM
 BEQ TNC
TNB1 RTS

* CH B VOL
VOLB LDA #$09
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA
 RTS

* TONE C FREQ, VOL
TNC JSR CHKCOM
 JSR FRMNUM
 JSR GETADR
 LDA #$04
 JSR LTCHAD
 LDA LINNUM
 JSR SNDATA
 LDA #$05
 JSR LTCHAD
 LDA LINNUM+1
 JSR SNDATA
 LDA #$07
 JSR LTCHAD
 LDA MIXER
 AND #$FB
 STA MIXER
 JSR SNDATA
 JSR IFCOM
 BNE TNC1
 JSR VOLC
 JSR IFCOM
 BNE TNC1
 JMP TNA
TNC1 RTS

* CH C VOL
VOLC LDA #$0A
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA
 RTS

MIXER DFB $FF
ETYPE DFB 0 ;ENV TYPE

* TURN OFF PSG
SOFF LDA #$07
 JSR LTCHAD
 LDA #$FF
 STA MIXER
 JSR SNDATA
 LDA #$08
 JSR LTCHAD
 LDA #$00
 JSR SNDATA
 LDA #$09
 JSR LTCHAD
 LDA #$00
 JSR SNDATA
 LDA #$0A
 JSR LTCHAD
 LDA #$00
 JSR SNDATA
 RTS

* CH A NOISE, VOL
NSA LDA #$07
 JSR LTCHAD
 LDA #$08 ;CH A VOL REG
 STA B ;TEMP SAVE
 LDA MIXER
 AND #$F7
NSE STA MIXER
 JSR SNDATA
 LDA #$06
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA
 JSR IFCOM
 BNE NSA1
 LDA B ;GET VOL REG #
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA
 JSR IFCOM
 BNE NSA1
 LDA #$0E
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA
NSA1 RTS

* CH B NOISE, VOL
NSB LDA #$07
 JSR LTCHAD
 LDA #$09
 STA B ;TEMP SAVE
 LDA MIXER
 AND #$EF
 JMP NSE

* CH C NOISE, VOL
NSC LDA #$07
 JSR LTCHAD
 LDA #$0A
 STA B ;TEMP SAVE
 LDA MIXER
 AND #$DF
 JMP NSE

* SET ENV TYPE
ENVT LDA #$0D
 JSR LTCHAD
 JSR COMBYT
 TXA
 STA ETYPE
 JSR SNDATA
 RTS

* SET ENV PERIOD
ENVP LDA #$0B
 JSR LTCHAD
 JSR CHKCOM
 JSR FRMNUM
 JSR GETADR
 LDA LINNUM
 JSR SNDATA
 LDA #$0C
 JSR LTCHAD
 LDA LINNUM+1
 JSR SNDATA
 RTS

* SET FILTER
FILT LDA #$0E
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA
 RTS


* AUTO ENV CNTRL TONE
ETNA LDA MIXER
 AND #$FE
 STA MIXER
 LDA #$00
 STA D ;FINE TUNE REG #
 LDA #$01
 STA E ;COARSE TUNE REG #
 JSR ENVTN
ETNB LDA MIXER
 AND #$FD
 STA MIXER
 LDA #$02 ;FINE TUNE REG #
 STA D
 LDA #$03 ;COARSE TUNE REG #
 STA E
 JSR ENVTN
ETNC LDA MIXER
 AND #$FB
 STA MIXER
 LDA #$04 ;FINE TUNE REG #
 STA D
 LDA #$05 ;COARSE TUNE REG #
 STA E
 JSR ENVTN
 BEQ ETNA

ENVTN JSR CHKCOM
 JSR FRMNUM
 JSR GETADR
 LDA D ;FINE TUNE REG #
 JSR LTCHAD
 LDA LINNUM
 JSR SNDATA
 LDA E ;COARSE TUNE REG #
 JSR LTCHAD
 LDA LINNUM+1
 JSR SNDATA
 LDA #$07
 JSR LTCHAD
 LDA MIXER
 JSR SNDATA
 JSR IFCOM
 BNE ENVTN1
 RTS
ENVTN1 LDA #$0D
 JSR LTCHAD
 LDA ETYPE
 JSR SNDATA
 PLA
 PLA ;EVEN STACK
 RTS

* AUTO ENV CTRL NOISE
ENSA LDA #$06
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA ;NOISE PER TO PSG
 LDA #$07
 JSR LTCHAD
 LDA MIXER
 AND #$F7
 STA MIXER
 JSR SNDATA
 PHA
 PHA  ;EVEN STACK
 JMP ENVTN1

ENSB LDA #$06
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA ;NOISE PER TO PSG
 LDA #$07
 JSR LTCHAD
 LDA MIXER
 AND #$EF
 STA MIXER
 JSR SNDATA
 PHA
 PHA  ;EVEN STACK
 JMP ENVTN1

ENSC LDA #$06
 JSR LTCHAD
 JSR COMBYT
 TXA
 JSR SNDATA ;NOISE PER TO PSG
 LDA #$07
 JSR LTCHAD
 LDA MIXER
 AND #$DF
 STA MIXER
 JSR SNDATA
 PHA
 PHA  ;EVEN STACK
 JMP ENVTN1

********************************
*    MISCELLANEOUS ROUTINES    *
********************************

* SET UP MCM
MULCOL JSR INIT
 LDA #$00 ;PGT FILL BYTE
 STA MCMCOL ;INITIAL COLOR = 0
 STA MCMCOH
 JSR FILPGT ;FILL PGT
 JSR MCNTFL ;FILL NT FOR MCM
 RTS

* CUR MCM COLOR
COL JSR COMBYT ;COLOR
 TXA
 AND #$0F ;4 LSB ONLY
 STA MCMCOL ;LSN
 ASL A
 ASL A
 ASL A
 ASL A
 STA MCMCOH ;MSN
 RTS

* CHECK FOR COMMA
IFCOM LDY #$00
 LDA (TXTPTL),Y
 CMP #$2C
 RTS

* GET 16 BIT APSOFT VAR, PLACE IN LINNUM, LINNUM+1
GET16 JSR CHKCOM
 JSR FRMNUM
 JMP GETADR

* PASS 16 BIT # TO APSOFT VAR
* 1ST JSR CHKCOM, THEN PUT
* LSB IN Y, MSB IN A
PUT16 JSR GIVAYF
 JSR PTRGET
 JSR CHKNUM
 TAX
 JSR MOVMF
 RTS

* LOAD VRAM FROM 6502 RAM
LD JSR GET16 ;6502 SOURCE
 LDA LINNUM ;ADDR LSB
 STA L
 LDA LINNUM+1 ;ADDR MSB
 STA H ;HL = SOURCE
 JSR GET16 ;VRAM DEST
 LDA LINNUM
 STA ADDRL
 LDA LINNUM+1
 STA ADDRH
 JSR WRSET
 JSR GET16 ;BLK LEN
 LDA LINNUM ;LEN LSB
 STA C
 LDA LINNUM+1
 STA B ;BC = LEN
 LDY #$00
LD1 LDA (HL),Y
 JSR WVRAM
 LDA C
 BNE LD2
 DEC B
LD2 DEC C
 LDA C
 ORA B
 BEQ LD3
 INY
 BNE LD1
 INC H
 JMP LD1
LD3 RTS

* UNLOAD VRAM INTO 6502 RAM
ULD JSR GET16 ;VRAM SOURCE
 LDA LINNUM ;ADDR LSB
 STA ADDRL
 LDA LINNUM+1 ;ADDR MSB
 STA ADDRH
 JSR RDSET
 JSR GET16 ;6502 DEST
 LDA LINNUM ;ADDR LSB
 STA E
 LDA LINNUM+1 ;ADDR MSB
 STA D ;DE = DEST
 JSR GET16
 LDA LINNUM ;LEN LSB
 STA C
 LDA LINNUM+1
 STA B ;BC = LEN
 LDY #$00
ULD1 JSR RVRAM
 STA (DE),Y
 LDA C
 BNE ULD2
 DEC B
ULD2 DEC C
 LDA C
 ORA B
 BEQ ULD3
 INY
 BNE ULD1
 INC D
 JMP ULD1
ULD3 RTS