       

*
* Player directives
*
ISDIRECT 
         LDX ISFLAG
         BNE :RTS
         LDX #23
: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 163          ;C=-t
         DFB 174          ;C=-s
         DFB 179          ;C=-w
         DFB 99+96        ;shift-c
         DFB 117+96       ;shift-u
         DFB 184          ;C=-u

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
         DA HSYNC
         DA HWAIT
         DA HCYCTEST
         DA HSLUR
         DA HSLOFF

LASTMARK DFB 00           ;Last marker accessed
LASTVAL  DFB 00           ;Last variable value
LASTREP  DFB 2            ;number of reps
LASTMAC  DFB 00           ;last macro
LASTINST DFB 00           ;instrument

DIRNUM   DFB 00           ;Directive number
DEFAULT  DFB 00           ;Default
MAXARG   DFB 00           ;Maximum allowed argument value

DARG     
         STA DIRNUM
         STX DEFAULT
         STY MAXARG
         JSR STAFIELD
         JSR SETMSG
         JSR READARG      ;READARG may exit with PLA PLA
         LDX ARGLEN
         BEQ :DONE
         CMP MAXARG
         BCC :CONT
         BNE :DONE
:CONT    TAX
         LDA DIRNUM
         JMP STAFIELD
:DONE    PLA              ;Default is accepted
         PLA
         JMP RET2

HVOLUME  
         LDA #SETVOL      ;Directive
         LDX #15          ;Default value
         LDY #15          ;Max arg value
         JSR DARG         ;Need to JSR, because READARG
RET2     LDA RETFLAG      ;may exit with PLA PLA PLA PLA
         BPL :RTS
         JMP RET          ;Insert a CR
:RTS     RTS

HACTG    
         LDA #ACTGLOB
         LDX LASTMAC
         LDY #23
JSRMAC   BIT SINGLEKEY
         BMI :SKIP
         JSR DARG
         STX LASTMAC
         JMP RET2
:SKIP    JSR STAFIELD
         JMP RET2

HDACTG   
         LDA #DACTGLOB
         LDX LASTMAC
         LDY #23
         BNE JSRMAC
HACTL    
         LDA #ACTLOC
         LDX LASTMAC
         LDY #23
         BNE JSRMAC
HDACTL   
         LDA #DACTLOC
         LDX LASTMAC
         LDY #23
         BNE JSRMAC

HREP     
         LDA #REPEAT
         LDX LASTREP
         LDY #255
         JSR DARG
         STX LASTREP
         JMP RET2

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

HLTEMP   DFB 00

HLINST   
         LDA #16
         STA ARGBASE
         LDA #LINST
         LDX LASTINST
         LDY #13
         JSR DARG
         STX LASTINST
         JMP RET2

HREPEND  
         LDA #ENDREP
         LDX #00
         JSR STAFIELD
         JMP RET2

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 LASTVAL
         LDY #255
         JSR DARG
         STX LASTVAL
         JMP RET2

HSTOP    
         LDA #VSTOP
         TAX
         JSR STAFIELD
         JMP RET2

HGON     
         LDA #GATEON
         LDX #00
         JSR STAFIELD
         JMP RET2

HGOFF    
         LDA #GATEOFF
         LDX #00
         JSR STAFIELD
         JMP RET2

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     
         LDX LASTMARK
         LDA #JUMP
         LDY #31
         JSR DARG
         TXA
         ASL
         TAX
         STX LASTMARK
         LDA #JUMP
         JSR STAFIELD
         JMP RET2

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

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

*
* Sync
*
HSYNC    
         LDA #SYNC
         LDX #00
         JSR STAFIELD
         JMP RET2

*
* Wait
*
HWAIT    
         LDA #WAIT
         LDX #00
         JSR STAFIELD
         JMP RET2

* Cycle Test bit

HCYCTEST 
         LDA #CYCTEST
         LDX #00
         JSR STAFIELD
         JMP RET2

HSLUR    
         LDA #SLUR
         LDX #00
         JSR STAFIELD
         JMP RET2

HSLOFF   
         LDA #SLOFF
         LDX #00
         JSR STAFIELD
         JMP RET2


*
* 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
         BEQ :LOOP
         INC BLNSW
         CMP #'9'+1
         BCC :C1
         LDX ARGBASE
         CPX #10
         BEQ :SPECIAL
         CMP #65
         BCC :SPECIAL
         CMP #'f'+1
         BCS :SPECIAL

: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              ;DARG
         PLA
         PLA              ;DIRECT
         TXA
         JMP OTHER
:C2      JSR ISEDIT
         BNE :GETKEY
         TAX
         PLA
         PLA
         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

