; Astro BASIC (2000 Baud Version)
; (C) July 1978 Bally Mfg.
; (C) Dec 1980 Revised
; 
; Written by Jay Fenton
;
; Source-code Retyped by Adam Trionfo
;
; Revisions:
;    * March 2, 2004     - 1.0
;           - 100% Finished - HVGLIB.H 2.6 (or above) required
;           - Matches perfectly with AstroBASIC cartridge
;           - First assemble with no errors
;    * February 29, 2004 - .02
;           - Finish typing in source-code
;           - Start converting to standard Z-80 mnemonics 
;    * February 14, 2004 - .01
;           - Begin typing in source-code
;
;  To assemble this Z-80 source code using ZMAC:
;  
;  zmac -d -o <outfile> -x <listfile> <filename>
;  
;  For example, assemble this Astrocade Z-80 ROM file:
;     
;  zmac -i -m -o astrobas.bin -x astrobas.lst astrobas.asm
;
; ***************************
; * BALLY BASIC INTERPRETER *
; *                         *
; * (C) JULY 1978 BALLY MFG *
; * (C) DEC 1980 REVISED    *
; *                         *
; * WRITTEN BY: JAY FENTON  *
; *                         *
; * BALLY BASIC IS BASED ON *
; * PALO ALTO TINY BASIC BY *
; * LICHEN WANG             *
; *                         *
; ***************************
; TINY BASIC INTERPRETER
;
INCLUDE "HVGLIB.H"      ; HOME VIDEO GAME LIBRARY
;
; MACROS
TOKEN   MACRO  TINDX, TGOTO
        DB     TINDX
        DEFF   TGOTO
        ENDM
DEFF    MACRO  WORDY
        DB     (WORDY >> 8) | 80H 
        DB     WORDY & 0FFH
        ENDM
TSTC   MACRO  CAT, DOG
        RST    1
        DB     'CAT'
        DB     (DOG - $)-1
        ENDM
TSTCC   MACRO  CAT1, DOG1
        RST    1
        DB     CAT1
        DB     (DOG1 - $)-1
        ENDM
ITEM    MACRO  STRANG, JUMPTO
        DB     'STRANG'
        DEFF   JUMPTO
        ENDM
;
URINAL  EQU    0FFFH
BOTSCR  EQU    4E20H
TOPSCR  EQU    4FEAH
BOTRAM  EQU    0A000H
DFTLMT  EQU    0A70CH
BOTROM  EQU    02000H
;
HLTPORT EQU    15H      ; KEYPAD KEY WITH HALT ONIT
;
CR      EQU    0DH
RUBOUT  EQU    1FH
COMMA   EQU    44
EDKEY   EQU    66H
NLLN    EQU    67H
; EQUATES FOR RESTART INSTRUCTIONS
RSTEXP  EQU    2        ; EXPR
RSTLDE  EQU    3        ; LDE
RSTIGN  EQU    4        ; IGNBLK
RSTPAR  EQU    5        ; PARN
RSTFIN  EQU    6        ; FINISH
;
TXTUNF  EQU    4E20H
VARBGN  EQU    4E22H
DEVVAR  EQU    4E56H    ; DEVICES VARIABLES
DEVCL0  EQU    4E56H    ; BACKGROUND COLOR
DEVCL1  EQU    4E58H    ; FOREGROUND COLOR
DEVTEM  EQU    4E5AH    ; TEMPO
VDMX    EQU    4E5CH    ; VDM X COORDINATE
VDMY    EQU    4E5EH    ; VDM Y COORDINATE
OLDXY   EQU    4E60H    ; PREVIOUS COORDINATES FROM VECTOR DRAW
DEVMO   EQU    4E62H    ; MASTER OSC
DEVOA   EQU    4E64H    ; OSC A
DEVOB   EQU    4E66H    ; OSC B
DEVOC   EQU    4E68H    ; OSC C
DEVVD   EQU    4E6AH    ; VIBRATO DEPTH
DEVVR   EQU    4E6CH    ; VIBRATO RATE
DEVVC   EQU    4E6EH    ; VOL C
DEVNM   EQU    4E70H    ; NOIS MODE
DEVVA   EQU    4E72H    ; VOLUME A
DEVVB   EQU    4E74H    ; VOLUME B
DEVNV   EQU    4E76H    ; NOISE VOLUME
REMAIN  EQU    4E78H    ; REMAINDER FROM LAST DIVIDE
SCRMOD  EQU    4E7AH    ; SCROLL MODE
VDMNLF  EQU    4E7CH    ; VDM NEW LINE FLAG
KEYTMR  EQU    4E7DH    ; KEYBOARD SCAN TIMER
MUZTMR  EQU    4E7EH    ; MUSIC NOTE TIMER
NEWTMR  EQU    4E7FH    ; NEW MUSIC TIMER VALUE
MUZMO   EQU    4E80H    ; MASTER OSC FOR DICK
MUZTON  EQU    4E81H    ; TONE VALUE
SHARPF  EQU    4E82H    ; SHARP-FLAT
;
KEYTRK  EQU    4E83H    ; KEYBOARD TRACKER
LINEND  EQU    4E84H
EDFLG   EQU    4E86H
PIXVAL  EQU    4E86H    ; PIXEL TO DRAW WITH
EDPTR   EQU    4E87H
MNMX    EQU    4E87H    ; MIN - MAX DELTAS FOR VECTOR DRAW
INCRO   EQU    4E89H    ; COORDINATE INCREMENTS FOR VECTOR DRAW
NLLNLN  EQU    4E8BH    ; AUTO LINE # STUFF
NLLNCT  EQU    4E8DH
NLLNZS  EQU    4E8EH    ; AUTO LINE NUMBER ZERO SUPPRESS FLAG
OLDLN   EQU    4E8FH    ; PREVIOUS LINE # TYPED
;
CHECKER EQU    4E91H    ; PLACE FOR CHECKSUM
HKVECT  EQU    4E92H
HKLPINT EQU    4E92H
HKINT   EQU    4E95H
CHKIO   EQU    4E98H
OUTCH   EQU    4E9BH
STACKP  EQU    4E9EH    ; STACK POINTER
ALTFON  EQU    4EA0H    ; ALTERNATE FONT DESCRIPTOR
OLDCUR  EQU    4EA7H
CURRNT  EQU    4EA9H
STKGOS  EQU    4EABH
VARNXT  EQU    4EADH
STKINP  EQU    4EADH
LOPVAR  EQU    4EAFH
LOPINC  EQU    4EB1H
LOPLMT  EQU    4EB3H
LOPLN   EQU    4EB5H
LOPPT   EQU    4EB7H
XQTBUF  EQU    4EBAH
BUFFER  EQU    4EBAH
BUFEND  EQU    4F22H
STKLMT  EQU    4F6AH
;       ORG    TOPSCR
STACK   EQU    4FEAH
;       ORG    BOTRAM
TXT     EQU    0A000H
;
        ORG    BOTROM
        JP     BEGIN    ; ** AUTOSTART CASSETTE **
PIXTBL  DB     80H
        DB     20H
        DB     08H
        DB     02H
; TRANSFER VECTORS TO RESTART ROUTINES
        JP     TSTCH    ; * RST 8
        JP     EXPR     ; * RST 16
        JP     LDE      ; * RST 24
        JP     IGNBLK   ; * RST 32
        JP     PARN     ; * RST 40
        POP    AF       ; * RST 48
        JP     FINISH
WHAT    DB     'WHAT?'
        DB     CR
        DW     HKLPINT
ITAB    DW     HKINT
; INITIAL VALUES FOR PARAMETER VECTOR
INIDEV  DW     7        ; BACKGROUND COLOR
        DW     0        ; FOREGROUND COLOR
        DW     2        ; MUSIC TEMPO
        DW     -77      ; VDM X COORDINATE
        DW     40       ; VDM Y COORDINATE
; BIT BANGER GOODIES FOLLOW:
BANGIN  EQU    3C00H    ; BIT BANGER READ PORT
BANG1   EQU    3800H    ; BIT BANG CODE TO WRITE A ONE
BANG0   EQU    3C00H    ; BIT BANG CODE TO WRITE A ZERO
;
WASTEIT MACRO  TIME, ?LAB
        LD     A,TIME
?LAB    DEC    A
        JR     NZ,?LAB
        ENDM
;
; PRINT COMMAND
; IF VARIABLE NAME, BLOCKSIZE GIVEN, WE WILL WRITE
; OUT THE SPECIFIED BLOCK RATHER THAN THE PROGRAM STORAGE AREA
TOUTPU  CALL   IGNATNL  ; ANY ARGS?
        JR     Z,YYSPGM ; JUMP TO SAVE PGM IF SO
        CALL   TSTVFF   ; ELSE GET START ADDR
        PUSH   HL       ; SAVE THAT
        TSTCC  COMMA,BADSAV     ; CHECK FOR COMMA 
        RST    RSTEXP   ; GET BLOCK SIZE
        ADD    HL,HL    ; CONVERT TO BYTES
        EX     DE,HL
        EX     (SP),HL  ; PUSH DE ON STACK
        EX     DE,HL    ; DE=START, HL=SIZE
        JR     YYOUTB   ; JUMP TO OUTPUTER
YYSPGM  LD     HL,CHECKER-4000H
        PUSH   DE
        LD     DE,4000H
; SAVE PROGRAM TO TAPE
YYOUTB  SYSSUK EMUSIC
        DI
        CALL   LEADER   ; WRITE OUT SOME LEADER
        LD     A,0A5H
        CALL   OUTBYA
OBL     RST    RSTLDE
        CALL   OUTBYA   ; TWEEDLE IT OUT
        INC    DE       ; BUMP BLOCK PTR
        DEC    HL       ; DECREMENT BLOCK SIZE
        LD     A,H      ; LOOP END YET?
        OR     L
        JR     NZ,OBL
        RST    RSTLDE
        LD     A,B      ; OUTPUT CHECKSUM
        CPL             ; COMPLEMENT FOR LATER TEST
        CALL   OUTBYA
        LD     B,2
        RST    RSTLDE
        EX     (SP),HL
        EX     (SP),HL
        CALL   LEADR1   ; PUT OUT TRAILER
        POP    DE
        EI
        RST    RSTFIN   ; BYE BYE
BADSAV  JP     QWHAT
TVLIST  PUSH   DE
        CALL   TVLLNK
        POP    DE
        RST    RSTFIN
; SPECIAL ENTRY TO LOAD COMBINED SCREEN AND PGM
;
; :INPUT COMMAND
; IF VARIABLE ADDRESS IS GIVEN, WE WILL INPUT
; THE BLOCK INTO THE SPECIFIED AREA, OTHERWISE
; WE HANDLE IT LIKE A PROGRAM
TINPUT  CALL   IGNATNL  ; AND ARGS?
        LD     HL,4000H
        CALL   NZ,TSTVFF  ; GET VAR ADDR
        PUSH   DE
        CALL   INBLK
XXELOD  POP    DE
        RST    RSTFIN
; : RUN COMMAND - LOADS BOOTSTRAP INTO RAM
; AND JUMPS TO IT
TLOAD   LD     HL,4000H ; HL=SCREEN TOP
        PUSH   HL
; SUBROUTINE TO INPUT A BLOCK, HL=STORE ADDR
; FIRST - AN ENTRY TO REVEAL FEEDBACK AREA
INBLK   CALL   SENWAI
; LOOP TO GRAB CHARS AND STORE EM
ZZCHRL  CALL   INCHAR
        JR     Z,ZZEOT
        CALL   STHL
        INC    HL
        JR     ZZCHRL
TVLLNK  CALL   SENWAI
ZZKIL   CALL   INCHAR
        JR     NZ,ZZKIL
ZZEOT   DEC    HL
        EI
        INC    D        ; SHOULD HAVE BEEN FF
        RET    Z
OUTCHQ  LD     A,'?'
        JP     OUTCH
;
SENWAI  SYSSUK EMUSIC
        DI
SENW    CALL   INCHAR   ; WAIT FOR THE SENTINEL
        JR     Z,SENW
        CP     0A5H
        JR     NZ,SENW
        LD     D,A
        RET
; INCHAR CLOBBERS A, BC, DE
INCHAR          ; NZ IF NO TIMEOUT, Z IF TIMEOUT, CHAR INC
        LD     A,(BANGIN+2)
        AND    1
        LD     E,A      ; PRIME THE PUMP
        LD     BC,810H  ; 8 BITS, 10=TIMEOUT FACTOR
SBW     CALL   INBIT    ; WAIT FOR START BIT
        JR     NC,GETL  ; GOT IT
        DEC    C        ; TIMEOUT?
        JR     NZ,SBW   ; NOT YET
        RET             ; Z SET
GETL    CALL   INBIT
        CALL   C,INBIT  ; GET ANOTHER 1
        RR     C
        DJNZ   GETL     ; GET 8 BITS
        LD     A,C      ; UPDATE CHECKSUM
        ADD    A,D
        LD     D,A
        DEC    B        ; SET NONZERO
        LD     A,C      ; RETURN VALUE
        RET             ; RETURN
INBIT
; CHECK FOR ABORT LOAD KEY
        IN     A,(HLTPORT)
        RRCA
        JP     C,INIT0
        LD     A,(BANGIN)
        XOR    E        ; CHECK FOR CHANGE
        RRCA
        JR   NC,INBIT   ; NO - WAIT
        WASTEIT 23
        LD     A,(BANGIN+1)
        AND    1
        CP     E
        LD     E,A
        RET    Z
        SCF
        RET
; OUTBYT CLOBBERS A, BC
OUTBYA  LD     C,A      ; GET CHAR FROM A
        ADD    A,B      ; ADD CHECKSUM ACCUM
        LD     B,A      ; AND SAVE
        PUSH   BC
        CALL   WRZERO   ; WRITE START BIT
        WASTEIT 14      ; VERY TIME SENSITIVE
        LD     B,8      ; WRITE 8 DATA, 1 STOP
WRL     SCF
        RR     C        ; GET BIT, INSERT 1 FOR STOP
        JR     C,WR1      ; IF ONE, WRITE ONE
        CALL   WRZERO   ; ELSE WRITE ZERO
        WASTEIT 12
        JR     NXT
NXT     JR     WRE      ; LOOP COUNTER
WR1     CALL   WRONE    ; WRITE ONE-BIT
        WASTEIT 32
WRE     DJNZ   WRL      ; TILL 8 BITS DONE
        JR     SEX
SEX     POP    BC
        CALL   WRONE    ; WRITE A ONE BIT FOR STOP
        WASTEIT 24
        RET
