; Disassembly of the file "ColorBAS.BIN" originally named: ; "Color BASIC (198x)(Jay Fenton)[From Proto EPROM].bin" ; ; Programmed and Commented by: Jay Fenton for Bally Manufacturing ; ; CPU Type: Z80 - for Bally and/or Astrocade Home Video Game System ; ; Created with dZ80 1.50 and a whole lot of hand editing/copying! ; Re-assembles 100% correctly with: zmac -i -m ColorBAS.ASM ; ; Dis-assembled and pasted-up by: Richard C. Degler, From Scratch ; Beginning on or about Monday, 21 of April 2008 at 07:42 PM ; ; Renamed some labels and added a very few comments in Mixed Case ; ; Source of Jay Fenton's comments is "astrobas.asm" by Adam Trionfo ; retyped from a wrapped-around paper listing with page headings of: ; TDL Z80 CP/M DISC ASSEMBLER VERSION 2.21 [overwritten by Page #] ; .MAIN. - ; Note: The only text in "bally_basic_souce_pages_01-32.pdf" was: ; > Bally BASIC Interpreter ; > ; > © July 1978 Bally Mfg. ; > © December 1980 Revised ; > ; > Written by Jay Fenton ; and: ; > This page left blank for double-sided printing purposes. ; Part Two - Assembly Code for the file "ColorBASIC (listing).ASM" ; Programmed by: Jay Fenton for Bally Manufacturing [see Part One] ; ; Reverse-source code found by Brett Bilbrey - "Bally Basic (1979)" ; Loose Leaf paper listing Scanned and saved as PDF by Adam Trionfo ; moved to Bally Alley Yahoo! user group dated Friday, May 15, 2009 ; ; Comments (ONLY) then retyped by: Richard C. Degler, From Scratch ; Beginning on Memorial Day Eve Sunday, 24 of May 2009 at 02:24 PM ; ; To match the style (and only where useful) these are marked by ;* ; Author Unknown, but no LC decenders listing had page headings of: ; ; CROMEMCO CDOS Z80 ASSEMBLER version 02.15 PAGE 0001 ; Bally Tiny Basic 8/25/79 ; [without leading semi-colons used here] and a program identifier: ; ; 0002 ;************************************************ ; 0003 ;* * ; 0004 ;* Bally Tiny Basic * ; 0005 ;* * ; 0006 ;* 8/25/79 * ; 0007 ;* * ; 0008 ;************************************************ ; 0009 ; ; ; [End of Header] ; ; Here then is: ; *************************** ; * BALLY BASIC INTERPRETER * [Comments WERE for Astro Basic] ; * * [so ignore changes to comments] ; * (C) JULY 1978 BALLY MFG * [; * (C) DEC 1980 REVISED *] ; * * ; * WRITTEN BY: JAY FENTON * ; * * ; * PALO ALTO TINY BASIC BY * ; * LICHEN WANG * ; * * ; *************************** ; TINY BASIC INTERPRETER [with original 300 baud tape interface] ; NOLIST INCLUDE "HVGLIB.H" ; HOME VIDEO GAME LIBRARY ; ; MACROS TOKEN MACRO TINDX, TGOTO DB TINDX DEFF TGOTO ENDM ITEM MACRO STRANG, JUMPTO ; Quoted Character DB 'STRANG' DEFF JUMPTO ENDM DEFF MACRO WORDY ;* Jump table entry DB (WORDY >> 8) | $80 DB WORDY & $FF ENDM TSTC MACRO CAT, DOG RST $08 DB 'CAT' ;* Char. to check DB (DOG - $)-1 ;* Jump bias if no match ENDM TSTCC MACRO CAT1, DOG1 RST $08 DB CAT1 ;* Char. to check DB (DOG1 - $)-1 ;* Jump bias if no match ENDM ; Defines EDKEY EQU $01 CR EQU $0D RUBOUT EQU $1F COMMA EQU $2C NLLN EQU $67 ; ; EQUATES FOR RESTART INSTRUCTIONS RSTEXP EQU $10 ; EXPR - Get EXPRession restart ;* Evaluate expression RSTOUT EQU $18 ; OUTC - OUT Char [became LDE - LoaD A, from (DE) in ab] RSTIGN EQU $20 ; IGNBLK - IGNore BLanKs ;* Get next non-blank from (DE) RSTPAR EQU $28 ; PARN - expression in PAReNthesis ;* Get value in () RSTFIN EQU $30 ; FINISH - Routine FINISH ;* cr. or ; otherwise, WHAT? ; BOTROM EQU FIRSTC ; $2000 ; ; Scratchpad area: BOTRAM EQU $4000 ; [NON-INTERLACED for 4-color display] TXT EQU BOTRAM + $0A00 ; [was TEXT originally] Text Array Area DFTLMT EQU TXT + $03FC ; [Hidden Bottom of screen $4A00 to $4DFC] ; [This is why Color Basic runs faster even with EIGHT interrupts/screen!] ; [And the reason SZ is only 1020 bytes, plus 2 bytes for EOProgram marker [??counts??]] ; BOTSCR EQU $4E00 ; BOTtom of SCReen [is actually end of TeXT+4] TAPINS EQU BOTSCR ;* TAPe INSert pointer TAPEXT EQU $4E01 ;* TAPe EXTract pointer TAPBUF EQU $4E02 ; [48 bytes of TAPe input BUFfer] TXTUNF EQU $4E32 ;* "End of Basic Pgm" address [plus 2 is a -1 ??] VDMNLF EQU $4E34 ; VDM NEW LINE FLAG KEYTMR EQU $4E35 ; KEYBOARD SCAN TIMER ;* Key release timer (60 Hz) MUZTMR EQU $4E36 ; MUSIC NOTE TIMER ;* Time remaining on current note NEWTMR EQU $4E37 ; NEW MUSIC TIMER VALUE ;* Time for next note MUZMO EQU $4E38 ; MASTER OSC FOR DICK ;* Master sound divider value MUZTON EQU $4E39 ; TONE VALUE ;* Next note to output SHARPF EQU $4E3A ; SHARP-FLAT ; PIXVAL EQU $4E3B ; PIXel VALue TO DRAW WITH MNMX EQU $4E3C ; MiN - MaX DELTAS FOR VECTOR DRAW INCRO EQU $4E3E ; COORDINATE INCRements FOR VECTOR DRAW NLLNLN EQU $4E40 ; AUTO LINE # STUFF NLLNCT EQU $4E42 NLLNZS EQU $4E43 ; AUTO LINE NUMBER Zero Suppress FLAG OLDLN EQU $4E44 ; PREVIOUS LINE # TYPED (used for GO+10) ALTFON EQU $4E46 ; 7 byte ALTernate FONt descriptor ;* Character Spec Table ; ?? EQU $4E4C ;* [+6 ??] Indexes VRBL storage area KEYTRK EQU $4E4D ; KEYpad debounce TRacKer ;* Last calc. input ; VARBGN EQU $4E4E ; One-letter variables (two bytes each) DEVVAR EQU $4E82 ; Two-letter DEVICES VARIABLES thusly: DEVCL0 EQU DEVVAR ; BC = [Character] Background (default Color 0) DEVCL1 EQU $4E84 ; FC = [Character] Foreground (default Color 1) DEVTEM EQU $4E86 ; NT = TEMPO Note Timer (default 31 ??) VDMX EQU $4E88 ; CX = VDM X COORDINATE (default -77) VDMY EQU $4E8A ; CY = VDM Y COORDINATE (default 28 [bb/ab $28]) OLDXY EQU $4E8C ; XY = PREVIOUS COORDINATES FROM VECTOR DRAW REMAIN EQU $4E8E ; RM = REMAINDER FROM LAST DIVIDE ; CLREND EQU $4E90 ; Flag for colors disable [New for Color Basic] LINPAL EQU $4E92 ; Color Palette to use for Lines 1 through 8 array PALCLR EQU $4E9A ; Base Address for Four-Color Palettes 1 through 8 LINCNT EQU $4EBA ; Current Line 0 through 8 for Interrupts SCNLIN EQU $4EBB ; Current Interrupt Line Number [New for Color Basic] ; CHMODE EQU $4EBC ;* I/O flag 0=KBD in, VID out ;* 1=TAP in, VID out ;* 2=KBD in, TAP out ;* 6=KBD in, TAP out ;* (expanded) CURRNT EQU $4EBD ; CURReNT line STKGOS EQU $4EBF ; STacK for GOSub STKINP EQU $4EC1 ; ?? VARNXT EQU STKINP ;* "NEXT" VRBL address LOPVAR EQU $4EC3 ; FOR VARiable ;* "FOR" VRBL address LOPINC EQU $4EC5 ; FOR STEP ;* "STEP" VRBL address LOPLMT EQU $4EC7 ; FOR TO ;* "TO" VRBL address LOPLN EQU $4EC9 ; LOoP Line Number ;* Line # of current FOR loop LOPPT EQU $4ECB ; 3 bytes LOoP PoinTer ;* Current FOR line text pointer ; BUFFER EQU $4ECE ; line input BUFFER ;* Keyboard input buffer BUFEND EQU $4F36 ; BUFfer END (104 Characters) ; ?? unused block of 32 bytes ?? STKLMT EQU $4F56 ; STacK LiMiT (153 bytes available) TOPSCR EQU RANSHT ; $4FEF used for Top of Stack STACKP EQU TOPSCR ; Initialized STACK Pointer ; LIST ORG BOTROM JP BEGIN ; ** AUTOSTART CASSETTE ** PIXTBL: ;* Masks for picture data (PX) DB $C0 ; [Wider than bb or ab] DB $30 DB $0C DB $03 ; TRANSFER VECTORS TO RESTART ROUTINES JP TSTCH ; * RST $08 JP EXPR ; * RST RSTEXP ;* Evaluate expression JP OUTC ; * RST RSTOUT [became LDE ; * RST RSTLDE in ab ??] JP IGNBLK ; * RST RSTIGN ;* Get next non-blank from (DE) JP PARN ; * RST RSTPAR ;* Get value of () or storage adrs POP AF ; * RST RSTFIN ;* cr. or ; otherwise, WHAT? JP FINISH ; external Transfer Vector to get a character from cassette tape into A L201A: JP CHKIO ; use TV=CALL 8218 from Basic Program [same as bb] CLRTBL: DB $00 ; Color Indexes ?? [New for cb] DB $55 DB $AA DB $FF ; INITIAL VALUES FOR PARAMETER VECTOR ;* Following is moved to DEVVAR at $4E82 INIDEV: DW $0000 ; [Character] BACKGROUND COLOR ;* BC preset-Color 0 DW $0001 ; [Character] FOREGROUND COLOR ;* FC preset-Color 1 DW $001E ; MUSIC TEMPO ;* NT preset INIVDM: DW $FFB3 ; (-77) VDM X COORDINATE ;* CX preset DW $001C ; (28) VDM Y COORDINATE ;* CY preset DW $0000 ; OLDXY COORDINATE ;* XY preset ; Text Strings CBASIC: DB 'COLOR BASIC',CR WHAT: DB 'WHAT?',CR HOW: DB 'HOW?',CR SORRY: DB 'SORRY',CR ; TABLE GIVING JUMP TO ADDRESS FOR COMMANDS TOKJT: DW LISTCOM ; 68 - 'LIST' COMmand routine DW CLRSCR ; 69 - 'CLEAR' DW RUN ; 6A - 'RUN' DW NEXT ; 6B - 'NEXT' DW LINEDR ; 6C - 'LINE' DW IFF ; 6D - 'IF' DW GOTO ; 6E - 'GOTO' DW GOSUB ; 6F - 'GOSUB' DW RETURN ; 70 - 'RETURN' DW BOXDRW ; 71 - 'BOX' DW FOR ; 72 - 'FOR' DW INPUT ; 73 - 'INPUT' DW PRINT ; 74 - 'PRINT' DW COLOR ; 75 - 'COLOR' [New for Color Basic] DW CLINE ; 76 - 'CLINE' [New for Color Basic] ; INTERRUPT VECTOR ITEMS DW LPINT ; (ITAB & $FFF0) Light Pen INTerrupt vector ITAB: DW TBIINT ; Tiny Basic Interpreter INTerrupt vector ; TABLE GIVING ASCII CHARS FOR TOKENS with last character marked negative TOKTXT: DB 'LIS' DB 'T' + $80 ; ($68) "LIST" Text DB 'CLEA' DB 'R' + $80 ; ($69) "CLEAR" DB 'RU' DB 'N' + $80 ; ($6A) "RUN" DB 'NEX' DB 'T' + $80 ; ($6B) "NEXT" DB 'LIN' DB 'E' + $80 ; ($6C) "LINE" DB 'I' DB 'F' + $80 ; ($6D) "IF" DB 'GOT' DB 'O' + $80 ; ($6E) "GOTO" DB 'GOSU' DB 'B' + $80 ; ($6F) "GOSUB" DB 'RETUR' DB 'N' + $80 ; ($70) "RETURN" DB 'BO' DB 'X' + $80 ; ($71) "BOX" DB 'FO' DB 'R' + $80 ; ($72) "FOR" DB 'INPU' DB 'T' + $80 ; ($73) "INPUT" DB 'PRIN' DB 'T' + $80 ; ($74) "PRINT" DB 'COLO' DB 'R' + $80 ; ($75) "COLOR" [New for Color Basic] DB 'CLIN' DB 'E' + $80 ; ($76) "CLINE" [New for Color Basic] DB 'STE' DB 'P' + $80 ; ($77) "STEP" [was $75 in bb/ab] DB 'RN' DB 'D' + $80 ; ($78) "RND" [was $76 in bb/ab] DB 'T' DB 'O' + $80 ; ($79) "TO" [was $77 in bb/ab] ; DEVICE VARIABLE TABLE /* Special 2-letter variables ; THIS TABLE IS IN INVERSE ORDER OF APPEARENCE IN MEMORY PARNUM EQU 7 DEVLST: ; [has first character minus $40 for ?? why??] DB 'R' - '@' DB 'M' ; "RM" = ReMainder from last divide DB 'X' - '@' DB 'Y' ; "XY" = Location from last draw DB 'C' - '@' DB 'Y' ; "CY" = Character print Y DB 'C' - '@' DB 'X' ; "CX" = Character print X DB 'N' - '@' DB 'T' ; "NT" = Note Tempo DB 'F' - '@' DB 'C' ; "FC" = character Foreground Color DB 'B' - '@' DB 'C' ; "BC" = character Background Color ; TINY BASIC INTERRUPT ROUTINE ;* NORMAL INTERRUPT PROCESSOR ; TBIINT: PUSH AF ; SAVE REGISTERS PUSH BC PUSH DE PUSH HL ; DEAL WITH KEYBOARD SCAN TIMER [Totally NOT like bb OR ab ??] LD A,(CLREND) OR A ; Disable Color Interrupts ? JR NZ,TBIN3 LD A,(LINCNT) ; Current Text Line INC A CP $08 JR NZ,TBIN1 XOR A TBIN1: LD (LINCNT),A CALL SETCLR ; do SET CoLoRs LD A,(SCNLIN) ; Read old Int LINE number ADD A,$10 ; Increment Int LINE number by 16 CP $80 JR C,TBIN2 LD A,$0C ; Reset Interrupt LINE number to 12 TBIN2: LD (SCNLIN),A ; Save new Int LINE number OUT (INLIN),A ; &($0F)=$0C, $1C, $2C, $3C, $4C, $5C, $6C, $7C TBIN3: LD HL,KEYTMR LD A,(HL) ;* Get key release timer AND A JR Z,TBIN4 ;* Jp if already zero DEC (HL) ; Count KEYTMR down to Zero TBIN4: INC HL ; Point to MUZTMR ; HAS MUSIC TIMER COUNTED DOWN? LD A,(HL) AND A JR Z,TBIN5 ; YEP - PLAY NEXT NOTE DEC (HL) ; ELSE DECREMENT IT JR NZ,INTDON ; JUMP IF NOT NOW ZERO XOR A OUT (TONEA),A JR TBINX ; Silence A Stacato ; MUSIC TIMER IS AT ZERO - ARE NEW PARAMETERS READY? TBIN5: INC HL ; STEP TO NEW TIMER VALUE OR (HL) ; IS IT NON ZERO? JR Z,INTDON ; JUMP IF NOT DEC HL ; ELSE SET OFFICIAL TIMER LD (HL),A ; SAY WE GOT IT INC HL LD (HL),$00 INC HL LD A,(HL) ; SET NEW MASTER OUT (TONMO),A LD (HL),OA2 ; Restore Center Octave = 71 INC HL LD A,(HL) ; AND NEW TONE OUT (TONEA),A AND A ; REST WANTED? JR Z,INTDON ; YES - JUMP AROUND VOLUME UPDATE LD A,$0F TBINX: OUT (VOLAB),A ; DONE - RESTORE REGISTERS AND GO BACK INTDON: POP HL POP DE POP BC JR LPIEX ;************************************************ ;* Light pen interrupt processor * ;************************************************ ; LPINT: PUSH AF EXX IN A,(SW2) ;* Collect at least 4 1s to start RRA ;* Then wait on a 0 (Start bit) LD A,C ;* Collect 8 bits, then wait for RRA ;* another start bit. LD C,A ;* Move old data to hi C LD A,B AND A JP M,LPIN1 ;* Minus means collecting 4 1s JR NZ,LPIN2 ;* NZ means collecting data BIT 7,C ;* Else waiting on start bit JR NZ,LPIN3 ;* Leave unless start bit found LD B,$08 ;* Now collect 8 data bits JR LPIN3 LPIN1: INC B ;* Increment 1 collector BIT 7,C JR NZ,LPIN3 ;* Good if a 1 LD B,$FC ;* Else reset collector JR LPIN3 LPIN2: DJNZ LPIN3 ;* Leave unless 8 bits collected LD HL,(TAPINS) LD A,L ;* Get insert pointer CALL RAMPIT ;* Update for next CP H JR Z,LPIN3 ;* Buffer is jammed; forget it! LD (TAPINS),A ;* Save insert pointer LD H,TAPBUF >> 8 ; $4E [point back to $4E00+TAPINS] LD (HL),C LPIN3: EXX LPIEX: POP AF EI RET ; [New for ColorBasic] Set Color Registers [should be before LPINT ??] ; SETCLR: LD E,A LD HL,LINPAL ; Base address for Line 1 - 8 Palettes LD D,$00 ADD HL,DE LD A,(HL) ADD A,A ADD A,A LD E,A ; SET COLOR REGISTERS TO VALUES IN Color Table plus Color Offset LD HL,PALCLR ; Base address for Color Palettes 1 - 8 ADD HL,DE LD A,(HL) OUT (COL0L),A INC HL LD A,(HL) OUT (COL1L),A INC HL LD A,(HL) OUT (COL2L),A INC HL LD A,(HL) OUT (COL3L),A RET ; Ramp pointer and reset to start of TAPe BUFfer if past end ; RAMPIT: INC A CP TXTUNF & $FF ; not to TAPBUF+$30 yet ? RET NZ LD A,TAPBUF & $FF RET ;* Prepare for tape input [and turn off cursor] ; ;* :INPUT, :LIST and :RUN call this routine ; TVLLNK: DI LD HL,$2222 ; should be (TAPBUF & $FF) + ((TAPBUF & $FF) << 8) LD (TAPINS),HL ; sets both pointers into buffer [$0202 to start!] EXX XOR A LD (DEVTEM),A ;* No notes INC A LD (CHMODE),A LD B,$FC EXX LD A,$18 ; Screen AND LightPen Interrupts OUT (INMOD),A EI RST RSTIGN ;* Get next non-blank from (DE) CALL ZONATNL ; do Zero ON AT NewLine or ; RET Z CALL EXPR ; Same as RST RSTEXP ;* Evaluate expression PUSH DE TVL1: PUSH HL CALL CHKIO ;* Get tape character POP HL TVL2: CP H JR NZ,TVL1 PUSH HL CALL CHKIO ;* Get tape character POP HL CP L JR NZ,TVL2 POP DE ; SUBROUTINE TO RETURN ZERO STATUS IF CHARACTER IN A ; IS NL OR ';' [ab combined with RSTIGN for IGNATNL] ; ZONATNL: CP ';' ; CHECK FOR CONTINUATION RET Z CP CR ; AND FOR CR RET ; ENTRY TO LOAD PROGRAM [NOT ab COMBINED SCREEN AND PGM] ; note: Pressing ANY KEY will cancel the tape input mode ; ; :INPUT COMMAND ;* - Load BASIC program into memory ; Any characters read in from tape will display on TV ; and be executed as if they were input by the KeyPad. ; TINPUT: CALL TVLLNK ; [ab only ?? AND ARGS?] do OPEN for Tape Input RST RSTFIN ;* cr. or ; otherwise, WHAT? ; :LIST command ;* - List BASIC tape ; note: displays information on tape WITHOUT saving to memory ; TVLIST: CALL TVLLNK ; do Prepare for Tape Input TVLIL: CALL CHKIO ; do Read a character from cassette tape RST RSTOUT ;* Output Char. in A JR TVLIL ; *PRINT character print routine ;* - Print BASIC program onto printe ; POUTPU: LD A,$06 DB $01 ; does a LD BC,$023E instead of LD A,$02 ;* Skips 2 bytes ; :PRINT character print routine ;* - Print BASIC program to tape ; TOUTPU: DB $3E ; does a LD A,$02 DB $02 LD (CHMODE),A RST RSTFIN ;* cr. or ; otherwise, WHAT? ; :RUN COMMAND - LOADS 128 byte BOOTSTRAP INTO RAM ; AND JUMPS TO IT ;* - Load tape to $4000-$407F and execute ; TLOAD: CALL TVLLNK ; do Prepare for Tape Input LD HL,NORMEM ; HL=SCREEN TOP PUSH HL ; SUBROUTINE TO INPUT A BLOCK, HL=STORE ADDR ; FIRST - AN ENTRY TO REVEAL FEEDBACK AREA ; INBLK: PUSH HL CALL CHKIO ; do Read a character from cassette tape POP HL LD (HL),A INC HL BIT 7,L JR Z,INBLK RET ; FUNCTION TO RETURN STATE OF ADDRESSED PIXEL ; IE... PIX(X,Y)= 1 IF PIXEL IS 1, 0 IF 0 ; ;* PX - Check screen dot ;* PX(,) ; PIXFUN: TSTC '(',PIXDUD ;* Open = Char. to check, Jump if no match PUSH BC RST RSTEXP ;* Evaluate expression PUSH HL ;* Save value of TSTCC COMMA,PIXDUD ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression TSTC ')',PIXDUD ;* Close = Char. to check, Jump if no match POP BC ;* X value PUSH DE ; SAVE PTR ;* Save text pointer LD D,L ;* D = Y LD E,C ;* E = X CALL R2ABS ;* Get odd crt adrs to A EX DE,HL ;* and adrs to DE SYSSUK INDEXB ; INDEX BYTE (SYSTEM SUBROUTINE) DW PIXTBL ; HL + A [not loaded!] to HL LD A,(DE) ; GET BYTE FROM SCREEN ;* Get CRT dots AND (HL) ; MASK OFF NONSENSE ;* AND with mask LD H,$00 LD L,H POP DE POP BC ;* No dot RET Z INC HL RET ;* Dot on ; SUBROUTINE TO GET VARIABLE MAKING SURE IT IS ONE ; TSTVFF: CALL TSTV ;* Get VRBL storage address RET NC ; GO BACK IF GOOD ;* Was a variable ; ELSE FALL INTO... PIXDUD: JP QWHAT ; BOX DRAW ROUTINE ;* - Draw a box on the screen ;* BOX(,,,,) ; BOXDRW: RST RSTEXP ; GET X ;* Evaluate expression PUSH HL ;* Save starting x TSTCC COMMA,BOXDUD ;* Comma = Char. to check, Jump if no match RST RSTEXP ; GET Y ;* Evaluate expression PUSH HL ;* Save starting y TSTCC COMMA,BOXDUD ;* Comma = Char. to check, Jump if no match CALL GETOK ;* Get Expr., Range 1-255 [0 asks HOW?] PUSH AF ;* Save xsize TSTCC COMMA,BOXDUD ;* Comma = Char. to check, Jump if no match CALL GETOK ;* Get Expr., Range 1-255 [0 asks HOW?] PUSH AF ;* Save ysize TSTCC COMMA,BOXDUD ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Get box type ;* Evaluate expression PUSH DE ;* Save text pointer POP IX ;* in IX POP AF ; RESTORE YS LD B,A ;* Get ysize to B [ab just uses POP BC !] POP AF ; AND XS LD C,A ;* Get xsize to C LD A,L ; PRESERVE FLAG ;* Get box type to A POP HL LD D,L ;* Get start y to D POP HL LD E,L ;* Get start x to E LD L,A ; NOW WE HAVE: B=YS, C=XS, D=Y, E=X, L=FLAG ; LIMIT CHECK Y LD H,B DEC H SRL H LD A,D CALL SABS ; do Set to ABSoulte value ADD A,H CP $20 ; [bb uses $2C, ab uses $2D ??] JR NC,BOXNDR LD A,D ADD A,H LD D,A ; AND X LD H,C SRL H LD A,E CALL SABS ; do Set to ABSoulte value ADD A,H CP $51 JR NC,BOXNDR LD A,E SUB H LD E,A ; DIDDLE WITH FLAG BYTE [to a byte of color 0,1,2,or 3 with NO X-ORing !] LD A,L AND $03 ; MODULO 4 [Color Basic only] PUSH DE ; A is INDEX into Color Index Table SYSSUK INDEXB ; HL + A [not loaded!] to HL DW CLRTBL ; $00,$55,$AA,$FF for Line Color POP DE PUSH AF CALL R2ABS ; do Relative TO ABSoulte conversion ; HL = ABS ADDR, A = SA, B=YS, C=XS OUT (MAGIC),A POP AF CALL BOXPUT ; do draw a BOX PUT on screen BOXNDR: PUSH IX POP DE RST RSTFIN ;* cr. or ; otherwise, WHAT? BOXDUD: JP QWHAT ; Set A to ABSoulute value ; SABS: AND A RET P NEG RET ; SUBROUTINE TO DRAW A BOX ON SCREEN ; BOXPUT: LD E,A LD A,C ; D = X / 4 RRCA RRCA AND $3F INC A LD D,A ; PAINT FULL BOX STRIPES MPT1: DEC D JR Z,MPT2 LD A,11111111B ; $FF [bb and ab used $AA] CALL STRIPE ; do draw a STRIPE on screen JR MPT1 MPT2: LD A,C AND $03 INC A LD C,A XOR A MPT3: DEC C JR Z,MPT4 RRCA RRCA OR 11000000B ; $C0 [bb and ab used $80] JR MPT3 MPT4: CALL STRIPE ; do draw a STRIPE on screen XOR A ; FALL INTO... ; SUBROUTINE TO PAINT A STRIPE ; STRIPE: PUSH HL PUSH BC PUSH DE LD (WASTER),A LD A,(WASTER + $4000) LD C,A AND E LD E,A LD A,C CPL LD C,A STRP1: LD A,(HL) AND C OR E LD (HL),A LD A,L ADD A,$28 LD L,A LD A,H ADC A,$00 LD H,A DJNZ STRP1 POP DE POP BC POP HL INC HL RET GETOK: RST RSTEXP ;* Evaluate expression LD A,H OR A JR NZ,LINEDX ;* Jp if over 255 OR L JR Z,LINEDX ;* Jp if = 0 RET ; LINE DRAWER ;* - Draw a line on the screen ;* LINE(,,) ; LINEDR: RST RSTEXP ;* Evaluate expression LD A,L PUSH AF ;* Save starting x TSTCC COMMA,LINEDX ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression LD A,L PUSH AF ;* Save starting y TSTCC COMMA,LINEDX ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression PUSH DE POP IX LD A,L AND $03 ; MODulo 4 [new for cb] SYSSUK INDEXB ; HL + A [not loaded!] to HL DW CLRTBL LD (PIXVAL),A ; SET PIXVAL LD DE,(OLDXY) ;* Current xy [Y is high order byte, X is lower byte] POP AF LD H,A POP AF LD L,A CALL RANG1 ; do check the RANGe of CX JR NC,LINED1 ;* Jp if out of range LD A,H CALL RANG2 ; do check the RANGe of CY JR NC,LINED1 ;* Jp if out of range LD (OLDXY),HL ; SET NEW LAST PLACE ;* Update xy NOP NOP ; [don't DIDDLE WITH FLAG BYTE or SET PIXVAL] CALL DVECT ; do Draw line VECTor LINED1: PUSH IX POP DE RST RSTFIN ;* cr. or ; otherwise, WHAT? LINEDX: 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 ; do Compute DELTA for X LD E,B LD L,C LD B,H LD C,D CALL CDELTA ; do Compute DELTA for Y 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,$00 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 R2ABS ; do Relative TO ABSoulte conversion PUSH BC PUSH HL LD C,A LD B,$00 LD HL,PIXTBL ADD HL,BC LD B,(HL) POP HL LD A,B CPL LD C,A LD A,(PIXVAL) AND B LD B,A LD A,(HL) AND C OR B LD (HL),A POP BC ; INCREMENT COORDINATES LD HL,(MNMX) LD A,B ADD A,H CP L JR C,VECT4 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 RANG1: CP $50 ;* Check CX range [-80 to 79] RET C CP $B0 CCF RET RANG2: CP $20 ;* Check CY range [-32 to 31 [bb was -44 to 43]] RET C CP $E0 ; [bb was $D4] CCF RET ; SUBROUTINE TO LOAD HL WITH VDM COORDINATES ; FROM DEVICE VARIABLES ; LDVDMC: PUSH AF LD A,(VDMY) CPL ADD A,$1D ; [bb and ab use $29 ??] CP $39 ; OUT OF RANGE? [bb and ab use $51 ??] JR C,LDVDM1 ; NO XOR A LDVDM1: LD H,A LD A,(VDMX) ; DIDDLE WITH X ADD A,$4D CP $9D 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 $1D ; [bb ab uses $29 ??] CPL LD L,A CALL SGNEXT ; do SiGN EXTend from L into H LD (VDMY),HL ;* Update CY POP HL LD A,L SUB $4D LD L,A CALL SGNEXT ; do SiGN EXTend from L into H LD (VDMX),HL ;* Update CX RET ; SUBROUTINE TO COMPUTE DELTA AND INCREMENT FOR TWO COORDINATES ; CDELTA: PUSH HL PUSH DE LD L,C CALL SGNEXT ; do SiGN EXTend from L into H EX DE,HL LD L,B CALL SGNEXT ; do SiGN EXTend from L into H XOR A SBC HL,DE ; COMPUTE SGN(DELTA) AND ABS(DELTA) OR H JR Z,CDELT1 LD C,A LD A,L NEG LD B,A JR CDELT3 CDELT1: OR L ; POS CASE 0? JR Z,CDELT2 LD A,$01 CDELT2: LD B,L LD C,A CDELT3: POP DE POP HL RET ; ... ; RELATIVE TO ABSOLUTE CONVERSTION ; R2ABS: PUSH DE ;* Save XY LD A,D ;* Get y CPL ;* Reverse sense ADD A,$20 ;* Make it 0-63 [bb and ab use $2C for 0-87] LD D,A ;* Put it back LD A,E ADD A,$50 ;* Same for x [0-159] LD E,A XOR A SYSTEM RELAB1 ;* Get CRT adrs to DE EX DE,HL POP DE ;* Regain original XY RET ; Set Palette Color [New for Color Basic ?? Needs comments ??] ; COLOR: RST RSTEXP ;* Evaluate expression PUSH HL TSTCC COMMA,CLREX ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression PUSH HL TSTCC COMMA,CLREX ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression PUSH HL TSTCC COMMA,CLREX ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression PUSH HL TSTCC COMMA,CLREX ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression PUSH DE POP IX LD E,L POP HL LD D,L POP HL LD C,L POP HL LD B,L POP HL DEC HL LD A,L SUB $08 JR NC,CLREX PUSH DE LD A,L ADD A,A ADD A,A LD E,A LD D,$00 LD HL,PALCLR ; Base address for Color Palettes 1 - 8 ADD HL,DE POP DE LD (HL),B INC HL LD (HL),C INC HL LD (HL),D INC HL LD (HL),E PUSH IX POP DE RST RSTFIN ;* cr. or ; otherwise, WHAT? CLREX: JP LINEDX ; Set Text Line Palette [New for Color Basic ?? Needs comments] ; CLINE: RST RSTEXP ;* Evaluate expression LD A,L PUSH AF TSTCC COMMA,CLREX ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression DEC HL LD B,L POP AF DEC A LD C,A SUB $08 JR NC,CLREX LD A,B SUB $08 JR NC,CLREX PUSH DE LD HL,LINPAL ; Base address for Line 1 - 8 Palettes LD D,$00 LD E,C ADD HL,DE LD (HL),B POP DE RST RSTFIN ;* cr. or ; otherwise, WHAT? ; KB - FUNCTION TO RETURN NEXT CHARACTER FROM KEYBOARD ; GETKB: PUSH BC PUSH DE CALL CHKIO ; do Read a character from keyboard POP DE POP BC LD L,A ;* HL is output register LD H,$00 RET ; DEVICE VARIABLE TO OUTPUT TO REFERENCED IO PORT ;* OUTPUT &()= ; PUTIO: RST RSTPAR ; GET PORT # ;* Get value of () or storage adrs TSTC '=',PUTCD2 ; GET EQUALS ;* Jump if no match 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 ;* cr. or ; otherwise, WHAT? ; FUNCTION TO RETURN VALUE OF A GIVEN IO PORT ;* INPUT =&() ; IOFUN: RST RSTPAR ;* Get value of () or storage adrs PUSH BC ; GET PORT NUMBA LD B,H LD C,L IN A,(C) LD L,A LD H,$00 POP BC RET ; DEVICE VARIABLE TO PLAY NOTE WITHOUT PRINTING [via MU=] ; PUTMU: TSTC '=',PUTCD2 ;* Equals = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression LD A,L CALL PNOTE ; do Play NOTE tone for key in A RST RSTFIN ;* cr. or ; otherwise, WHAT? ; DEVICE VARIABLE TO OUTPUT CHARACTER ON VDM [via TV=] ; PUTCD: TSTC '=',PUTCD2 ;* Equals = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression LD A,L RST RSTOUT ;* Output Char. in A RST RSTFIN ;* cr. or ; otherwise, WHAT? PUTCD2: JP QWHAT ; ROUTINE TO TRANSFER CONTROL TO ASSEMBLY LANGUAGE SUBROUTINE ;* CALL ; DOCALL: LD HL,BBRET ; PUSH RETURN ADDR ON STACK PUSH HL RST RSTEXP ; GET ADDRESS ;* Evaluate expression JP (HL) ; AND JUMP TO IT ; :RETURN to close off the tape input port ; TCLOSE: CALL INIT0 ; do INITialize interrupts to 0 BBRET: RST RSTFIN ;* cr. or ; otherwise, WHAT? ;* Initialize interrupts ; INIT0: IN A,(SW2) ; $12 for 300 Baud Interface ?? AND $02 JR NZ,INIT0 ; Loop on Down ?? LD (CHMODE),A ; Zero LD A,$1E LD (DEVTEM),A ;* Preset Note Time DI IM 2 LD A,ITAB >> 8 ;* Interrupt Page LD I,A LD A,$08 ; Normal Screen Interrupt only OUT (INMOD),A LD A,ITAB & $FF ; Set TBIINT as Interrupt OUT (INFBK),A ;* Interrupt vector EI RET ; ** TINY BASIC EXECUTION STARTS HERE ** ; CLEAR WHOLE KIT AND KABOOBLE ; ;*********************** ;* Cold Start * ;*********************** ; BEGIN: XOR A OUT (MAGIC),A ; Set up port $0C LD HL,NORMEM LD B,A ; [ab added MAKE SURE SHIFTER FLUSHED code here] BEGIN1: LD (HL),B INC HL LD A,H CP $50 JR NZ,BEGIN1 LD SP,SYSRAM SYSTEM INTPC ;* Start multiple Subr. DO SETOUT DB $80 ;* Display height DB 00101100B ;* Border [$2C or 44] color 0, Left DB $08 ;* Normal interrupts DO EMUSIC ;* Kill sound ; INITIALIZE DEVICE VARIABLES DO SETB ; STORE BYTE (SYSTEM ROUTINE) DB OA2 ; $47 for Dick Answorth notes DW MUZMO ; for Master Oscillator DO FILL ; FILL BYTES (SYSTEM ROUTINE) DW PALCLR ; Base address for Color Palettes DW $0020 ; 32 bytes of color DB $07 ; set all to White DO SETB ; STORE BYTE (SYSTEM ROUTINE) DB $00 ; Black DW PALCLR + 1 ; FOREGROUND COLOR Palette #1 DO SETB ; STORE BYTE (SYSTEM ROUTINE) DB $0C ; Begin at Scanline #12 DW SCNLIN ; Interrupt LINE number DO MOVE ; MOVE BYTES (SYSTEM ROUTINE) DW DEVVAR DW $000A ;* Move 10 bytes from DW INIDEV ;* $2021 to $4E82 DO MOVE ; MOVE BYTES (SYSTEM ROUTINE) DW ALTFON DW $0007 ;* Move 7 bytes from DW FNTSYS ;* $0206 to $4E46 DO SETW ; STORE WORD (SYSTEM ROUTINE) DW $0806 DW ALTFON + 1 ;* Frame height [still] = 8, Char spacing = 6 DO SETW ; STORE WORD (SYSTEM ROUTINE) DW TXT + 4 DW TXTUNF ;* LD (TXTUNF),$4A04 [actual memory location] DO XINTC ;* End multiple Subr. LD HL,TXT + 1 ; TeXT + 1 init to $FF (or -1) End of Program marker LD A,$FF CALL STHL ; STore A by HL [interlaced into TeXT if necessary] RINIT: CALL INIT0 ; do INITialize interrupts to 0 INIT: CALL CRLF ; do display a Carriage Return (and Line Feed) TELL: LD DE,CBASIC ; "COLOR BASIC",cr text CALL PRTSTG ; do PRinT STrinG to TV ; DIRECT COMMAND - TEXT COLLECTOR ; ; STOP command ; STOP: RSTART: LD SP,STACKP ; RANSHT precludes MUZCPU and Counter Timers LD HL,XXST1 + 1 LD (CURRNT),HL XXST1: LD HL,$0000 LD (LOPVAR),HL LD (STKGOS),HL XXST2: LD A,'>' CALL GETLN ; do GET a LiNe PUSH DE LD DE,BUFFER LD A,(DE) CP '>' JR NZ,XXST3 INC DE XXST3: CALL TSTNUM ;* Get possible line number RST RSTIGN ;* Get next non-blank from (DE) LD A,H OR L POP BC ;* BC = end of line JR Z,EXEC0 ;* Direct mode if no line # LD (OLDLN),HL DEC DE ;* Put binary line number in LD A,H ;* front of first significant LD (DE),A ;* character of line in input DEC DE ;* buffer LD A,L LD (DE),A PUSH BC PUSH DE LD A,C SUB E PUSH AF ;* A = # bytes in line CALL FNDLN ;* Find this line in SAVE area PUSH DE ;* DE = adrs JR NZ,XXST4 ;* Jp if not found; insert PUSH DE ;* Found, delete it CALL FNDNXT ;* Find next line POP BC ;* Start adrs of line to delete LD HL,(TXTUNF) ;* End of all text CALL MVUP ;* Move up to delete LD H,B ;* Save new text end address LD L,C LD (TXTUNF),HL XXST4: POP BC ;* Adrs of where to insert LD HL,(TXTUNF) ;* Text end address POP AF ;* Length of new line PUSH HL ;* Save text last adrs. CP $03 ;* Length = 3, delete only JR Z,RSTART ADD A,L ;* Compute new text end LD E,A ;* to DE LD A,$00 ADC A,H LD D,A LD HL,DFTLMT ;* Last possible address EX DE,HL CALL COMP ; do COMPare HL and DE JP NC,QSORRY ;* SORRY if no room LD (TXTUNF),HL ;* Save new text end POP DE ;* Old text end CALL MVDOWN ; do MoVe a block DOWN POP DE ;* New line start POP HL ;* end CALL MVUP ;* Move line to SAVE JR XXST2 ;* Get next line ; DIRECT AND EXEC ;* Direct Execute ; EXEC0: RST RSTIGN ; GET FIRST NONBLANK ;* Get next non-blank from (DE) PUSH DE ; SAVE POINTER CP $68 ; IS SHE A TOKEN? ;* Is this a word? JR C,EXEC0A ; NO CP $77 ;* Yes, sure? [only $75 in bb] JR NC,EXEC0A ;* No, assume implied LET ; WE FOUND A TOKEN - LOOKUP IN TABLE AND JUMP TO IT RLCA LD E,A LD D,$00 LD HL,TOKJT - $D0 ;* Jump table [TOKJT - (2 * $68)] ADD HL,DE LD E,(HL) INC HL LD D,(HL) EX DE,HL POP DE INC DE JP (HL) ;* Go to proper routine ; NOT A TOKEN - A VARIABLE PERHAPS? EXEC0A: CALL TSTV ; TEST FOR VARIABLE ;* Get adrs. of VRBL JR C,EXEC0B ; NO - SEARCH 1 TSTC '=',EXEC0B ;* Equals = Char. to check, Jump if no match POP BC CALL SETV1 ; ASSIGNMENT 1 RST RSTFIN ;* cr. or ; otherwise, WHAT? EXEC0B: POP DE LD HL,TAB2 - 1 EXEC: RST RSTIGN ; EXEC ;* Get next non-blank from (DE) PUSH DE ; SAVE POINTER EX1: LD A,(DE) ; ZAPPED LDE INC DE INC HL CP (HL) JR Z,EX1 LD A,$7F DEC DE CP (HL) JR C,EX3 EX2: INC HL CP (HL) JR NC,EX2 INC HL POP DE JR EXEC EX3: LD A,(HL) ; LOAD HL WITH THE JUMP INC HL ; ADDRESS FROM TABLE LD L,(HL) AND $7F LD H,A POP AF JP (HL) ; CLEAR COMMAND ; ; Clear Screen routine CLRSCR: LD HL,NORMEM PUSH DE LD DE,NORMEM + 1 LD (HL),$00 LD BC,$09FF LDIR ; RESET VDM GOODIES SYSSUK MOVE DW VDMX DW $0006 ; 6 bytes VDM X, VDM Y, OLDXY DW INIVDM ; INIDEV Part 2 to $4E88 POP DE RST RSTFIN ;* cr. or ; otherwise, WHAT? ; RUN routine(s) ; RUN: LD DE,TXT ; RUn NeXt One RUNX1: LD HL,$0000 ;* RST30 Jumps here on cr CALL FNDLP ;* Find next line [starting at Pointer] JP C,RSTART ;* Passed end; quit ; RUN The goSub Line RUNTSL: EX DE,HL LD (CURRNT),HL ;* Set CURRNT to line address EX DE,HL INC DE ;* Bump past line number INC DE ; RUN SaMe Line ;* RST30 Jps to RUNSML on ; RUNSML: CALL WHATSU ; CHECK FOR INTERRUPT KEY JP EXEC0 ;* Continue Same line execution [close enough for JR] ; GOTO routine ; GOTO: RST RSTEXP ;* Evaluate expression PUSH DE ;* Save for error routine CALL FNDLN ;* Find target line JP NZ,AHOW ;* No such line POP AF ;* Clear stack JR RUNTSL ; LIST AND PRINT ; ;* LIST [][,] LISTCOM: LD HL,$0000 ; ASSUME AT EOL ;* Preset to list from beginning RST RSTIGN ;* Get next non-blank from (DE) CALL ZONATNL ; do Zero ON AT NewLine or ; JR Z,LIS1 ;* Jp if ; or cr CP ',' ; LEADING COMMA? ;* Jp if only # lines specified JR Z,LIS1 ; YEP - SKIP FIRST EXPR GET ; NOT AT FIRST - GET FIRST EXPR RST RSTEXP ;* Evaluate expression LIS1: PUSH HL ;* Save line # for start LD HL,$FFFF ;* Set for max number of lines TSTCC COMMA,LIS2 ;* Comma = Char. to check, Jump if no match RST RSTEXP ;* Evaluate expression ;* Get number of lines LIS2: PUSH DE POP IY EX (SP),HL CALL FNDLN ; do FiND HL Line Number in TeXT LIS3: JR C,LSQUIT EX (SP),HL LD A,H OR L JR Z,LSQUIT DEC HL EX (SP),HL CALL PRTLN ; do PRinT Line Number then Space CALL PRTSTG ; do PRinT STrinG to TV CALL WHATSU ; do Check for PAUSE or ABORT keys CALL FNDLP ; do FiND Linenumber starting at Pointer JR LIS3 LSQUIT: PUSH IY POP DE RST RSTFIN ;* cr. or ; otherwise, WHAT? ; PRINT routine ; PRINT: LD C,$08 ; C=# OF SPACES /* Default number of spaces TSTCC $3B,PRT1 ; IF NULL LIST & ";" ;* Jump if no match CALL CRLF ; GIVE CR-LF AND JR RUNSML ; CONTINUE SAME LINE PRT1: TSTCC CR,PRT5 ; IF NULL LIST (CR) ;* Jump if no match CALL CRLF ; GIVE CR-LF AND JR RUNX1 ; CONTINUE SAME LINE PRT2: TSTC '#',PRT3 ; ELSE IS IT FORMAT? ;* Jump if no match RST RSTEXP ; YES, EVALUATE EXPR. LD A,$C0 ;* Limit to 6 bits AND L OR H JP NZ,QHOW LD C,L ; AND SAVE IT IN C JR PRT4 ; LOOK FOR MORE TO PRINT PRT3: CALL QTSTG ; OR IS IT A STRING? JR PRT8 ; IF NOT, MUST BE EXPR. PRT4: TSTCC COMMA,PRT7 ; IF COMMA, GO FIND NEXT ;* Jump if no match PRT5: TSTCC COMMA,PRT6 ;* Comma = Char. to check, Jump if no match LD A,$20 RST RSTOUT ; Output SPACE in A JR PRT5 PRT6: CALL FIN ; IN THE LIST. JR PRT2 ; LIST CONTINUES PRT7: CALL CRLF ; LIST ENDS RST RSTFIN ;* cr. or ; otherwise, WHAT? PRT8: RST RSTEXP ; EVALUATE THE EXPR PUSH BC CALL PRTNUM ; PRINT THE VALUE POP BC JR PRT4 ; Next value [not another 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: CALL PUSHA ; SAVE THE CURRENT "FOR" ;* Save current "FOR" params RST RSTEXP ; PARAMETERS ;* Evaluate expression PUSH DE ; AND TEXT POINTER ;* Save text pointer CALL FNDLN ; FIND THE TARGET LINE ;* Find target line JP NZ,AHOW ; NOT THERE. SAY "HOW?" ;* Not present; 'HOW?' LD HL,(CURRNT) ; SAVE OLD ;* Save everything PUSH HL ; 'CURRENT' OLD 'STKGOS' LD HL,(STKGOS) PUSH HL LD HL,$0000 ; AND LOAD NEW ONES LD (LOPVAR),HL ;* And load it up ADD HL,SP LD (STKGOS),HL JP RUNTSL ; THEN RUN THAT LINE RETURN: LD HL,(STKGOS) ; OLD STACK POINTER ;* Old stack pointer LD A,H ; 0 MEANS NOT EXIST OR L JP Z,QWHAT ; SO, WE SAY: "WHAT?" ;* RETURN with no GOSUB LD SP,HL ; ELSE, RESTORE IT ;* Restore old SP POP HL LD (STKGOS),HL ; AND THE OLD 'STKGOS' ;* And old STKGOS POP HL LD (CURRNT),HL ; AND THE OLD 'CURRNT' ;* And old CURRNT POP DE ;* Get old text pointer CALL POPA ;* Restore old "FOR" params RST RSTFIN ;* cr. or ; otherwise, WHAT? ; ******************************************* ; * ; * *** 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 VARIABLE 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 ;* Save old "FOR" params CALL SETVAL ; SET THE CONTROL VAR. ;* Set control VRBL DEC HL ; HL IS ITS ADDRESS LD (LOPVAR),HL ; SAVE THAT TSTCC $79,FR1 ; TO? - LOOK FOR WORD "TO" ;* "TO" (don't need one) RST RSTEXP ; EVALUATE THE LIMIT FR1: LD (LOPLMT),HL ; SAVE THAT ;* Save limit LD HL,$0001 ;* Preset step of 1 TSTCC $77,FR2 ; STEP? ;* "STEP" (don't need one), Jump if no match RST RSTEXP ;* Evaluate expression FR2: LD (LOPINC),HL ; SAVE THAT TOO ;* Save increment LD HL,(CURRNT) ; SAVE CURRENT LINE # LD (LOPLN),HL ; AND TEXT POINTER ;* Save current line number EX DE,HL LD (LOPPT),HL ;* And current text pointer LD BC,$000A ; DIG INTO STACK TO ;* Dig into stack to find LD HL,(LOPVAR) ; FIND 'LOPVAR' ;* LOPVAR from last EX DE,HL LD H,B LD L,B ; HL=0 NOW ;* HL = 0 ADD HL,SP ; HERE IS THE STACK JR FR4 FR3: ADD HL,BC ; EACH LEVEL IS 10 DEEP ;* Each level is 10 deeper FR4: LD A,(HL) ; GET THAT OLD 'LOPVAR' ;* Get old LOPVAR INC HL OR (HL) JR Z,FR5 ; 0 SAYS NO MORE IN IT ;* Jp if no more LD A,(HL) DEC HL CP D ; SAME AS THIS ONE? ;* Same as this one? JR NZ,FR3 LD A,(HL) ; THE OTHER HALF? ;* Other half also? XOR E JR NZ,FR3 EX DE,HL ; YES, FOUND ONE ;* Yes, found one LD H,A LD L,A ADD HL,SP ; TRY TO MOVE SP ;* Try to move SP LD B,H LD C,L LD HL,$000A ADD HL,DE CALL MVDOWN ; AND PURGE 10 WORDS ;* Purge 10 words LD SP,HL ; IN THE STACK ;* In the stack FR5: LD HL,(LOPPT) ; JOB DONE, RESTORE DE ;* Job done EX DE,HL RST RSTFIN ; AND CONTINUE ;* cr. or ; otherwise, WHAT? NEXT: CALL TSTV ; GET ADDRESS OF VAR. ;* Get adrs. of VRBL JP C,QWHAT ; NO VARIABLE, "WHAT?" ;* None, 'WHAT?' LD (VARNXT),HL ; YES, SAVE IT ;* Save its address NXT1: PUSH DE ; SAVE TEXT POINTER ;* Save text pointer EX DE,HL LD HL,(LOPVAR) ; GET VAR. IN 'FOR' ;* Get VRBL in FOR LD A,H OR L ; 0 SAYS NEVER HAD ONE JP Z,AWHAT ; SO WE ASK: "WHAT?" ;* Never had one CALL COMP ; ELSE WE CHECK THEM ;* Check them for match JR Z,NXT2 ; OK, THEY AGREE ;* Jp if agree POP DE ; NO, LET'S SEE ;* No agree, Purge current CALL POPA ; PURGE CURRENT LOOP ;* loop and pop one level LD HL,(VARNXT) ; AND POP ONE LEVEL JR NXT1 ; GO CHECK AGAIN ;* Try again NXT2: EX DE,HL ; COME HERE WHEN AGREED ;* ;Get value of VRBL to DE LD A,(DE) ; DE=VALUE OF VAR. LD L,A INC DE LD A,(DE) LD H,A EX DE,HL LD HL,(LOPINC) ;* Get increment PUSH HL LD A,H XOR D ; S=SIGN OF DIFFER LD A,D ; A=SIGN OF DE ADD HL,DE ; ADD ONE STEP ;* Add one step JP M,NXT3 ; CANNOT OVERFLOW XOR H ; MAY OVERFLOW JP M,NXT5 ; AND IT DID NXT3: EX DE,HL LD HL,(LOPVAR) ; PUT IT BACK LD A,E CALL STHL ; STore A by HL [interlaced into TeXT if necessary] INC HL ; HL=LIMIT LD A,D CALL STHL ; STore A by HL [interlaced into TeXT if necessary] LD HL,(LOPLMT) ; HL=LIMIT POP AF ; OLD HL OR A ; EXAMINE SIGN BIT JP P,NXT4 ; IF POS SKIP EX DE,HL ;* Step > 0 EX DE,HL ;* Step < 0 NXT4: CALL CKHLDE ; COMPARE WITH LIMIT ;* Compare with limit POP DE ; RESTORE TEST POINTER ;* Restore text pointer JR C,NXT6 ; OUTSIDE LIMIT ;* Outside limit LD HL,(LOPLN) ; WITHIN LIMIT, GO ;* Within limit LD (CURRNT),HL ; BACK TO THE SAVED ;* Put LOPLN in CURRNT LD HL,(LOPPT) ; 'CURRNT' AND TEXT ;* and LOPPT EX DE,HL ; POINTER RST RSTFIN ;* cr. or ; otherwise, WHAT? ; RESTO LINKS IN HERE NXT5: POP HL ; OVERFLOW , PURGE POP DE ; GARBAGE IN STACK NXT6: CALL POPA ; PURGE THIS LOOP RST RSTFIN ;* cr. or ; otherwise, WHAT? ; IF AND REM routines ; REM: LD HL,$0000 ;* Make it false JR IFREM ;* . Comment line IFF: RST RSTEXP ;* Evaluate expression IFREM: LD A,H OR L JP NZ,RUNSML ;* Jp if true CALL FND2 ;* Otherwise skip rest of line JP NC,RUNTSL ;* And run next one JP RSTART ; ********************************************************* ; * ; * *** 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 STRING WILL BE ; * PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. AND ; * SETS 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 INPUT: PUSH DE ; SAVE IN CASE OF ERROR CALL QTSTG ; IS NEXT ITEM A STRING? JR INP4 ; NO INP0: CALL TSTV ; YES, BUT FOLLOWED BY A ;* Get adrs. of VRBL JR C,INP2 ; M6IVARIABLE? NO. INP1: CALL INP6 LD DE,BUFFER ; POINTS TO BUFFER RST RSTEXP ; EVALUATE INPUT POP DE ; OK, GET OLD HL EX DE,HL LD A,E ;* Save value in VRBL CALL STHL ; STore A by HL [interlaced into TeXT if necessary] INC HL LD A,D CALL STHL ; STore A by HL [interlaced into TeXT if necessary] POP HL ; GET OLD 'CURRNT' LD (CURRNT),HL POP DE ; AND OLD TEXT POINTER INP2: POP AF ; PURGE JUNK IN STACK TSTCC COMMA,INP3 JR INPUT ; YES, MORE ITEMS. INP3: RST RSTFIN ;* cr. or ; otherwise, WHAT? INP4: PUSH DE ; SAVE FOR 'PRTSTG' CALL TSTV ; MUST BE VARIABLE NOT ;* Get adrs. of VRBL JR NC,INP5 ;* OK [became JP C,QWHAT in ab] JP QWHAT ; "WHAT?" IT IS NOT? INP5: LD B,E POP DE CALL PRTCHS ; PRINT THOSE AS PROMPT JR INP1 ; YES, INPUT VARIABLE INP6: POP BC ; RETURN ADDRESS PUSH DE ; SAVE TEXT POINTER ;* Save in case of error EX DE,HL LD HL,(CURRNT) ; ALSO SAVE 'CURRNT' PUSH HL LD HL,INPUT ; A NEGATIVE NUMBER LD (CURRNT),HL ; AS A FLAG LD HL,$0000 ; SAVE SP TOO ADD HL,SP LD (STKINP),HL PUSH DE ; OLD HL PUSH BC LD A,' ' ;* Space after VRBL JP GETLN ; AND GET A LINE ENDCHK: LD A,(DE) ;* End of list 1 [or DEFLT: ??] CP CR ;* Empty link is OK JR Z,INP3 JP QWHAT ;* Else 'WHAT?' ; ********************************************* ; * ; * *** EXPR *** ; * ; * 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS. ; * ::= ; * ; * WHERE IS ONE OF THE OPERATORS IN TAB6 AND THE RESULT ; * OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE. ; * ; * ::=(+ OR -)(+ OR -)(...) ; * WHERE () ARE OPTIONAL AND (...) ARE OPTIONAL REPEATS. ; * ; * ::=<(<* OR />)(...) ; * ; * ::= ; * ; * () ; * ; * IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN ; * AS INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND ; * CAN BE AN IN PARENTHESES. ; EXPR: CALL EXPR1 ; *** EXPR *** PUSH HL ; SAVE 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. ;* - end of list 3 RET ; RETURN HL= 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 EX DE,HL ; VALUE IN DE NOW EX (SP),HL ; 1ST IN HL CALL CKHLDE ; COMPARE 1ST WITH 2ND POP DE ; RESTORE TEXT POINTER LD HL,$0000 ; SET HL=0, A=1 LD A,$01 RET EXPR1: TSTC '-',XP11 ; NEGATIVE SIGN? LD HL,$0000 ; YES, FAKE "0-" JR XP16 ; TREAT LIKE SUBTRACT ;* Fake "0-x" XP11: TSTC '+',XP12 ; POSITIVE SIGN? IGNORE ;* Ignore leading + XP12: CALL EXPR2 ; 1ST XP13: TSTC '+',XP15 ; ADD? PUSH HL ; YES, SAVE VALUE CALL EXPR2 ; GET 2ND 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 ;* Jp if signs different XOR H ; 1ST 2ND SIGN EQUAL ;* Signs alike JP P,XP13 ; SO IS RESULT JP QHOW ; ELSE WE HAVE OVERFLOWN XP15: TSTC '-',XPR9 ; SUBTRACT? XP16: PUSH HL ; YES, SAVE 1ST CALL EXPR2 ; GET 2ND CALL CHGSGN ; NEGATE JR XP14 ; AND ADD THEM EXPR2: CALL EXPR3 ; GET 1ST XP21: TSTCC $62,XP24 ; MULTIPLY? PUSH HL ; YES, SAVE 1ST CALL EXPR3 ; AND GET 2ND LD B,$00 ; CLEAR B FOR SIGN CALL CHKSGN ; CHECK SIGN EX (SP),HL ; 1ST IN HL CALL CHKSGN ; CHECK SIGN OF 1ST EX DE,HL ;* 2nd in DE EX (SP),HL ;* Get back 1st LD A,H ; IS HL > 255? OR A JR Z,XP22 ; NO ;* Jp if HL <255 LD A,D ; YES, HOW ABOUT DE OR D EX DE,HL ; PUT SMALLER IN DE JP NZ,AHOW ; ALSO >, WILL OVERFLOW ;* Jp if DE >255 (will overflow) XP22: LD A,L ; THIS IS DUMB LD HL,$0000 ; CLEAR RESULT OR A ; ADD AND COUNT JR Z,XP25 ;* Done XP23: ADD HL,DE JP C,AHOW ; OVERFLOW DEC A JR NZ,XP23 ;* Continue multiply JR XP25 ; FINISHED XP24: TSTCC $63,XPR9 ; DIVIDE? ;* Jump if no match PUSH HL ; YES, SAVE 1ST CALL EXPR3 ; AND GET 2ND ONE LD B,$00 ; 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 ;* End of list 2 JR C,XP32 ; NOR A VARIABLE ;* Is it a variable? No EX DE,HL ;* Yes, a variable LD A,(DE) PUSH AF INC DE LD A,(DE) EX DE,HL LD H,A ;* Get VRBL value to HL 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 '"',XPR9 ; HAVE WE GOT QUOTES? ;* Get one byte ASCII input LD A,(DE) ; NAILED RSTLDE [instead of using RST RSTLDE ??] LD L,A ; FAILED TSTNUM SET H TO ZERO INC DE TSTC '"',XPR9 ; ERROR IF NO TRAILING RET ; ***** ; * ; PARN: TSTC '(',XPRO ; NO DIGIT, MUST BE RST RSTEXP ; "(EXPR)" ;* Evaluate expression TSTC ')',XPRO XPR9: RET XPRO: JP QWHAT ; ELSE SAY: "WHAT?" ; *** RND(EXOR) *** ; RND: RST RSTPAR ; *** RND(EXOR) *** ;* Get value of () or storage adrs LD A,H ; EXPR MUST BE + OR A JP M,QHOW ;* Bad if - OR L JP Z,QHOW ;* or if 0 PUSH DE ; SAVE BOTH EX DE,HL ; DE = RANGE XOR A SYSTEM RANGED ; Get Random Number LD L,A XOR A SYSTEM RANGED ; Get Random Number LD H,A ; HL = RANDOM # PUSH BC CALL DIVIDE ; RND(N)=MOD(M,N)+1 POP BC POP DE INC HL RET ABS: RST RSTPAR ; *** ABS(EXPR) *** ;* Get value of () or storage adrs 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,$1B CALL CHKRNG ; GET DATA CPL SUB $80 LD L,A ; FALL INTO... ; SIGN EXTEND SUBROUTINE SGNEXT: LD H,$00 LD A,L AND A RET P DEC H RET ; FUNCTION TO SENSE STATE OF TRIGGER ; GETTRG: CALL CHKRN1 ; do CHecK RaNge is 1-4 AND $10 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 ; do CHecK RaNge is 1-4 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,$0F CHKRNG: PUSH BC PUSH AF RST RSTPAR ;* Get value of () or storage adrs POP AF ADD A,L LD C,A IN A,(C) POP BC LD HL,$0000 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,$00 CALL DV1 LD B,C ; SAVE RESULT IN B LD A,L ; (REMAINDER + L)/DE POP HL LD H,A DV1: LD C,$FF ; RESULT IN C [initialize to -1] DV2: INC C ; DUMB ROUTINE AND A SBC HL,DE JR NC,DV2 ADD HL,DE RET CHKSGN: LD A,H ; *** CHKSGN *** ;* Check sign of HL OR A ; CHECK SIGN OF HL RET P ; IF -, CHANGE SIGN ;* Leave if + CHGSGN: LD A,H ; *** CHGSGN *** ;* Change sign of HL OR L RET Z ;* +0 stays the same LD A,H ;* Change sign PUSH AF CPL ; CHANGE SIGN OF HL LD H,A LD A,L CPL LD L,A INC HL POP AF XOR H JP P,QHOW LD A,B ; AND ALSO FLIP B ;* Also flip sign of B XOR $80 LD B,A RET CKHLDE: LD A,H ; *** CKHLDE *** XOR D ; SAME SIGN? JP P,CK1 ; YES, COMPARE ;* Jp if same sign EX DE,HL ; NO, XCH AND COMPARE ;* Exchange CK1: CALL COMP ;* Compare RET ;* COMPare HL and DE ;* Z if HL = DE ;* C if HL < DE COMP: LD A,H ; *** COMP *** CP D ; COMPARE HL WITH DE RET NZ ; RETURN CORRECT C AND LD A,L ; ZFLAGS CP 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.) [up with 'INPUT' ??] ; * ; * 'ERROR' PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). IT THEN ; * PRINTS THE LINE POINTED BY 'CURRNT' 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 GETS MESSAGE "WHAT?". 'AWHAT' JUST GETS MESSAGE "WHAT?" ; * AND JUMPS TO 'ERROR'. 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING. ; * 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS. ; SETVAL: CALL TSTVFF ; *** SETVAL *** ;* Get adrs. of VRBL TSTC '=',QWHAT ; "WHAT?" NO VARIABLE ;* Jump if no match SETV1: PUSH HL ; SAVE ADDRESS OF VAR. RST RSTEXP ; EVALUATE EXPR. LD B,H LD C,L ;* Value now in BC POP HL ;* Get address PUSH AF LD A,C CALL STHL ;* Place into VRBL [interlaced into TeXT if necessary] INC HL LD A,B CALL STHL ; STore A by HL [interlaced into TeXT if necessary] POP AF RET FINISH: CALL FIN ; CHECK END OF COMMAND ;* RST30 after POP AF JR QWHAT ; PRINT "WHAT?" IF WRONG FIN: TSTCC $3B,FIN1 ; *** FIN *** ;* Semicolon, Jump if no match POP AF ; ";", PURGE RET ADDR. JP RUNSML ; CONTINUE SAME LINE FIN1: TSTCC CR,FNDX ; NOT ";", IS IT CR? ;* $0D, Jump if no match POP AF ; PURGE RETURN ADDRESS JP RUNX1 IGNBLK: LD A,(DE) ; *** IGNBLK *** ;* RST20 [not RST#0] CP ' ' ; IGNORE BLANKS $20 RET NZ ; IN TEXT (WHERE DE->) INC DE ; AND RETURN THE FIRST JR IGNBLK ; NON-BLANK CHAR. IN A QWHAT: PUSH DE ; *** QWHAT *** AWHAT: LD DE,WHAT ; *** AWHAT *** ERROR: CALL CRLF ; *** ERROR *** CALL PRTSTG ; PRINT ERROR MESSAGE LD HL,(CURRNT) ; GET CURRENT LINE # ;* Current line pointer PUSH HL ;* Save it EX DE,HL ; CHECK THE VALUE LD A,(DE) ;* Get character in text LD H,A INC DE LD A,(DE) OR H EX DE,HL POP DE ;* Set DE to line # JP Z,TELL ; IF ZERO, JUST RESTART ;* If 0, just restart EX DE,HL ; IF NEGATIVE ;* Get first digit LD A,(DE) EX DE,HL OR A JP M,INPERR ; REDO INPUT ;* If negative, redo input CALL PRTLN ; ELSE PRINT THE LINE Number then Space POP BC ; HL=ERROR ADDR LD B,C CALL PRTCHS LD A,'?' RST RSTOUT ; Output $3F Question Mark in A 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 LINE # IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & ; * NZ. IF WE REACHED THE END OF TEXT SAVE AREA AND CANNOT 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 #. 'FNDNXT' 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? LD A,(DE) LD C,A DEC DE ADD A,A RET C LD A,(DE) ; 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,FND1 ; NO, NOT THERE YET) DEC DE ; ELSE WE EITHER FOUND OR B ; IT, OR IT IS NOT THERE FNDX: RET ; NC,Z: FOUND; NC,NZ: NO FNDNXT: INC DE ; FIND NEXT LINE FND1: INC DE ; JUST PASSED BYTE FND2: LD A,(DE) ;* Try to find cr CP CR ; HIT A CR YET? JR NZ,FND1 ; NO SIR EEE INC DE JR FNDLP ; REENTER FIND LOOP ; *** TSTV *** ;* Get VRBL storage adrs. ; TSTV: RST RSTIGN ;* Get next non-blank from (DE) CP '%' ; PEEK-POKE? JR Z,TSTV1 SUB '@' ; TEST VARIABLE RET C ; C: NOT A VARIABLE JR NZ,TSTV2 ; NOT "@" ARRAY ; [ab calls as GRAB AND VERIFY SUBSCRIPT routine here ??] INC DE ; SKIP DA NAME RST RSTPAR ; GET THE PARM ;* Get value of () or storage adrs 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 ; do COMPare HL and DE JR C,ASORRY ; APOLOGIZE FOR RANGE ERR ; LD HL,(TXTUNF) DEC HL DEC HL ADD HL,DE POP DE RET ; does %(ADDR) PEEK-POKE CALL here ; TSTV1: INC DE RST RSTPAR ; GET ADDR ;* Get value of () or storage adrs XOR A ; CLEAR CY RET ; AND GO BACK TSTV2: CP $1B ; 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,$1A 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,$00 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. ; ;**************************************** ;* RST8 TSTCH * ;**************************************** ; TSTCH: EX (SP),HL ; *** TSTCH *** ;* Get (caller+1) RST RSTIGN ; IGNORE LEADING BLANKS ;* Get next non-blank from (DE) CP (HL) ; AND TEST THE CHARACTER ;* Same? INC HL ; COMPARE THE BYTE THAT ;* Next location JR Z,TCH1 ; FOLLOWS THE CALL INTS. ;* Match! PUSH BC ; WITH TEXT (DE->) LD C,(HL) ; IF NOT =, ADD THE 2ND ;* Get # of bytes to skip LD B,$00 ; BYTE THAT FOLLOWS THE ADD HL,BC ; CALL TO THE OLD PC ;* Increment past POP BC ; I.E., DO A RELATIVE DEC DE ; JUMP IF NOT = ;* Stay stuck on non-match TCH1: INC DE ; IF =, SKIP THOSE BYTES ;* Next char. INC HL ; AND CONTINUE ;* Bump past # bytes EX (SP),HL ;* Put return back on stack RET TSTNUM: LD HL,$0000 ; *** TSTNUM *** LD B,H ; TEST IF THE TEXT IS RST RSTIGN ; A NUMBER ;* Get next non-blank from (DE) TNM1: CP '0' ; IF NOT, RETURN 0 IN RET C ; B AND HL CP ':' ; IF NUMBERS, CONVERT RET NC ; TO BINARY IN HL AND LD A,$F0 ; 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 $0F ; CODE ADD A,L LD L,A LD A,$00 ADC A,H LD H,A POP BC LD A,(DE) ; DO THIS DIGIT AFTER JP P,TNM1 ; 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 *** ; do COMPare HL and DE RET Z ; DE=HL, RETURN LD A,(DE) ; GET ONE BYTE PUSH HL ; SHOVEL REGS LD H,B LD L,C CALL STHL ; MOVE IT [interlaced into TeXT if necessary] POP HL INC DE ; INCREASE BOTH POINTERS INC BC JR MVUP ; UNTIL DONE MVDOWN: LD A,B ; *** MVDOWN *** SUB D ; TEST IF DE = BC JP NZ,MVD1 ; NO, GO MOVE LD A,C ; MAYBE, OTHER BYTE SUB E RET Z ; YES, RETURN MVD1: DEC DE ; ELSE MOVE A BYTE DEC HL ; BUT FIRST DECREASE LD A,(DE) ; BOTH PTRS AND THEN CALL STHL ; DO IT [interlaced into TeXT if necessary] 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 JP Z,PPAX ; 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 PPAX: PUSH BC ; BC = RETURN ADDR. RET PUSHA: LD HL,STKLMT ; *** PUSHA *** CALL CHGSGN ; do CHanGe SiGN of HL 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 JP Z,PUAX 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) PUAX: PUSH HL PUSH BC ; BC = RETURN ADDR. RET ; * *** PRTSTG *** QTSTG *** PRTNUM *** AND PRTLN *** ; * ; * 'PRTSTG' 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 INCLUDED IN COUNT. POSITIVE SIGN IS NOT. ; * ; * 'PRTLN' FINDS A SAVED LINE, PRINTS THE LINE # AND A SPACE. ; PRTSTG: SUB A ; *** PRTSTG *** PTS1: LD B,A PTS2: LD A,(DE) ; GET A CHARACTER INC DE ; BUMP POINTER CP B ; SAME AS OLD A RET Z ; YES, RETURN RST RSTOUT ; ELSE PRINT IT ;* Output Char. in A CP CR ; WAS IT A CR? JR NZ,PTS2 ; NO - NEXT RET ; YES-RETURN QTSTG: TSTCC $22,QTS2 ;* Char. to check; Jump bias if no match LD A,$22 ; IF DOUBLE QUOTE-PRINT IT QTS1: CALL PTS1 ; PRINT UNTIL ANOTHER CP CR ; WAS LAST ONE A CR? POP HL ; RETURN ADDRESS JP Z,RUNX1 ; WAS CR, END OF THIS INC HL ; SKIP 2 BYTES, THEN RET INC HL JP (HL) QTS2: TSTCC $27,QTS3 ;* Char. to check; Jump bias if no match LD A,$27 ; OR IF SINGLE JR QTS1 ; LIKEWIZE QTS3: RET PRTCHS: LD A,E CP B RET Z LD A,(DE) RST RSTOUT ;* Output Char. in A INC DE JR PRTCHS ; *** PRTNUM *** ; PRTNUM: LD B,$00 ; B=SIGN CALL CHKSGN ; CHECK SIGN JP P,PTN1 ; NO SIGN LD B,'-' ; B=SIGN DEC C ; '-' TAKES SPACE PTN1: PUSH DE LD DE,$000A PUSH DE DEC C PUSH BC PTN2: CALL DIVIDE ; DIV HL BY 10 LD A,B ; RESULT 0 OR C JP Z,PTN3 ; 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 PTN2 ; AND DIV BY 10 PTN3: POP BC ; WE GOT ALL DIGITS IN PTN4: DEC C ; THE STACK LD A,C ; IF SPACE COUNT NEG OR A JP M,PTN5 ; NO LEADING BLANKS LD A,' ' RST RSTOUT ; SPACE OUTCH ;* Output Space JR PTN4 ; MORE? PTN5: LD A,B ; PRINT SIGN OR A CALL NZ,OUTC ; MAYBE - OR NULL LD E,L ; LAST REMAINDER IN E PTN6: LD A,E ; CHECK DIGIT IN E CP $0A ; 10 IS FLAG FOR NO MORE POP DE RET Z ; IF SO RETURN ADD A,'0' RST RSTOUT ; AND PRINT THE DIGIT ;* Output Char. in A JR PTN6 ; GO BACK FOR MORE PRTLN: LD A,(DE) ; *** PRTLN*** LD L,A ; LOW ORDER LINE # INC DE LD A,(DE) ; HIGH ORDER LD H,A INC DE LD C,$04 ; PRINT 4 DIGIT [minimum] LINE # CALL PRTNUM ; do PRinT NUMber in HL LD A,' ' ; FOLLOWED BY BLANK RST RSTOUT ; Output SPACE in A RET ; Tables for some COMMANDS, FUNCTIONS, and RELATIVE OPERATIONS TAB2: ITEM 'TV',PUTCD ; DIRECT-STATEMENT ITEM 'MU',PUTMU ITEM '&',PUTIO ITEM 'CALL',DOCALL ITEM '.',REM ; [Note: ITEM '$',DOLLAR for Calculator routine has been deleted] DB ':' TOKEN $68,TVLIST ; on :LIST DB ':' TOKEN $74,TOUTPU ; on :PRINT DB ':' TOKEN $73,TINPUT ; on :INPUT DB ':' TOKEN $6A,TLOAD ; on :RUN DB ':' TOKEN $70,TCLOSE ; on :RETURN DB '*' TOKEN $74,POUTPU ; on *PRINT ITEM 'STOP',STOP DEFF ENDCHK ; [or DEFLT ?? ab just uses FINISH ??] ;* End list 1 ; ;* FUNCTIONS ; TAB3: TOKEN $78,RND ; Input 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 ;* End list 2 TAB6: ITEM '>=',XPR1 ; RELATION OPS ITEM '#',XPR2 ITEM '>',XPR3 ITEM '=',XPR5 ITEM '<=',XPR4 ITEM '<',XPR6 DEFF XPR7 RANEND EQU $ ;* End list 3 ; more routines here ; ;* Output A and input into BUFFER GETLN: LD DE,BUFFER ; *** GET a LiNe *** GL1: RST RSTOUT ; PROMPT OR ECHO ;* Output Char. in A GL2: PUSH BC PUSH DE PUSH HL ; PLACE UP CURSOR BLOCK LD C,$55 ; [bb AND ab $AA] CALL CURSE ; do Draw CURSor ; 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 $05 JR NZ,GL2B ; JUMP IF NOT ; GET PREVIOUS LINE # AND BUMP IT LD HL,(OLDLN) LD DE,$000A ADD HL,DE RES 7,H ; ALLOW NEG LD (NLLNLN),HL ; MOVE TO WORKING RAM CELL ; COMPUTE DIVISION SUBTRACTOR GL2B: SYSSUK INDEXW ;* Get $2F0F+(A*2) DW TBLDIV - 2 ;* to DE LD HL,(NLLNLN) LD B,$00 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 ; SET NONZERO FLAG JR GL2D ; NOTHIN FANCY GL2C: CALL CHKIO ; GET NORMAL CHARACTER from keyboard GL2D: POP HL POP DE POP BC LD (DE),A ; STUFF CHAR AS DELIMITER CP RUBOUT JR NZ,GL4 ;* Jp if not ERASE LD A,E CP BUFFER & $00FF JR Z,GL2 ;* Jp if at beginning DEC DE LD A,(DE) CP $68 ; TOKEN TO RUB OUT? JR NC,TOKIN CALL PNOTE ; do Play NOTE tone for key in A LD A,RUBOUT JR GL1 TOKIN: PUSH DE CALL TOKEPT ; do TOKEn PoinTer returned in HL TOKER: LD A,(HL) PUSH HL AND $7F CALL PNOTE ; do Play NOTE tone for key in A LD A,$1F CALL VDM ; do Virtual Display Monitor output POP HL LD A,(HL) INC HL RLCA JR NC,TOKER TOKEQ: LD A,RUBOUT ; [label not needed] RST RSTOUT ; ECHO ONE RUBOUT CHAR ;* Output Char. in A POP DE GL3: JP GL2 GL4: CP CR JP Z,GL5 LD A,E CP BUFEND & $00FF JR Z,GL3 LD A,(DE) INC DE JP GL1 GL5: INC DE INC DE LD A,$FF LD (DE),A DEC DE CRLF: LD A,CR ; Carriage Return (and Line Feed) ; SUBROUTINE TO OUTPUT A CHARACTER [to ??] [?? how is this different from OUTCH ??] ; ;* OUTC (RST $18) ; OUTC: PUSH HL PUSH DE PUSH BC PUSH AF LD D,A ;* Save the character LD A,(CHMODE) CP $06 JR Z,OUTX1 ;* Jp if not *PRINT AND $02 JR Z,OUTX2 ;* Jp if not :PRINT OUT1: LD C,D RLC C OUT2: IN A,(SW2) ; $12 for 300 Baud Interface ?? AND $02 JR Z,OUT2 ;* Wait for clock high [on down ??] LD B,$0A ;* Do 10 bits OUT3: LD A,$C0 OUT4: DEC A JR NZ,OUT4 ;* Give clock some time DEC B ;* Count output bits JR Z,OUTX2 IN A,(SW2) LD E,A OUT5: IN A,(SW2) XOR E AND $02 JR Z,OUT5 LD A,E XOR C AND $02 JR Z,OUT6 IN A,(SW2) OUT6: SET 1,C RRC C JR OUT3 OUTX1: LD A,D ;* *PRINT process CP $68 JR C,OUT1 ;* Jp if not word OUTX2: LD A,D CALL VDM ; do Virtual Display Monitor output POP AF POP BC POP DE POP HL RET ; SUBROUTINE TO SIMULATE A CHARACTER DISPLAY IN THE ARCADE ; FRAME BUFFER. THE SIMULATED VDM [Virtual Display Monitor] ; 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 SET ; IS USED. ; OUTCH: LD L,A LD A,(CHMODE) CP $06 LD A,L JR Z,OUTC ; SOME FUNNY GUYS ENTER HERE VDM: CP CR JR Z,VDMOCR CP RUBOUT ; TRANSLATE TRASH TO ? JR Z,VDM1 JR C,FILT1 CP $7A JR C,FILT2 FILT1: LD A,'?' FILT2: CP $68 ; TOKEN TO PRINT? JR NC,TOKEP ; JUMP IF SO ; PLAY NOTE FOR THIS CHAR CALL PNOTE ; do Play NOTE tone for key in A ; NON NEW LINE CHAR - UNWRITE OLD CURSOR VDM1: CALL UCURSE ; do Undraw CURSor CALL LDVDMC ; do LoaD VDM Coordinates 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 $06 ; NO - BACKUP X LD L,A JR VDMDN1 ; AND JOIN STORE BACK VDM2: LD L,$96 LD A,H SUB $08 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,A ; [NEW for Color Basic ??] LD A,(DEVCL1) ; Foreground Color AND $03 ; MODulo 4 RLC A RLC A ; Move to ON Color position LD C,A LD A,(DEVCL0) ; Background Color AND $03 ; MODulo 4 OR C OR $10 LD C,A ; WRITE THE CHAR as - 0001fcbc LD A,D LD D,H ; COORDINATES TO DE LD E,L LD IX,ALTFON ; USING ALTERNATE CHAR FONT SYSTEM CHRDIS ; IT ;* Display Character LD A,L ; ADVANCE X POINTER ;* Skip a space ADD A,6 LD L,A CP $9C ; END OF LINE? JR NZ,VDMDN1 ; NO - JUMP CALL NEWLIN ; YES - NEW 1 LINE LD A,$01 ; AND SET NEW LINE FORCED FLAG JR VDMDN2 VDMDN1: CALL STVDMC ; do STore VDM Coordinates VDMDON: XOR A ; CLEAR NEW LINE FORCED FLAG VDMDN2: LD (VDMNLF),A RET ; ROUTINE TO DISPLAY A TOKEN IN FULL FORM ; TOKEP: CALL TOKEPT ; do TOKEn PoinTer returned in HL TOKEP1: LD A,(HL) AND $7F PUSH HL CALL OUTCH ; do OUTput CHaracter in A POP HL LD A,(HL) INC HL RLCA JR NC,TOKEP1 LD A,' ' ; PUT SPACE AFTER TOKEN JP OUTCH ; AND GO HOME via OUTput CHaracter ; SUBROUTINE TO UNWRITE THE CURSOR ; UCURSE: LD C,$00 JR CURSE ; do Draw CURSor in Color 0 ; SUBROUTINE TO DISPLAY NEW LINE ; NEWLIN: CALL LDVDMC ; do LoaD VDM Coordinates ; IS SCROLL UP NEEDED? LD L,$00 LD A,H CP $38 ; [bb and ab use $50] JR NZ,NEWL1 ; JUMP IF NOT NEEDED ; SCROLL UP IS NEEDED CALL STVDMC ; do STore VDM Coordinates ; COLOR BASIC [non-interlaced] SCROLL MODE PUSH HL LD HL,NORMEM + $08*BYTEPL LD DE,NORMEM LD BC,$38 * BYTEPL LDIR ; Snap Scroll Up LD HL,NORMEM + $38*BYTEPL LD (HL),$00 LD DE,NORMEM + $38*BYTEPL + 1 LD BC,$08*BYTEPL - 1 LDIR ; Clear Bottom Line POP HL RET NEWL1: ADD A,$08 LD H,A CALL STVDMC ; do STore VDM Coordinates RET ; SUBROUTINE TO PAINT CURSOR ; C = DATA TO PAINT 00 OR AA ; CURSE: PUSH AF ;* Get CY/CX to HL CALL LDVDMC ; do LoaD VDM Coordinates EX DE,HL XOR A SYSTEM RELAB1 ;* Subroutine 58 OUT (MAGIC),A EX DE,HL LD A,C LD BC,$0806 CALL BOXPUT ; do draw a BOX PUT on screen POP AF RET CHKIO: ; Read a character from keyboard or cassette tape SENWAI: LD A,(CHMODE) ;* I/O flag DEC A JR NZ,XCHKIO ;* Not 1 = KBD input CALL KEYSCN ;* 1 = TAP input, chk for abort JP NZ,RINIT ;* Abort, start over LD HL,(TAPINS) ;* Get tape input buffer pointer LD A,H ;* Get extract pointer CP L JR Z,SENWAI ;* No data yet LD L,A LD H,TAPBUF >> 8 ; $4Exx LD C,(HL) ;* Get tape data CALL RAMPIT ; do Increment Tape Buffer pointer LD (TAPEXT),A ;* Update extract pointer LD A,C ;* Get byte RET ; Old KEYBOARD HANDLER ; No SHIFT KEY ROLLOVER ; XCHKIO: CALL KEYSCN ; MAKE SURE PREVIOUS KEY RELEASED ;* Get keyboard data JR NZ,XCHKIO ;* Wait till no key change ; AWAIT DEBOUNCE TIMER COUNTDOWN LD HL,KEYTMR LD (HL),$06 ; SET IT ;* Set key release timer LOOPER: LD A,(HL) AND A JR NZ,LOOPER ;* Wait for timer to expire ; SAVE BACKGROUND COLOR LD A,(DEVCL0) ;* Get BC 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,$FFEB ; (-21) ** SIZE OF LOOKUP TABLE ;* 20 keys+color LD BC,$0414 GETK2: IN A,(C) ; INPUT FROM PORT ;* Get shift key AND $20 ; SHIFT KEY DOWN? JR NZ,GETK3 ; JUMP IF YEP ;* Got one ADD HL,DE ; ELSE TO NEXT TABLE ;* Back up to previous table INC C ; AND PORT ;* Next port DJNZ GETK2 ;* Do all 4 ports ; NO SHIFT KEY IS DOWN - USE WHATEVER WE HAD BEFORE POP HL ;* Get current no-shift address JR GETK5 ; A SHIFT KEY IS DOWN - SAME OLD STORY? GETK3: POP DE ; DISCARD OLD BELIEFS ;* Clear stack LD A,(DEVCL0) ; SET NEW COLOR ;* Get BC CP (HL) JR Z,GETK4 ;* Jp if same as desired LD A,(HL) ;* Get desired BC LD (DEVCL0),A ;* Save it CALL CLICK ; do short Click GETK4: INC HL ; SKIP COLOR BYTE ;* Point to keys ; NOW SCAN FOR ANY 'NORMAL' KEY DEPRESSION GETK5: CALL KEYSCN ;* Get input ;* Not there, allow different shift key JR Z,GETK1 ; JUMP IF NO KEY DOWN ; WE GOT ONE - CONVERT TO ASCII DEC A ; BY TABLE LOOKUP ;* Back to keys 0-23 LD C,A LD B,$00 ADD HL,BC ;* Point to conversion POP AF ; RESTORE COLOR ;* Get original BC LD (DEVCL0),A ;* Reset it LD A,(HL) ; GET CODE ;* Get key conversion AND A ; A HLT PERCHANCE? JR Z,INIJMP ; YEP - RESET ;* Restart if no code CP $01 ; AN ERROR? JP Z,CHKIO ; YEP - GO DOIT AGAIN ;* Meaningless key ; GOOD KEY... PUSH AF ;* Save key code CP NLLN JR NC,CHKI02 ;* Jp if word SYSSUK INDEXB ; HL + A [not loaded!] to HL DW DICKY + 7 ; Offset past DICKS MUSIC SYSTEM NOTE LOOKUP TABLE INC A JR NZ,CHKI02 CALL CLICK ; do Click if $FF (GO,ERASE,+,-,0,x,divide) CHKI02: POP AF ;* Regain converted key CP NLLN ;* Was it GO+10 ? RET NZ LD HL,$0005 ;* Yes LD (NLLNCT),HL ; SET FLAG AND ZERO SUPPRESS LD A,$0D ; PASS BACK CR AS FIRST CHAR ;* Return a CR RET ; Old CLICK ROUTINE ; CLICK: LD A,(NEWTMR) ;* Wait for current note to finish AND A JR NZ,CLICK ; Finish Previous Note LD A,G0 ; $FD or 253 (not "GO") LD (MUZTON),A LD A,(DEVTEM) ;* Get note time AND A RET Z ; Silence if Tempo = 0 LD A,$01 ;* 1 beat delay LD (NEWTMR),A ; Short Click RET ; SUBROUTINE TO CHECK FOR HLT KEY WHILE PGM RUNNING ;* Check for PAUSE or ABORT ; WHATSU: PUSH BC PUSH DE CALL KEYSCN ; GET KEY CODE ;* Get calculator input SUB $02 ; FREEZE? ;* Was it PAUSE? JR Z,FRZKEY ;* Yes DEC A JR Z,INIJMP ;* Jp if HALT JR FRZGBK ; ELSE GO BACK TO CALLER ;* Else leave ;* PAUSE: wait for another key FRZKEY: CALL KEYSCN ; SCAN FOR NONZERO KEY TO REL JR Z,FRZKEY CP $03 ; HLT NAILED? ;* Was it another HALT INIJMP: JP Z,INIT ;* Yes, restart FRZGBK: POP DE POP BC RET ; SUBROUTINE TO SCAN TINY BASIC KEYBOARD ;* KEYPAD INPUT (all but shift) ; KEYSCN: LD BC,$0414 ; B = CNT, C = PORT # LD DE,KEYTRK ; DE = KEYBOARD MEMORY XOR A SYSTEM RANGED ;* Random number KYSCN1: IN A,(C) ; LOOK AT COLUMN ;* Raw key number AND $1F ; ISOLATE THE RELEVANT JR NZ,KYSCN2 ; JUMP IF BITS HIGH ;* Got one INC C ; BUMP PORT # ;* Next port DJNZ KYSCN1 ;* Do all input ports XOR A ; SET ZERO STATUS LD (DE),A ; NOTHIN - SAY ZIP ;* Set last key = 0 RET ;* and leave ; DEPRESSION FOUND - JUMP UP AND DOWN KYSCN2: DEC B LD C,$00 ; 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 ;* Keys 1-24 LD B,A LD A,(DE) XOR B RET Z ; QUIT IF THE SAME ;* Leave if same as last time LD A,B ;* Save new value LD (DE),A ; ELSE UPDATE TRACKER RET ;* and leave ; SUBROUTINE TO PLAY A NOTE ;* NOTE OUTPUT ; 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 CP $63 JR Z,PNOTDV ; Down an octave on Divide sign CP $62 JR Z,PNOTML ; Up an octave on Multiply sign CP '+' JR Z,PNOTPL ; Sharp next note +1 through +7 CP '-' JR Z,PNOTMN ; Flat next note -1 through -7 CP '0' JR Z,PNOTZ ; to Play Note Zero LD HL,DICKY + 7 ; Offset past DICKS MUSIC SYSTEM NOTE LOOKUP TABLE ; Tone STORe routine by A from table at HL ;* HL+A to HL TSTOR: SYSTEM INDEXB ; INDEX BYTE (SYSTEM SUBROUTINE) INC A JR Z,PNOTCL ; on $FF - for CR aka GO ;* -1 is no sound INC A JR Z,ANSW ; on $FE - Play Notes 1 thru 7 ;* -2 is number key DEC A DEC A LD (MUZTON),A ;* Save next note LD A,(DEVTEM) LD (NEWTMR),A PNOTCL: XOR A ; Clear SHARPF ;* Set for normal notes PSHARP: LD (SHARPF),A LINKB: POP AF POP DE POP HL RET PNOTDV: LD A,OA1 MSTOR: LD (MUZMO),A ; Master oscillator STORe ;* Set master sound divider JR LINKB PNOTML: LD A,OA3 JR MSTOR PNOTPL: LD A,$01 ;* Set for sharps DB $11 ; does a LD DE,$023E ;* Skips 2 bytes PNOTMN: DB $3E ; does a LD A,$02 ;* Set for flats DB $02 JR PSHARP ; save as SHARPF PNOTZ: LD HL,MUZTMR ; Play NOTe Zero routine LD A,(DEVTEM) DI ADD A,(HL) ; add NT to MUZTMR ;* Increment note timer by one NT LD (HL),A EI JR LINKB ; LINK Back ANSW: LD A,(SHARPF) ; *** for Dick AiNSWorth *** SYSSUK INDEXW ; INDEX WORD (SYSTEM SUBROUTINE) DW DICKY EX DE,HL POP AF PUSH AF SUB '1' ;* Set for proper increment JR TSTOR ; SUBROUTINE TO POINT AT A TOKEN ; TOKEPT: LD HL,TOKTXT ; POINT AT TEXT LIST SUB $68 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: DW NORMAL ;* Normal note table DW SHARPS ;* Sharp note table DW FLATS ;* Flat note table ; ;* FLAT 1-8 TABLE, also NULL and ASCII VALUE NOTE TABLE 0 to 5 FLATS: DB $64,$59,$4F,$4A,$42,$3B,$34 ; ;* NORMAL 1-8 TABLE, also SCII VALUE NOTE TABLE 6 to 12 & 13 (Carriage return) NORMAL: DB $5E,$54,$4A,$46,$3E,$37,$31 DB $FF ; DICKY + 7 + CR TBLDIV: DW $0001 ; 1 ;* also ASCII VALUE NOTE TABLE 14, 15 DW $000A ; 10 ;* also 16, 17 DW $0064 ; 100 ;* also 18, 19 DW $03E8 ; 1000 ;* also 20, 21 DW $2710 ; 10000 ;* also 22, 23 ;* SHARP 1-8 TABLE, also ASCII VALUE NOTE TABLE 24 to 30 SHARPS: DB $59,$4F,$46,$42,$3B,$34,$2E ; Each Letter has its own Note offset DICKY + 7 + ASCII DB $FF ; ASCII 31 (Erase aka RUBOUT) ; 16 SYMBOLS from Space ! " # $ % & ' ( ) * + , - . / DB $00,$E1,$D4,$C8,$BD,$B2,$A8,$9F DB $96,$8D,$85,$FF,$77,$FF,$6A,$64 ; Flags for NUMBERS 0 through 7 DB $FF,$FE,$FE,$FE,$FE,$FE,$FE,$FE ; NUMBERS 8 and 9 plus 6 SYMBOLS from : ; < = > ? DB $2E,$2C,$29,$27,$25,$22,$20,$1F ; AT sign and LETTERS A through Z plus [ \ ] Up Left DB $1D,$1B,$1A,$18,$17,$15,$14,$13 DB $12,$11,$10,$0F,$0E,$0D,$0B,$0A DB $09,$08,$07,$06,$05,$04,$03,$02 DB $01,$64,$5E,$59,$54,$4F,$4A,$46 ; Ending with Down and Right then Multiply and Divide DB $42,$3E,$FF,$FF ; TABLE OF FIST LEVEL KEYCODES ;* CHARACTER TABLE, NO SHIFT KEYS FIRSTL: DB CR ; Go DB EDKEY ; Pause DB $00 ; Halt DB $63 ; Divide DB '7' DB '8' DB '9' DB $62 ; Multiply DB '4' DB '5' DB '6' DB '-' DB '1' DB '2' DB '3' DB '+' DB ' ' DB '0' DB RUBOUT DB '=' ; FIRST SHIFT KEY ;* PORT 17 SHIFT KEY (GREEN BACKGROUND) KTBL1: DB $A7 ; FIRST SHIFT KEY COLOR = Green DB CR ; (Go) DB EDKEY ; (Pause) DB $00 ; (Halt) DB $01 ; (EDKEY) DB 'A' DB 'D' DB 'G' DB 'J' DB 'M' DB 'P' DB 'S' DB 'V' DB 'Y' DB $5F ; Left Arrow DB $5E ; Up Arrow DB '&' DB '$' DB '<' DB '(' DB '#' ; SECOND SHIFT KEY ;* PORT 16 SHIFT KEY (RED BACKGROUND) KTBL2: DB $5F ; SECOND SHIFT KEY COLOR = Red DB CR ; (Go) DB $2F ; Slash DB $00 ; (Halt) DB $5B ; Left Bracket DB 'B' DB 'E' DB 'H' DB 'K' DB 'N' DB 'Q' DB 'T' DB 'W' DB 'Z' DB $27 ; Apostrophe DB '.' DB '@' DB ',' DB $22 ; Quotes DB ';' DB '%' ; TABLE THE THIRD ;* PORT 15 SHIFT KEY (BLUE BACKGROUND) KTBL3: DB $0F ; THIRD SHIFT KEY COLOR = Blue DB CR ; (Go) DB $5C ; Backslash DB $00 ; (Halt) DB $5D ; Right Bracket DB 'C' DB 'F' DB 'I' DB 'L' DB 'O' DB 'R' DB 'U' DB 'X' DB '!' DB $61 ; Right Arrow DB $60 ; Down Arrow DB '*' DB '?' DB '>' DB ')' DB ':' ; TOKEN KEY ;* PORT 14 SHIFT KEY (WORDS) KTBL4: DB $77 ; WORDS KEY COLOR = Gold DB NLLN ; GO+10 DB EDKEY ; (Pause) DB $6A ; RUN token DB $68 ; LIST token DB $72 ; FOR token DB $79 ; TO token [BB was $77] DB $77 ; STEP token [BB was $75] DB $6B ; NEXT token DB $6F ; GOSUB token DB $70 ; RETURN token DB $78 ; RND token [BB was $76] DB $6D ; IF token DB $69 ; CLEAR token DB $6C ; LINE token DB $71 ; BOX token DB $6E ; GOTO token DB $76 ; CLINE token [BB was EDKEY] DB $73 ; INPUT token DB $75 ; COLOR token [BB was $01] DB $74 ; PRINT token ; One final Routine here ; SUBROUTINE TO STORE a byte using LD (HL),A ; [Always non-interlaced, so CALL STHL could be replaced ??] ; STHL: LD (HL),A RET ; 20 Filler Bytes to match original ROM image DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF DB $FF,$FF,$FF,$FF ;* SPARE CELLS ; END OF COLOR BASIC INTERPRETER