0100*********************************** ** BLAZIN' FORTH FOR CBM-64** BY* 0101( BLAZIN' FORTH 85 SYSTEM LOADER)VIEW? OFF=3 .( THRU ) LOAD CR24 30 .( ASSEMBLER )THRU CR 0102*SCOTT BALLANTYNE ** **COPYRIGHT (C) 1985 ** OK TO COPY, NOT TO SELL!!* 0103 4 23 .( UTILITIES )THRU CR31 49 .( EDITOR ) THRU CR50 57 .( STRINGS ) THRU CR58 70 .( SID SUPPORT )THRU CR 0104* ************************************?* SYSTEM LOADER BLOCK = SCREEN 1 0105 71 104 .( VIC SUPPORT )THRU CR\2 VIEW? ! .( LOCATE ENABLED) CR` 0106* SCREEN 2 LEFT BLANK FOR ADDITIONS* ENJOY!8*?********************************** 0107  0108  0109( UTILITIES -- THRU, TEXT, PRINTING? #LP, DEFER, IS SDBJUN85)A: THRU 1+ SWAP DO I U. I LOAD ?TERMINAL ?LEAVE LOOP ;H 0110  0111: TEXT HERE 84 1+ BLANK WORD+PAD 84 1+ CMOVE ;f: ?VECTORTRUE ABORT" UNSPECIFIED VECTOR" ; 0112  0113: DEFERCREATE ['] ?VECTOR , DOES> @ EXECUTE ; : (IS) R> DUP 2+ >R @ >BODY ! ;: IS STATE @ IF COMPILE (IS) ELSE ' >BODY ! THEN ; IMMEDIATEA 0114  011556 USER PRINTING? ( TRUE IF PRINTING)4 CONSTANT #LP( LINE PRINTER DEVICE NUMBER ) 0116( UTILITIES -- PRINTER, NOPRINTER, ?KEY PAUSE SDBJUN85) DEFER PRINTERDEFER NOPRINTER`: LP CR PRINTING? ON #LP DUP 0 0 0 (OPEN) IOERR 0117( UTILITIES -- [LINE] .LINE LISTSDBJUN85)AVOCABULARY EDITORn 0118  #LP (CMDOUT) IOERR 147 EMIT ;: NLP CR PRINTING? OFF 19 EMIT CMDOFF #LP CLOSE ;J' LP IS PRINTER ' NLP IS NOPRINTER 0119: (LINE) PRINTING? @ IF CMDOFF THEN BLOCK SWAPC/L * + C/L PRINTING? @ IF #LP (CMDOUT) DROP THEN ;B: .LINE (LINE) -TRAILING TYPE ; 0120 ?HEX=CODE ?KEY XSAVE STX, FFE4 JSR, PHA, XSAVE LDX,0 # LDA, PUSH JMP, END-CODE 0200 ?: LIST CR DUP SCR !+." SCR #" U. 16 0,DO CR I 3 .R SPACE I SCR @ 0201 ?: PAUSE ?KEY ?DUP IF 3 <> IF KEY 3 = ELSE TRUE THENELSE FALSE THEN ;DECIMAL8 0202 .LINE ?TERMINAL ?LEAVE#LOOP CR EDITOR ; 0203( UTILITIES -- .INDEX, INDEXSDBJUN85): .INDEX PRINTING? @ IF CMDOFF THEN ?DISC 0204( UTILITIES --- .VERSION, TITLE, TRIADSDBJUN85)A: .VERSION." REL64.1.0.2" ;` 0205  PAD SWAP 1 T&S >DISC,IF .DERR THEN PRINTING? @ IF #LP (CMDOUT) DROP THEN PAD C/L -TRAILING TYPE DROP ;X 0206: TITLE CR 10 SPACES4." BLAZIN' FORTH '85 VERSION " .VERSION." -- OK TO COPY, NOT TO SELL." CR ;P 0207: INDEXCR 1+ SWAP,DO CR I 4 .R 4 SPACES I OFFSET @ + .INDEXPAUSE ?LEAVE LOOP CR ;_ 0208: TRIAD #LINE OFF 0 3 UM/MOD SWAP DROP 3 * 3 OVER + SWAP DO CR I LIST PAUSE ?LEAVE%LOOP TITLE3BEGIN #LINE @ 60 < WHILE CR REPEAT ; 0209  0210 ?: TRIADS ( SCR-START SCR-END)'1+ SWAP DO I TRIAD PAUSE IF QUIT THEN 3 +LOOP ;L 0211( UTILITIES --- WORDS, SDBJUN85)A: WORDS CR CONTEXT @ @.BEGIN DUP C@ 31 AND #OUT @ + 40 > 0212 ( UTILITIES -- ASCII, CONTROL, FREESDBMAY85)A: ASCIIBL WORD 1+ C@ STATE @+IF [COMPILE] LITERAL THEN ; IMMEDIATE 0213  IF CR THEN DUP ID.,11 #OUT @ 2DUP + 40 >+IF CR 2DROP5ELSE OVER MOD - SPACES 0214 ?: CONTROL ASCII " WORD 1+ C@ STATE @&IF [COMPILE] LITERAL THEN ; IMMEDIATEO 0215  THENLINK @ DUP 0= PAUSE OR UNTIL DROP ;l 0216 ?: FREE ( --- FREEMEM ) R HEX 0& 0300 ELSE ." STACK EMPTY " THEN ;Z: RECURSE ( IMPLEMENT RECURSION IN FORTH ) LATEST NAME> , ; IMMEDIATE 0301 DO CR DUP I + DUP 0 6 D.R 2 SPACES DUP 8 0DO DUP I + C@ 3 .R LOOP)DROP SPACE DUP 8 + 8 0*DO DUP I + C@ 3 .R LOOP 0302 ?( FOLLOWING WORD ALLOWS ONE LINE COMMENTS )U: // ( SKIP REST OF CURRENT LINE ) 0303 DROP 3 SPACES 10 0.DO DUP I + C@ DUP 20 < OVER 7E > ORIF DROP 2E THEN EMIT,LOOP DROP PAUSE ?LEAVE 10 +LOOP 0304 BLK @ 0= ABORT" USE ONLY WHEN LOADING">IN @ C/L / 1+ C/L * >IN ! ; IMMEDIATE 0305 DROP CR R> BASE ! ;%DECIMAL 0306( UTILITIES -- PAGE EMPTY BYE MOVESDBMAY85) : PAGE CONTROL "" EMIT #LINE OFF #OUT OFF ;R: EMPTY 4 +ORIGIN @ ['] FORTH >BODY ! 0307( UTILITIES -- DOS$SDBMAY85)A: >DOS 15 CLOSE 15 8 OVER 0 0 (OPEN) DROP 15 (CMDOUT) DROP ;C 0308  16 +ORIGIN @ FENCE !,18 +ORIGIN @ DP !/20 +ORIGIN @ VOC-LINK ! ;: DCLOSE 13 CLOSE 15 CLOSE ;# 0309: DOS" STATE @ IF COMPILE >DOS [COMPILE] ." COMPILE CMDOFFELSE ASCII " TEXT >DOS PAD COUNT TYPECMDOFF THEN ; IMMEDIATEY 0310: RESTART DCLOSE COLD ;)HEX=: BYE DCLOSE FFFC EXECUTE ;#DECIMAL8 0311  0312 ?: MOVE ROT ROT 2DUP U<1IF ROT CMOVE>3ELSE ROT CMOVE THEN ;! 0313  0314( MIXED MODE MATH -- ALLOW OPTIONAL LOADING SDBMAY85 )A: M+ ( D1 N --- D2 )1S>D D+ ;/ 0315( I/O EXTENSIONS CURSOR, CURSORPOS,SDBMAY85) HEX}CODE CURSOR XSAVE STX, BOT LDA, SEC LDY, TAX, CLC, 0316 : M*/ ( D1 N1 N2 --- D2 )-2DUP XOR SWAP ABS >R SWAP 0317  FFF0 JSR, XSAVE LDX, POPTWO JMP, END-CODEICODE CURSORPOS DEX, DEX, XSAVE STX, SEC, FFF0 JSR,TXA, PHA, XSAVE LDX, BOT STY, 0318 ABS >R OVER XOR ROT ROT DABS$SWAP R@ UM* ROT R> UM* ROT 0 D+!R@ UM/MOD ROT ROT R> UM/MOD%SWAP DROP SWAP ROT 0< IF DNEGATE THEN ; 0319 0 # LDA, BOT 1+ STA, PUSH JMP, END-CODE DECIMAL 0320 ?( THESE OPERATORS ARE RARELY USED --IF TRULY NEEDED OFTEN, MAY BE RE-DEFINED IN CODE )K 0400  0401( I/O EXTENSIONS JOYSTICK, JOYBUTTONSDBJUN85) HEX=CODE JOYSTICK BOT LDA, 01 # EOR, TAY, DC00 ,Y LDA,0FF # EOR, 0F # AND, 8 # CMP, 0402( I/O EXTENSIONS PADDLE PADDLE BUTTONSDBJUN85 ) HEX=CODE PADDLE SEI, DC02 LDA, PHA, 0C0 # LDA, DC02 STA,BOT LDA, .A LSR, 80 # LDA, TAY, CS IF, .A LSR, THEN, 0403 CS IF, N STA, 0B # LDA, N SBC, 1 # CMP,0= IF, 4 # LDA, THEN, ELSE, 2 # CMP,CS IF, 6 # CMP, CS NOT IF, 3 # ADC, THEN, THEN, THEN, TAY, DEY, TYA, 0< NOT IF, 0 # LDY, THEN, 0404 DC00 STA, BEGIN, NOP, DEY, 0< UNTIL,BOT LDA, 1 # EOR, TAY, D419 ,Y LDA,BOT STA, PLA, DC02 STA, CLI, NEXT JMP, END-CODEK 0405 PHA, TYA, PUT JMP, END-CODE`CODE JOYBUTTON BOT LDA, 1 # EOR, TAY, DC00 ,Y LDA,010 # AND, 0= IF, 0FF # LDA, ELSE, 0 # LDA, THEN, 0406CODE PADDLEBUTTON BOT LDA, 2 # CMP, CSIF, DC01 LDA, ELSE, DC00 LDA, THEN, PHA,BOT LDA, .A LSR, PLA, CS IF, 8 # AND, ELSE, 4 # AND, THEN,0= IF, DEY, THEN, TYA, PHA, PUT JMP, END-CODE 0407 PHA, PUT JMP, END-CODEdDECIMALx 0408DECIMAL 0409( I/O EXTENSIONS JIFFY! JIFFY@ SETCLOCK READCLOCKSDBJUN85) HEX=CODE JIFFY! XSAVE STX, SEC LDA, PHA, SEC 1+ LDA, BOT LDY, TAX,PLA, FFDB JSR, XSAVE LDX, POPTWO JMP, END-CODE 0410( UTILITIES -- DEBUGGING: RP@ UNRAVEL ?PARAMS SDBJUN85) CODE RP@ ( -- ADDR RETURN STACK 1- )XSAVE STX, TSX, TXA, PHA, 1 # LDA, XSAVE LDX, PUSH JMP, END-CODE? 0411 ?CODE JIFFY@ DEX, DEX, XSAVE STX, FFDE JSR,N STY, TAY, TXA, XSAVE LDX, BOT STY, BOT 1+ STA,N LDA, PHA, 0 # LDA, PUSH JMP, END-CODE 0412: ID? ( TRUE IF VALID NAME)+DUP @ [ ' : @ ] LITERAL =&SWAP @ C@ [ ' FORTH @ C@ ] LITERAL = OR ;Q 0413DECIMALy: JIFFIES ( +N --- WAIT N JIFFIES )%JIFFY@ ROT M+) 0414: UNRAVEL ( SHOW PREVIOUS NESTING)!BEGIN RP@ RP0 @ <> WHILE*R> DUP 2- @ DUP ID? IF >NAME ID. SPACE DROPELSE DROP U. THEN) 0415 BEGIN 2DUP JIFFY@ DU< UNTIL$2DROP ; 0416 REPEAT QUIT ;p: ?PARAMS ( N -- UNRAVEL IF DEPTH < N )DEPTH 1- > IF CR ." NOT ENOUGH PARAMETERS " UNRAVEL THEN ; 0417( UTILITIES -- DEBUGGING: ;NEXT NEXT> >NEXT SDBJUN85) HEX=VARIABLE 'TRACE VARIABLE S 0418( UTILITIES - DEBUGGING: >NEXT ID.LSDBJUL85) HEX=CODE >NEXT ( N -- POINT NEXT TO N)04C # LDA, NEXT 0B + STA, BOT LDA, NEXT 0C + STA, 0419CODE ;NEXT ( EXIT THEN NEXT )#( EXIT) PLA, IP STA, PLA, IP 1+ STA,( GET W) PLA, W STA, PLA, W 1+ STA,( NEXT) CLC, IP LDA, 2 # ADC, IP STA, CS 0420 BOT 1+ LDA, NEXT 0D + STA, POP JMP, END-CODESCREATE ASSEMBLER+ ( RESTORE NEXT)'018 # LDA, NEXT 0B + STA, 0A5 # LDA, NEXT 0C + STA, 0501 IF, IP> LDA, IP CMP, IP> 1+ LDA, IP 1+ SBC, CSIF, DEX, DEX, IP LDA, BOT STA, IP 1+ LDA, BOT 1+ STA, W 1+ LDA, PHA, W LDA, PHA,&'TRACE LDA, W STA, 'TRACE 1+ LDA, W 1+ STA, W 1- JMP, 0502 084 # LDA, NEXT 0D + STA, NEXT JMP, END-CODEDECIMAL8 0503 THEN, THEN, ' ;NEXT @ 0C + JMP, DECIMALU: ID.L ( CFA LEN -- )-OVER >NAME DUP ID. SPACE ROT 1- - + SPACES ; 0504( UTILITIES - DEBUGGERS: 'EXIT STEP TRACE CONTSDBJUL85) : 'EXIT ( CFA -- LAST WORD)(BEGIN 1+ DUP @ ['] EXIT = UNTIL ;VARIABLE CON3 0505( UTILITIES -- LOOK WATCH EYESDBJUL85) VARIABLE EYE 0 ,0VARIABLE 'UNRAVEL ' UNRAVEL 2+ 'UNRAVEL !S 0506: STEP ( CFA -- )2NEXT> CR @ 10 ID.L .S SPACE KEY CONTROL "" OVER = IF CON OFF DROP CR ." P? ")BEGIN QUERY RUN CR ." P? " CON @ UNTIL 0507CREATE LOOKASSEMBLER HEX#EYE LDA, EYE 2+ CMP, 0=*IF, EYE LDA, EYE 3 + CMP, 0=&IF, ' ;NEXT @ 0C + JMP, THEN, 0508 THEN CONTROL "" OVER = IF'DROP CR ." TRACING OFF" QUIT#THEN DROP >NEXT ;NEXT ; ' STEP 'TRACE !O 0509 THEN, 'UNRAVEL LDA, IP STA, 'UNRAVEL 1+ LDA, IP 1+ STA,' NEXT> @ JMP,DECIMALd: WATCH ( ADDR -- ), 0510: TRACE NEXT> ' DUP ID? NOT ABORT" CAN'T TRACE"DUP ! >NEXT ;: NOTRACE NEXT> ." TRACING OFF" QUIT ;: CONTCON ON 0 ;* 0511 DUP EYE ! @ EYE 2+ !,EYE @ DUP LOOK 1+ ! 1+ LOOK 9 + ! ( PATCH LOOK)LOOK >NEXT ;o 0512( ASSEMBLER -- CONSTANTS , REGISTERS, WFRSDB-MAY85) HEX=VOCABULARY ASSEMBLERASSEMBLER DEFINITIONSQ 0513( ASSEMBLER -- INDEX, ADDRESSING MODES WFRSDB-MAY85) VARIABLE INDEX -2 ALLOT(0909 , 1505 , 0115 , 8011 , 8009 , 1D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 , 1C0C , 801C , 2C80 , 0514( REGISTERS )38B CONSTANT XSAVE 87 CONSTANT W 89 CONSTANT UP84 CONSTANT IP7C CONSTANT N_ 0515 ?VARIABLE MODE 2 MODE !): .A 0 MODE ! ; : # 1 MODE ! ; : MEM 2 MODE ! ; : ,X 3 MODE ! ; : ,Y 4 MODE ! ; : X) 5 MODE ! ; 0516( FORTH KERNAL LOCATIONS )&0957 CONSTANT POP-0955 CONSTANT POPTWO*084C CONSTANT PUT, 0517: )Y 6 MODE ! ; : ) F MODE ! ;^: BOT ,X 0 ; ( ADDRESS THE BOTTOM OF THE STACK ) : SEC ,X 2 ; ( ADDRESS SECOND ITEM ON DATA STACK ) 0518084A CONSTANT PUSH,0851 CONSTANT NEXT,0879 CONSTANT SETUPj 0519: RP) ,X 101 ; ( ADDRESS BOTTOM OF RETURN STACK ) 0520( ASSEMBLER -- UPMODE, CPUWFRSDB-MAY85)A: UPMODE IF MODE @ 8 AND 0= IF 8 MODE +! THEN THEN1 MODE @ 0F AND 0 ?DO DUP + LOOP 0600( ASSEMBLER -- M/CPU MULTI-MODE OP-CODES WFRSDB-MAY85) : M/CPU CREATE C, , DOES>)DUP 1+ @ 80 AND IF 10 MODE +! THEN OVERFF00 AND UPMODE UPMODE IF MEM CR LATEST ID. 0601 OVER 1+ @ AND 0= ;i: CPU CREATE C, DOES> C@ C, MEM ;00 CPU BRK, 18 CPU CLC, D8 CPU CLD, 58 CPU CLI, 0602 ABORT" HAS INCORRECT ADDRESS MODE" THEN C@ MODE C@INDEX + C@ + C, MODE C@ 7 AND IF MODE C@0F AND 7 < IF C, ELSE , THEN THEN MEM ;P 0603 B8 CPU CLV, CA CPU DEX, 88 CPU DEY, E8 CPU INX,C8 CPU INY, EA CPU NOP, 48 CPU PHA, 08 CPU PHP,68 CPU PLA, 28 CPU PLP, 40 CPU RTI, 60 CPU RTS,38 CPU SEC, F8 CPU SED, 78 CPU SEI, AA CPU TAX, 0604 1C6E 60 M/CPU ADC, 1C6E 20 M/CPU AND, 1C6E C0 M/CPU CMP,1C6E 40 M/CPU EOR, 1C6E A0 M/CPU LDA, 1C6E 00 M/CPU ORA,1C6E E0 M/CPU SBC, 1C6C 80 M/CPU STA, 0D0D 01 M/CPU ASL,0C0C C1 M/CPU DEC, 0C0C E1 M/CPU INC, 0D0D 41 M/CPU LSR, 0605 A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS,98 CPU TYA, 0606 0D0D 21 M/CPU ROL, 0D0D 61 M/CPU ROR, 0414 81 M/CPU STX,0486 E0 M/CPU CPX, 0486 C0 M/CPU CPY, 1496 A2 M/CPU LDX,0C8E A0 M/CPU LDY, 048C 80 M/CPU STY, 0480 14 M/CPU JSR,8480 40 M/CPU JMP, 0484 20 M/CPU BIT, 0607( ASSEMBLER -- BEGIN, UNTIL, IF, THEN, ELSE,WFRSDB-JUN85) : BEGIN, HERE 1 ; IMMEDIATEb: UNTIL, >R 1 ?PAIRS R> C, HERE 1+ - C, ; IMMEDIATE 0608( ASSEMBLER -- AGAIN,WHILE,REPEAT, CS 0= 0< <=WFRSDB-MAY85)A: AGAIN, 1 ?PAIRS JMP, ; IMMEDIATE[ 0609 ?: IF,C, HERE 0 C, 3 ; IMMEDIATE[: THEN,ABS 3 ?PAIRS HERE OVER C@ 0610: WHILE, >R DUP 1 ?PAIRS R> [COMPILE] IF, 2+ ; IMMEDIATEF: REPEAT, >R >R 1 ?PAIRS JMP,-R> R> 2- [COMPILE] THEN, ; IMMEDIATE 0611 IF SWAP ! ELSE OVER 1+ - SWAP C! THEN ; IMMEDIATEF: ELSE,3 ?PAIRS HERE 1+ 1 JMP,'SWAP HERE OVER 1+ - SWAP C! -3 ; IMMEDIATE 0612 ?: NOT 20 + ; ( REVERSE ASSEMBLY TEST )90 CONSTANT CS ( ASSEMBLER TEST FOR CARRY SET )D0 CONSTANT 0= ( ASSEMBLER TEST FOR EQUAL ZERO ) 0613  061410 CONSTANT 0< ( ASSEMBLER TEST FOR LES THAN OR EQUAL ZERO) 90 CONSTANT >= ( ASSEMBLER TEST FOR GREATER OR EQUAL ZERO)( >= IS ONLY CORRECT AFTER SUB, OR CMP, )50 CONSTANT VS ( ASSEMBLER TEST FOR OVERFLOW SET) 0615( FORTH-83 ASSEMB EXT WORDS, END-CODE ;CODE CODE WFRSDB-MAY85)AFORTH DEFINITIONS DECIMAL%: END-CODE CURRENT @ CONTEXT ! ?CSP SMUDGE ; 0616( START OF EDITOR -- FORTH SUPPORTSDBMAY85)FORTH DEFINITIONS HEX* 0617 ?: CODE CREATE SMUDGE HERE DUP 2- !$[ ASSEMBLER ] MEM ASSEMBLER !CSP ;T 0618 ?: LINE DUP 0FFF0 AND ABORT" OFF EDITING SCREEN"SCR @ (LINE) DROP ;a 0619: ;CODE ?CSP COMPILE (;CODE),[COMPILE] [ ASSEMBLER !CSP ; IMMEDIATEEXITVIEW LOCATESDBMAY85)A: >VIEW >LINK 2- ;k 0703( EDITOR SUPPORT -- -TEXTSDBJUL84) CODE -TEXT 3 # LDA, SETUP JSR,!BEGIN, N 2+ LDA, N 3 + ORA, 0= NOT WHILE,N 4 + )Y LDA,/ 0704: LOCATE ' >VIEW @ DUP 0= OVER 0801 > OR ABORT" CAN'T LOCATE",LIST ;l 0705 N )Y CMP,70= NOT IF, 0 # LDA, PHA, PUSH JMP, THEN,N 2+ LDA, 0= IF, N 3 + DEC, THEN, N 2+ DEC, INY,0= IF, N 4 + INC, N INC, THEN, REPEAT, 0706  0707 FF # LDA, PHA, PUSH JMP, END-CODE 0708  0709  0710( EDITOR SUPPORT -- MATCHSDBJUL85)A: MATCH>R >R 2DUP R> R> 2SWAP OVER + SWAPDO 2DUP I -TEXT# 0711( STARTING FORTH EDITOR -- #LOCATE #LEAD #LAG SDBMAY85)AEDITOR DEFINITIONSm 0712 IF >R 2DROP R> - I SWAP - 0 SWAP 0 0 LEAVE THEN LOOP<2DROP SWAP 0= SWAP ;` 0713: #LOCATE R# @ C/L /MOD ;e: #LEAD#LOCATE LINE SWAP ;` 0714  0715: #LAG#LEAD DUP >R + C/L R> - ; 0716  0717  0718( STARTING FORTH EDITOR >MOVE BUFMOVESDBMAY85)A: >MOVE LINE C/L CMOVE UPDATE ;^ 0719( STARTING FORTH EDITOR >LINE#, FBUF, IBUF SDBMAY85)A: >LINE# #LOCATE SWAP DROP ;a 0720: BUFMOVE PAD C@:IF PAD SWAP C/L 1+ CMOVE(ELSE DROP THEN ;c 0800: FBUFPAD 55 + ;k: IBUFFBUF 55 + ;i 0801  0802  0803  0804  0805( STARTING FORTH ED. HOLD,KILL,SPREAD,XSDBMAY85)A: (HOLD) LINE IBUF 1+ C/L DUP IBUF C! CMOVE ;P 0806( STARTING FORTH EDITOR - POINT T LSDBMAY85)A: POINT CR SPACE #LEAD TYPE 5E EMIT%#LAG TYPE #LOCATE . DROP ; 0807: (KILL) LINE C/L BLANK UPDATE ;^: (SPREAD) >LINE# DUP 1- 0E0DO I LINE I 1+ >MOVE TRUE 0808 : T C/L * R# ! POINT ;' 0809  +LOOP (KILL) ;f: X >LINE# DUP (HOLD) 0F DUP ROT$?DO I 1+ LINE I >MOVE LOOP (KILL) ; 0810 : L SCR @ LIST ;m 0811  0812  0813( STARTING FORTH EDITOR - M B TOP ?SEEKSDBMAY85)A: N1 SCR +! ;n 0814( STARTING FORTH EDITOR -- R PSDBMAY85): (R)>LINE# IBUF 1+ SWAP >MOVE ; 0815: BTRUE SCR +! ;l: (TOP) R# OFF ;m 0816  0817: ?SEEKIF (TOP) TRUE ABORT" NOT FOUND" THEN ; 0818: P 5E TEXT IBUF BUFMOVE (R) ; 0819  0820  0900( STARTING FORTH EDITOR -- WIPE COPY 1LINE SDBJUN85)A: WIPE SCR @ OFFSET @ + BUFFER 0400 BLANK UPDATE ;K 0901( STARTING FORTH EDITOR -- SEEK DELETESDBMAY85)A: (SEEK) BEGIN 03FF R# @ < ?SEEK 1LINE UNTIL ;Q 0902: W WIPE ; ( ABBREVIATION FOR CONVENIENCE )S: COPY SWAP BLOCK OVER BUFFER 0400 CMOVEBLOCK UPDATE DROP ;# 0903: (DELETE) >R #LAG + R@ -2#LAG R@ NEGATE R# +!,#LEAD + SWAP CMOVE-R> BLANK UPDATE ;! 0904 ?: 1LINE #LAG FBUF COUNT MATCH R# +! ; 0905  0906  0907  0908( STARTING FORTH EDITOR -- F ESDBMAY85)A: (F) 5E TEXT FBUF BUFMOVE (SEEK) ;Z 0909( STARTING FORTH EDITOR -- D TILLSDBMAY85)A: D(F) E ;q 0910: F (F) POINT ;o: (E) FBUF C@ (DELETE) ;e 0911 ?: TILL #LEAD + 5E TEXT1FBUF BUFMOVE 1LINE 0=+?SEEK #LEAD + SWAP - (DELETE) 0912: E(E) POINT ; 0913 POINT ; 0914  0915  0916( STARTING FORTH EDITOR -- BUMPSDBMAY85)VARIABLE COUNTER/ 0917( STARTING FORTH EDITOR - SSDBMAY85)A: S 5E TEXT COUNTER OFF-FBUF BUFMOVE- 0918 : BUMP 1 COUNTER +! COUNTER @'038 > IF COUNTER OFF THEN ; 0919 SCR @ DUP >R ?DO I SCR !((TOP);BEGIN=1LINE IF POINT SCR ? BUMP THEN 0920  1000 03FF R# @ <3UNTIL;LOOP R> SCR ! ;j 1001  1002  1003( STARTING FORTH EDITOR -- I, U,SDBMAY85)A: I 5E TEXT9IBUF BUFMOVE- 1004( STARTING FORTH EDITOR -- R MSDBMAY85)A: R (E) I ;q 1005 IBUF COUNT #LAG ROT OVER MIN >R!R@ R# +!8R@ - >R9DUP HERE R@ CMOVE( 1006: MSCR @ >R8R# @ >R9>LINE# (HOLD)3SWAP SCR !. 1007 HERE #LEAD + R> CMOVE+R> CMOVE UPDATE1POINT ;r 1008 1+ C/L * R# !3(SPREAD) (R)3R> C/L + R# !2R> SCR ! ;. 1009 ?: UC/L R# +! (SPREAD) P ; 1010FORTH DEFINITIONS DECIMAL%EXIT|EDITOR MODIFIED FROM FORTH DIMENSIONS III 1011( STRINGS $VARIABLE " $SIZE $LENGTH SDBJUN85): ?STRING 255 > ABORT" MAX LENGTH IS 255" ;: $ALLOTDUP C, 0 C, ALLOT ; : STRINGDUP ?STRING CREATE $ALLOT ;CODE 1012( STRINGS --- $+ $! $?SDBJUN85): $SIZE ( ADDR -- MAXSIZE ) 1- C@ ;: $LENGTH ( ADDR -- LENGTH ) C@ ;^ 1013 CLC, W LDA, 3 # ADC, PHA, TYA, W 1+ ADC, PUSH JMP, END-CODEB: STRINGS ( # SIZE ) DUP ?STRING CREATE DUP C,SWAP 0 DO DUP $ALLOT LOOP DROP 1014: $+( $ADDR1 $ADDR2 --- $ADDR1 $ADDR2 + )SWAP >R COUNT3R@ $SIZE R@ $LENGTH - MIN'R@ COUNT + SWAP+ 1015  DOES> DUP C@ 2+ ROT * + 2+ ;Z: (") R@ DUP C@ R> + 1+ >R ; ( RUN TIME OF "): "( COMPILE OR MOVE TO PAD A STRING LITERAL) 1016 DUP >R CMOVE R> R@ $LENGTH + R> C! ; ( COUNT BYTE)I: $!( $ADDR1 $ADDR2 --- STORE $ADDR1 AT $ADDR2 )2DUP $SIZE SWAP $LENGTH MIN 1017 ASCII " ?CHAR3STATE @ IF COMPILE (") ,$.ELSE DUP PAD C! PAD 1+ SWAP CMOVEPAD THEN ; IMMEDIATE 1018 2DUP SWAP >R >R11+ CMOVE R> R> C! ;h: $? ( ADDR --- ) COUNT TYPE ; 1019( STRINGS -- SUB$&SDBJUN85)@: SUB$( $ADDR C1 C2 --- MOVE TO PAD)2 PICK $LENGTH MIN // CLIP TO MAX LENGTH 1020( STRINGS -- +$! SDBJUN85)]: +$! ( ADDR1 ADDR2 +N ))( STORE $ADDR1 AT $ADDR2 + INDEX) 1100 OVER - DUP 1 <2IF DROP 2DROP 01ELSE 1+ >R + PAD 1+ R@ CMOVE$R> THEN PAD C! ;( 1101 OVER $LENGTH OVER - 1+ 0 MAX >R!+ SWAP COUNT R> MIN-ROT SWAP CMOVE ;m 1102 ?: COPY$( $ADDR1 C1 C2 ADDR2 -- )#>R SUB$ R@ PAD =0IF R> DROP ELSE PAD R> $! THEN ; 1103 ?: $BLANK ( FILL STRING WITH BLANKS )DUP $SIZE OVER 1+ OVER BLANK SWAP C! ;V 1104  1105  1106( STRINGS --- $- SDBJUN85)^CODE $- 2 # LDA, SETUP JSR,&N 2+ )Y LDA, N )Y CMP,& 1107( STRINGS -- BOOLEANS $= $< ETC. SDBJUN85)// ALL HAVE THE STACK EFFECT ( ADDR1 ADDR2 -- FLAG )L: $=$- 0= ;, 1108 CS IF, N )Y LDA, THEN, XSAVE STX, TAX, 0= NOTIF, BEGIN, INY, N 2+ )Y LDA, N )Y CMP, 0= NOTIF, 0 # LDY, CS3IF, 1 # LDA, ELSE, DEY, TYA, THEN, 1109 ?: $<$- 0< ;m: $>$- 0> ;, 1110 PHA, TYA, XSAVE LDX, PUSH JMP, THEN,DEX, 0= UNTIL, 0 # LDY, N 2+ )Y LDA, N )Y CMP, THEN, 0=6IF, TYA, ELSE, CS+ 1111 ?: $<>$= NOT ;l: $<=2DUP $= ROT ROT $< OR ; 1112 IF, 1 # LDA, ELSE, DEY, TYA, THEN,THEN, PHA, TYA, XSAVE LDX, PUSH JMP, END-CODE 1113: $>=2DUP $= ROT ROT $> OR ; 1114// STRINGS -- (IN$)SDBJUN85CODE (IN$) ( SUB$ STR$ COUNT SUBLEN )4 # LDA, SETUP JSR, INY, N 1- STY, N 1+ STY, N 3 + STY, BEGIN, N 1+ LDY, N 4 + )Y LDA, 1115( STRINGS - IN$SDBJUN85)X: IN$( ADDR1 IN ADDR2 -- INDEX ) 2DUP $LENGTH SWAP $LENGTH! 1116 N 3 + LDY, N 6 + )Y CMP,#0= IF, N 3 + LDY, N CPY, 0=)IF, N 1- LDA, PHA, 0 # LDA, PUSH JMP, THEN,INY, N 3 + STY, N 1+ INC, 1117 2DUP AND 0= >R22DUP < R> AND1IF 2DROP 2DROP 00ELSE DUP >R - 1+ R> (IN$) THEN ; 1118 ELSE, N 1- INC, N 2+ DEC,'0= IF, 0 # LDA, PHA, PUSH JMP, THEN,N 1- LDA, N 1+ STA, 1 # LDA, N 3 + STA, THEN,AGAIN, END-CODE. 1119: VALUE$ ( ADDR --- D ) NUMBER ;`: INPUT$ ( ADDR1 -- )/PAD 1+ 80 EXPECT SPAN @ PAD C! PAD SWAP $! ; 1120  1200  1201( SID -- CONSTANTS, TABLES, DATA STRUCTURE DEFINERS SDBJUN85) 54272 CONSTANT SID20 CONSTANT VOICE ( CURRENT VOICE)( NOTE VALUES FOR OCTAVE 8 )# 1202( SID SUPPORT - STORAGESDBJUN85) 14 7 0 3CONSTANT OFFSETS(0 0 0 3CONSTANT WAVEFORM'0 0 0 3CONSTANT OCTAVE' 1203CREATE NOTES 34334 , 36376 , 38539 , 40830 , 43258 , 45830 ,48556 , 51443 , 54502 , 57743 , 61176 , 64814 ,C: 3CONSTANT CREATE C, C, C, ;CODE 1204 0 0 0 3CONSTANT DURATION'0 0 0 C+VOICE RESTING?'0 0 0 C+VOICE SUSIMG)0 0 0 C+VOICE RELIMG' 1205 ' VOICE >BODY LDY, INY, INY,$W )Y LDA, PHA, 0 # LDA, PUSH JMP, END-CODER: 2+VOICE CREATE 6 ALLOT ;CODE 1206 0 0 0 C+VOICE ATTIMG)0 0 0 C+VOICE DECIMG-0 CONSTANT TRANS12+VOICE TIMER( 1207 ' VOICE >BODY LDA, .A ASL, TAY, INY, INY, TYA,CLC, W ADC, PHA, 0 # LDA, W 1+ ADC, PUSH JMP, END-CODEE: C+VOICE CREATE C, C, C, DOES> VOICE + ; 1208 VARIABLE MAAZEL0VARIABLE REL.TIME.VARIABLE VOL.MODE.VARIABLE RES.FLT& 1209( SID -- INTERRUPT SUPPORTSDBJUN85)AHEX=VARIABLE SYSIRQ0314 @ SYSIRQ ! 1210( SID --- IRQ ROUTINE!SDBJUN85) CREATE GATEOFF ASSEMBLERHEX!2 # LDX,8BEGIN, TXA, PHA, .A ASL, TAX, 1211 ?CODE SETIRQ ( IRQADDR --- )&SEI, 0314 LDA, SYSIRQ STA, 0315 LDA, SYSIRQ 1+ STA, BOT LDA, 0314 STA, BOT 1+ LDA, 0315 STA, CLI, POP JMP, END-CODE1212 TIMER ,X LDA, TIMER 1+ ,X ORA, 0= NOTIF, TIMER ,X LDY, 0=.IF, TIMER 1+ ,X DEC, THEN,&DEY, TYA, TIMER ,X STA, TIMER 1+ ,X LDA, 0= 1213 ?DECIMAL 1214 IF, PLA, TAX, ' RESTING? >BODY ,X LDA, 0=IF, REL.TIME CPY, 0=.IF, ' OFFSETS >BODY ,X LDY, ' WAVEFORM >BODY ,X LDA, 0FE # AND, SID 4 + ,Y STA, THEN, 1215  1216 THEN,9ELSE, PLA, TAX, THEN,)ELSE, PLA, TAX, THEN, DEX, 0<!UNTIL, SYSIRQ ) JMP,DECIMAL 1217( SID -- LOW LEVEL WORDSSDBJUN85) : START.IRQ GATEOFF SETIRQ ;": END.IRQSYSIRQ @ SETIRQ ;` 1218( SID -- TRANPOSE, PLAY PRIMITIVESDBJUN85)ACODE TRANSPOSE ( VAL --)*BOT LDA, ' TRANS >BODY STA, POP JMP, END-CODE 1219: +VOICE ( VAL -- ADDR) OFFSETS SID + + ;UCODE NOTE# ( NOTE-CODE OCTAVE -- VAL )SEC LDA, .A ASL, TAY, NOTES ,Y LDA, SEC STA, 1220 ?: PLAY ( NOTE-CODE --- ).BEGIN TIMER @ 0= UNTIL*FALSE RESTING? C!& 1300 NOTES 1+ ,Y LDA, SEC 1+ STA, BOT LDA, 7 # EOR, TAY, BEGIN, DEY, 0< NOT WHILE, SEC 1+ LSR, SEC ROR, REPEAT, POP JMP, END-CODEl 1301 TRANS + 12 /MOD OCTAVE +(NOTE# 0 +VOICE !0WAVEFORM 4 +VOICE C!,NOTE.LEN ;- 1302: TEMPO ( TEMPO -- )0DUP MAAZEL ! 3 75 ROT */ REL.TIME ! ;W: NOTE.LEN DURATION 75 MAAZEL @ */ TIMER ! ; 1303  1304( SID --- DEFINERS FOR HI-LEVELSDBJUN85) : MAKEWAVE CREATE C, ;CODE(2 # LDY, W )Y LDA, ' VOICE >BODY LDY,' WAVEFORM >BODY ,Y STA, NEXT JMP, END-CODE 1305( SID -- DEFINE USER WORDS: WAVEFORMS, OC V SDBJUN85)A17 MAKEWAVE TRIANGLE33 MAKEWAVE SAWTOOTH65 MAKEWAVE PULSE129 MAKEWAVE NOISE 1306 ?: MAKEOCTAVE CREATE C, ;CODE&2 # LDY, W )Y LDA, ' VOICE >BODY LDY,' OCTAVE >BODY ,Y STA, NEXT JMP, END-CODE 130719 MAKEWAVE SYNCH21 MAKEWAVE RINGU0 MAKEOCTAVE OC0 1 MAKEOCTAVE OC12 MAKEOCTAVE OC2 3 MAKEOCTAVE OC3 1308 ?: MAKEVOICE CREATE C, ;CODE'2 # LDY, W )Y LDA, ' VOICE >BODY STA, NEXT JMP, END-CODEC 1309 4 MAKEOCTAVE OC4 5 MAKEOCTAVE OC56 MAKEOCTAVE OC6 7 MAKEOCTAVE OC7U0 MAKEVOICE V1. 1310: MAKELEN CREATE C, ;CODE)2 # LDY, W )Y LDA, ' VOICE >BODY LDY,' DURATION >BODY ,Y STA, NEXT JMP, END-CODE: MAKENOTE CREATE C, DOES> C@ PLAY ; 1311 1 MAKEVOICE V202 MAKEVOICE V3 1312( SID -- DEFINE USER WORDS: DURATIONSSDBJUN85) ( 3 IS GATEOFF VALUE ),6 MAKELEN 1/329 MAKELEN .1/3212 MAKELEN 1/1618 MAKELEN .1/16 1313( SID -- DEFINE USER WORDS: NOTESSDBJUN85)B0 MAKENOTE C1 MAKENOTE C#2 MAKENOTE D3 MAKENOTE D# 1314 24 MAKELEN 1/836 MAKELEN .1/848 MAKELEN 1/474 MAKELEN .1/496 MAKELEN 1/2144 MAKELEN .1/2192 MAKELEN WHOLE+ 1315 4 MAKENOTE E5 MAKENOTE F 6 MAKENOTE F# 7 MAKENOTE G 8 MAKENOTE G# 9 MAKENOTE A10 MAKENOTE A# 11 MAKENOTE B 1316 ?: TRIPLET DURATION 2* 3 / [ ' DURATION >BODY ] LITERALVOICE + C! ;(: RBEGIN TIMER @ 0= UNTIL" 1317 ( ENHARMONICS )21 MAKENOTE D_ 3 MAKENOTE E_ 1318 TRUE RESTING? C! 0 4 +VOICE C! NOTE.LEN ;P: TIETRUE RESTING? C! BEGIN TIMER @ 0= UNTILFALSE RESTING? C! NOTE.LEN ; 1319 4 MAKENOTE F_ 5 MAKENOTE E#6 MAKENOTE G_ 8 MAKENOTE A_10 MAKENOTE B_o 1320( SID -- REGISTER MODIFYSDBJUN85) : ATTACK ( VAL --) 2* 2* 2* 2* DUP ATTIMG C!DECIMG C@ OR 5 +VOICE C! ;: DECAY ( VAL --) DUP DECIMG C! ATTIMG C@ OR 5 +VOICE C! ; 1400( SID -- REGISTER MODIFY: FILTERSSDBJUN85)A: FILTER VOICE 2* DUP 0= - RES.FLT @ OR"DUP RES.FLT ! SID 23 + C! ; 1401 ?: SUSTAIN ( VAL--) 2* 2* 2* 2* DUP SUSIMG C!RELIMG C@ OR 6 +VOICE C! ;: RELEASE ( VAL--) DUP RELIMG C! SUSIMG C@ OR 6 +VOICE C! ; 1402 ?: NOFILTER 255 VOICE 2* DUP 0= - - RES.FLT @ ANDDUP RES.FLT ! SID 23 + C! ;_ 1403 ?: PULSE.WIDTH ( VAL --) 2 +VOICE ! ;: MODE CREATE C, DOES> C@ VOL.MODE @ 15 AND ORDUP VOL.MODE ! SID 24 + C! ; 1404: RESONANCE 2* 2* 2* 2* RES.FLT @ 15 AND ORDUP RES.FLT ! SID 23 + C! ;`: CUTOFF DUP 7 AND SID 21 + C! 2/ 2/ 2/ 2/ SID 22 + C! ; 140579 MODE HIPASS 47 MODE BANDPASS31 MODE LOWPASS 95 MODE NOTCH]: VOLUME VOL.MODE @ 240 AND OR DUP VOL.MODE ! SID 24 + C! ; 1406 ?: V3OFF VOL.MODE @ 128 OR DUP VOL.MODE ! SID 24 + C!VOICE V3 NOFILTER [ ' VOICE >BODY ] LITERAL ! ;F 1407( SID -- FINAL WORDS: MUSIC.ON MUSIC.OFF OSC3Q ENV3@ SDBJUN85)A: OSC3@ [ SID 27 + ] LITERAL C@ ;: ENV3@ [ SID 28 + ] LITERAL C@ ; 1408// GRAPHICS SUPPORT, VARIABLESSDBJUL85 VARIABLE PENSTATE( TRUE IF PENDOWN)VARIABLE TURTLESTATE ( TRUE IF TURTLE IS VISIBLE)VARIABLE GRAPHIC?( TRUE IF GRAPHICS SCREEN ON) 1409 ?: MUSIC.ON ( INITIALIZE EVERYTHING )SID 25 ERASE V10['] WAVEFORM >BODY 3 ERASE# 1410VARIABLE MULTI( TRUE IF DOUBLECOLOR)VARIABLE HEADING( CURRENT HEADING OF TURTLE)VARIABLE PEN ( PEN COLOR FOR GRAPHICS)VARIABLE GBACK( BACKGROUND COLOR FOR GRAPHICS) 1411 TIMER 6 ERASE SUSIMG 3 ERASE#ATTIMG 3 ERASE DECIMG 3 ERASE#RELIMG 3 ERASE RESTING? 3 ERASE!0 TRANSPOSE1 1412VARIABLE XCOR( ACTUAL XCOOR FOR USER)VARIABLE YCOR( ACTUAL YCOR FOR USER)VARIABLE SPLIT?( TRUE IF SPLITSCREEN)VARIABLE SPRITE#( CURRENT SPRITE) 1413 VOL.MODE OFF RES.FLT OFF'START.IRQ ;s: MUSIC.OFF SID 25 ERASE END.IRQ ; 1414VARIABLE LX VARIABLE RX VARIABLE LY VARIABLE HY VARIABLE WWVARIABLE WH VARIABLE AY ( WINDOWING VARIABLES)1 PEN ! GBACK OFF GRAPHIC? OFF MULTI OFFPENSTATE ONTURTLESTATE ON SPLIT? ON 1415// GRAPHICS SUPPORT -- VARIABLESSDBJUL85 HEX=0FB CONSTANT PX( LOCATION OF TEMPX)0FD CONSTANT PY( LOCATION OF TEMPY) 1416// GRAPHICS SUPPORT -- GIRQ, GNMI,SDBJUL85 ASSEMBLER HEX1CREATE GRTI ( HANDLES RTI WHEN ROM ISGONE)PLA, 01 STA, PLA, RTI,' 14170B0 CONSTANT MOVES ( 4 BYTES FOR DLINE)VARIABLE LERR( LINE ERROR FOR DLINE)VARIABLE #ON( STORAGE FOR SPRITE ENABLE REG) 2VARIABLE URX( UNROUNDED X COR) 1418 ?CREATE GNMI ( HANDLES NMI'S WHEN ROM IS GONE)PHA, 01 LDA, PHA, GRTI 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ # LDA, PHA,GRTI 0FF AND # LDA, PHA, 37 # LDA, 01 STA, 0 # LDA, PHA, 14192VARIABLE URY( UNROUNDED Y COR)CREATE TSHAPE 64 ALLOT ( TURTLE IMAGE)ZCREATE 'PLOT ASSEMBLER -1 JMP, ( VECTOR FOR PLOT) 1420 FFFA ) JMP, ( TO KERNAL NMI)bCREATE GIRQ ( HANDLE IRQ'S WHEN ROM IS GONE)PHA, 01 LDA, PHA, GRTI 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ # LDA, PHA, 1500FORTH;080 #ON ! ( ENABLE TURTLE)ECIMAL8 1501 GRTI 0FF AND # LDA, PHA, 37 # LDA, 01 STA, 0 # LDA, PHA,FFFE ) JMP, ( TO KERNAL IRQ)bDECIMAL8 1502// GRAPHICS SUPPORT -- (SPLIT)SDBJUL85 ASSEMBLER HEX1CREATE (SPLIT) ( ALLOW SPLIT MODES)D019 LDA, D019 STA, D012 LDA, 0< IF, 1503// GRAPHICS SUPPORT -- GROFF, CLEARSCREEN SDBJUL85 HEX=: GROFF ( DISABLE GRAPHICS SCREEN)!GRAPHIC? @ IF. 1504 D011 LDA, 07F # AND, TAX, 0EF # AND, D011 STA,DD00 LDA, 03 # ORA, DD00 STA, D018 LDA, 03 # AND, 014 # ORA,D018 STA, 0 # LDA, D015 STA, TXA, 01F # AND, TAX, 01 # LDA,1 +ORIGIN LDY, D021 STY, D020 STY, 1505 DD00 C@ 03 OR DD00 C! 01B D011 C! 0C8 D016 C! 15 D018 C! 0 D015 C! 0 +ORIGIN @ D020 !"2 +ORIGIN C@ 0286 C! PAGETHEN ;V 1506 0C8 # LDY, D016 STY, D011 STX, ELSE, DD00 LDA, 0FC # AND, DD00 STA, 03B # LDA, D011 STA, #ON LDA, D015 STA, MULTI LDA, 0< IF, 0D8 # LDA, D016 STA, THEN, 0D1 # LDA, 068 # LDX, 1507: CS ( CLEAR GRAPHICS SCREEN)#GRAPHIC? @ IF5E000 1F40 ERASE D800 03F8 GBACK @ DUP 2* 2* 2* 2* OR 034 01 C! FILL 036 01 C!# 1508 D018 STX, GBACK LDY, D020 STY, D021 STY, THEN,D012 STA, DC0D LDA, 01 # AND, 0= IF, FEBC JMP, THEN, EA31 JMP,@DECIMAL8 1509 MULTI @ IF D800 03F8 GBACK @ FILL THENGBACK @ DUP D020 C! D021 C! THEN ;ZDECIMAL8 1510// GRAPHICS SUPPORT -- GRON, ?X , ?Y ,SDBJUL85 HEX=: GRON ( ENABLE GRAPHICS SCREEN )"DD00 C@ 0FC AND DD00 C! 03B D011 C! 1511// GRAPHICS SUPPORT -- ?XY , 'PIXSDBJUL85 ASSEMBLERHEX0CREATE ?XY ( RETURN WITH CS NOT IF OUT OF RANGE)?Y JSR, CS IF, ?X JSR, THEN, 0 # LDY, RTS, 1512 MULTI @ IF 0D8 ELSE 0C8 THEN D016 C!068 D018 C! #ON @ D015 C! ;`CREATE ?X ASSEMBLER+ 1513 ?CREATE 'PIX ( CONVERT X,Y, TO ADDRESS OF BYTE)03 STY, PY LDA, 0F8 # AND, 02 STA,.A ASL, 03 ROL, .A ASL, 03 ROL, 02 ADC, CS IF, 03 INC, THEN, 1514 SEC, PX LDA, RX SBC, PHA, PX 1+ LDA, RX 1+ SBC, TAY, PLA, CLC, WW ADC, TYA, WW 1+ ADC, RTS,XCREATE ?Y6 1515 .A ASL, 03 ROL, .A ASL, 03 ROL, .A ASL, 03 ROL, 02 STA, PY LDA, 07 # AND, 02 ADC, 02 STA, CS IF, 03 INC, THEN, PX LDA, 0F8 # AND, CLC, 02 ADC, 02 STA, 03 LDA, PX 1+ ADC,03 STA, PX LDA, 07 # AND, TAX, 02 LDA, 04 STA, 03 LDA, 05 STA,1516 SEC, PY LDA, LY SBC, PHA, PY 1+ LDA, LY 1+ SBC, TAY, PLA, CLC, WH ADC, TYA, WH 1+ ADC, RTS,XDECIMAL8 1517 0E0 # ORA, 03 STA, 05 LDA, .A LSR, 04 ROR, .A LSR,04 ROR, .A LSR, 04 ROR, 0D8 # ORA, 05 STA, RTS,ODECIMAL8 1518// GRAPHICS SUPPORT -- MASKSSDBJUL85 HEX=CREATE MASKS ( FOR SPEED)(080 C, 040 C, 020 C, 010 C, 08 C, 04 C, 02 C, 01 C, 1519// GRAPHICS SUPPORT -- MPIXSDBJUL85 CREATE MPIX ( HANDLE MULTICOLOR) ASSEMBLER HEX02 )Y LDA, MASKS 010 + ,X AND, PHA,6 LDA, PEN CMP, 0= IF, PLA, RTS, THEN, ( UNSET) 1520( MASKS 8 + -- HIRES OFF )'07F C, 0BF C, 0DF C, 0EF C, 0F7 C, 0FB C, 0FD C, 0FE C,( MASKS 16 + -- AND MASKS FOR MULTI)03F C, 03F C, 0CF C, 0CF C, 0F3 C, 0F3 C, 0FC C, 0FC C, 1600 04 )Y LDA, 0F # AND, PEN CMP, 0=!IF, PLA, MASKS 020 + ,X ORA, RTS, THEN,06 CMP, 0= IF, 04 )Y LDA, 0F0 # AND, PEN ORA, 04 )Y STA, PLA, MASKS 020 + ,X ORA, RTS, THEN, ( CODE 10 PIXELS) 1601( MASKS 24 + -- MASKS FOR CODE 01 PIXELS)040 C, 040 C, 010 C, 010 C, 04 C, 04 C, 01 C, 01 C, ( MASKS 32 + -- MASKS FOR CODE 10 PIXELS)080 C, 080 C, 020 C, 020 C, 08 C, 08 C, 02 C, 02 C, 1602 04 )Y LDA, .A LSR, .A LSR, .A LSR, .A LSR, PEN CMP, 0= IF, PLA, MASKS 018 + ,X ORA, RTS, THEN,06 CMP, 0= IF, PEN LDA, .A ASL, .A ASL, .A ASL, .A ASL, 07 STA,04 )Y LDA, 0F # AND, 07 ORA, 04 )Y STA, 1603( MASKS 40 + -- MASKS FOR CODE 11 PIXELS )0C0 C, 0C0 C, 030 C, 030 C, 0C C, 0C C, 03 C, 03 C,LDECIMAL8 1604 PLA, MASKS 018 + ,X ORA, RTS, THEN, ( CODE 01)36 # LDA, 01 STA, PEN LDA, 04 )Y STA, PLA, MASKS 028 + ,X ORA, RTS, ( CODE 11 PIXELS)&DECIMAL8 1605// GRAPHICS SUPPORT - SPIXSDBJUL85 ASSEMBLER HEX1CREATE SPIX ( SET/RESET PIXELS)"?XY JSR, CS NOT IF, RTS, THEN, 1606// GRAPHICS SUPPORT -- (DLINE)SDBJUL85 CODE (DLINE) HEX ( MY MX DX DY #PIX -- )3 # LDA, SETUP JSR, BOT LDA, 09B STA, BOT 1+ LDA, 09C STA,SEC LDA, 09E STA, SEC 1+ LDA, 09F STA, XSAVE STX, 1607 GBACK LDA, 6 STA, 'PIX JSR, 034 # LDA, 01 STA,MULTI LDA, 0< IF, MPIX JSR,%ELSE, 6 LDA, PEN CMP, 0= IF, 2 )Y LDA, MASKS 8 + ,X AND, ELSE, PEN LDA, .A ASL, .A ASL, .A ASL, .A ASL, 06 ORA, 1608BEGIN, 'PLOT JSR, N LDA, 0= IF, N 1+ DEC, THEN, N DEC, N 1+ LDA, 0< NOT WHILE, CLC, LERR LDA, N 2+ ADC, LERR STA, LERR 1+ LDA, N 3 + ADC, LERR 1+ STA, 0< IF, CLC, PX LDA, MOVES ADC, PX STA, PX 1+ LDA, MOVES 1+ ADC, PX 1+ STA, CLC, PY LDA, MOVES 2+ ADC, 1609 4 )Y STA, 2 )Y LDA, MASKS ,X ORA, THEN,THEN, 2 )Y STA, 36 # LDA, 01 STA, RTS,WSPIX 'PLOT 1+ ! ( VECTOR 'PLOT TO SPIX) 1610PY STA, PY 1+ LDA, MOVES 3 + ADC, PY 1+ STA,ELSE, CLC, PX LDA, 09B ADC, PX STA, PX 1+ LDA, 09C ADC, PX 1+ STA, CLC, PY LDA, 09E ADC, PY STA, PY 1+ LDA, 09F ADC,PY 1+ STA, SEC, LERR LDA, N 4 + SBC, LERR STA, LERR 1+ LDA, 1611 DECIMAL8 1612 N 5 + SBC, LERR 1+ STA, THEN, REPEAT,XSAVE LDX, POPTWO JMP, END-CODEaDECIMAL8 1613// MATH SUPPORT FOR GRAPHICS -- SINTABSDBJUL85 CREATE SINTAB ( ANGLES 1-90 / 16384)00000 , 00286 , 00571 , 00856 , 01143 , 01428 , 01712 , 01997 , 02280 , 02562 , 02844 , 03126 , 03406 , 03686 , 03963 , 04240 , 1614// MATH SUPPORT FOR GRAPHICS -- SIN COSSDBJUL85 HEX=CODE SIN ( ANGLE --- SIN )%067 # LDA, BOT CMP, 01 # LDA, BOT 1+ SBC, CS NOT IF, BOT LDA, 161504515 , 04790 , 05062 , 05334 , 05603 , 05872 , 06137 , 06401 , 06663 , 06923 , 07182 , 07438 , 07692 , 07942 , 08192 , 08437 , 08681 , 08922 , 09161 , 09397 , 09630 , 09859 , 10087 , 10310 , 10531 , 10749 , 10962 , 11173 , 11381 , 11585 , 11785 , 11983 , 1616SEC, 068 # SBC, BOT STA, BOT 1+ LDA, 01 # SBC, BOT 1+ STA, THEN, BOT LDA, 0B5 # CMP, BOT 1+ LDA, 0 # SBC, CS IF, BOT LDA,0B4 # SBC, BOT STA, INY, THEN, TYA, PHA,BOT LDA, 05B # CMP, CS IF, 0B4 # LDA, BOT SBC, THEN, 161712174 , 12365 , 12550 , 12732 , 12910 , 13084 , 13254 , 13421 , 13582 , 13741 , 13893 , 14044 , 14188 , 14329 , 14465 , 14598 , 14725 , 14848 , 14966 , 15081 , 15191 , 15296 , 15396 , 15491 , 15582 , 15668 , 15749 , 15825 , 15897 , 15964 , 16025 , 16082 , 1618.A ASL, TAY, SINTAB ,Y LDA, BOT STA, INY, SINTAB ,Y LDA, BOT 1+ STA, PLA, 0= NOT IF, 0 # LDY, ' NEGATE @ JMP, THEN,NEXT JMP, END-CODEl 161916134 , 16182 , 16225 , 16261 , 16293 , 16321 , 16344 , 16361 , 16374 , 16380 , 16384 , 1620CODE COS ( ANGLE -- COS)(CLC, 05A # LDA, BOT ADC, BOT STA, TYA, BOT 1+ ADC, BOT 1+ STA, ' SIN @ JMP, END-CODE)DECIMAL8 1700// MATH SUPPORT FOR GRAPHICS -- SGN, ?DENGATE SDBJUL85 HEX=CODE SGN ( NUMBER -- SIGN)'BOT 1+ LDA, 0< NOT IF, BOT ORA, 0= NOT 1701// MATH SUPPORT FOR GRAPHICS -- /CORHEX=CODE /COR ( DNUM -- COR )&BOT 1+ LDA, PHA, 0< IF, ' DNEGATE @ 1+ @ JSR, THEN, 1702 IF, 01 # LDA, PHA, TYA, PUT JMP, THEN, THEN,FORTH ' 0< @ ASSEMBLER JMP, END-CODEODE ?DNEGATE ( D N -- D+-)$ 170305 # LDY, BEGIN, BOT 1+ LSR, BOT ROR, SEC 1+ ROR, DEY, 0= UNTIL, SEC 1+ LDA, SEC STA, BOT LDA, SEC 1+ STA, INX, INX, PLA, 0<IF, ' NEGATE @ JMP, THEN, NEXT JMP, END-CODES 1704 BOT 1+ LDA, 0< IF, INX, INX, ' DNEGATE @ JMP, THEN,POP JMP, END-CODEmDECIMAL8 1705CODE ASPECT ( USERS YCOR -- SYSTEMS YCOR )BOT 1+ LDA, PHA, 0< IF, ' NEGATE @ 1+ @ JSR, THEN, DEX, DEX, 0D5 # LDA, BOT STA, BOT 1+ STY,' UM* @ 1+ @ JSR, SEC 1+ LDA, SEC STA, BOT LDA, SEC 1+ STA, 1706  1707INX, INX, PLA, 0< IF, ' NEGATE @ 1+ @ JSR, THEN,BOT LDA, SEC, 0C7 # SBC, BOT STA, BOT 1+ LDA, 0 # SBC, BOT 1+ STA, ' NEGATE @ JMP, END-CODEDECIMAL8 1708// GRAPHICS SUPPORT -- (G$)SDBJUL85 HEX=CODE (G$) ( ADDRESS COUNT -- )#02 # LDA, SETUP JSR, XSAVE STX, 1709// GRAPHICS SUPPORT -- G$SDBJUL85 HEX=: G$ ( $ADDRESS X Y ).ASPECT FFF8 AND PY ! FFF8 AND PX ! COUNT DUP 0<> 1710 BEGIN, ?XY JSR, CS IF, 'PIX JSR, 34 # LDA, 01 STA, PEN LDA,.A ASL, .A ASL, .A ASL, .A ASL, GBACK ORA, 04 )Y STA, 031 # LDA, 01 STA, N 5 + STY, N 2+ )Y LDA, 60 # CMP, CS IF,7F # AND, 60 # ORA, 0DF # AND, ELSE, 20 # CMP, CS 1711 IF (G$) ELSE 2DROP THEN ; 1712 IF, 03F # AND, THEN, THEN,$.A ASL, N 5 + ROL, .A ASL, N 5 + ROL, .A ASL, N 5 + ROL,N 4 + STA, N 5 + LDA, D0 # ORA, N 5 + STA, 07 # LDY, BEGIN, N 4 + )Y LDA, 2 )Y STA, DEY, 0< UNTIL, 36 # LDA, 01 STA,1713  1714 THEN, CLC, PX LDA, 08 # ADC, PX STA, CS IF, PX 1+ INC, THEN, N 2+ INC, 0= IF, N 3 + INC, THEN, N LDA, 0= IF, N 1+ DEC, THEN, N DEC, N LDA, N 1+ ORA, 0= UNTIL,XSAVE LDX, NEXT JMP, END-CODE DECIMAL 1715 DECIMAL8 1803// GRAPHICS SUPPORT TURTLE WORDS -- TPIXSDBJUL85 ASSEMBLER HEX3CREATE TPIX ( REPLACES SPIX WHEN TURTLE IS BEING DRAWN) SEC, 014 # LDA, PY SBC, 02 STA, .A ASL, 02 ADC, 02 STA, 1804// GRAPHICS SUPPORT TURTLE -- SPRITEPOS TCOR SDBJUL85 HEX=CODE SPRITEPOS ( # X Y -- )&03 # LDA, SETUP JSR, XSAVE STX, N 4 + LDA, PHA, 7 # EOR, TAX, 1805 PX LDA, .A LSR, .A LSR, .A LSR, CLC, 02 ADC, TAY,PX LDA, 07 # AND, TAX, TSHAPE ,Y LDA, MASKS ,X ORA, TSHAPE ,Y STA, RTS,k 1806 PLA, .A ASL, TAY, SEC, 0F9 # LDA, N SBC, N STA, 0 # LDA,N 1+ SBC, 0= NOT IF, 0FF # LDA, N STA, THEN, N LDA, D001 ,Y STA, CLC, N 2+ LDA, 018 # ADC, N 2+ STA, N 3 + LDA, 0 # ADC,N 3 + STA, 02 # CMP, CS IF, 01 # LDA, N 3 + STA, 0FF # LDA, 1807  1808N 2+ STA, THEN, N 2+ LDA, D000 ,Y STA, N 3 + LDA, 0= NOTIF, D010 LDA, MASKS ,X ORA, ELSE, D010 LDA, MASKS 8 + ,X AND, THEN, D010 STA, XSAVE LDX, NEXT JMP, END-CODER 1809 DECIMAL8 1810: TCOR ( DIST TRIG - TURTLE-COR) OVER >R >R ABS R@ ABS UM* D2/ R> R> XOR ?DNEGATE /COR ;IDECIMAL8 1811// GRAPHICS SUPPORT -- DLINESDBJUL85B: DLINE ( ACTUAL SCREEN CORDS: NEWX NEWY -- )PY @ - SWAP PX @ - DUP SGN >R ABS 1812// GRAPHICS SUPPORT FOR TURTLE -- TCOR, SIN120 COS120 SDBJUL85 120 SIN CONSTANT SIN120 120 COS CONSTANT COS120M: DRAW-TURTLE ( DRAWS TURTLE SHAPE) 1813 SWAP DUP SGN >R ABS-2DUP > IF R> R@ MOVES ! MOVES 2+ OFFELSE 2DUP < IF SWAP THEN R@ MOVES 2+ ! MOVES OFF R> THENR> 2SWAP OVER DUP 2/ NEGATE LERR ! (DLINE) ; 1814 TSHAPE 64 ERASE TPIX 'PLOT 1+ ! 10 HEADING @ SIN TCOR DUP 12 + PX !10 HEADING @ COS TCOR DUP 10 + PY !OVER SIN120 TCOR OVER COS120 TCOR + >R 1815  1816 OVER COS120 TCOR OVER SIN120 TCOR - R>OVER 12 + OVER 10 + DLINE 12 10 DLINEOVER SIN120 TCOR OVER COS120 TCOR + >R>R COS120 TCOR R> SIN120 TCOR - 12 + R> 10 + DLINE 1817  1818 >R 12 + R> 10 + DLINE TSHAPE 57280 64 52 1 C! CMOVE 54 1 C! SPIX 'PLOT 1+ ! ; 1900// GRAPHICS SUPPORT TURTLE -- TPOS, TSET, SDBJUL85 : TPOS ( SET TURTLE POSITION)%7 XCOR @ 12 - 209 YCOR @ ASPECT - SPRITEPOS ;HEX< 1901// GRAPHICS SUPPORT -- SP DSSDBJUL85 HEX=: SP GRAPHIC? @ IF ( TURN ON SPLIT MODE)01 DC0D C! (SPLIT) 0314 ! 1 D01A C! SPLIT? ON THEN ; 1902 ?: TSET ( INITIALIZE TURTLE)%TURTLESTATE @ IF3PEN @ D02E C! 07F ( MASK)! 1903 ?: FSGRAPHIC? @ IF ( TURN OF SPLIT MODE)0 D01A C! EA31 0314 ! 81 DC0D C! GRON GBACK @ D020 C! THEN ; : NOSPLIT ( DEFAULT TO FULLSCREEN) SPLIT? OFF FS ; 1904 D017 C@ OVER AND D017 C!(D01D C@ OVER AND D01D C!(34 1 C! DBFF C! 36 1 C!)DRAW-TURTLE #ON C@ 80 OR DUP D015 C! #ON ! TPOS THEN ; 1905 ?DECIMAL 1906 DECIMALx 1907  1908// GRAPHICS SUPPORT -- HRBG, BGSDBJUL85 HEX=CODE HRBG ( CHANGE BACKGROUND IN HIRES MODE)XSAVE STX, 34 # LDA, 01 STA, GBACK LDA, N STA, 0D8 # LDA, 1909// GRAPHICS -- ST HT ST ND SCOLOR DCOLOR PC PESDBJUL85 : PUPENSTATE OFF ; // PENUP!: PDPENSTATE ON ; // PENDOWNHEX< 1910 N 2+ STA, N 1+ STY, 03 # LDX, BEGIN, N 1+ )Y LDA, F0 # AND,N ORA, N 1+ )Y STA, INY, 0= IF, N 2+ INC, DEX, THEN, 0 # CPX, 0= UNTIL, BEGIN, N 1+ )Y LDA, F0 # AND, N ORA,N 1+ )Y STA, INY, 0F8 # CPY, 0= UNTIL, 1911: HT// HIDETURTLE$TURTLESTATE OFF #ON @ 07F AND DUP #ON ! D015 C! ;: ST// SHOWTURTLE!TURTLESTATE ON TSET ;% 1912 36 # LDA, 01 STA, XSAVE LDX, NEXT JMP, END-CODEPDECIMALx 1913: ND// NODRAW'FS GROFF GRAPHIC? OFF ;!: PC// SET PENCOLORDUP 0< IF ( ERASE) DROP GBACK @ PEN ! 1914: BG ( CHANGE BACKGROUND: CODE -- ) 15 AND GBACK ! SPLIT? @ NOT%IF GBACK @ DUP 53280 C! 53281 C! THENMULTI @ NOT IF HRBG THEN ;" 1915  ELSE 0F AND DUP PEN ! D02E C! THEN ;: PE-1 PC ; ( PENERASE) DECIMAL 1916// GRAPHICS SUPPORT -- (SETXY) SETXY SETH: (SETXY) ( NEWX NEWY),XCOR @ PX ! YCOR @ ASPECT PY !"2DUP YCOR ! XCOR !* 1917// GRAPHICS SUPPORT -- RT LT FD BKSDBJUL85 : RT( ANGLE -- ) HEADING @ + SETH ; // RIGHT: LT( ANGLE -- ) NEGATE RT ; // LEFTU 1918 PENSTATE @ IF ASPECT DLINE ELSE 2DROP THENTURTLESTATE @ IF TPOS THEN ;a: SETXY ( NEWX NEWY )( 2000: FD( FORWARD-DIST -- ))DUP >R ABS HEADING @ SIN DUP >R ABSUM* D2/ R> R@ XOR ?DNEGATE URX 2@ D+ 2DUP URX 2! /COR R@ ABS HEADING @ COS DUP >R ABS 2001 2DUP 8192 UM* URY 2! 8192 UM* URX 2! (SETXY) ;O: SETH ( DEGREES -- )/DUP 0< IF 360 + THEN 360 MOD HEADING ! 2002 UM* D2/ R> R> XOR ?DNEGATE URY 2@ D+ 2DUP URY 2! /COR (SETXY) ; // MOVE FORWARDb: BKNEGATE FD ; // BACK# 2003 TURTLESTATE @ IF DRAW-TURTLE THEN ; 2004  2005// GRAPHICS - TRY WINDOWING&: RESWIND 240 AY ! LX OFF HY OFF 200 DUP LY ! WH !320 DUP RX ! WW ! 160 XCOR ! 120 YCOR ! ;CODE (RY) ?Y JSR, CS IF, 0 # LDA, ELSE, 255 # LDA, THEN, 2006// GRAPHICS SUPPORT SPRITES! -- SETSHAPE SPRITEONHEX=: SETSHAPE ( DATA-ADDRESS SHAPE# -- ) 40 * C000 OR 34 01 C! 40 CMOVE 36 01 C! ; 2007 PHA, PUSH JMP, END-CODE&CODE (TX) ?X JSR, CS IF, 0 # LDA, ELSE, 255 # LDA, THEN, PHA, PUSH JMP, END-CODE&: ?WINDOW IF ND TRUE ABORT" WINDOW OUT OF RANGE" THEN ; 2008 ?: SPRITEON ( SHAPE# )-DUP 40 * C000 OR 34 01 C!'3F + C@ SWAP DBF8 SPRITE# @ + C! 36 01 C! 2009: RY (RY) ?WINDOW ; : TX (TX) ?WINDOW ;: HOME LX @ RX @ + 2/ AY @ 2/ SETXY 0 SETH ;: DRAW ( INITIALIZE DRAW MODE)%GRAPHIC? ON [ HEX ] GNMI FFFA ! GIRQ FFFE ! [ DECIMAL ] 2010 IF D01C C@ MASKS SPRITE# @ 7 XOR + C@ OR ELSED01C C@ [ MASKS 8 + ] LITERAL SPRITE# @ 7 XOR + C@ AND THEND01C C! #ON @ MASKS SPRITE# @ 7 XOR + C@ OR DUP #ON ! D015 C! ; DECIMAL8 2011 RESWIND HOME PAGE CS GRON&SPLIT? @ IF SP 0 19 CURSOR THEN TSET ;: SCOLORMULTI OFF DRAW ; // SINGLE COLOR: DCOLORMULTI ON DRAW ; // DOUBLECOLOR 2012  2013// GRAPHICS SUPPORT - SPRITES!"HEX=: SX CREATE C, DOES> C@ SPRITE# ! ;0 SX S1 1 SX S2 2 SX S3 3 SX S4 4 SX S5 5 SX S6 6 SX S7 7 SX S8 2014// GRAPHICS SUPPORT SPRITES --"HEX=: SPRITEXY ( X Y -- ).>R SPRITE# @ SWAP R> 5 6 */ SPRITEPOS ; 2015 ?: SPR-DCOLOR ( CODE CODE )*D026 C! D025 C! ;j 2016 ?: WIDE-SPRITE ( FLAG).D01D C@ SWAP IF MASKS SPRITE# @ 7 XOR + C@ OR ELSE[ MASKS 8 + ] LITERAL SPRITE# @ 7 XOR + C@ AND THEN D01D C! ;2017: SPRITECOLOR ( CODE -- )+D027 SPRITE# @ + C! ;g: HIDESPRITE#ON @ [ MASKS 8 + ] LITERAL SPRITE# @ 2018 ?: HIGH-SPRITE ( FLAG)/D017 C@ SWAP IF MASKS SPRITE# @ 7 XOR + C@ OR ELSE [ MASKS 8 + ] LITERAL SPRITE# @ 7 XOR + C@ AND THEN D017 C! ; 2100 7 XOR + C@ AND DUP D015 C! #ON ! ;: SHOWSPRITE #ON @ MASKS SPRITE# @ 7 XOR + C@ OR DUPD015 C! #ON ! ;-DECIMAL8 2101: SPRITECOVER ( FLAG)*D01B C@ SWAP IF [ MASKS 8 + ] LITERAL SPRITE# @ 7 XOR + C@ ANDELSE MASKS SPRITE# @ 7 XOR + C@ OR THEN D01B C! ; DECIMAL8 2102// GRAPHICS SUPPORT - SPRITES#HEX=: SPRITEBANG ( -- FLAG)+D01E C@ SPRITE# @ 7 XOR MASKS + C@ AND 0<> ; 2103// GRAPHICS - TRY WINDOWING%: WINDOW ( LX LY RX HY )+2 PICK OVER + >R ( SAVE AY)$ASPECT DUP PY ! RY HY ! SWAP ASPECT DUP PY ! RY 1+ LY ! 2104 ?: DATABANG ( -- FLAG).D01F C@ SPRITE# @ 7 XOR MASKS + C@ AND 0<> ;P 2105 DUP PX ! TX 1+ RX ! DUP PX ! TX LX !RX @ LX @ - WW ! LY @ HY @ - WH ! R> AY !PENSTATE @ PU HOME PENSTATE ! ;] 2106  2107  2108 DECIMAL8 2109  2110// GRAPHICS SUPPORT -- BIGNAMESSDBJUL85 : NODRAW ND ; : FULLSCREEN FS ; : CLEARSCREEN CS ; : SETHEADING SETH ; : HIDETURTLE HT ; : SHOWTURTLE ST ;: RIGHT RT ; : LEFT LT ; : BACK BK ; : FORWARD FD ; 2111( BACH - PARTITA #5 , PREDLUDESDBJUN85)A: BACH1.4 V3 1/2 R V2 1/2 R V1 OC5 1/16 D C OC4 B A 1/8 G R ; : BACH1.66 2112: PENERASE PE ; : PENCOLOR PC ; : PENUP PU ;: PENDOWN PD ; : BACKGROUND BG ; : SPLITSCREEN SP ; 2113  D V2 OC3 1/8 B V3 OC3 1/8 G V1 R V2 R V3 R ( M2)V1 E V2 OC4 C V3 G V1 R V2 R V3 RV1 D V2 OC3 B V3 G V1 .1/4 R V2 R V3 R( M3)V1 1/16 OC5 D C OC4 B A G F# E D C OC3 B A G 1/8 2114  2115 ( M4)F# V2 OC4 C V3 OC2 G V1 R V2 R V3 RV1 G V2 OC3 B V3 G V1 .1/4 R V2 .1/4 R V3 .1/4 R ; : BACH1-4 BACH1.4 BACH1.6 ;%EXIT; 2116  2117  2118( BACH PRELUDE #5&SDBJUN85): C-B OC4 1/16 C D E F# G A B ;: BACH5-167( M5) V2 OC3 1/16 G B C-B OC5 C D E 2200( BACH PRELUDE #5&SDBJUN85): BACH17-20 7 TRANSPOSE BACH1-4 0 TRANSPOSE ;: BACH21-249V3 OC2 1/8 G V1 OC4 1/16 R F# V3 R V2 OC3 1/8 G V1 E F# 2201 ( M6) OC3 F# A B C-B OC5 C D#( M7) OC3 E G A B C-B OC5 C"( M8) OC3 D OC5 C OC4 A F# D OC3 A F# D OC2 DOC4 C OC3 B A G' 2202 V2 B V1 G F# V2 G V1 E F# V2 E V1 G E V2 C# V1 A B ( M22) V2 R V3 A V1 OC5 C# OC4 G V3 R V2 A V1 F# G V2 OC4 C# V1 A G V2 OC3 A V1 F# G V2 F# V1 A F# V2 D V1 B OC5 C# ( M23) V2 R V3 B V1 D OC4 A V3 R V2 B V1 G A V2 OC4 D V1 B A 2203 ( M9) OC4 B G F# D OC3 B G D OC2 G OC3 F# E D C#( M10) OC4 B G E C# OC3 G E C# OC2 C# OC3 B A G F# ( M11) OC4 A F# E C# OC3 A F# C# OC2 F# OC3 E D C# OC2 B( M12) OC4 A F# D OC3 B F# D OC2 B OC1 B OC3 A G F# E 2204 V2 OC3 B V1 G A V2 G V1 B G V2 E V1 OC5 C# DV2 C# V1 E OC4 B V2 OC4 C# V1 A B V2 E V1 OC5 C# OC4 B V2 C# V1 A B V2 OC3 A V1 OC5 C# OC4 A V2 F# V1 OC5 D E ; EXIT; 2205( M13) OC4 G E D OC3 B G E OC2 B E OC3 D C# OC2 B A ( M14) OC4 G E C# OC3 A E C# OC2 A OC1 A OC3 G F# E D V1( M15) 1/16 R OC3 A V2 R V1 B OC4 C# D E F D OC3 G# OC4 F E D ( M16) C# D E F# G A B_ G OC5 F E D C# ; 2206  2207( BACH PRELUDE #5%SDBJUN85) : BACH25-285( M25) V2 1/16 D V1 F# V2 OC4 D V1 G 1/8 A V2 C# DV1 R V2 E D V1 F# V2 C# D V1 G V2 OC3 B OC4 D 2208( BACH PRELUDE #5%SDBJUN85) : BACH29-319V2 1/8 D V1 1/16 F# E V2 A V1 D C# V2 F# V1 D F#V2 D V1 OC4 A OC5 C# V2 C# V1 D F# V2 A V1 OC4 A OC5 C# 2209  V1 A V2 OC3 B A)( M26) G V1 1/16 B V2 OC4 D V1 A 1/8 B V2 C# D V1 C# V2 E D V1 E V2 C# D V1 F# V2 OC3 A OC4 D V1 G V2 OC3 A G( M27) F# V1 1/16 A V2 OC4 D V1 G 1/8 A V2 C# D 2210( M30) V2 OC2 B V1 F E V2 OC3 G# V1 D C# V2 F V1 D FV2 D V1 OC4 G# OC5 C# V2 OC2 A V1 D FV2 OC3 A V1 OC4 A OC5 D"( M31) V2 OC2 G# V1 F E V2 OC3 B V1 D C# V2 F V1 D F 2211  V1 OC4 B V2 E D V1 OC5 F# V2 C# D V1 BV2 OC3 G OC4 D V1 A V2 OC3 G F#!E V1 1/16 G V2 OC4 D V1 F# 1/8 G V2 C# DV1 OC4 A V2 E D V1 OC5 E V2 C# D V1 A V2 OC3 F# OC4 D 2212 V2 D V1 OC4 G# OC5