;
; LEADER CLOBEBERS BC AND A
LEADER  LD     B,15     ; APPROX 3 SECS
LEADR2  WASTEIT 32
        NOP
LEADR1  CALL   WRONE    ; LEADER IS ALL ONES
        DEC    BC
        LD     A,B
        OR     C
        JR     NZ,LEADR2
        WASTEIT 29
        RET
;
; WRONE WRITES ONE HALF CYCLE OF ONE-BIT (1/1200 SEC)
;
WRONE   LD     A,(BANG1) ; CHANGE ITS STATE
        WASTEIT 36       ; WASIT SOME, THEN FALL INTO...
        LD     A,(BANG0)
        RET
;
; WRZERO WRITES ONE HALF CYCLE OF ZERO BIT (1/2400 SEC)
;
WRZERO  LD     A,(BANG1)
        WASTEIT 17
        NOP
        NOP
        LD     A,(BANG0)
        RET
;
;
;
CKHLDE  LD     A,H
        XOR    D
        JP     P,COMP
        EX     DE,HL
; ...
COMP    LD     A,H
        CP     D
        RET    NZ
        LD     A,L
        CP     E
        RET
HOW     DB     'HOW?'
        DB     CR
SORRY   DB     'SORRY'
        DB     CR
;
; TABLE GIVING JUMP TO ADDRESS FOR COMMANDS
TOKJT   DW     LISTCOM  ; 'LIST' TOKEN
        DW     CLRSCR
        DW     RUN
        DW     NEXT
        DW     LINEDR
        DW     IFF
        DW     GOTO
        DW     GOSUB
        DW     RETURN
        DW     BOXDRW
        DW     FOR
        DW     INPUT
        DW     PRINT
; INITIAL HOOK VECTOR ITEMS
HOOKER  JP     LPINT
        JP     TBIINT
        JP     XCHKIO
        JP     XOUTCH
        DW     STACK
; TABLE GIVING ASCII CHARS FOR TOKENS
TOKTXT
        DB     'LIS'
        DB     'T'+80H
        DB     'CLEA'
        DB     'R'+80H
        DB     'RU'
        DB     'N'+80H
        DB     'NEX'
        DB     'T'+80H
        DB     'LIN'
        DB     'E'+80H
        DB     'I'
        DB     'F'+80H
        DB     'GOT'
        DB     'O'+80H
        DB     'GOSU'
        DB     'B'+80H
        DB     'RETUR'
        DB     'N'+80H
        DB     'BO'
        DB     'X'+80H
        DB     'FO'
        DB     'R'+80H
        DB     'INPU'
        DB     'T'+80H
        DB     'PRIN'
        DB     'T'+80H
        DB     'STE'
        DB     'P'+80H
        DB     'RN'
        DB     'D'+80H
        DB     'T'
        DB     'O'+80H
;
; DEVICE VARIABLE TABLE
; THIS TABLE IS IN INVERSE ORDER OF APPEARENC IN MEMORY
PARNUM  EQU    19
DEVLST
        DB     'S'-'@'
        DB     'M'
        DB     'R'-'@'
        DB     'M'
        DB     'N'-'@'
        DB     'V'
        DB     'V'-'@'
        DB     'B'
        DB     'V'-'@'
        DB     'A'
        DB     'N'-'@'
        DB     'M'
        DB     'V'-'@'
        DB     'C'
        DB     'V'-'@'
        DB     'F'
        DB     'V'-'@'
        DB     'R'
        DB     'T'-'@'
        DB     'C'
        DB     'T'-'@'
        DB     'B'
        DB     'T'-'@'
        DB     'A'
        DB     'M'-'@'
        DB     'O'
        DB     'X'-'@'
        DB     'Y'
        DB     'C'-'@'
        DB     'Y'
        DB     'C'-'@'
        DB     'X'
        DB     'N'-'@'
        DB     'T'
        DB     'F'-'@'
        DB     'C'
        DB     'B'-'@'
        DB     'C'
; TINY BASIC INTERRUPT ROUTINE
TBIINT  PUSH   AF       ; SAVE REGISTERS
        PUSH   BC
        PUSH   HL
; DEAL WITH KEYBOARD SCAN TIMER
        LD     HL,KEYTMR
        LD     A,(HL)
        AND    A
        JR     Z,TBIN0
        DEC    (HL)
TBIN0   INC    HL
; HAS MUSIC TIMER COUNTED DOWN?
        LD     A,(HL)
        AND    A
        JR     Z,TBIN1  ; YEP - PLAY NEXT NOTE
        DEC    (HL)     ; ELSE DECREMENT IT
        JR     NZ,TBIN3 ; JUMP IF NOT NOW ZERO
        XOR    A
        LD     (DEVOA),A 
        JR     TBIN2
; MUSIC TIMER IS AT ZERO - ARE NEW PARAMETERS READY?
TBIN1   INC    HL       ; STEP TO NEW TIMER VALUE
        OR     (HL)     ; IS IT NON ZERO?
        JR     Z,TBIN3  ; JUMP IF NOT
        LD     (HL),0   ; SAY WE GOT IT
        JP     M,TBIN3  ; IF MINUS UPDATE NOTHING
        DEC    HL       ; ELSE SET OFFICIAL TIMER
        LD     (HL),A
        INC    HL
        INC    HL
        LD     A,(HL)      ; SET NEW MASTER
        LD     (DEVMO),A 
        LD     (HL),OA2
        INC    HL
        LD     A,(HL)      ; AND NEW TONE
        LD     (DEVOA),A 
        AND    A        ; REST WANTED?
        JR     Z,TBIN3  ; YES - JUMP AROUND VOLUME UPDATE
        LD     A,15
TBIN2   LD     (DEVVA),A
; SET COLOR REGISTERS TO VALUES IN PARAMETER VARS %0 AND %1
TBIN3   LD     A,(DEVCL0)
        OUT    (COL0L),A
        OUT    (COL1L),A 
        LD     A,(DEVCL1)
        OUT    (COL2L),A 
        OUT    (COL3L),A 
; UPDATE THE MUSIC PROCESSOR
        LD     A,(DEVTEM)
        RLCA
        JR     C,INTDON
        LD     BC,410H
        LD     HL,DEVMO
LP1     LD     A,(HL)
        OUT    (C),A
        INC    HL
        INC    HL
        INC    C
        DJNZ   LP1
        LD     B,(HL)   ; B=VD
        INC    HL
        INC    HL
        LD     A,(HL)   ; A=VR
        RRCA
        RRCA
        XOR    B
        AND    0C0H
        XOR    B
        OUT    (C),A
        INC    HL
        INC    HL
        LD     B,(HL)   ; B=VOLC
        INC    HL
        INC    HL
        LD     A,(HL)   ; A=NM
        RLCA
        RLCA
        RLCA
        RLCA
        XOR    B
        AND    30H
        XOR    B
        OUT    (15H),A
        INC    HL
        INC    HL
        LD     B,(HL)   ; VA
        INC    HL
        INC    HL
        LD     A,(HL)   ; VB
        RLCA
        RLCA
        RLCA
        RLCA
        XOR    B
        AND    0F0H
        XOR    B
        OUT    (16H),A
        INC    HL
        INC    HL
        LD     A,(HL)   ; GET NOISE VOLUME
        OUT    (17H),A
; DONE - RESTORE REGISTERS AND GO BACK
INTDON  POP    HL
        POP    BC
        POP    AF 
LPINT   EI
        RET
; CAMMAND TO SILENCE MUSIC PORTS
SILENCE
        PUSH   DE
        SYSSUK FILL
        DW     DEVOA
        DW     20
        DB     0
        POP    DE
        RST    RSTFIN
; ROUTINE TO MOVE PROGRAM LINE FROM PGM STORAGE AREA
; INTO EXECUTION BUFFER
EXPAND  LD     HL,(CURRNT)
        LD     BC,(OLDCUR)
        AND    A
        SBC    HL,BC
        RET    Z
EXPMAN  LD     HL,(CURRNT)
        BIT    7,H      ; IN LINE BUFFER ALREADY?
        RET    Z        ; YES - KICKOUT
        LD     (OLDCUR),HL
        INC    HL
        INC    HL
        ADD    HL,HL
        LD     BC,XQTBUF
EXP1    LD     A,(HL)
        RLCA
        INC    HL
        XOR    (HL)
        AND    0AAH
        XOR    (HL)
        LD     (BC),A
        INC    HL
        INC    BC
        CP     CR
        JR     NZ,EXP1
        SCF
        RR     H
        RR     L
        LD     (LINEND),HL
        RET
; SUBROUTINE TO RETURN ZERO STATUS IF CHARACTER IN A IS NL OR
; ';'
IGNATNL RST    RSTIGN   ; IGNORE ANY BLANKS
ATNL    CP     ';'      ; CHECK FOR CONTINUATION
        RET    Z
        CP     CR       ; AND FOR CR
        RET
; FUNCTION TO RETURN STATE OF ADDRESSED PIXEL
; IE... PIX(X,Y)= 1 IF PIXEL IS 1, 0 IF 0
PIXFUN  TSTC  '(',PIXDUD
        PUSH   BC
        RST    RSTEXP
        PUSH   HL
        TSTCC  COMMA,PIXDUD
        RST    RSTEXP
        TSTC  ')',PIXDUD
        POP    BC
        PUSH   DE       ; SAVE PTR
        LD     D,L
        LD     E,C
        CALL   R2A
        EX     DE,HL
        SYSSUK INDEXB   ; INDEX BYTE (SYSTEM SUBROUTINE)
        DW     PIXTBL
        LD     A,(DE)   ; GET BYTE FROM SCREEN
        AND    (HL)     ; MASK OFF NONSENSE
        LD     H,0
        LD     L,H
        POP    DE
        POP    BC
        RET    Z
        INC    HL
        RET
; SOUROUTINE TO GET VARIABLE MAKING SURE IT IS ONE
TSTVFF  CALL   TSTV
        RET    NC       ; GO BACK IF GOOD
; ELSE FALL INTO...
PIXDUD  JP     QWHAT
CLRSCR  CALL   CLRENT
        LD     HL,0
        LD     (OLDXY),HL 
        RST    RSTFIN
; BOX DRAW ROUTINE
BOXDRW  RST    RSTEXP   ; GET X
        PUSH   HL
        TSTCC  COMMA,BOXDUD    ; FIND COMMA
        RST    RSTEXP   ; GET Y
        PUSH   HL
        TSTCC  COMMA,BOXDUD
        RST    RSTEXP
        LD     A,L
        PUSH   AF 
        TSTCC  COMMA,BOXDUD
        RST    RSTEXP
        LD     B,L
        PUSH   BC
        TSTCC  COMMA,BOXDUD
        RST    RSTEXP
        PUSH   DE
        POP    IX
        POP    BC       ; RESTORE YS
        POP    AF       ; AND XS
        LD     C,A
        LD     A,L      ; PRESERVE FLAG
        POP    HL
        LD     D,L
        POP    HL
        LD     E,L
        LD     L,A
; NOW WE HAVE: B=YS, C=XS, D=Y, E=X, L=FLAG
; LIMIT CHECK Y
        LD     H,B
        SRL    H
        LD     A,D
        CALL   SABS
        ADD    A,H
        CP     45
        JR   NC,BOXNDR
        LD     A,B      ; DIVIDE SIZE AGAIN
        DEC    A        ; THIS TIME WITH PRESUB
        SRL    A
        ADD    A,D
        LD     D,A
; AND X
        LD     H,C
        SRL    H
        LD     A,E
        CALL   SABS
        ADD    A,H
        CP     81
        JR   NC,BOXNDR
        LD     A,E
        SUB    H
        LD     E,A
; DIDDLE WITH FLAG BYTE
        LD     A,L
        AND    3        ; MODULO 4
        JR     Z,BOXNDR ; SKIP DRAW IF ZERO
        SUB    2        ; ELSE SUBTRACT 2 FOR MASK
BOXDR1  PUSH   AF 
        CALL   R2A
; HL = ABS ADDR, A = SA, B=YS, C=XS
        OUT    (MAGIC),A
        POP    AF 
        CALL   BOXPUT
BOXNDR  PUSH   IX
        POP    DE
        RST    RSTFIN
BOXDUD  JP     QWHAT
SABS    AND    A
        RET    P
        CPL
        INC    A
        RET
; SUBROUTINE TO DRAW A BOX ON SCREEN
BOXPUT  LD     E,A
        LD     A,C      ; D = X / 4
        RRCA
        RRCA
        AND    3FH
        INC    A
        LD     D,A
; PAINT FULL BOX STRIPES
MPT1    DEC    D
        JR     Z,MPT2
        LD     A,10101010B
        CALL   STRIPE
        JR     MPT1
MPT2    LD     A,C
        AND    3
        INC    A
        LD     C,A
        XOR    A
MPT3    DEC    C
        JR     Z,MPT4
        RRCA
        RRCA
        OR     10000000B
        JR     MPT3
MPT4    CALL   STRIPE
        XOR    A
; FALL INTO...
; SUBROUTINE TO PAINT A STRIPE
STRIPE  PUSH   HL
        PUSH   BC
        LD     (URINAL),A 
        LD     A,(URINAL+4000H)
        LD     C,A
STRP1   LD     A,E
        CP     1
        JR     NZ,STRP2
        LD     A,(HL)
        XOR    C
STRP2   XOR    (HL)
        AND    C
        XOR    (HL)
        LD     (HL),A
        LD     A,L
        ADD    A,BYTEPL
        LD     L,A
        LD     A,H
        ADC    A,0
        LD     H,A
        DJNZ   STRP1
        POP    BC
        POP    HL
        INC    HL
        RET
; LINE DRAWER
LINEDR  RST    RSTEXP
        LD     A,L
        PUSH   AF 
TSTCC   COMMA,LINED4
        RST    RSTEXP
        LD     A,L
        PUSH   AF 
LINED1  TSTCC  COMMA,LINED4
        RST    RSTEXP
        LD     C,L
        PUSH   DE
        POP    IX
        LD     DE,(OLDXY)
        POP    AF 
        LD     H,A
        POP    AF 
        LD     L,A
        LD     (OLDXY),HL  ; SET NEW LAST PLACE
; DIDDLE WITH FLAG BYTE
        LD     A,C
        AND    3
        JR     Z,LINED3
        SUB    2
LINED2  LD     (PIXVAL),A  ; SET PIXVAL
        CALL   DVECT
LINED3  PUSH   IX
        POP    DE
        RST    RSTFIN
