P       

*
* Player directives
*
ISDIRECT 
         LDX ISFLAG
         BNE :RTS
         LDX #18
:LOOP    CMP DIRTAB,X
         BEQ :RTS
         DEX
         BPL :LOOP
:RTS     RTS

*
* DIRECT
*   Handle player directive contained in A
*
DIRECT   
         JSR ISDIRECT
         TXA
         ASL
         TAX
         LDA DIRLOC,X
         STA :JMP+1
         LDA DIRLOC+1,X
         STA :JMP+2
:JMP     JMP $C000

DIRTAB                    ;Player directives
         DFB 109+96       ;shift-m
         DFB 167          ;C=-m
         DFB 119+96       ;shift-w
         DFB 103+96       ;shift-g
         DFB 165          ;C=-g
         DFB 108+96       ;shift-l
         DFB 182          ;C=-l
         DFB 105+96       ;shift-i
         DFB 114+96       ;shift-r
         DFB 178          ;C=-r
         DFB 115+96       ;shift-s
         DFB 111+96       ;shift-o
         DFB 185          ;C=-o
         DFB 122+96       ;shift-z
         DFB 118+96       ;shift-v
         DFB 190          ;C=v
         DFB 106+96       ;Shift-j
         DFB 181          ;C=-j
         DFB 174          ;C=-s

DIRLOC   
         DA SETMARK
         DA CLRMARK
         DA HVOLUME
         DA HACTG
         DA HDACTG
         DA HACTL
         DA HDACTL
         DA HLINST
         DA HREP
         DA HREPEND
         DA HSTOP
         DA HGON
         DA HGOFF
         DA HRESTART
         DA HLOADL
         DA HLOADG
         DA HJMP
         DA HJSR
         DA HRTS

DIRNUM   DFB 00           ;Directive number
MAXARG   DFB 00           ;Maximum allowed argument value
DARG     
         STA DIRNUM
         STY MAXARG
         JSR STAFIELD
         JSR SETMSG
         JSR READARG
         LDX ARGLEN
         BEQ :DONE
         CMP MAXARG
         BCC :CONT
         BNE :DONE
:CONT    TAX
         LDA DIRNUM
         JMP STAFIELD
:DONE    LDX #00          ;JMP and JSR need this
         RTS

HVOLUME  
         LDA #SETVOL      ;Directive
         LDX #15          ;Default value
         LDY #15          ;Max arg value
         BNE DARG

HACTG    
         LDA #ACTGLOB
         LDX #00
         LDY #23
         BNE DARG
HDACTG   
         LDA #DACTGLOB
         LDX #00
         LDY #23
         BNE DARG
HACTL    
         LDA #ACTLOC
         LDX #00
         LDY #23
         BNE DARG
HDACTL   
         LDA #DACTLOC
         LDX #00
         LDY #23
         BNE DARG
HREP     
         LDA #REPEAT
         LDX #1
         LDY #255
         BNE DARG

HLOADL   
         LDA #4
         JSR SETACT
:WAIT    JSR GETIN
         BEQ :WAIT
         CMP #'0'
         BCC :WAIT
         CMP #'8'
         BCS :WAIT
         EOR #$30
         ORA #LOADLOC
         LDX #0
         LDY #255
         BNE DARG

HLINST   
         LDA #16
         STA ARGBASE
         LDA #LINST
         LDX #00
         LDY #13
         JSR DARG
         LDA #10          ;Restore decimal mode
         STA ARGBASE
         RTS

HREPEND  
         LDA #ENDREP
         LDX #00
         JMP STAFIELD

HLOADG   
         LDA #4
         JSR SETACT
:WAIT    JSR GETIN
         BEQ :WAIT
         CMP #'0'
         BCC :WAIT
         CMP #'9'+1
         BCC :CONT
         CMP #'a'
         BCC :WAIT
         CMP #'g'
         BCS :WAIT
         SBC #6           ;-7
:CONT    
         EOR #$30         ;-48
         ORA #LOADGLOB
         LDX #0
         LDY #255
         JMP DARG

HSTOP    
         LDA #VSTOP
         TAX
         JMP STAFIELD

HGON     
         LDA #GATEON
         LDX #00
         JMP STAFIELD

HGOFF    
         LDA #GATEOFF
         LDX #00
         JMP STAFIELD

HRESTART 
         LDA #RESTART
         TAX
         JMP STAFIELD
*
* Set/clear marker.  Not really a player directive, but
* close enough!
*
SETMARK  
         JSR READARG
         LDX ARGLEN
         BEQ :RTS
         CMP #32
         BCC :CONT
         LDA #00
:CONT    ASL              ;Marker number
         TAX
         LDA POINT1
         STA MARKERS,X
         LDA POINT1+1
         STA MARKERS+1,X
:RTS     RTS

CLRMARK  
         JSR READARG
         LDX ARGLEN
         BEQ :RTS
         ASL
         TAX
         LDA #00
         STA MARKERS,X
         STA MARKERS+1,X
:RTS     RTS

*
* JMP to marker
*
HJMP     
         LDA #JUMP
         LDX #00
         LDY #31
         JSR DARG
         TXA
         ASL
         TAX
         LDA #JUMP
         JMP STAFIELD

*
* JSR to marker
*
HJSR     
         LDA #JSUB
         LDX #00
         LDY #31
         JSR DARG
         TXA
         ASL
         TAX
         LDA #JSUB
         JMP STAFIELD

*
* Return from subroutine
*
HRTS     
         LDA #RSUB
         LDX #00
         JMP STAFIELD


*
* READARG -- Reads in a numerical argument from the
*   action box.  DEL and RETURN work normally,
*   everything else works as editor function etc.
*
*   Value of argument read in is returned in .A
*
ARGBASE  DFB 10
ARGLEN   DFB 0
READARG  
         LDA #00
         JSR SETACT
READARG2 LDX #23
         LDY #2
         CLC
         JSR PLOT
         LDA #00
         STA STRING
         STA ARGLEN
         LDA #7           ;Yellow
         STA $0286
         STA $0287

:GETKEY  LDA #0
         STA BLNSW
:WAIT    JSR GETIN
         BEQ :WAIT
         LDX #1
         STX BLNCT
:LOOP    LDX BLNON
         BNE :LOOP
         INC BLNSW
         CMP #'9'+1
         BCC :C1
         LDX ARGBASE
         CPX #10
         BEQ :GETKEY
         CMP #65
         BCC :GETKEY
         CMP #'f'+1
         BCS :GETKEY

:C1      CMP #'0'
         BCC :SPECIAL
         LDX ARGLEN
         CPX #4
         BCS :GETKEY
         STA STRING,X
         JSR CHROUT
         INX
         STX ARGLEN
         LDA #00
         STA STRING,X
         BEQ :GETKEY

:SPECIAL CMP #13
         BEQ :DONE
         CMP #20
         BEQ :DELETE
         JSR ISOTHER
         BNE :C2
         TAX
         PLA
         PLA
         TXA
         JMP OTHER
:C2      JSR ISEDIT
         BNE :GETKEY
         TAX
         PLA
         PLA
         TXA
         JMP EDIT

:DELETE  LDX ARGLEN
         BEQ :GETKEY
         DEX
         STX ARGLEN
         LDA #00
         STA STRING,X
         LDA #157         ;left
         JSR CHROUT
         LDA #32
         JSR CHROUT
         LDA #157
         JSR CHROUT
         JMP :GETKEY

:DONE    LDA #<STRING
         LDX #>STRING
         LDY ARGBASE
         JSR ASCTONUM
         LDA ACC
         RTS