LINED4  JP     QHOW
; LARRY LIVERMORE'S VECTOR DRAWING ALGORITHM
; H=Y1, L=X1, D=Y2, E=X2
DVECT   PUSH   DE
        LD     B,L
        LD     C,E
        CALL   CDELTA
        LD     E,B
        LD     L,C
        LD     B,H
        LD     C,D
        CALL   CDELTA
        LD     H,C
        LD     D,B
; NOW WE HAVE: H=SGN(DY), L=SGN(DX)
; D=ABS(DY), E=ANS(DX)
        LD     (INCRO),HL 
; DECIDE WHICH DELTA IS LARGER
; CALL  BIGGER MX, SMALLER MN
        LD     C,0
        LD     A,D
        CP     E
        JR     C,VECT1
        LD     D,E
        LD     E,A
        INC    C
VECT1   LD     A,D      ; MX TO A
        SRL    A
        LD     B,A
        EX     DE,HL
        LD     (MNMX),HL
        POP    DE
        LD     A,L
        INC    A        ; MAKE SURE LAST PIXEL WRITTEN
; THE INFAMOUS PIXEL PAINTING LOOP
VECT2   PUSH   AF 
        CALL   R2ACLP
        JR   NC,VECT2A
        PUSH   BC
        PUSH   HL
        LD     C,A
        LD     B,0
        LD     HL,PIXTBL
        ADD    HL,BC
        LD     B,(HL)
        POP    HL
        LD     A,(PIXVAL)
        CP     1
        JR     NZ,VECT9
        LD     A,(HL)
        XOR    B
VECT9   XOR    (HL)
        AND    B
        XOR    (HL)
        LD     (HL),A
        POP    BC
; INCREMENT COORDINATES
VECT2A  LD     HL,(MNMX)
        LD     A,B
        ADD    A,H
        CP     B        ; DID WRAP AROUND UNIVERSE?
        JR     C,FUZZ
        CP     L
        JR     C,VECT4
FUZZ    SUB    L
        LD     B,A
        LD     HL,(INCRO)
        LD     A,D
        ADD    A,H
        LD     D,A
VECT3   LD     A,E
        ADD    A,L
        LD     E,A
        JR     VECT5
VECT4   LD     B,A
        LD     HL,(INCRO)
        LD     A,C
        RRCA
        JR   NC,VECT3
        LD     A,D
        ADD    A,H
        LD     D,A
; END OF LOOP
VECT5   POP    AF 
        DEC    A
        JR     NZ,VECT2
        RET
; SUBROUTINE TO LOAD HL WITH VDM COORDINATES
; FROM DEVICE VARIABLES
LDVDMC  PUSH   AF 
        LD     A,(VDMY)
        CPL
        ADD    A,41
        CP     81       ; OUT OF RANGE?
        JR     C,LDVDM1 ; NO
        XOR    A
LDVDM1  LD     H,A
        LD     A,(VDMX) ; DIDDLE WITH X
        ADD    A,77
        CP     157
        JR     C,LDVDM2
        XOR    A
LDVDM2  LD     L,A
        POP    AF 
        RET
; SUBROUTINE TO STORE HL INTO VDM COORDINATE DEVICE VARIABLES
STVDMC  PUSH   HL
        LD     A,H
        SUB    41
        CPL
        LD     L,A
        CALL   SGNEXT
        LD     (VDMY),HL 
        POP    HL
        LD     A,L
        SUB    77
        LD     L,A
        CALL   SGNEXT
        LD     (VDMX),HL
        RET
; SUBROUTINE TO COMPUTE DELTA AND INCREMENT FOR TWO COORDINATES
CDELTA  PUSH   HL
        PUSH   DE
        LD     L,C
        CALL   SGNEXT
        EX     DE,HL
        LD     L,B
        CALL   SGNEXT
        XOR    A
        SBC    HL,DE
; COMPUTE SGN(DELTA) AND ABS(DELTA)
        OR     H
        JR     Z,CDELT1
        LD     C,A
        LD     A,L
        CPL
        INC    A
        LD     B,A
        JR     CDELT3
CDELT1  OR     L        ; POS CASE 0?
        JR     Z,CDELT2
        LD     A,1
CDELT2  LD     B,L
        LD     C,A
CDELT3  POP    DE
        POP    HL
        RET
; RELATIVE TO ABSULUTE CONVERSION WITHING CLIPPING
R2ACLP  LD     A,E
        ADD    A,80
        CP     160      ; IN RANGE 0-159 - CY FOR OK
        RET    NC
        LD     A,D
        ADD    A,44
        CP     88
        RET    NC
; ...
; RELATIVE TO ABSOLUTE CONVERSTION
R2A     PUSH   DE
        LD     A,D
        CPL
        ADD    A,44
        LD     D,A
        LD     A,E
        ADD    A,80
        LD     E,A
        XOR    A
        SYSTEM RELAB1
        EX     DE,HL
        POP    DE
        SCF
        RET
; KB - FUNCTION TO RETURN NEXT CHARACTER FROM KEYBOARD
GETKB   PUSH   BC
        PUSH   DE
        CALL   CHKIO
        POP    DE
KBLNKX  POP    BC
        LD     L,A
        LD     H,0
        RET
; DEVICE VARIABLE TO OUTPUT TO REFERENCED IO PORT
PUTIO   RST    RSTPAR   ; GET PORT #
        TSTC  '=',PUTCD2  ; GET EQUALS
        PUSH   HL       ; SAVE PORT #
        RST    RSTEXP   ; EVALUATE EXPRESSION FOLLOWING
        LD     A,L      ; A=VALUE TO OUTPUT
        POP    HL       ; RESTORE PORT #
        PUSH   BC
        LD     B,H
        LD     C,L
        OUT    (C),A    ; IT    1
        POP    BC
        RST    RSTFIN   ; GO HOME
; FUNCTION TO RETURN VALUE OF A GIVEN IO PORT
IOFUN   RST    RSTPAR   ; GET PORT NUMBA
        PUSH   BC
        LD     B,H
        LD     C,L
        IN     A,(C)
        JR     KBLNKX
; DEVICE VARIABLE TO PLAY NOTE WITHOUT PRINTING
PUTMU   TSTC  '=',PUTCD2
        RST    RSTEXP
        LD     A,L
        CALL   PNOTE
        RST    RSTFIN
; DEVICE VARIABLE TO OUTPUT CHARACTER ON VDM
PUTCD   TSTC  '=',PUTCD2
        RST    RSTEXP
        LD     A,L
        CALL   OUTCH
        RST    RSTFIN
PUTCD2  JP     QWHAT
; ROUTINE TO TRANSFER CONTROL TO ASSEMBLY LANGUAGE SUBROUTINE
DOCALL  LD     HL,BBRET ; PUSH RETURN ADDR ON STACK
        PUSH   HL
        RST    RSTEXP   ; GET ADDRESS
        JP     (HL)            ; AND JUMP TO IT
; ** TINY BASIC EXECUTION STARTS HERE **
; CLEAR WHOLE KIT AND KABOOBLE
BEGIN   XOR    A
        OUT    (MAGIC),A
        LD     H,A
        LD     L,A
        LD     (HL),A   ; MAKE SURE SHIFTER FLUSHED
BEGIN1  LD     (HL),A
        INC    HL
        BIT    4,H
        JR     Z,BEGIN1
        LD     SP,SYSRAM
        SYSTEM INTPC
        DO     SETOUT
        DB     176
        DB     44
        DB     18H
; INITIALIZE DEVICE VARIABLES
        DO     MOVE     ; MOVE BYTES (SYSTEM ROUTINE)
        DW     DEVVAR 
        DW     10 
        DW     INIDEV 
        DO     MOVE     ; MOVE BYTES (SYSTEM ROUTINE)
        DW     ALTFON 
        DW     07 
        DW     FNTSYS 
        DO     MOVE     ; MOVE BYTES (SYSTEM ROUTINE)
        DW     HKVECT 
        DW     14 
        DW     HOOKER 
        DO     SETW     ; STORE WORD (SYSTEM ROUTINE)
        DW     6A0H 
        DW     ALTFON 
        DO     SETW     ; STORE WORD (SYSTEM ROUTINE)
        DW     TXT+4 
        DW     TXTUNF 
        DO     SETW     ; STORE WORD (SYSTEM ROUTINE)
        DW     5555H 
        DW     4002H    ; TXT+2
        DONT   XINTC
INIT0   DI
        IM     2
        LD     A,ITAB >> 8
        LD     I,A
        LD     A,ITAB & 0FFH
        OUT    (INFBK),A
        LD     A,200
        OUT    (INLIN),A
        EI
INIT    CALL   CRLF
; DIRECT COMMAND - TEXT COLLECTOR
TELL
STOP
RSTART  LD     HL,(STACKP)
        LD     SP,HL
        LD     HL,XXST1+1
        LD     (CURRNT),HL 
XXST1   LD     HL,0
        LD     (OLDCUR),HL 
        LD     (LOPVAR),HL 
        LD     (STKGOS),HL 
XXST2   LD     A,'>'
        CALL   GETLN
        PUSH   DE
        LD     DE,BUFFER
        CALL   TSTNUM
        RST    RSTIGN
        LD     A,H
        OR     L
        POP    BC
        JR     Z,EXEC0
        LD     (OLDLN),HL 
        DEC    DE
        LD     A,H
        LD    (DE),A
        DEC    DE
        LD     A,L
        LD    (DE),A
        PUSH   BC
        PUSH   DE
        LD     A,C
        SUB    E
        PUSH   AF 
        CALL   FNDLN
        PUSH   DE
        JR     NZ,XXST3
        PUSH   DE
        CALL   FNDNXT
        POP    BC
        LD     HL,(TXTUNF)
        CALL   MVUP
        LD     H,B
        LD     L,C
        LD     (TXTUNF),HL 
XXST3   POP    BC
        LD     HL,(TXTUNF)
        POP    AF 
        PUSH   HL
        CP     3
        JR     Z,RSTART
        ADD    A,L
        LD     E,A
        LD     A,0
        ADC    A,H
        LD     D,A
        LD     HL,DFTLMT
        EX     DE,HL
        CALL   COMP
        JP     NC,QSORRY
        LD     (TXTUNF),HL 
        POP    DE
        CALL   MVDOWN
        POP    DE
        POP    HL
        CALL   MVUP
        JR     XXST2
; DIRECT AND EXEC
EXEC0   RST    RSTIGN   ; GET FIRST     NONBLANK
        PUSH   DE       ; SAVE POINTER
        SUB    68H      ; IS SHE A TOKEN?
        JR     C,EXEC0A   ; NO
        CP     0DH
        JR     NC,EXEC0A
; WE FOUND A TOKEN - LOOKUP IN TABLE AND JUMP TO IT
        RLCA
        LD     E,A
        LD     D,0
        LD     HL,TOKJT
        ADD    HL,DE
        LD     E,(HL)
        INC    HL
        LD     D,(HL)
        EX     DE,HL
        POP    DE
        INC    DE
        JP     (HL)
; NOT A TOKEN - A VARIABLE PERHAPS?
EXEC0A  CALL   TSTV     ; TEST FOR VARIABLE
        JR     C,EXEC0B   ; NO - SEARCH   1
        TSTC   '=',EXEC0B
        POP    BC       ; THROW OUT OLD PTR
        CALL   SETV1    ; ASSIGNMENT    1
BBRET   RST    RSTFIN
EXEC0B  POP    DE
        LD     HL,TAB2-1
EXEC    RST    RSTIGN   ; EXEC
        PUSH   DE       ; SAVE POINTER
EX1     LD     A,(DE)   ; ZAPPED LDE
        INC    DE
        INC    HL
        CP     (HL)
        JR     Z,EX1
        LD     A,07FH
        DEC    DE
        CP     (HL)
        JR     C,EX5
EX2     INC    HL
        CP     (HL)
        JR     NC,EX2
        INC    HL
        POP    DE
        JR     EXEC
EX5     LD     A,(HL)   ; LOAD HL WITH THE JUMP
        INC    HL       ; ADDRESS FROM TABLE
        LD     L,(HL)
        AND    07FH
        LD     H,A
        POP    AF 
        JP     (HL)
; IF AND REM
IFF     RST    RSTEXP
        LD     A,H
        OR     L
        JR     NZ,RUNSML
REM
RUNNXL  LD     DE,(LINEND)
        JR     RUNX1
RUN     LD     DE,TXT
RUNX1   LD     HL,0
        CALL   FNDLP
        JP     C,RSTART
RUNTSL  LD     (CURRNT),DE
        IN     A,(14H)
        LD     L,A
        IN     A,(15H)
        AND    L
        CP     20H
        CALL   Z,PRTLNS
OK
        CALL   EXPAND
        LD     DE,XQTBUF
RUNSML  CALL   WHATSU   ; CHECK FOR INTERRUPT KEY
        JR     EXEC0
GOTO    RST    RSTEXP
        PUSH   DE
        CALL   FNDLN
        JP     NZ,AHOW
        POP    AF 
        JR     RUNTSL
; LIST AND PRINT
; NEW - IMPROVED LIST COMMAND
; LETS YOU PUT IT IN A PROGRAM
LISTCOM LD     HL,0     ; ASSUME AT EOL
        CALL   IGNATNL
        JR     Z,LS3
        CP     ','      ; LEADING COMMA?
        JR     Z,LS3    ; YEP - SKIP FIRST EXPR GET
; NOT AT FIRST - GET FIRST EXPR
LS2     RST    RSTEXP
LS3     PUSH   HL
        LD     HL,0FFFFH
        TSTCC  COMMA,LS4
        RST    RSTEXP
LS4     PUSH   DE
        POP    IY
	  EX     (SP),HL
	  CALL   FNDLN
LS5     JR     C,LSQUIT
	  EX     (SP),HL
	  LD     A,H
	  OR     L
	  JR     Z,LSQUIT
	  DEC    HL
	  EX     (SP),HL
	  CALL   PRTLNS
	  CALL   WHATSU
	  CALL   FNDLP
	  JR     LS5
LSQUIT  PUSH   IY
	  POP    DE
	  RST    RSTFIN
PRINT   LD     C,8      ; C=# OF SPACES
	  TSTCC  59,PR1   ; IF NULL LIST & ";"
	  CALL   CRLF     ; GIVE CR-LF AND
	  JR     RUNSML   ; CONTINUE SAME LINE
PR1     TSTCC  CR,PR6   ; IF NULL LIST (CR)
	  CALL   CRLF     ; ALSO GIVE CR-LF AND
	  JP     IMCHEK   ; GO TO NEXT LINE IF POSSIBLE
PR2     TSTC   '#',PR4  ; ELSE IS IT FORMAT?
PR3     RST    RSTEXP   ; YES, EVALUATE EXPR.
	  LD     C,L      ; AND SAVE IT IN C
	  JR     PR5      ; LOOK FOR MORE TO PRINT
PR4     CALL   QTSTG    ; OR IS IT A STRING?
	  JR     PR9      ; IF NOT, MUST BE EXPR.
PR5     TSTCC  COMMA,PR8  ; IF COMMA, GO FIND NEXT
PR6     TSTCC  COMMA,PR7
        CALL   SPOUTCH
	  JR     PR6
PR7     CALL   FIN      ; IN THE LIST.
	  JR     PR2      ; LIST CONTINUES
PR8     CALL   CRLF     ; LIST ENDS
	  RST    RSTFIN
PR9     RST    RSTEXP   ; EVALUATE THE EXPR
	  PUSH   BC
	  CALL   PRTNUM   ; PRINT THE VALUE
	  POP    BC
	  JR     PR5      ; PRINT THE VALUE
; * **************************************************************
; *
; *  *** GOSUB *** & *** RETURN ***
; *
; * 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO' COMMAND,
; * EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER ETC. ARE SAVED
; * SO THAT EXECUTION CAN BE CONTINUED AFTER THE SUBROUTINE 'RETURN'.
; * IN ORDER THAT 'GOSUB' CAN BE NESTED (AND EVEN RECURSIVE), THE SAVE
; * AREA MUST BE STACKED.  THE STACK POINTER IS SAVED IN 'STKGOS'.  THE
; * OLD 'STKGOS' IS SAVED IN THE STACK.  IF WE ARE IN THE MAIN ROUTINE,
; * 'STKGOS' IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF CODE).
; * BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
; *
; * 'RETURN(CR)' UNDOES EVERYTHING THAT 'GOSUB' DID, AND THUS RETURN THE
; * EXECUTION TO THE COMMAND AFTER THE MOST RECENT 'GOSUB'.  IF 'STKDOS'
; * IS ZERO, IT INDICATES THAT WE NEVER HAD A 'GOSUB' AND IS THUS AN
; * ERROR
; *
GOSUB
        LD    A,(CURRNT+1)  ; DISALLOW FROM COMMAND
        RLCA
        JP     NC,QHOW
        CALL   PUSHA    ; SAVE THE CURRENT "FOR"
        RST    RSTEXP   ; PARAMETERS
        PUSH   DE       ; AND TEXT POINTER
        CALL   FNDLN    ; FIND THE TARGET LINE
        JP     NZ,AHOW  ; NOT THERE.  SAY "HOW?"
        LD     HL,(CURRNT) ; SAVE OLD
        PUSH   HL       ; 'CURRENT' OLD 'STKGOS'
        LD     HL,(STKGOS)
        PUSH   HL
        LD     HL,0     ; AND LOAD NEW ONES
        LD     (LOPVAR),HL
        ADD    HL,SP
        LD     (STKGOS),HL
        JP     RUNTSL   ; THEN RUN THAT LINE
RETURN  LD     HL,(STKGOS) ; OLD STACK POINTER
        LD     A,H      ; 0 MEANS NOT EXIST
        OR     L
        JP     Z,QWHAT  ; SO, WE SAY: "WHAT?"
        LD     SP,HL    ; ELSE, RESTORE IT
RESTO   POP    HL
        LD     (STKGOS),HL  ; AND THE OLD 'STKGOS'
        POP    HL
        LD     (CURRNT),HL  ; AND THE OLD 'CURRNT'
        POP    DE
        CALL   POPA
        CALL   EXPAND
        RST    RSTFIN
; *******************************************
; *
; * FOR *** & NEXT ***
; *
; * 'FOR' HAS TWO FORMS: 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND
; * 'FOR VAR=EXP1 TO EXP2'.  THE SECOND FORM MEANS THE SAME THING
; * AS THE FIRST FORM WITH EXP3=1, (I.E. WITH A STEP OF +1)  TBI
; * WILL FIND THE VARIABLE VAR. AND SET ITS VALUE TO THE CURRENT 
; * VALUE OF EXP1.  IT ALSO EVALUATES EXP2 AND EXP3 AND SAVES ALL
; * THESE TOGETHER WITH THE TEXT POINTER ETC. IN THE 'FOR' SAVE AREA
; * WHICH CONSISTS OF 'LOPVAR', 'LOPINC', 'LOPLMT', 'LOPLN', AND 'LOPPT'.
; * IF THERE IS ALREADY SOMETHING IN THE SAVE AREA (INDICATED BY A
; * NON-ZERO 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
; * BEFORE THE NEW ONE OVERWRITES IT.  TBI WILL THEN DIG IN THE STACK
; * AND FIND OUT IF THIS SAME VARIAABLE WAS USED IN ANOTHER CURRENTLY
; * ACTIVE 'FOR' LOOP.  IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS
; * DEACTIVATED.  (PURGED FROM THE STACK..)
; *
; * 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILY PHYSICAL) END OF
; * THE 'FOR' LOOP.  THE CONTROL VARIABLE VAR. IS CHECKED WITH THE
; * 'LOPVAR'.  IF THEY ARE NOT THE SAME, TBI DIGS IN THE STACK TO FIND
; * THE RIGHT ONE AND PURGES ALL THOSE THAT DID NOT MATCH.  EITHER WAY,
; * TBI THEN ADDS THE 'STEP' TO THAT VARIABLE AND CHECKS THE RESULT WITH
; * THE LIMIT.  IF IT IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE
; * COMMAND FOLLOWING THE 'FOR'.  IF OUTSIDE THE LIMIT, THE SAVE AREA IS
; * PURGED AND EXECUTION CONTINUES.
; *
FOR     CALL   PUSHA    ; SAVE THE OLD SAVE AREA
        CALL   SETVAL   ; SET THE CONTROL VAR.
        DEC    HL       ; HL IS ITS ADDRESS
        LD     (LOPVAR),HL   ; SAVE THAT
        TSTCC  77H,FR1A ; TO? - LOOK FOR WORD "TO"
FR1     RST    RSTEXP   ; EVALUATE THE LIMIT
FR1A    LD     (LOPLMT),HL  ; SAVE THAT
        LD     HL,1
        TSTCC  75H,FR4  ; STEP?
        RST    RSTEXP
FR4     LD     (LOPINC),HL  ; SAVE THAT TOO
        LD     HL,(CURRNT)  ; SAVE CURRENT LINE #
        LD     (LOPLN),HL   ; AND TEXT POINTER
        EX     DE,HL
        LD     (LOPPT),HL 
        LD     BC,10    ; DIG INTO STACK TO
        LD     HL,(LOPVAR)  ; FIND 'LOPVAR'
        EX     DE,HL
        LD     H,B
        LD     L,B      ; HL=0 NOW
        ADD    HL,SP    ; HERE IS THE STACK
        JR     FR6
FR5     ADD    HL,BC    ; EACH LEVEL IS 10 DEEP
FR6     LD     A,(HL)   ; GET THAT OLD 'LOPVAR'
        INC    HL
        OR     (HL)
        JR     Z,FR7    ; 0 SAYS NO MORE IN IT
        LD     A,(HL)
        DEC    HL
        CP     D        ; SAME AS THIS ONE?
        JR     NZ,FR5
        LD     A,(HL)   ; THE OTHER HALF?
        XOR    E
        JR     NZ,FR5
        EX     DE,HL    ; YES, FOUND ONE
        LD     H,A
        LD     L,A
        ADD    HL,SP       ; TRY TO MOVE SP
        LD     B,H
        LD     C,L
        LD     HL,10
        ADD    HL,DE
        CALL   MVDOWN   ; AND PURGE 10 WORDS
        LD     SP,HL    ; IN THE STACK
FR7     LD     HL,(LOPPT)  ; JOB DONE, RESTORE DE
        EX     DE,HL
        RST    RSTFIN   ; AND CONTINUE
NEXT    CALL   TSTV     ; GET ADDRESS OF VAR.
        JP     C,QWHAT    ; NO VARIABLE, "WHAT?"
        LD     (VARNXT),HL   ; YES, SAVE IT
NX1     PUSH   DE       ; SAVE TEXT POINTER
        EX     DE,HL
        LD     HL,(LOPVAR)  ; GET VAR. IN 'FOR'
        LD     A,H
        OR     L        ; 0 SAYS NEVER HAD ONE
        JP     Z,AWHAT  ; SO WE ASK: "WHAT?"
        CALL   COMP     ; ELSE WE CHECK THEM
        JR     Z,NX2    ; OK, THEY AGREE
        POP    DE       ; NO, LET'S SEE
        CALL   POPA     ; PURGE CURRENT LOOP
        LD     HL,(VARNXT)  ; AND POP ONE LEVEL
        JR     NX1      ; GO CHECK AGAIN
NX2     EX     DE,HL    ; COME HERE WHEN AGREED
        RST    RSTLDE   ; DE=VALUE OF VAR.
        LD     L,A
        INC    DE
        RST    RSTLDE
        LD     H,A
        EX     DE,HL
        LD     HL,(LOPINC)
        PUSH   HL
        LD     A,H
        XOR    D        ; S=SIGN OF DIFFER
        LD     A,D      ; A=SIGN OF DE
        ADD    HL,DE        ; ADD ONE STEP
        JP     M,NX3    ; CANNOT OVERFLOW
        XOR    H        ; MAY OVERFLOW
        JP     M,NX5    ; AND IT DID
NX3     EX     DE,HL
        LD     HL,(LOPVAR)  ; PUT IT BACK
        CALL   STDEHL
        LD     HL,(LOPLMT)  ; HL=LIMIT
        POP    AF       ; OLD HL
        RLCA            ; EXAMINE SIGN BIT
        JR   NC,NX4     ; IF POS SKIP EX     DE,HL
        EX     DE,HL
NX4     CALL   CKHLDE   ; COMPARE WITH LIMIT
        POP    DE       ; RESTORE TEST POINTER
        JR     C,NX6    ; OUTSIDE LIMIT
        LD     HL,(LOPLN)  ; WITHIN LIMIT, GO
        LD     (CURRNT),HL   ; BACK TO THE SAVED
        LD     HL,(LOPPT)  ; 'CURRNT' AND TEXT
        EX     DE,HL    ; POINTER
        CALL   EXPAND
        RST    RSTFIN
NX5     POP    HL       ; OVERFLOW , PURGE
; RESTO LINKS IN HERE
NXXX    POP    DE       ; GARBAGE IN STACK
NX6     CALL   POPA     ; PURGE THIS LOOP
        RST    RSTFIN
; *
; *********************************************************
; *
; *  IF *** INPUT *** & LET (& DEFLT) ****
; *
; *
; * 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE COMMANDS
; * (INCLUDING OTHER 'IF'S). SEPARATED BY SEMI-COLONS.  NOTE THAT THE
; * WORD 'THEN' IS NOT USED.  TBI EVALUATES THE EXPR. IF IT IS NON-ZERO,
; * EXECUTION CONTINUES.  IF THE EXPR. IS ZERO, THE COMMANDS THAT
; * FOLLOW ARE IGNORED AND EXECUTION CONTINUES AT THE NEXT LINE.
; *
; * 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED BY A
; * LIST OF ITEMS.  IF THE ITEM IS A STRING IN A SINGLE OR DOUBLE QUOTES,
; * OR IS AN UP-ARROW, IT HAS THE SAME EFFECT AS IN 'PRINT'.  IF AN ITEM
; * IS A VARIABLE, THIS VARIABLE NAME IS PRINTED OUT FOLLOWED BY A
; * COLON.  THEN TBI WAITS FOR AN EXPR. TO BE TYPED IN.  THE VARIABLE IS
; * THEN SET TO THE VALUE OF THIS EXPR.  IF THE VARIABLE IS PROCEDED BY
; * A STRING (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STING WILL BE
; * PRINTED FOLLOWED BY A COLON.  TBI THEN WAITS FOR INPUT EXPR.   AND
; * SET THE VARIABLE TO THE VALUE OF THE EXPR.
; *
; * IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", "HOW?", OR
; * 'SORRY' AND REPRINT THE PROMPT AND REDO THE INPUT.  THE EXECUTION
; * WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.  THIS IS HANDLED IN
; * 'INPERR'.
; *
INPERR  LD     HL,(STKINP)  ; *** INPERR ***
        LD     SP,HL    ; RESTORE OLD SP
        POP    HL       ; AND OLD 'CURRNT'
        LD     (CURRNT),HL 
        POP    DE       ; AND OLD TEXT POINTER
        POP    DE       ; REDO INPUT
        CALL   EXPMAN   ; EXPAND THAT LINE OUT
INPUT   EQU    $
IP1     PUSH   DE       ; SAVE IN CASE OF ERROR
        CALL   QTSTG    ; IS NEXT ITEM A STRING?
        JR     IP8      ; NO
IP2     CALL   TSTV     ; YES, BUT FOLLOWED BY A
        JR     C,IP5      ; M6I VARIABLE? NO.
IP3     CALL   IP12
        LD     DE,BUFFER ; POINTS TO BUFFER
        RST    RSTEXP   ; EVALUATE INPUT
        POP    DE       ; OK, GET OLD HL
        EX     DE,HL
        CALL   STDEHL
IP4     POP    HL       ; GET OLD 'CURRNT'
        LD     (CURRNT),HL 
        POP    DE       ; AND OLD TEXT POINTER
        CALL   EXPMAN
IP5     POP    AF       ; PURGE JUNK IN STACK
IP6     TSTCC  COMMA,IP7  ; IS NEXT CH. ','?
        JR     INPUT    ; YES, MORE ITEMS.
IP7     RST    RSTFIN
IP8     PUSH   DE       ; SAVE FOR 'PRTSTG'
        CALL   TSTV     ; MUST BE VARIABLE NOT
        JP     C,QWHAT    ; "WHAT?" IT IS NOT?
IP11    LD     B,E
        POP    DE
        CALL   PRTCHS   ; PRINT THOSE AS PROMPT
        JR     IP3      ; YES, INPUT VARIABLE
IP12    POP    BC       ; RETURN ADDRESS
        PUSH   DE       ; SAVE TEXT POINTER
        EX     DE,HL
        LD     HL,(CURRNT)  ; ALSO SAV 'CURRNT'
        PUSH   HL
        LD     HL,IP1   ; A NEGATIVE NUMBER
        LD     (CURRNT),HL   ; AS A FLAG
        LD     HL,0     ; SAVE SP TOO
        ADD    HL,SP
        LD     ( STKINP),HL 
        PUSH   DE       ; OLD HL
        PUSH   BC
        LD     A,' '
        JP     GETLN    ; AND GET A LINE
; *********************************************
; *
; ** EXPR **
; *
; * 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS
; * <EXPR>::=<EXPR1>
; *           <EXPR1><REL.OP><EXPR1>
; * WHERE <REL.OP> IS ONE OF THE OPERATORS IN TAB6 AND THE RESULT OF
; * THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
; * <EXPR1>::=(+ OR -)<EXPR2>(+ OR -<EXPR2>)(...)
; * WHERE () ARE OPTIONAL AND (...) ARE OPTIONAL REPEATS.
; * <EXPR2>::=<<EXPR3>(<* OR /><EXPR3>)(...)
; * <EXPR3>::=<VARIABLE>
; *            <FUNCTION>
; *            (<EXPR>)
; * <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR> AS
; * INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
; * <EXPR3> CAN BE AN <EXPR> IN PARENTHESES.
EXPR    CALL   EXPR1    ; *** EXPR ***
        PUSH   HL       ; SAVE <EXPR1> VALUE
        LD     HL,TAB6-1 ; LOOKUP REL.OP.
        JP     EXEC     ; GO DO IT.
XPR1    CALL   XPR8     ; REL.OP. ">="
        RET    C        ; NO, RETURN HL=0
        LD     L,A      ; YES, RETURN HL=1
        RET
XPR2    CALL   XPR8     ; REL.OP. "#"
        RET    Z        ; FALSE, RETURN HL=0
        LD     L,A      ; TRUE, RETURN HL=1
        RET
XPR3    CALL   XPR8     ; REL.OP. ">"
        RET    Z        ; FALSE
        RET    C
        LD     L,A      ; TRUE, RETURN HL=1
        RET
XPR4    CALL   XPR8     ; REL.OP "<="
        LD     L,A      ; SET HL=1
        RET    Z        ; REL. TRUE, RETURN
        RET    C
        LD     L,H      ; ELSE SET HL=0
        RET
XPR5    CALL   XPR8     ; REL.OP. "="
        RET    NZ             ; FALSE, RETURN HL=0
        LD     L,A      ; ELSE SET HL=1
        RET
XPR6    CALL   XPR8     ; REL.OP. "<"
        RET    NC       ; FALSE, RETURN HL=0
        LD     L,A      ; ELSE SET HL=1
        RET
XPR7    POP    HL       ; NOT REL.OP.
        RET             ; RETURN HL=<EXPR1>
XPR8    LD     A,C      ; SUBROUTINE FOR ALL
        POP    HL       ; REL.OP.'S
        POP    BC
        PUSH   HL       ; REVERSE TOP OF STACK
        PUSH   BC
        LD     C,A
        CALL   EXPR1    ; SET 2ND <EXPR1>
        EX     DE,HL    ; VALUE IN DE NOW
        EX     (SP),HL  ; 1ST <EXPR1> IN HL
        CALL   CKHLDE   ; COMPARE 1ST WITH 2ND
        POP    DE       ; RESTORE TEXT POINTER
        LD     HL,0     ; SET HL=0, A=1
        LD     A,1
        RET
EXPR1   TSTC   '-',XP11 ; NEGATIVE SIGN?
        LD     HL,0     ; YES, FAKE "0-"
        JR     XP16     ; TREAT LIKE SUBTRACT
XP11    TSTC   '+',XP12 ; POSITIVE SIGN?  IGNORE
XP12    CALL   EXPR2    ; 1ST <EXPR2>
XP13    TSTC   '+',XP15 ; ADD?
        PUSH   HL       ; YES, SAVE VALUE
        CALL   EXPR2    ; GET 2ND <EXPR2>
XP14    EX     DE,HL    ; 2ND IN DE
        EX     (SP),HL  ; 1ST IN HL
        LD     A,H      ; COMPARE SIGN
        XOR    D
        LD     A,D
        ADD    HL,DE
        POP    DE       ; RESTORE TEST POINTER
        JP     M,XP13   ; 1ST 2ND SIGN DIFFER
        XOR    H        ; 1ST 2ND SIGN EQUAL
        JP     P,XP13   ; SO IS RRESULT
        JP     QHOW     ; ELSE WE HAVE OVERFLOWN
XP15    TSTC   '-',XPR9 ; SUBTRACT?
XP16    PUSH   HL       ; YES, SAVE 1ST <EXPR2>
        CALL   EXPR2    ; GET 2ND <EXPR2>
        CALL   CHGSGN   ; NEGATE
        JR     XP14     ; AND ADD THEM
EXPR2   CALL   EXPR3    ; GET 1ST <EXPR3>
XP21    TSTCC  62H,XP24 ; MULTIPLY?
        PUSH   HL       ; YESY, SAVE 1ST
        CALL   EXPR3    ; AND GET 2ND <EXPR3>
        LD     B,0      ; CLEAR B FOR SIGN
        CALL   CHKSGN   ; CHECK SIGN
        EX     (SP),HL  ; 1ST IN HL
        CALL   CHKSGN   ; CHECK SIGN OF 1ST
        EX     DE,HL
        EX     (SP),HL
        LD     A,H      ; IS HL > 255?
        OR     A
        JR     Z,XP22   ; NO
        LD     A,D      ; YES, HOW ABOUT DE
        OR     D
        EX     DE,HL    ; PUT SMALLER IN DE
        JP     NZ,AHOW  ; ALSO >, WILL OVERFLOW
XP22    LD     A,L      ; THIS IS DUMB
        LD     HL,0     ; CLEAR RESULT
        OR     A        ; ADD AND COUNT
NERDXX  JR     Z,XP25
XP23    ADD    HL,DE
        JP     C,AHOW     ; OVERFLOW
        DEC    A
        JR     NERDXX   ; FINISHED
XP24    TSTCC  63H,XPR9 ; DIVIDE?
        PUSH   HL       ; YES, SAVE 1ST <EXPR3>
        CALL   EXPR3    ; AND GET 2ND ONE
        LD     B,0      ; CLEAR B FOR SIGN
        CALL   CHKSGN   ; CHECK SIGN OF 2ND
        EX     (SP),HL  ; GET 1ST IN HL
        CALL   CHKSGN   ; CHECK SIGN OF 1ST
        EX     DE,HL
        EX     (SP),HL
        EX     DE,HL
        LD     A,D      ; DIVIDE BY 0?
        OR     E
        JP     Z,AHOW     ; SAY "HOW?"
        PUSH   BC       ; ELSE, SAVE SIGN
        CALL   DIVIDE   ; USE SUBROUTINE
        POP    DE       ; SIGN STUFF TO DE
        PUSH   BC       ; SAVE DIVIDE RESULT
        BIT    7,D      ; WAS SIGN SET?
        CALL   NZ,CHGSGN  ; YEP - CHANGE
        LD     (REMAIN),HL   ; STUFF IT
        POP    HL       ; RESULT IN HL
        LD     B,D      ; COPY OVER SIGN STUFF
        LD     C,E
XP25    POP    DE       ; GET TEXT POINTER BACK
        LD     A,H      ; HL MUST BE +
        OR     A
        JP     M,QHOW   ; ELSE IT IS OVERFLOW
        LD     A,B
        OR     A
        CALL   M,CHGSGN  ; CHANGE SIGN IF NEEDED
        JR     XP21      ; LOOK FOR MORE TERMS
EXPR3   LD     HL,TAB3-1 ; FIND FUNCTION IN TAB3
        JP     EXEC      ; AND GO DO IT
NOTF    CALL   TSTV      ; NO, NOT A FUNCTION
        JR     C,XP32    ; NOR A VARIABLE
        EX     DE,HL
        RST    RSTLDE
        PUSH   AF 
        INC    DE
        RST    RSTLDE
        EX     DE,HL
        LD     H,A
        POP    AF 
        LD     L,A
        RET
XP32    CALL   TSTNUM   ; OR IS IT A NUMBER?
        LD     A,B      ; # OF DIGIT
        OR     A
        RET    NZ             ; OK
; SINGLE CHAR STRING CONSTANT?
        TSTC  '"',PARN ; HAVE WE GOT QUOTES?
        LD     A,(DE)   ; NAILED RSTLDE
        LD     L,A      ; FAILED TSTNUM SET H TO ZERO
        INC    DE
        TSTC   '"',XPRO ; ERROR IF NO TRAILING
        RET
; *****
; *
PARN    TSTC  '(',XPRO ; NO DIGIT, MUST BE
PARNP   RST    RSTEXP   ; "(EXPR)"
        TSTC  ')',XPRO
XPR9    RET
XPRO    JP     QWHAT    ; ELSE SAY: "WHAT?"
RND     RST    RSTPAR   ; *** RND(EXOR) ***
        LD     A,H      ; EXPR MUST BE +
        OR     A
        JP     M,QHOW
        PUSH   DE       ; SAVE BOTH
        EX     DE,HL    ; DE = RANGE
        XOR    A
        SYSTEM RANGED
        LD     L,A
        XOR    A
        SYSTEM RANGED
        LD     H,A
; HL = RANDOM #
        PUSH   BC
        LD     A,D
        OR     E
        CALL   NZ,DIVIDE  ; RND(N)=MOD(M,N)+1
        POP    BC
        POP    DE
        INC    HL
        RET
ABS     RST    RSTPAR   ; *** ABS(EXPR) ***
        DEC    DE
        CALL   CHKSGN   ; CHECK SIGN
        INC    DE
        RET
SIZE    LD     HL,(TXTUNF)  ; *** SIZE ***
        PUSH   DE       ; GET THE NUMBER OF
        EX     DE,HL    ; FREE BYTES BETWEEN 'TXTUNF'
        LD     HL,DFTLMT ; AND 'TXTLMT'
        AND    A
        SBC    HL,DE
        POP    DE
        RET
; FUNCTION TO SENSE DIAL VALUE
GETPOT  LD     A,1BH
        CALL   CHKRNG   ; GET DATA
        CPL
        SUB    80H
        LD     L,A
; FALL INTO...
; SIGN EXTEND SUBROUTINE
SGNEXT  LD     H,0
        LD     A,L
        AND    A
        RET    P
        DEC    H
        RET
; FUNCTION TO SENSE STATE OF TRIGGER
GETTRG  CALL   CHKRN1
        AND    10H
        RET    Z
        INC    L
        RET
; FUNCTIONS TO RETURN JOYSTICK VALUE
; THESE FUNCTIONS RETURN EITHER +1, 0, OR -1, DEPENDING
; ON JOYSTICK STATE
GETJX   CALL   CHKRN1   ; PARM IN RANGE?
        RRCA
        RRCA
        RRCA
        JR     C,GETJY3
        RRCA
        JR     C,GETJY1
        RET
; ENTRY FOR Y JOYSTICK VALUE
GETJY   CALL   CHKRN1
        RRCA
        JR   NC,GETJY2
GETJY1  INC    HL
        RET
GETJY2  RRCA
        RET    NC
GETJY3  DEC    HL
        RET
; SUBROUTINE TO GET PARAMETER BETWEEN 1 AND 4
CHKRN1  LD     A,0FH
CHKRNG  PUSH   BC
        PUSH   AF 
        RST    RSTPAR
        POP    AF 
        ADD    A,L
        LD     C,A
        IN     A,(C)
        POP    BC
        LD     HL,0
        RET
; *
; **********************************************
; * *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
; *
; * 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
; *
; * 'SUBDE' SUBTRACTS DE FROM HL
; *
; * 'CHKSGN' CHECKS SIGN OF HL.  IF +,NO CHANGE. IF -,CHANGE SIGN AND
; * FLIP SIGN OF B.
; *
; * 'CHKSGN' CHANGES SIGN OF HL AND B UNCONDITIONALLY.
; *
; * 'CKHLDE' CHECKS SIGN OF HL AND DE.  IF DIFFERENT, HL AND DE ARE
; * INTERCHANGED.  IF SAME SIGN, NOT INTERCHANGED.  EITHER CASE, HL DE
; * ARE THEN COMPARED TO SET THE FLAGS.
; *
DIVIDE  PUSH   HL       ; *** DIVIDE ***
        LD     L,H      ; DIVIDE H BY DE
        LD     H,0
        CALL   DV1
        LD     B,C      ; SAVE RESULT IN B
        LD     A,L      ; (REMAINDER + L)/DE
        POP    HL
        LD     H,A
DV1     LD     C,-1     ; RESULT IN C
DV2     INC    C        ; DUMB ROUTINE
        AND    A
        SBC    HL,DE
        JR   NC,DV2
        ADD    HL,DE
        RET
CHKSGN  LD     A,H      ; *** CHKSGN ***
        OR     A        ; CHECK SIGN OF HL
        RET    P        ; IF -, CHANGE SIGN
CHGSGN  LD     A,H      ; *** CHGSGN ***
        OR     L
        RET    Z
        LD     A,H
        PUSH   AF 
        CPL             ; CHANGE SIGN OF HL
        LD     H,A
        LD     A,L
        CPL
        LD     L,A
        INC    HL
        POP    AF 
;       XOR    H
;       JP     QHOW
        LD     A,B      ; AND ALSO FLIB B
        XOR    80H
        LD     B,A
        RET
; CKHLDE  LD     A,H    ; *** CKHLDE ***
;         XOR    D      ; SAME SIGN?
;         JP     CH1    ; YES, COMPARE
;         EX     DE,HL  ; NO, XCH AND COMPARE
; CK1     CALL   COMP
;         RET
; COMP    LD     A,H    ; *** COMP ***
;         CMP    D      ; COMPARE HL WITH DE
;         RET    NZ           ; RETURN CORRECT C AND
;         LD     A,L    ; ZFLAGS
;         CMP    E      ; BUT OLD A IS LOST
;         RET
; * **************************************************
; *
; * *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS)***
; *
; * "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND THEN AN
; * EXPR. IT EVALUATES THE EXPR. AND SETS THE VARIABLE TO THAT VALUE.
; *
; * "FIN" CHECKS THE END OF A COMMAND.  IF IT ENDED WITH ";",EXECUTION
; * CONTINUES.  IF IT ENDED WITH A CR, IT FINDS THE NEXT LINE AND
; * CONTINUES FROM THERE.
; *
; * "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR.  THIS IS REQUIRED IN
; * CERTAIN COMMANDS. (GOTO,RETURN,AND STOP ETC.)
; *
; * "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). IT THEN
; * PRINTS THE LINE POINTED BY 'CURRENT' WITH A "?" INSERTED AT WHERE THE
; * OLD TEXT POINTER (SHOULD BE ON TOP OF THE STACK) POINTS TO.
; * EXECUTION OF TB IS STOPPED AND TBI IS RESTARTED.  HOWEVER, IF
; * 'CURRNT'=> ZERO (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND
; * IS NOT PRINTED. AND IF 'CURRNT'=>NEGATIVE # (INDICATING 'INPUT'
; * COMMAND, THE INPUT LINE IS NOT PRINTED AND EXECUTION IS NOT
; * TERMINATED BUT CONTINUED AT 'INPERR'.
; *
; * RELATED TO 'ERROR' ARE THE FOLLOWING:  'QWHAT' SAVES TEXT POINTED IN
; * STACK AND GET MESSAGE "WHAT?" JUST GETS MESSAGE "WHAT?" AND
; * JUMP TO 'ERROR'.  'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
; * 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION DO THIS.
; *
SETVAL  CALL   TSTVFF   ; *** SETVAL ***
        TSTC  '=',QWHAT  ; 2WHAT?" NO VARIABLE
SETV1   PUSH   HL       ; SAVE ADDRESS OF VAR.
        RST    RSTEXP   ; EVALUATE EXPR.
        EX     DE,HL
        EX     (SP),HL
        CALL   STDEHL
        POP    DE
        RET
FINISH  CALL   FIN      ; CHECK END OF COMMAND
        JR     QWHAT    ; PRINT "WHAT?" IF WRONG
FIN     TSTCC  59,FI1   ; *** FIN ***
        POP    AF       ; ";", PURGE RET ADDR.
        JP     RUNSML   ; CONTINUE SAME LINE
FI1     TSTCC  CR,FI2   ; NOT ";", IF IT CR?
        POP    AF       ; PURGE RETURN ADDRESS
IMCHEK  LD     A,(CURRNT+1)
        RLCA
        JP     NC,RSTART
        JP     RUNNXL   ; RUN NEXT LINE
QWHAT   PUSH   DE       ; *** QWHAT ***
AWHAT   LD     DE,WHAT   ; *** AWHAT ***
ERROR   CALL   CRLF     ; *** ERROR ***
        CALL   PRTSTG   ; PRINT ERROR MESSAGE
        LD     HL,(CURRNT)  ; GET CURRENT LINE #
        PUSH   HL
        EX     DE,HL    ; CHECK THE VALUE
        RST    RSTLDE
        LD     H,A
        INC    DE
        RST    RSTLDE
        OR     H
        EX     DE,HL
        POP    DE
        JP     Z,TELL   ; IF ZERO, JUST RESTART
        EX     DE,HL    ; IF NEGATIVE
        RST    RSTLDE
        EX     DE,HL
        OR     A
        JP     M,INPERR ; REDO INPUT
        CALL   PRTLN    ; ELSE PRINT THE LINE
        POP    HL       ; HL=ERROR ADDR
        LD     BC,XQTBUF
        AND    A
        SBC    HL,BC
        ADD    HL,DE
        LD     B,L
        CALL   PRTCHS
        CALL   OUTCHQ
        CALL   PRTSTG   ; LINE
        JP     TELL     ; THEN RESTART
QSORRY  PUSH   DE       ; *** QSORRY ***
ASORRY  LD     DE,SORRY  ; *** ASORRY ***
        JR     ERROR
; * *****************************************
; *
; * *** FNDLN (& FRIENDS) ***
; *
; * 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE TEXT SAVE 
; * AREA.  DE IS USED AS THE TEXT POINTER.  IF THE LINE IS FOUND, DE
; * WILL POINT TO THE BEGINNING OF THAT LINE (I.E., THE LOW BYTE OF THE
; * LINE #), AND FLAGS ARE NC & Z.  IF THAT LINE IS NOT THERE AND A LINE
; * WITH A HIGHER # IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC &
; * NZ.  IF WE REACHED THE END OF TEXT SAVE AREA AND CAN NOT FIND THE
; * LINE, FLAGS ARE C & NZ.  'FNDLN' WILL INITIALIZE DE TO THE BEGINNING
; * OF THE TEXT SAVE AREA TO START THE SEARCH.  SOME OTHER ENTRIES OF
; * THIS ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.  'FNDLP'
; * WILL START WITH DE AND SEARCH FOR THE LINE #.  'FINDNXT' WILL BUMP DE
; * BY 2, FIND A CR AND THEN START SEARCH.  'FNDSKP' USES DE TO FIND A
; * CR, AND THEN STARTS SEARCH.
; *
FNDLN   LD     A,H      ; *** FNDLN ***
        OR     A        ; CHECK SIGN OF HL
        JP     M,QHOW   ; IT CANNOT BE -
        LD     DE,TXT   ; INIT. TEXT POINTER
FNDLP   INC    DE       ; IS EDT MARK?
        RST    RSTLDE
        LD     C,A
        DEC    DE
        ADD    A,A
        RET    C
        RST    RSTLDE   ; C,NZ PASSED END
        SUB    L        ; WE DID NOT, GET BYTE 1
        LD     B,A      ; IS THIS THE LINE?
        INC    DE       ; COMPARE LOW ORDER
        LD     A,C      ; GET BYTE 2
        SBC    A,H      ; COMPARE HIGH ORDER
        JR     C,FL1    ; NO, NOT THERE YET
        DEC    DE       ; ELSE WE EITHER FOUND
        OR     B        ; IT, OR IT IS NOT THERE
FI2     RET    ; NC,Z: FOUND; NC,NZ: NO
FNDNXT  INC    DE       ; FIND NEXT LINE
FL1     INC    DE       ; JUST PASSED BYTE
; FASTER FNDSKP
FNDSKP  EX     DE,HL
        ADD    HL,HL    ; CONVERT TO 'NORMAL'
FS01    LD     A,(HL)   ; GET NEXT BYTE
        RLCA            ; COMBINE WITH FOLLOWING FELLA
        INC    HL
        XOR    (HL)     ; TO MAKE THE REAL DATA
        AND    0AAH
        XOR    (HL)
        INC    HL
        CP     CR       ; HIT A CR YET?
        JR     NZ,FS01  ; NO SIR EEE
        SCF             ; WE GOT IT
        RR     H        ; NORMALIZE OUR POINTER
        RR     L
        EX     DE,HL
        JR     FNDLP    ; REENTER FIND LOOP
; SUBROUTINE TO GRAB AND VERIFY SUBSCRIPT
GETSUB  POP    IY       ; STICK RETURN INTO IY
        INC    DE       ; SKIP DA NAME
        RST    RSTPAR   ; GET THE PARM
        ADD    HL,HL    ; CONVERTETH TO BYTES
        JP     C,QHOW     ; REJECT ABSURD VALUES
        PUSH   DE       ; SAVE SCAN PTR
        EX     DE,HL
        CALL   SIZE     ; CHECK FOR VALID SUBSCRIPT
        CALL   COMP
        JR     C,ASORRY ; APOLOGIZE FOR RANGE ERR
        JP     (IY)     ; GO HOME
TSTV    RST    RSTIGN   ; *** TSTV ***
        CP     '%'      ; PEEK-POKE?
        JR     Z,TSTV0
        CP     '*'      ; BACKWARDS ARRAY?
        JR     Z,STARR  ; YEP - JUMP TO IT
        SUB    '@'      ; TEST VARIABLES
        RET    C        ; C: NOT A VARIABLE
        JR     NZ,TV1   ; NOT "@" ARRAY
        CALL   GETSUB
        LD     HL,(TXTUNF)
        DEC    HL
        DEC    HL
        ADD    HL,DE
        POP    DE
        RET
; PROCESS BACKWARDS ARRAY
STARR   CALL   GETSUB
        LD     HL,DFTLMT ; SUBTRACT INDEX FROM END
        SBC    HL,DE
        POP    DE
        XOR    A        ; NO CY SHIT
        RET
; %(ADDR) PEEK-POKE CALL
TSTV0   INC    DE
        RST    RSTPAR   ; GET ADDR
        XOR    A        ; CLEAR CY
        RET    ; AND GO BACK
TV1     CP     27       ; NOT @, IS IT A TO Z
        CCF             ; IF NOT RETURN C FLAG
        RET    C
        INC    DE       ; IF A THROUGH Z
; IS SECOND CHARACTER ALSO ALPHA?
        LD     L,A      ; SAVE FIRST ONE
        LD     A,(DE)   ; ZAPPED RSTLDE
        CP     'A'
        JR     C,DEVV4  ; IF NOT IN RANGE A-Z
        CP     'Z'+1
        JR   NC,DEVV4   ; THEN SEARCH
        PUSH   BC
        PUSH   DE
        LD     H,A      ; SECOND CHAR TO H
        LD     B,PARNUM ; B - ITERATION CTR
        LD     DE,DEVLST ; DE - SEARCH TABLE
DEVV1   LD     A,(DE)   ; GET FIRST ENTRY
        INC    DE
        CP     L
        LD     A,(DE)
        INC    DE
        JR     NZ,DEVV2
        CP     H
        JR     NZ,DEVV2
; MATCH FOUND - FIGURE OUT LOOKUP INDEX
        LD     A,B
        ADD    A,26
        LD     L,A
        POP    DE
        INC    DE       ; BUMP CHAR PTR
        JR     DEVV3
; MISMATCH - LOOP BACK IF POSS
DEVV2   DJNZ   DEVV1
; NOT POSSIBLE - RETURN NOT A VAR
        POP    DE
        POP    BC
        DEC    DE       ; BACKUP TO CHAR START
        SCF             ; SET CARRY
        RET
DEVV3   POP    BC
DEVV4   LD     A,L
        LD     HL,VARBGN-2
        RLCA
        ADD    A,L
        LD     L,A
        LD     A,0
        ADC    A,H
        LD     H,A
        RET
; *
; * ***************************************
; *
; * ***TSTCH *** TSTNUM ***
; *
; * TSTCH IS USED TO TEST THE NEXT NON-BLANK CHARACTER IN THE TEXT
; * (POINTED BY DE) AGAINST THE CHARACTER THAT FOLLOWS THE CALL.  IF
; * THEY DO NOT MATCH, N BYTES OF CODE WILL BE SKIPPED OVER, WHERE N IS
; * BETWEEN 0 & 255 AND IS STORED IN THE SECOND BYTE FOLLOWING THE CALL
; *
; * TSTNUM IS USED TO CHECK WHETHER THE TEXT (POINTED BY DE) IS A
; * NUMBER.  IF A NUMBER IS FOUND, B WILL BE NON-ZERO AND HL WILL
; * CONTAIN THE VALUE (IN BINARY) OF THE NUMBER, ELSE B AND HL ARE 0.
; *
TSTCH   EX     (SP),HL  ;  *** TSTCH ***
        RST    RSTIGN   ; IGNORE LEADING BLANKS
        CP     (HL)     ;  AND TEST THE CHARACTER
        INC    HL       ; COMPARE THE BYTE THAT
        JR     Z,TC1    ; FOLLOWS THE CALL INTS.
        PUSH   BC       ; WITH TEXT (DE->)
        LD     C,(HL)   ;  IF NOT =, ADD THE 2ND
        LD     B,0      ;  BYTE THAT FOLLOWS THE
        ADD    HL,BC    ;  CALL TO THE OLD PC
        POP    BC       ;  I.E., DO A RELATIVE
        DEC    DE       ;  JUMP IF NOT =
TC1     INC    DE       ;  IF =, SKIP THOSE BYTES
        INC    HL       ;  AND CONTINUE
        EX     (SP),HL
        RET
TSTNUM  LD     HL,0     ; *** TSTNUM ***
        LD     B,H      ; TEST IF THE TEXT IS
        RST    RSTIGN   ; A NUMBER
TN1     CP     '0'      ; IF NOT, RETURN 0 IN
        RET    C        ; B AND HL
        CP     3AH      ; IF NUMBERS, CONVERT
        RET    NC       ; TO BINARY IN HL AND
        LD     A,0F0H   ; SET B TO # OF DIGITS
        AND    H        ; IF H>255, THERE IS NO
        JR     NZ,QHOW  ; ROOM FOR NEXT DIGIT
        INC    B        ; B COUNTS # OF DIGITS
        PUSH   BC
        LD     B,H      ; HL=10*HL+(NEW DIGIT)
        LD     C,L
        ADD    HL,HL    ; WHERE 10* IS DONE BY
        ADD    HL,HL    ; SHIFT AND ADD
        ADD    HL,BC
        ADD   HL,HL
        LD     A,(DE)   ; AND (DIGIT) IS FROM
        INC    DE       ; STRIPPING THE ASCII
        AND    00FH     ; CODE
        ADD    A,L
        LD     L,A
        LD     A,0
        ADC    A,H
        LD     H,A
        POP    BC
        LD     A,(DE)   ; DO THIS DIGIT AFTER
        JP     P,TN1    ; DIGIT. S SAYS OVERFLOW
QHOW    PUSH   DE       ; *** ERROR: "HOW?" ***
AHOW    LD     DE,HOW
        JP     ERROR
; MVUP, MVDOWN, POPA, AND PUSHA
; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC->
;       UNTIL DE=HL
;
; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
;       UNTIL DE=BC
;
; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE STACK
; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE STACK
MVUP    CALL   COMP     ; *** MVUP ***
        RET    Z        ; DE=HL, RETURN
        RST    RSTLDE   ; GET ONE BYTE
        PUSH   HL       ; SHOVEL REGS
        LD     H,B
        LD     L,C
        CALL   STHL     ; MOVE IT
        POP    HL
        INC    DE       ; INCREASE BOTH POINTERS
        INC    BC
        JR     MVUP     ; UNTIL DONE
MVDOWN  LD     A,B      ; *** MCDOWN ***
        SUB    D        ; TEST IF DE = BC
        JR     NZ,MD1   ; NO, GO MOVE
        LD     A,C      ; MAYBE, OTHER BYTE
        SUB    E
        RET    Z        ; YES, RETURN
MD1     DEC    DE        ; ELSE MOVE A BYTE
        DEC    HL       ; BUT FIRST DECREASE
        RST    RSTLDE   ; BOTH PTRS AND THEN
        CALL   STHL     ; DO IT
        JR     MVDOWN   ; LOOP BACK
POPA    POP    BC       ; BC = RETURN ADDR.
        POP    HL       ; RESTORE LOPVAR, BUT
        LD     (LOPVAR),HL   ; =0 MEANS NO MORE
        LD     A,H
        OR     L
        JR     Z,PP1    ; YEP, GO RETURN
        POP    HL       ; NO, RESTORE OTHERS
        LD     (LOPINC),HL 
        POP    HL
        LD     (LOPLMT),HL 
        POP    HL
        LD     (LOPLN),HL 
        POP    HL
        LD     (LOPPT),HL 
PP1     PUSH   BC       ; BC = RETURN ADDR.
        RET
PUSHA   LD     HL,-STKLMT  ; *** PUSHA ***
        POP    BC          ; BC = RETURN ADDR.
        ADD    HL,SP       ; IS STACK NEAR THE TOP?
        JP     NC,QSORRY   ; YES - SORRY FOR THAT
        LD     HL,(LOPVAR) ; ELSE SAVE LOOP VAR.S
        LD     A,H         ; BUT IF LOPVAR IS 0
        OR     L           ; THAT WILL BE ALL
        JR     Z,PU1
        LD     HL,(LOPPT)  ; ELSE MORE TO SAVE
        PUSH   HL
        LD     HL,(LOPLN)
        PUSH   HL
        LD     HL,(LOPLMT)
        PUSH   HL
        LD     HL,(LOPINC)
        PUSH   HL
        LD     HL,(LOPVAR)
PU1     PUSH   HL
        PUSH   BC       ; BC = RETURN ADDR.
        RET
; PRTSTG, QTSTG, PRTNUM, PRTLN
; 'PRTSRG' PRINTS A STRING POINTED AT BY DE.  IT STOPS
; PRINTING AND RETURNS TO CALLER WHEN EITHER A CR IS
; PRINTED OR WHEN THE NEXT BYTE IS ZERO. REG. A AND B
; ARE CHANGED. REG. DE POINTS TO WHAT FOLLOWS THE CR
; OR TO THE ZERO
; 'QTSTG' LOOKS FOR SINGLE QUOTE, OR DOUBLE QUOTE.  IF
; EITHER IT PRINTS THE STRING UNTIL MATCHING UNQUOTE
; AND RETURNS 2 BYTES LATE.
; 'PRTNUM' PRINTS THE NUMBER HL. LEADING BLANKS ARE ADDED IF
; NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN C,
; ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO PRINTED
; AND COUNTED IN. POSITIVE SIGN IS NOT.
; 'PRTLN' FINDS A SAVED LINE, PRINTS THE LINE # AND A SPACE.
PRTLNS  CALL   PRTLN
PRTSTG  SUB    A        ; *** PRTSTG ***
PS1     LD     B,A
PS2     RST    RSTLDE   ; GET A CHARACTER
        INC    DE       ; BUMP POINTER
        CP     B        ; SAME AS OLD A
        RET    Z        ; YES, RETURN
        CALL   OUTCH    ; ELSE PRINT IT
        CP     CR       ; WAS IT A CR?
        JR     NZ,PS2   ; NO - NEXT
        RET             ; YES-RETURN
QTSTG   RST    RSTLDE
        INC    DE       ; BUMP PAST
        CP     '"'
        JR     Z,QT1    ; IF SINGLE QUITE-PRINT IT
        CP     27H      ; OR IF DOUBLE
        JR     Z,QT1    ; LIKEWISE
        DEC    DE
        RET
QT1     CALL   PS1      ; PRINT UNTIL ANOTHER
QT2     CP     CR       ; WAS LAST ONE A CR?
        POP    HL       ; RETURN ADDRESS
        JP     Z,IMCHEK ; WAS CR, END OF THIS
        INC    HL       ; SKIP 2 BYTES, THE RET
        INC    HL
        JP     (HL)
PRTCHS  LD     A,E
        CP     B
        RET    Z
        RST    RSTLDE
        CALL   OUTCH
        INC    DE
        JR     PRTCHS
PRTNUM  EQU    $        ; *** PRTNUM ***
PN3     LD     B,0      ; B=SIGN
        CALL   CHKSGN   ; CHECK SIGN
        JP     P,PN4    ; NO SIGN
        LD     B,'-'    ; B=SIGN
        DEC    C        ; '-' TAKES SPACE
PN4     PUSH   DE
        LD     DE,10
        PUSH   DE
        DEC    C
        PUSH   BC
PN5     CALL   DIVIDE   ; DIV HL BY 10
        LD     A,B      ; RESULT 0
        OR     C
        JR     Z,PN6    ; YES, WE GOT ALL
        EX     (SP),HL  ; NO SAVE REMAINDER
        DEC    L        ; AND COUNT SPACE
        PUSH   HL       ; HL IS OLD BC
        LD     H,B      ; MOVE RESULT TO BC
        LD     L,C
        JR     PN5      ; AND DIV BY 10
PN6     POP    BC       ; WE GOT ALL DIGITS IN
PN7     DEC    C        ; THE STACK
        BIT    7,C      ; IF SPACE COUNT NEG
        JR     NZ,PN8   ; NO LEADING BLANKS
        CALL   SPOUTCH  ; SPACE OUTCH
        JR     PN7      ; MORE?
PN8     LD     A,B      ; PRINT SIGN
        OR     A
        CALL   NZ,OUTCH ; MOAYBE - OR NULL
        LD     E,L      ; LAST REMAINDER IN E
PN9     LD     A,E      ; CHECK DIGIT IN E
        CP     10       ; 10 IS FLAG FOR NO MORE
        POP    DE
        RET    Z        ; IF SO RETURN
        ADD    A,'0'
        CALL   OUTCH    ; AND PRINT THE DIGIT
        JR     PN9      ; GO BACK FOR MORE
PRTLN   RST    RSTLDE   ; *** PRTLN***
        LD     L,A      ; LOW ORDER LINE #
        INC    DE
        RST    RSTLDE   ; HIGH ORDER
        LD     H,A
        INC    DE
        LD     C,2      ; PRINT 2 DIGIT LINE #
        CALL   PRTNUM
SPOUTCH LD     A,' '    ; FOLLOWED BY BLANK
        JP     OUTCH
TAB2    ITEM   'TV',PUTCD ; DIRECT-STATEMENT
        ITEM   'MU',PUTMU
        ITEM   '&',PUTIO
        ITEM   'CALL',DOCALL
        ITEM   '.',REM
        DB     ':'
        TOKEN  74H,TOUTPU
        DB     ':'
        TOKEN  73H,TINPUT
        DB     ':'
        TOKEN  6AH,TLOAD
        DB     ':'
        TOKEN  68H,TVLIST
        TOKEN  60H,SILENCE
        ITEM   'STOP',STOP
        DEFF   FINISH
TAB3    TOKEN  76H,RND  ; FUNCTIONS
        ITEM   'KN',GETPOT
        ITEM   'TR',GETTRG
        ITEM   'JX',GETJX
        ITEM   'JY',GETJY
        ITEM   'KP',GETKB
        ITEM   'PX',PIXFUN
        ITEM   '&',IOFUN
        ITEM   'ABS',ABS
        ITEM   'SZ',SIZE
        DEFF   NOTF
TAB6    ITEM   '>=',XPR1  ; RELATION OPS
        ITEM   '#',XPR2
        ITEM   '>',XPR3
        ITEM   '=',XPR5
        ITEM   '<=',XPR4
        ITEM   '<',XPR6
        DEFF   XPR7
RANEND  EQU    $
GLED    LD     A,(EDFLG)
        AND    A
        JR     Z,GLEDA
        LD     DE,BUFFER
        CALL   TSTNUM
        CALL   FNDLN
        LD     A,'?'
        RET    NZ
        INC    DE
        CALL   GLEDB
        XOR    A
        LD     (EDFLG),A 
GLEDA   LD     DE,(EDPTR)
        RST    RSTLDE
GLEDB   INC    DE
        LD     (EDPTR),DE
        RET
GETLN   LD     DE,BUFFER
        LD     (EDFLG),A 
GL1     CALL   OUTCH    ; PROMPT OR ECHO
GL2     PUSH   BC
        PUSH   HL
        PUSH   DE
; PLACE UP CURSOR BLOCK
        LD     C,0AAH
        CALL   CURSE
; RETURN CHAR FROM NEXT LINE #
GL2A    LD     HL,NLLNCT
        LD     A,(HL)      ; SENSE FLAG
        AND    A
        JR     Z,GL2C
        DEC    (HL)
; FIRST TIME THRU?
        CP     5
        JR     NZ,GL2B  ; JUMP IF NOT
; GET PREVIOUS LINE # AND BUMP IT
        LD     HL,(OLDLN)
        LD     DE,10
        ADD    HL,DE
        RES    7,H      ; ALLOW NEG
GL2J    LD     (NLLNLN),HL   ; MOVE TO WORKING RAM CELL
; COMPUTE DIVISION SUBTRACTOR
GL2B    SYSSUK INDEXW
        DW     TBLDIV-2
        LD     HL,(NLLNLN)
        LD     B,0
GL2E    AND    A
        SBC    HL,DE
        JP     M,GL2F
        INC    B
        JR     GL2E
GL2F    ADD    HL,DE
        LD     (NLLNLN),HL 
        LD     HL,NLLNZS
        LD     A,B
        AND    A
        JR     NZ,GL2G
        LD     A,(HL)
        AND    A
        JR     Z,GL2A   ; YES - JUMP BACK
        XOR    A
GL2G    ADD    A,'0'    ; MAKE ASCII
        LD     (HL),A   ; ET NONZERO FLAG
        JR     GL2D
; NOTHIN FANCY
GL2C    CALL   CHKIO    ; GET NORMAL CHARACTER
        POP    DE
        LD    (DE),A    ; STUFF CHAR AS DELIMITER
        PUSH   DE
        CP     EDKEY
        CALL   Z,GLED
GL2D    POP    DE
        POP    HL
        POP    BC
GL3     LD    (DE),A
        CP     RUBOUT
        JR     NZ,GL4
        LD     A,E
        CP     BUFFER & 0FFH
        JR     Z,GL2
        DEC    DE
        LD     A,(DE) 
        CP     68H      ; TOKEN TO RUB OUT?
        JR   NC,TOKIN
        CALL   PNOTE
        LD     A,RUBOUT
        JR     GL1
TOKIN   PUSH   DE
        CALL   TOKEPT
TOKER   LD     A,(HL)
        PUSH   HL
        AND    7FH
        CALL   PNOTE
        LD     A,RUBOUT
        CALL   VDM
        POP    HL
        LD     A,(HL)
        INC    HL
        RLCA
        JR   NC,TOKER
TOKEQ   LD     A,RUBOUT
        CALL   OUTCH    ; ECHO ONE RUBOUT CHAR
        POP    DE
GL9     JP     GL2
GL4     XOR    CR
        JR     Z,GL5
        LD     A,E
        CP     BUFEND & 0FFH
        JR     Z,GL9
        LD     A,(DE)
        INC    DE
        JP     GL1
GL5     INC    DE
        INC    DE
        DEC    A
        LD    (DE),A
        DEC    DE
CRLF    LD     A,CR
        JP     OUTCH
; SUBROUTINE TO SIMULATE A CHARACTER DISPLAY IN
; THE ARCADE FRAME BUFFER.  THE SIMULATED VDM HAS
; DIMENSIONS 26 CHARS BY 11 LINES.  THE CHARACTER GRAPHICS ARE 5 X 7
; IN A 6 X 8 FRAME.  ALTERNATE FONT IS USED TO GET THIS.
; THE 64 UPPER CASE ASCII CHARACTERS ARE DISPLAYED BY THIS
; HANDLER.  THE ASCII CONTROL CHARACTERS CARRIAGE RETURN AND
; RUBOUT ARE ALSO PROCESSED BY THIS HANDLER.  CR CAUSES
; THE DISPLAY TO GO TO THE NEXT LINE OF THE DISPLAY, WITH
; SCROLL UP IF NECESSARY.  RUBOUT CAUSES THE CURSOR TO MOVE
; BACKWARDS ONE CHARACTER POSITION.
; CHARACTER TO DISPLAY IS IN A.  THE ALTERNATE REGISTER
; IS USED.
XOUTCH  PUSH   AF 
        EXX
        CALL   VDM
        POP    AF 
        EXX
        RET
; SOME FUNNY GUYS ENTER HERE
VDM     CP     CR
        JR     Z,VDMOCR
        CP     RUBOUT   ; TRANSLATE TRASH TO ?
        JR     Z,VDM1
        JR     C,FILT1
        CP     78H
        JR     C,FILT2
FILT1   LD     A,'?'
FILT2   CP     68H      ; TOKEN TO PRINT?
        JR   NC,TOKEP   ; JUMP IF SO
; PLAY NOTE FOR THIS CHAR
        CALL   PNOTE
; NON NEW LINE CHAR - UNWRITE OLD CURSOR
VDM1    CALL   UCURSE
        CALL   LDVDMC
        CP     RUBOUT   ; WAS THAT RUBOUT?
        JR     NZ,VDM3  ; JUMP IF NOT
; RUBOUT ENTERED - SO RUB OUT
        LD     A,L      ; GET X
        AND    A        ; IS X =0?
        JR     Z,VDM2   ; YES - JUMP
        SUB    6        ; NO - BACKUP X
        LD     L,A
        JR     VDMDN1   ; AND JOIN STORE BACK
VDM2    LD     L,150
        LD     A,H
        SUB    8
        LD     H,A
        JR     VDMDN1
; NEW LINE CHAR - DID WE JUST WRAP AROUND
VDMOCR  LD     A,(VDMNLF) ; CHECK OLD GLORY
        AND    A
        JR     NZ,VDMDON  ; YES - SKIP DIDDLING
        CALL   UCURSE   ; NO - UNWRITE CURSOR
        CALL   NEWLIN   ; GO TO NEXT LINE
        JR     VDMDON   ; AND QUIT
; NORMAL CHARACTER ENTERED - DISPLAY IT
VDM3    LD     D,H      ; COORDINATES TO DE
        LD     E,L
        OR     80H      ; ALT FONT THE CHAR
        LD     C,011000B ; OR WRITE THE CHAR
        LD     IX,ALTFON ; USING ALTERNATE CHAR F
        SYSTEM CHRDIS    ; IT    
        LD     A,L       ; ADVANCE X POINTER
        ADD    A,6
        LD     L,A
        CP     156       ; END OF LINE?
        JR     NZ,VDMDN1 ; NO - JUMP
        CALL   NEWLIN    ; YES - NEW 1 LINE
        LD     A,1       ; AND SET NEW LINE FORCED FLAG
        JR     VDMDN2
VDMDN1  CALL   STVDMC
VDMDON  XOR    A         ; CLEAR NEW LINE FORCED FLAG
VDMDN2  LD     (VDMNLF),A 
        RET
; ROUTINE TO DISPLAY A TOKEN IN FULL FORM
TOKEP   CALL   TOKEPT
TOKEP1  LD     A,(HL)
        AND    7FH
        PUSH   HL
        CALL   VDM
        POP    HL
        LD     A,(HL)
        INC    HL
        RLCA
        JR   NC,TOKEP1
TOKEP2  LD     A,' '    ; PUT SPACE AFTER TOKEN
        JP     VDM      ; AND GO HOME
; SUBROUTINE TO UNWRITE THE CURSOR
UCURSE  LD     C,0
        JR     CURSE
; SUBROUTINE TO DISPLAY NEW LINE
NEWLIN  CALL   LDVDMC
; IS SCROLL UP NEEDED?
        LD     L,0
        LD     A,H
        CP     80
        JR     NZ,NEWL1 ; JUMP IF NOT NEEDED
; SCROLL UP IS NEEDED
        CALL   STVDMC
; WHAT MODE SHALL WE USE?
        LD     A,(SCRMOD)
        DEC    A
        RET    Z
        DEC    A
        LD     HL,4C80H
        JR     Z,CLRLP
        DEC    A
        JR     Z,CLRENT
        DEC    A
        JR     Z,CLRFRZ
        LD     HL,4DC0H
SCRL9   LD     A,(HL)
        AND    01010101B
        LD     (HL),A
        INC    HL
        LD     A,L
        CP     20H
        JR     NZ,SCRL9
        LD     B,4
SCRLP   PUSH   BC
        LD     HL,NORMEM
        LD     DE,NORMEM+80
        LD     BC,0C00EH
SCRUP   LD     A,(DE)
        XOR    (HL)
        AND    10101010B
        XOR    (HL)
        LD     (HL),A
        INC    HL
        INC    DE
        DJNZ   SCRUP
        DEC    C
        JR     NZ,SCRUP
        POP    BC
        DJNZ   SCRLP
        RET
;
NEWL1   ADD    A,8
        LD     H,A
        JP     STVDMC
; CLEAR COMMAND
CLRFRZ
        CALL   KEYSCN
        JR     Z,CLRFRZ
; RESET VDM GOODIES
CLRENT  PUSH   DE
        SYSSUK MOVE     ; MOVE BYTES (SYSTEM ROUTINE)
        DW     VDMX
        DW     4
        DW     INIDEV+6
        POP    DE
        LD     HL,4000H
CLRLP   LD     A,(HL)
        AND    01010101B
        LD     (HL),A
        INC    HL
        LD     A,H
        CP     4EH
        JR     NZ,CLRLP
        RET
; SUBROUTINE TO PAINT CURSOR
; C = DATA TO PAINT 00 OR AA
CURSE   PUSH   AF 
        CALL   LDVDMC
PCURS1  EX     DE,HL
        XOR    A
        SYSTEM RELAB1
        OUT    (MAGIC),A
        EX     DE,HL
        LD     A,C
        LD     BC,0806H
        CALL   BOXPUT
        POP    AF
        RET
; NEW KEYBOARD HANDLER
; WITH SHIFT KEY ROLLOVER
XCHKIO  CALL   KEYSCN   ; MAKE SURE PREVIOUS KEY RELEASE
        JR     NZ,XCHKIO
; AWAIT DEBOUNCE TIMER COUNTDOWN
CHKIO0  LD     HL,KEYTMR
        LD     (HL),6      ; SET IT
LOOPER  LD     A,(HL)
        AND    A
        JR     NZ,LOOPER
; SAVE BACKGROUND COLOR
        LD     A,(DEVCL0)
        PUSH   AF 
; ASSUME FIRST LEVEL KEYCODE
        LD     HL,FIRSTL
GETK1   PUSH   HL       ; SAVE TABLE PTR
; SCAN ONLY FOR SHIFT KEYS
        LD     HL,KTBL4
        LD     DE,-21   ; ** SIZE OF LOOKUP TABLE
        LD     BC,0414H
GETK2   IN     A,(C)    ; INPUT FROM PORT
        AND    20H      ; SHIFT KEY DOWN?
        JR     NZ,GETK3 ; JUMP IF YEP
        ADD    HL,DE        ; ELSE TO NEXT TABLE
        INC    C        ; AND PORT
        DJNZ   GETK2
; NO SHIFT KEY IS DOWN - USE WHATEVER WE HAD BEFORE
        POP    HL
        JR     GETK5
; A SHIFT KEY IS DOWN - SAME OLD STORY?
GETK3   POP    DE        ; DISCARD OLD BELIEFS
        LD     A,(HL)      ; SET NEW COLOR
        LD     (DEVCL0),A 
GETK4   INC    HL       ; SKIP COLOR BYTE
; NOW SCAN FOR ANY 'NORMAL' KEY DEPRESSION
GETK5   CALL   KEYSCN
        JR     Z,GETK1  ; JUMP IF NO KEY DOWN
; WE GOT ONE - CONVERT TO ASCII
        DEC    A        ; BY TABLE LOOKUP
        LD     C,A
        LD     B,0
        ADD    HL,BC
        POP    AF       ; RESTORE COLOR
        LD     (DEVCL0),A 
        LD     A,(HL)      ; GET CODE
        AND    A        ; A HLT PERCHANCE?
        JR     Z,INIJMP ; YEP - RESET
        CP     1        ; AN ERROR?
        JR     Z,XCHKIO  ; YEP - GO DOIT AGAIN
; GOOD KEY...
CHKI02
        RLCA
        CALL   C,WCLICK
        LD     A,(HL)
        AND    7FH
        CP     NLLN
        RET    NZ
        LD     HL,5
        LD     (NLLNCT),HL   ; SET FLAG AND ZERO SUPPRESS
        LD     A,CR     ; PASS BACK CR AS FIRST CHAR
        RET
;
; NEW CLICK ROUTINE
WCLICK
        LD     A,G0
        LD     (MUZTON),A 
        LD     A,(DEVTEM)
        DEC    A
        RET    M
        LD     A,1
        LD     (NEWTMR),A
        RET
; SUBROUTINE TO CHECK FOR HLT KEY WHILE PGM RUNNING
WHATSU  PUSH   BC
        PUSH   DE
        CALL   KEYSCN   ; GET KEY CODE
        SUB    2        ; FREEZE?
        JR     Z,FRZKEY
        DEC    A
        JR     Z,INIJMP
        JR     FRZGBK   ; ELSE GO BACK TO CALLER
FRZKEY  CALL   KEYSCN   ; SCAN FOR NONZERO KEY TO REL
        JR     Z,FRZKEY
        CP     3        ; HLT NAILED?
INIJMP  JP     Z,INIT
FRZGBK  POP    DE
        POP    BC
        RET
; SUBROUTINE TO SCAN TINY BASIC KEYBOARD
KEYSCN  LD     BC,0414H  ; B = CNT, C = PORT #
        LD     DE,KEYTRK ; DE = KEYBOARD MEMORY
        XOR    A
        SYSTEM RANGED
KYSCN1  IN     A,(C)        ; LOOK AT COLUMN
        AND    1FH      ; ISOLATE THE RELEVANT
        JR     NZ,KYSCN2  ; JUMP IF BITS HIGH
        INC    C        ; BUMP PORT #
        DJNZ   KYSCN1
        XOR    A        ; SET ZERO STATUS
        LD    (DE),A        ; NOTHIN - SAY ZIP
        RET
; DEPRESSION FOUND - JUMP UP AND DOWN
KYSCN2  DEC    B
        LD     C,0      ; COME UP WITH BIT #
KYSCN4  RRCA            ; SHIFT BIT OVER
        JR     C,KYSCN3   ; JUMP IF THE ONE
        INC    C        ; ELSE COUNT UP
        JR     KYSCN4   ; AND TRY AGAIN
; FOUND BIT - ASSEMBLE KEYCODE
KYSCN3  LD     A,C      ; BIT # TO A
        RLCA            ; * 4
        RLCA
        OR     B        ; COMBINE WITH COL #
        INC    A
        LD     B,A
        LD     A,(DE)
        XOR    B
        LD     A,B
        RET    Z        ; QUIT IF THE SAME
        LD    (DE),A    ; ELSE UPDATE TRACKER
        RET
; SUBROUTINE TO PLAY A NOTE
PNOTE   PUSH   HL
        PUSH   DE
        PUSH   AF 
        LD     H,A
; WAIT FOR PREVIOUS PARAMETERS TO BE EATEN
PRWAIT  LD     A,(NEWTMR)
        AND    A
        JR     NZ,PRWAIT  ; LOOP
        LD     A,H
        XOR    ' '
        JR     Z,TSTOR
        LD     A,H
        CP     63H
        JR     Z,PNOTDV
        CP     62H
        JR     Z,PNOTML
        CP     '+'
        JR     Z,PNOTPL
        CP     '-'
        JR     Z,PNOTMN
        CP     CR
        JR     Z,PNOTCL
        SUB    '0'
        JR     Z,PNOTZ
        DEC    A
        CP     7
        JR     C,ANSW
        LD     A,6CH
        SUB    H
        JR     TSTOR
ANSW    LD     HL,SHARPF
        ADD    A,(HL)
        SYSSUK INDEXB   ; INDEX BYTE (SYSTEM SUBROUTINE)
        DW     DICKY
TSTOR   LD     (MUZTON),A
        LD     A,(DEVTEM)
        LD     (NEWTMR),A 
PNOTCL  XOR    A
PSHARP  LD     (SHARPF),A 
LINKB   POP    AF 
        POP    DE
        POP    HL
        RET
PNOTDV  LD     A,OA1
        DB     11H
PNOTML  LD     A,OA3
        LD     (MUZMO),A
        JR     LINKB
PNOTPL  LD     A,7
        DB     11H
PNOTMN  LD     A,14
        JR     PSHARP
PNOTZ   LD     HL,MUZTMR
        LD     A,(DEVTEM)
        AND    A
        JP     M,LINKB
        DI
        ADD    A,(HL)
        LD     (HL),A
        EI
        JR     LINKB
; SUBROUTINE TO POINT AT A TOKEN
TOKEPT  LD     HL,TOKTXT ; POINT AT TEXT LIST
        SUB    68H
JOKEP1  RET    Z        ; QUIT IF POINTING AT EM
JOKEP2  BIT    7,(HL)   ; MOVE PAST NEXT WORD
        INC    HL
        JR     Z,JOKEP2
        DEC    A
        JR     JOKEP1   ; LOOP BACK AND CHECK
; DICKS MUSIC SYSTEM NOTE LOOKUP TABLE
DICKY   DB     C2,D2,E2,F2,G2,A2,B2
        DB     CS2,DS2,F2,FS2,GS2,AS2,C3
        DB     B1,CS2,DS2,E2,FS2,GS2,AS2
TBLDIV  DW     1
        DW     10
        DW     100
        DW     1000
        DW     10000
IGNBLK  LD     A,(DE)   ; *** IGNBLK ***
        CP     ' '      ; IGNORE BLANKS
        RET    NZ       ; IN TEXT (WHERE DE->)
        INC    DE       ; AND RETURN THE FIRST
        JR     IGNBLK   ; NON-BLANK CHAR. IN A
; TABLE OF FIST LEVEL KEYCODES
FIRSTL
        DB     CR+80H
        DB     EDKEY
        DB     0
        DB     63H+80H
        DB     '7'
        DB     '8'
        DB     '9'
        DB     62H+80H
        DB     '4'
        DB     '5'
        DB     '6'
        DB     '-'+80H
        DB     '1'
        DB     '2'
        DB     '3'
        DB     '+'+80H
        DB     ' '
        DB     '0'+80H
        DB     RUBOUT+80H
        DB     '='
; FIRST SHIFT KEY
KTBL1
        DB     0A7H     ; FIRST SHIFT KEY COLOR
        DB     CR+80H
        DB     EDKEY
        DB     0
        DB     1
        DB     'A'
        DB     'D'
        DB     'G'
        DB     'J'
        DB     'M'
        DB     'P'
        DB     'S'
        DB     'V'
        DB     'Y'
        DB     5FH
        DB     5EH
        DB     '&'
        DB     '$'
        DB     '<'
        DB     '('
        DB     '#'
; SECOND SHIFT KEY
KTBL2
        DB     05FH     ; SECOND SHIFT KEY COLOR
        DB     CR+80H
        DB     2FH
        DB     0
        DB     5BH
        DB     'B'
        DB     'E'
        DB     'H'
        DB     'K'
        DB     'N'
        DB     'Q'
        DB     'T'
        DB     'W'
        DB     'Z'
        DB     27H
        DB     '.'
        DB     '@'
        DB     ','
        DB     22H
        DB     ';'
        DB     '%'
; TABLE THE THIRD
KTBL3
        DB     0FH      ; THIRD SHIFT KEY COLOR
        DB     CR+80H
        DB     5CH
        DB     0
        DB     5DH
        DB     'C'
        DB     'F'
        DB     'I'
        DB     'L'
        DB     'O'
        DB     'R'
        DB     'U'
        DB     'X'
        DB     '!'
        DB     61H
        DB     60H
        DB     '*'
        DB     '?'
        DB     '>'
        DB     ')'
        DB     ':'
; TOKEN KEY
KTBL4
        DB     77H      ; WORDS KEY COLOR
        DB     NLLN
        DB     EDKEY
        DB     6AH
        DB     68H
        DB     72H
        DB     77H
        DB     75H
        DB     6BH
        DB     6FH
        DB     70H
        DB     76H
        DB     6DH
        DB     69H
        DB     6CH
        DB     71H
        DB     6EH
        DB     EDKEY
        DB     73H
        DB     1
        DB     74H
; SUBROUTINE TO LD   A,(DE) FROM SCREEN TEXT MEMORY IF NECESSARY
LDE     BIT    7,D
        JR     Z,LDE1
        EX     DE,HL
        ADD   HL,HL
        LD     A,(HL)
        RLCA
        INC    HL
        XOR    (HL)
        AND    10101010B
        XOR    (HL)
        SCF
        RR     H
        RR     L
        EX     DE,HL
        RET
LDE1    LD     A,(DE)
        RET
; DOUBLE STORE INTO HL
STDEHL
        LD     A,E
        CALL   STHL
        INC    HL
        LD     A,D
; THEN FALL INTO...
; SUBROUTINE TO STORE LD     (HL),A
STHL    BIT    7,H
        JR     Z,STHL1
        PUSH   BC
        LD     C,A
        ADD   HL,HL
        RRCA
        XOR    (HL)
        AND    01010101B
        XOR    (HL)
        LD     (HL),A
        INC    HL
        LD     A,C
        XOR    (HL)
        AND    01010101B
        XOR    (HL)
        LD     (HL),A
        SCF
        RR     H
        RR     L
        LD     A,C
        POP    BC
        RET
STHL1   LD     (HL),A
        RET

; END OF BALLY BASIC INTERPRETER (AKA ASTROBASIC)