mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-01 06:41:37 +00:00
1 line
171 KiB
Plaintext
1 line
171 KiB
Plaintext
\\ ÄIRECTORY VOLKSÆÏÒÔÈ 4OF4 26OCT87RE . 0 .. 0 Ã16-ÔAPE-ÄEMO 2 Ã64-ÇRAFIC-ÄEMO 6 CLOAD/CSAVE &13 ÔAPE-ÖERSION:ÌOADÓCREEN &16 ÒAMDISK &21 ÓUPERTAPE &32 AUTO-ÄECOMPILER &51 ÓCREENSWITCH &61 ÇRAFIC &64 ÍATH &90 ÓIEVE ÂENCHMARK &138 ÇRAFIC-ÄEMO &144 ÓPRITE-ÄEMO &160 ÓPRITE-ÄATA &165 ÓPRITE-ÅDITOR &166 \\ ÃONTENT VOLKSÆÏÒÔÈ 4OF4 26OCT87RE ÄIRECTORY 0 ÃONTENT 1 Ã16-ÔAPE -ÄEMO &2- &5 Ã64-ÇRAFIC-ÄEMO &6- &12 CLOAD CSAVE &13- &15 ÔAPE-ÖERSION:ÌOADÓCREEN &16- &20 ÒAMDISK &21- &30 &31 FREE ÓUPERTAPE &32- &50 AUTOMATIC ÄECOMPILER &51- &60 ÓCREENS VIA ÕSERÐORT Ã64 &61- &63 ÇRAFIC Ã64 ONLY!! &64- &88 &89 FREE ÍATH &90- &96 &97-&100 FREE ÔAPE ÒAMDISK ÓUPERTAPE &101-&135 SHADOW ÓIEVE ÂENCHMARK &138 ÇRAFIC-ÄEMO Ã64 ONLY!! &144-&155 ÓPRITE-ÄEMO Ã64 ONLY!! &160-&164 ÓPRITE-ÄATA &165 ÓPRITE ÅDITOR &166-&168 \ ÄEMOÌ:Ã16ÔAPE-ÄEMO ?DLOAD CLV10OCT87 \ ÄEMO: 80 ÓCREENS IN TOTAL !!! \ CHECKS IF A WORD IS DEFINED: Ü : EXISTS? ( STRING--FLAG) CR CAPITALIZE DUP FIND NIP UNDER 0= ÉÆ ." NOT " ÔÈÅÎ ." FOUND: " COUNT TYPE ; \ LAST ACCESSED DISKF: Ü ÖARIABLE ÌASTÄISK -1 ÌASTÄISK ! \ LOAD ÓÃÒ FROM ÄÉÓË, IF ×ÏÒÄ NAMED \ ÓÔÒÉÎÇ IS NOT IN ÆORTH ÄICTIONARY Ü : ?DLOAD ( STRING SCR DISK--) 2 PICK EXISTS? ÉÆ DROP DROP DROP EXIT ÔÈÅÎ DUP ÌASTÄISK @ - ÉÆ FLUSH ." ÉNSERT #" DUP . KEY DROP DUP ÌASTÄISK ! ÔÈÅÎ DROP ." SCR#" DUP . CR LOAD EXISTS? 0= ERROR" ???" ; --> \ ÄEMOÌ:?RELOC CLV10OCT87 \ RELOCATES SYSTEM CALL ÃÏÌÄ IF NECCES. Ü : ?RELOC ( S0 R0 LIMIT --) DUP LIMIT = 2 PICK ORIGIN $A + @ = AND 3 PICK ORIGIN 8 + @ = AND ÉÆ DROP DROP DROP EXIT ÔÈÅÎ ['] LIMIT >BODY ! \ LIMIT ORIGIN $Á + ! \ R0 DUP 6 + ORIGIN 1+ ! \ TASK ORIGIN 8 + ! \ S0 COLD ; \ COMPILES FORWARD REFERENCES THAT WILL \ BE LOADED LATER Ü : (FORWARD" "LIT CAPITALIZE FIND ÉÆ EXECUTE ÅÌÓÅ COUNT TYPE ." UNSATISFIED" QUIT ÔÈÅÎ ; RESTRICT Ü : FORWARD" COMPILE (FORWARD" ," ; IMMEDIATE RESTRICT --> \ ÄEMOÌ:64KB Ã16ÄEMO CLV10OCT87 \ CONFIGURES SYSTEM FOR 64Ë IF POSSIBLE : 64KB $533 @ $FD00 - ?DUP ÉÆ CR U. ." TOO SMALL" EXIT ÔÈÅÎ LIMIT $FD00 - ÉÆ $8000 $8400 $FD00 ?RELOC ÔÈÅÎ ; \ WILL BE INSTALLED AS 'ÒÅÓÔÁÒÔ: : C16DEMO CR ." C16-ÄEMO" FORWARD" TAPEINIT" 0 DRIVE FORWARD" FLOPPY" CR ." ÔYPE 'HELP' TO GET HELP" CR ." ÔYPE '64KB' TO USE 64KB" ; --> \ ÄEMOÌ:Ã16ÄEMOÌOAD CCLV14OCT87 \ ÔHIS WORD LOAD THE COMPLETE \ ÄEMO-ÖERSION. ×ILL BE INSTALLED AS \ 'ÃÏÌÄ AND LATER AS Ã16ÄÅÍÏ Ü : C16ÄEMOÌOAD $9000 $9400 $C000 ?RELOC ÆORTH " ÃODE" 5 3 ?DLOAD ÆORTH " ÅDITOR" $13 3 ?DLOAD ÆORTH " DEBUG" $2F 3 ?DLOAD ÆORTH " HELP" $A 1 ?DLOAD ÆORTH " ÔAPEINIT" $10 4 ?DLOAD ['] NOOP ÉS 'COLD ['] C16DEMO ÉS 'RESTART FORWARD" ÅDITOR" FORWARD" ÅDIBOARD" 1 SCR ! 0 R# ! SAVE $7A00 $7BF0 $8000 ?RELOC ; ' C16ÄEMOÌOAD ÉS 'COLD SAVE CR .( ÔYPE : COLD) CR .( AFTER ALL: SAVESYSTEM!!!) \ ÇRAPHIC-ÄEMO FOR Ã64 23OCT87RE (16 .( ÎOT FOR Ã16!) \\ Ã) ÏNLYFORTH \NEEDS BUFFERS .( ÂUFFERS?!) \\ \NEEDS DEMOSTART .( ÄEMOSTART?!) \\ \NEEDS TASKS .( ÔASKER??!) \\ \NEEDS HELP .( HELP??!) \\ \NEEDS GRAPHIC &58 +LOAD \NEEDS .MESSAGE2 1 2 +THRU ÇRAPHIC ALSO \NEEDS MOIRE 6 +LOAD \NEEDS SLIDE &154 +LOAD \ THE ÄEMO 3 5 +THRU 1 ÓCR ! 0 Ò# ! SAVE \ DEMO-VERSION 06NOV87RE Ü : (CENTER." "LIT COUNT Ã/Ì OVER - 2/ SPACES TYPE CR ; RESTRICT Ü : C." COMPILE (CENTER." ," ; IMMEDIATE RESTRICT Ü : .ÆÇES C." ÆORTH ÇESELLSCHAFT E.Ö." ; Ü : .VÆ83 C." *** VOLKSÆÏÒÔÈ-83 ***" ; Ü : .(C) C." (C) 1985-2006" C." ÂERND ÐENNEMANN ËLAUS ÓCHLEISIEK" C." ÇEORG ÒEHFELD ÄIETRICH ×EINECK" C." ÃLAUS ÖOGT ÅWALD ÒIEGER " C." ÃARSTEN ÓTROTMANN " ; Ü : .SOURCE C." WWW.FORTH-EV.DE" CR C." VOLKSFORTH.SF.NET" ; Ü : WAIT ÂÅÇÉÎ KEY 3 - ÕÎÔÉÌ ; \ DEMO-VERSION 20OCT87RE : .MESSAGE1 ( -- ) SINGLETASK PAGE .VÆ83 CR .(C) CR C." VOLKSÆORTH IS FREE SOFTWARE" C." SEE FILE ÃÏÐÙÉÎÇ IN THE" C." DISTRIBUTION PACKAGE" MULTITASK WAIT ; : .MESSAGE2 ( -- ) PAGE C." ÙOU NOW HAVE CREATED A" C." WORKSYSTEM WITH ÅDITOR," C." ÄEBUGGER AND ÁSSEMBLER!" C." ÐLEASE INSERT AN EMPTY, FORMATTED" C." ÄISK AND SAVE THE NEW SYSTEM WITH" C." ÓÁÖÅÓÙÓÔÅÍ <NAME> (EG. ÆÏÒÔÈ)" C." AS A LOADABLE PROGRAM FILE" CR .VÆ83 CR C." ÉNFORMATION ON VOLKSÆORTH FROM" .ÆÇES C." ON:" CR .SOURCE WAIT ; \ DEMO-VERSION 20OCT87RE GRAPHIC ALSO Ü ÖARIABLE END? : KILLDEMO ( -) KILLSPRITES ENDSLIDE SINGLETASK .MESSAGE2 ['] 1541R/W ÉS R/W ['] NOOP ÉS 'COLD ['] NOOP ÉS 'RESTART ['] (QUIT ÉS 'QUIT NOGRAPHIC [ ' DEMOSTART >NAME 4 - ] ÌITERAL (FORGET SAVE &16 BUFFERS ; \ DEMO-VERSION 06NOV87RE Ü : DEMOR/W ( ADR BLK R/WF - F) END? @ 0 MAX DUP SMALL RED COLORED -1 END? +! SPRITE PUSH KILLSPRITES 1541R/W ; Ü : DEMOQUIT ÂÅÇÉÎ .STATUS CR QUERY INTERPRET STATE @ ÉÆ ." COMPILING" ÅÌÓÅ ." VÆ83" ÔÈÅÎ END? @ 0< DUP ÉÆ DROP CR ." ËILL THE ÄEMO? N/Y " KEY CAPITAL ÁSCII Ù = DUP NOT ÉÆ DEL DEL DEL ÔÈÅÎ ÔÈÅÎ ÕÎÔÉÌ KILLDEMO ; \ DEMO-VERSION 20OCT87RE : DEMONSTRATION ÏNLYFORTH GRAPHIC ['] DEMOR/W ÉS R/W ['] KILLDEMO ÉS 'COLD SLIDE MULTITASK PAUSE 4 END? ! ['] DEMOQUIT ÉS 'QUIT ['] (ERROR ERRORHANDLER ! ['] NOOP ÉS 'ABORT .MESSAGE1 LINIEN TEXT KEY DROP MOIRE TEXT KEY DROP ." HELP" ROW 1- 0 AT ABORT ; ' DEMONSTRATION ÉS 'COLD ' KILLDEMO ÉS 'RESTART \ HIRES DEMO WORDS 06NOV87RE : LINIEN CLRSCREEN YEL BLU COLORS HIRES &320 0 ÄÏ &320 0 ÄÏ É &198 Ê 0 LINE &35 +ÌÏÏÐ &35 +ÌÏÏÐ ; : MOIRE CLRSCREEN ORA RED COLORS HIRES &320 0 ÄÏ É &198 &319 É - 0 LINE 3 +ÌÏÏÐ &199 0 ÄÏ &319 &198 É - 0 É LINE 2 +ÌÏÏÐ ; \ CÓAVE CÌOAD.. CLV10OCT87 ÏNLYFORTH \NEEDS ÃODE .( NEED ÁSSEMBLER!) QUIT $FF90 >LABEL SETÍSG $90 >LABEL STATUS $FFBA >LABEL SETLFS $FFBD >LABEL SETÎAM $ÆÆÄ8 >LABEL ÂÓÁÖÅ $ÆÆÄ5 >LABEL ÂÌÏÁÄ ÌABEL SLÐARS SETUP JSR (16 ROM Ã) $80 # LDA SETÍSG JSR 0 # LDA STATUS STA Î LDA SEC 8 # SBC (DRV STA Ãà ?[ DEX ]? (DRV 1+ STX Î LDX Î 1+ LDY 1 # LDA SETLFS JSR Î 4 + LDX Î 5 + LDY Î 2+ LDA SETNAM JSR Î 6 + LDX Î 7 + LDY RTS END-CODE ÌABEL SLÅRR \ ÁÒ=ËERNALERROR Ãà ?[ 0 # LDA ]? PHA STATUS LDA $BF # AND (16 RAM Ã) PUSH JMP END-CODE --> ÆÏÒÔÈ-ÇÅÓÅÌÌÓÃÈÁÆÔ (C) BP/KS/RE/WE/CLV \ ..CÓAVE CÌOAD CLV10OCT87 ÃODE CÓAVE ( F T+1 ÎAME ÎLEN DEV--ERR) 5 # LDA ÓÌÐARS JSR Î 8 + # LDA BSAVE JSR SLÅRR JMP END-CODE ÃODE CÌOAD ( F ÎAME ÎLEN DEV--T+1 ERR) 4 # LDA ÓÌÐARS JSR 0 # LDA BLOAD JSR PHP PHA TYA PHA TXA PHA 0 # LDY ÓÐ 2DEC PLA ÓÐ )Y STA INY PLA ÓÐ )Ù STA PLA PLP SLÅRR JMP END-CODE --> \\ POSSIBLE ERRORS ÁÒ ÃÆ ÓÔ ÂASIC ÆORTH XX Ì 00 NO ERROR 0 0 00 È 00 STOP-KEY 1E 1E 00 Ì 60 END-OF-TAPE 04 00 00 Ì 10 LOAD/VERIFY-ERROR 1D/1C 1D 00 Ì 60 ÃHECKSUMERROR 1D 1D 0-8 È 00 ËERNAL-ÅRROR 0-8 0-8 ÆÏÒÔÈ-ÇÅÓÅÌÌÓÃÈÁÆÔ (C) BP/KS/RE/WE/CLV \ ..CÓAVE CÌOAD ÌUXUS CLV10OCT87 ÃODE .ERR ( ERR#-ERR# ) \ PRINTS MESSAGE ÓÐ X) LDA 0>= ?[ (16 TAX DEX ROM $8654 JSR Ã) (64 .Á ASL TAX ROM $A326 ,X LDA $24 STA $A327 ,X LDA $25 STA DEY Ã) DEY [[ INY $24 )Y LDA PHP $7F # AND $FFD2 JSR PLP 0< ?] (16 RAM Ã) (64 RAM Ã) ]? XYÎEXT JMP END-CODE : DERR? ( ERR# -- FLAG) DUP ÉÆ CR DUP U. .ERR ." ERROR" ÔÈÅÎ DUP $FF AND 5 = NOT (DRV @ -1 > AND ÉÆ DERROR? OR ÔÈÅÎ (DRV @ 0 MAX (DRV ! ; \\ FOR USAGE AFTER ÃÓÁÖÅ AND ÃÌÏÁÄ. ÔHE LAST LINE IS ONLY FOR ÃOMPATIBILITY WITH OLD VERSION. \ ÔAPEÖERSION:ÌOADÓCREEN CLV12OCT87 ÏNLYFORTH \NEEDS ÃODE .( ?! ÃODE !?) QUIT 5 +LOAD \ ÒAMDISK -3 +LOAD \ CSAVE/LOAD 1 3 +THRU \ ÔAPE (16 $10 +LOAD Ã) \ SUPERÔAPE 4 +LOAD \ SAVESYS ÏNLYFORTH ÖARIABLE AUTOLOAD AUTOLOAD OFF : TAPEÉNIT CR CR ." ÔAPE2.00 " \IF SUPERTAPE SUPERTAPE ['] RAMR/W ÉS R/W 1 DRIVE AUTOLOAD @ ÉÆ AUTOLOAD OFF LOADRAMDISK ÔÈÅÎ ; SAVE ' TAPEÉNIT ÉS 'RESTART \ RESTART \ STORE RESTORE CLV24JUL87 \ WIE PUSH PULL ABORT" Ü ÃREATE RESTORE 0 ] R> R> ! ; : STORE ( ADDR -- ) R> SWAP DUP >R @ >R RESTORE >R >R ; RESTRICT \ RSTACK: RESTORE DATE ADDRESS .... Ü : BACK \ -- \ REWINDS RSTACK R> ÂÅÇÉÎ RDEPTH ×ÈÉÌÅ R> RESTORE = ÉÆ R> R> ! ÔÈÅÎ ÒÅÐÅÁÔ >R ; : (RESTORE" "LIT SWAP ÉÆ >R CLEARSTACK R> BACK ERRORHANDLER PERFORM EXIT ÔÈÅÎ DROP ; RESTRICT : RESTORE" COMPILE (RESTORE" ," ; IMMEDIATE RESTRICT \ TAPE-INTERFACE CLV01AUG87 \NEEDS CLOAD .( ?! CLOAD ?!) QUIT \NEEDS RESTORE .( ?! RESTORE ?!) QUIT ÖARIABLE DEVICE 0 DEVICE ! : COMMODORE 1 DEVICE ! ; \ DEVICE.. : FLOPPY 8 DEVICE ! ; : BLOAD ( [FROM NAME COUNT -- ]TO) DEVICE @ CLOAD DERR? RESTORE" LOAD" ; : BSAVE ( [FROM ]TO NAME COUNT--) DEVICE @ CSAVE DERR? RESTORE" SAVE" ; : N" ( -- ADR COUNT) ÁSCII " PARSE ; \ ÒAMDISK ÔAPEÉNTERFACE CLV29JUL87 ÏNLYFORTH ÒAMDISK ALSO : SAVEÒAMÄISK RD BEHIND ID COUNT BSAVE ; : LOADÒAMÄISK RD? 0= ÉÆ RANGE MEMTOP RDNEW RD ÔÈÅÎ " ÒÄ." COUNT BLOAD DROP ; \ \IF SAVESYSTEM" CLV01AUG87 \NEEDS RESTORE" .( ?! RESTORE" ?!) QUIT ÏNLYFORTH : \IF NAME FIND 0= ÉÆ [COMPILE] \ ÔÈÅÎ DROP ; IMMEDIATE : SAVESYSTEM \ -- NAME MUST FOLLOW \ ÆORTH-ËERNAL A LA BOOT: SCR STORE 1 SCR ! R# STORE 0 R# ! \ ÅDITOR A LA BOOT \IF ÅDITOR [ ÅDITOR ] \IF ÅDITOR STAMP$ STORE STAMP$ OFF \IF ÅDITOR (PAD STORE (PAD OFF SAVE \ ÓUPERTAPE? IF THEN OTHER ROUTINE \IF SUPERTAPE DEVICE @ 7 = \IF SUPERTAPE ÉÆ STÓAVÓYS EXIT ÔÈÅÎ \ NOW WE SAVE ORIGIN $17 - HERE N" BSAVE ; \ ÒÄ: LOADSCREEN CLV01AUG87 ÏNLYFORTH (16 $FD00 Ã) (64 $C000 Ã) ÃONSTANT MEMTOP ÖOCABULARY ÒAMDISK ÒAMDISK ALSO DEFINITIONS 1 9 +THRU ÏNLYFORTH \ ÒÄ: BASICS CLV01AUG87 ÖARIABLE (RD (RD OFF $31 CONSTANT PLEN : ADR> ( ADR--OFS) (RD @ - ; : >ADR ( OFS--ADR) (RD @ + ; : ADR@ ( OFS--ADR) >ADR @ >ADR ; : RD? ( -- ADR FLAG ) (RD @ DUP DUP @ PLEN = AND ; : RD ( -- ADR) RD? 0= ABORT" NO ÒAMDISK" ; Ü : TAKE ( ADR-- ) ADR> 2 >ADR ! ; : ADR ( --ADR ) 2 ADR@ ; : DATA ( --ADR ) ADR 4 + ; Ü : END ( --ADR ) 4 ADR@ ; : BEHIND ( --ADR ) END 4 + ; Ü : END+ ( LEN-- ) 4 >ADR +! ; : BLK# ( --ADR ) 8 >ADR ; : ID ( --ADR ) $10 >ADR ; \ ÒÄ: NEW DELETE LEN@ LEN! CLV01AUG87 Ü : ?FULL END 6 ADR@ B/BLK - 4 - U> ABORT" ÒAMDISK FULL" ; Ü : NEW ( --) END TAKE ?FULL ; Ü : LEN! ( LEN--) \ END NEW BLOCK ?DUP 0= ?EXIT BLK# @ END 2+ ! 4 + DUP END ! END+ END OFF ; Ü : LEN@ ( --LEN) \ GEN LENGTH ADR @ DUP 0= ?EXIT 4 - ; : DELETE ( --) ADR DUP @ UNDER + ADR BEHIND OVER - CMOVE NEGATE END+ ; \ ÒÄ: SEARCH BINARY CLV01AUG87 : SEARCH ( BLK --) \ SET CURRENT ÂLOCK RD ÂÅÇÉÎ DUP @ + DUP @ ×ÈÉÌÅ ( BLK ADR ) 2DUP 2+ @ = ÕÎÔÉÌ TAKE BLK# ! ; Ü : NOTÒÄ? ( BLK--FLAG) BLK/DRV U< ; ÏNLYFORTH ÒAMDISK ALSO : BINARY ( BLK--BLK) \ NO ÃOMÐAND DUP OFFSET @ + NOTÒÄ? ?EXIT DUP BLOCK DROP UPDATE DELETE NEW B/BLK LEN! ; \ ÒÄ: CBM>7BIT 7BIT>CBM CLV01AUG87 ÌABEL CBM>7B \ ÁÒ=CHAR -- 7BITÃHAR $80 # CMP 0< ?[ RTS ]? $C0 # CMP ÃÓ ?[ $E0 # CMP Ãà ?[ $A0 # ADC RTS ]? ]? $1F # AND RTS END-CODE ÌABEL 7B>CBM \ ÁÒ=7BITÃHAR -- CHAR $60 # CMP Ãà ?[ RTS ]? $A0 # SBC RTS END-CODE ÃODE C>7 SP X) LDA CBM>7B JSR PUTÁ JMP ÃODE 7>C SP X) LDA 7B>CBM JSR PUTÁ JMP END-CODE \ ÒÄ: CP1 CP2 CLV01AUG87 ÌABEL CP1 ( FROM TO COUNT--TOCOUNT) 3 # LDA SETUP JSR Î 2+ LDA Î 6 + STA Î 3+ LDA Î 7 + STA DEY $7F # LDX Î LDA 0= ?[ Î 1+ LDA 0= ?[ PLA PLA 0 # LDA PUSH0A JMP ]? ][ Î 1+ INC ]? RTS ÌABEL CP2 SEC Î 2+ LDA Î 6 + SBC PHA Î 3+ LDA Î 7 + SBC PUSH JMP \ ÒÄ: EXPAND COMPRESS CLV01AUG87 ÃODE EXPAND CP1 JSR [[ [[ Î 4 + )Y LDA 0< ?[ $7F # AND TAY TAX BL # LDA [[ Î 2+ )Y STA DEY 0< ?] INY SEC TXA Î 2+ ADC Î 2+ STA ÃÓ ?[ Î 3+ INC ]? ][ 7B>CBM JSR Î 2+ )Y STA Î 2+ WINC ]? Î 4 + WINC Î DEC 0= ?] Î 1+ DEC 0= ?] CP2 JMP END-CODE ÃODE COMPRESS CP1 JSR [[ [[ Î 4 + )Y LDA BL # CMP 0= ?[ INX 0= ?[ DEX TXA Î 2+ )Y STA Î 2+ WINC $80 # LDX ]? ][ $80 # CPX 0>= ?[ PHA TXA Î 2+ )Y STA Î 2+ WINC $7F # LDX PLA ]? CBM>7B JSR Î 2+ )Y STA Î 2+ WINC ]? Î 4 + WINC Î DEC 0= ?] Î 1+ DEC 0= ?] $80 # CPX 0>= ?[ TXA Î 2+ )Y STA Î 2+ WINC ]? CP2 JMP END-CODE \ ÒÄ: RAMÒ/× CLV01AUG87 Ü : ENDWRITE ( COMPÌEN--) DATA UNDER + ( [FROM ]TO ) ÂÅÇÉÎ 1- DUP C@ $7F U> ×ÈÉÌÅ 2DUP U> ÕÎÔÉÌ 1+ SWAP - LEN! ; Ü : ENDREAD ( TOÁDR EXPÌEN--) UNDER + B/BLK ROT - BL FILL ; : RAMÒ/× ( ADR BLK FILE Ò/ÎOT× -- ERROR) 2 PICK NOTÒÄ? ÉÆ 1541R/W ÅÌÓÅ SWAP ABORT" NO FILE" SWAP SEARCH LEN@ B/BLK = ( ADR R? B?) ÉÆ 0= ÉÆ DATA ÅÌÓÅ DATA SWAP ÔÈÅÎ B/BLK CMOVE ÅÌÓÅ 0= ÉÆ DELETE NEW DATA B/BLK COMPRESS ENDWRITE ÅÌÓÅ DUP DATA SWAP LEN@ EXPAND ENDREAD ÔÈÅÎ ÔÈÅÎ FALSE ÔÈÅÎ ; \ ÒÄ: ID RDUSE/DEL/NEW CLV01AUG87 : .RD ( --) (RD @ U. RD DROP END U. 6 ADR@ U. ID COUNT TYPE ; : ID! ( ADR COUNT--) $20 ID C! ID COUNT BL FILL $1A UMIN ID 3 + PLACE " ÒÄ." COUNT ID 1+ SWAP CMOVE ; : ID" ÁSCII " PARSE ID! ; \ ID" NAME : RDUSE ( FROM --) (RD ! ; : RDDEL ( --) RD @ DUP 2 >ADR ! 4 >ADR ! END OFF ; Ü : RANGE ( ADR--ADR) LIMIT UMAX MEMTOP UMIN ; : RDNEW ( FROM TO--) RANGE SWAP RANGE SWAP 2DUP $500 - U> ABORT" RANGE!" OVER PLEN OVER ! RDUSE SWAP - 6 >ADR ! RDDEL 0 0 ID! ; \ ÒÄ: RDCHECK CLV01AUG87 Ü : ?ERROR ÉÆ ." ERROR " ÔÈÅÎ ; : RDCHECK .RD RD ÂÅÇÉÎ DUP @ DUP 0 B/BLK 5 + UWITHIN NOT ?ERROR + DUP CR U. DUP @ DUP 3 U.R SPACE ×ÈÉÌÅ DUP 2+ @ BLK/DRV U/MOD 1 U.R ." :" 2 U.R DUP 4 + &26 TYPE STOP? ?EXIT ÒÅÐÅÁÔ END - ?ERROR ; \ ÓÔ:ÓUPERTAPE ÌOADÓCREEN CLV01AUG87 (64 .( NOT FOR Ã64!! ) QUIT Ã) \NEEDS ÃODE .( NEEDS ÁSSEMBLER!) QUIT ÁSSEMBLER \NEEDS ROM .( ??! ROM !??) QUIT ÏNLYFORTH 1 $12 +THRU \ LOAD SUPERTAPE \\ ÓUPERTAPE WAS DEVELOPED BY GERMAN MAGAZIN C'T ( WWW.HEISE.DE ) ×E THANK THE PUBLISHER FOR PERMISSION TO ADAPT ÓUPERÔAPE FOR VOLKSÆORTH \ ÓÔ:ÌABELS.. CLV16JUN87 \ ------ HARDWARE-ÁDDRESSES ----------- $0001 >ÌABEL PÃASS $FF02 >ÌABEL PÔIMER $FF09 >ÌABEL PÔIMERÂÃTRL $FF3F >ÌABEL PÒAMÏN $FF3E >ÌABEL PÒAMÏFF \ ------ ÓYSTEM-ÖECTORS -------------- $0330 >ÌABEL VÓAVE $032E >ÌABEL VÌOAD \ --- ÉNPUT-ÐARAMS ÌOAD/ÓAVE --------- $AE >ÌABEL ZÄEVICEÎR $AD >ÌABEL ZÓECADD $AF >ÌABEL ZÆILENAMEÚ $AB >ÌABEL ZÆILEÎAMEà $B4 >ÌABEL ZÂASÌOADÁDD $B2 >ÌABEL ZÉÏÓTARTÚ $9D >ÌABEL ZÐROGÅNDÚ \ --- ÏUTPUT ÐARAMS FOR ÌOAD/ÓAVE ---- $90 >ÌABEL ZÓTATUS \ ÓÔ:..ÌABELS CLV16JUN87 \ ------ USED ÓYSTEM ÒOUTINES --------- $E38D >ÌABEL XÃASSÍOTORÏN $E3B0 >ÌABEL XÃASSÍOTORÏFF $E364 >ÌABEL XÃASSÐRTÏN $E378 >ÌABEL XÃASSÐRTÏFF $F050 >ÌABEL XÌOAD $F1A4 >ÌABEL XÓAVE $F189 >ÌABEL XÍSGÌOADÖERIFY $E31B >ÌABEL XÐRESSPLAY $E319 >ÌABEL XÐRESSÒEC $EBCA >ÌABEL XÆOUNDÆILE $F160 >ÌABEL XÓEARCHING $FFD2 >ÌABEL KÏUTPUT \ ------ USED ÚEROPAGE ÁDDRESSES ------ $5F >ÌABEL ZÂEGINÚ $61 >ÌABEL ZÅNDÚ $93 >ÌABEL ZÖERIFYÆLAG $59 >ÌABEL ÚÂLOCKËIND $58 >ÌABEL ZÂIT $57 >ÌABEL ZÂYTE $FF >ÌABEL ZÔMP \ ÓÔ:..ÌABELS CLV16JUN87 $D8 >ÌABEL ZÒESERVÁÁ $5D >ÌABEL ZÃHECKÓUM $63 >ÌABEL ZÃHECKÓUM $DA >ÌABEL ZÔMPÓÐ \ --- OTHER ÓYSTEMADRESSEN ---------- $07C8 >ÌABEL SÔIME $0332 DUP >ÌABEL SÃASSÂUFFER $19 + $100 MOD >ÌABEL CÃASSÂUFFERÅND \ --------- ËONSTANTEN -------------- $07 >ÌABEL CÄEVICEÓÔ $2A >ÌABEL CÈEADERÍARK $C5 >ÌABEL CÄATAÍARK $4F >ÌABEL CHSL $B5 >ÌABEL CLSL $78 >ÌABEL CHSSH $34 >ÌABEL CHSSL $FF >ÌABEL CLSSH $78 >ÌABEL CLSSL $16 >ÌABEL CÓYNCÂYTE $0B >ÌABEL CÓYNCÂYTESÌOAD $40 >ÌABEL CÓYNCÂYTEÃOUNT \ ÓÔ:VERSCHIEDENES CLV28JUL87 ÌABEL BTLÂEG ÌABEL PUFFINIT \ ÌOAD ÐOINTER TO ÂUFFER SÃASSBUFFER $100 U/MOD # LDA ZÂEGINÚ 1+ STA ZÅNDÚ 1+ STA # LDA ZÂEGINÚ STA CÃASSBUFFERÅND # LDA ZÅNDÚ STA RTS END-CODE ÌABEL TIMERÂÓTART SÔIME LDA PÔIMER STA 0 # LDA PÔIMER 1+ STA $10 # LDA PÔIMERÂÃTRL STA RTS END-CODE ÌABEL DELAYÍOTOR \ ÍOTOR START ÄELAY 0 # LDX 0 # LDY [[ [[ DEX 0= ?] DEY 0= ?] RTS END-CODE \ ÓÔ:STÅNDE ETC. CLV23JUL87 ÌABEL STÅND 0 # LDA $2C C, ÌABEL LOADÅRROR $1D # LDA $2C C, ÌABEL EOT $04 # LDA $2C C, ÌABEL VERÅRROR $1C # LDA $2C C, ÌABEL BRKÅRROR $1E # LDA PÒAMÏFF STA PHA XÃASSÍOTORÏFF JSR XÃASSÐRTÏFF JSR ZÔMPÓÐ LDX PLA TXS ZÂEGINÚ LDX ZÂEGINÚ 1+ LDY 01 # CMP CLI RTS END-CODE \\ CBM: STOP: AR=0 CF=1 NORMAL AR=0 CF=0 ST=0 EOT $80 LOAD/VERERR $10 CHECKSUM $60 ... KERNAL-ERRORS AR=0..8 CF=1 S.ÒÏÍ:$A803 \ ÓÔ:BITÒEAD CLV18JUN87 ÌABEL BITÒEAD \ CUR.ÂYTE IN ÁÒ $10 # LDA [[ PTIMERÂCTRL BIT 0<> ?] PÃASS LDA $10 # AND ZÂIT CMP 0<> ?[ CLC ]? ZÂIT STA ZÂYTE ROR ZÂYTE LDA 0< ?[ ZÃHECKÓUM WÉNC ]? [[ PÃASS LDA $10 # AND ZÂIT CMP 0<> ?] ZÂIT STA TIMERÂÓTART JSR ZÂYTE LDA RTS END-CODE \ ÓÔ:STÒEAD.. CLV05AUG87 ÌABEL STÒEAD \ READS A BLOCK ZÂLOCKËIND STA 0 # LDX ÌABEL SYNCRON [[ BITÒEAD JSR CÓYNCÂYTE # CMP 0= ?] CÓYNCÂYTESÌOAD # LDX [[ $08 # LDY [[ BITÒEAD JSR DEY 0= ?] CÓYNCÂYTE # CMP SYNCRON BNE DEX 0= ?] [[ $08 # LDY [[ BITÒEAD JSR DEY 0= ?] CÓYNCÂYTE # CMP 0<> ?] ZÂLOCKËIND CMP 0<> ?[ CÄATAÍARK # CMP SYNCRON BEQ $10 # LDA ZÓTATUS STA LOADÅRROR JMP ]? 0 # LDA ZÃHECKÓUM STA ZÃHECKÓUM 1+ STA $08 # LDY [[ BITÒEAD JSR DEY 0= ?] ZÔMP STA \ ÓÔ:..STÒEAD CLV28JUL87 [[ [[ ZÃHECKÓUM LDA ZÃHECKÓUM STA ZÃHECKÓUM 1+ LDA ZÃHECKÓUM 1+ STA BITÒEAD JSR BITÒEAD JSR ZÖERIFYÆLAG LDA 0= ?[ ZÔMP LDA ZÂEGINÚ )Ù STA ]? BITÒEAD JSR BITÒEAD JSR ZÔMP LDA ZÂEGINÚ )Ù CMP 0<> ?[ INX ]? BITÒEAD JSR BITÒEAD JSR ZÂEGINÚ WÉNC BITÒEAD JSR BITÒEAD JSR ZÔMP STA ZÂEGINÚ 1+ LDA ZÅNDÚ 1+ CMP 0= ?] ZBEGINÚ LDA ZÅNDÚ CMP 0= ?] \ ÓÔ:..STÒEAD CLV05AUG87 ZÔMP LDA ÚÃHECKÓUM CMP 0<> ?[ ÌABEL ÓÅRROR ZÓTATUS LDA $60 # ORA ZÓTATUS STA LOADÅRROR JMP ]? $08 # LDY [[ ÂITÒEAD ÊSR DEY 0= ?] ZÃHECKÓUM 1+ CMP ÓÅRROR BNE 0 # CPX 0<> ?[ $10 # LDA ZÓTATUS STA VERÅRROR JMP ]? ÌABEL LDÒÔÓ RTS END-CODE \ ÓÔ:STÌOAD.. CLV23JUL87 ÌABEL STÌOAD ZÖERIFYÆLAG STA 0 # LDA ZÓTATUS STA ZÄEVICEÎR LDA CÄEVICEÓÔ # CMP 0<> ?[ XÌOAD JMP ]? \ ÃÂÍ-ÒOUTINE ÌABEL LOADÎEXT TSX ZÔMPÓÐ STX XÐRESSPLAY JSR LDÒÔÓ BCS SEI ZÖERIFYÆLAG LDA PHA 0 # LDA ZÖERIFYÆLAG STA XÓEARCHING JSR ÌABEL LD×RONGÆILE XÃASSÍOTORÏN JSR DELAYÍOTOR JSR XÃASSÐRTÏN JSR PUFFÉNIT JSR CLSL # LDA SÔIME STA CÈEADERÍARK # LDA STÒEAD JSR $63 # LDY XÆOUNDÆILE JSR 0 # LDY [[ SÃASSÂUFFER ,Ù LDA KÏUTPUT JSR INY $10 # CPY 0= ?] $FF # LDY \ ÓÔ:..STÌOAD CLV23JUL87 ÌABEL LDÃOMP [[ INY ZÆILEÎAMEà CPY 0<> ?[[ PÒAMÏN STA ZÆILENAMEÚ )Ù LDA PÒAMÏFF STA SÃASSÂUFFER ,Ù CMP LDÃOMP BEQ ÁSCII ? # CMP LDÃOMP BEQ SÃASSÂUFFER $10 + LDA $02 # AND 0<> ?[ $80 # LDA ZÓTATUS STA EOT JMP ]? XÃASSÐRTÏFF JSR LD×RONGÆILE JMP ]]? PLA ZÖERIFYÆLAG STA XÍSGÌOADÖERIFY JSR ZÂASÌOADÁDD LDA ZÂEGINÚ STA ZÂASÌOADÁDD 1+ LDA ZÂEGINÚ 1+ STA ZÓECÁDD LDA 0<> ?[ SÃASSÂUFFER $11 + LDA ZÂEGINÚ STA SÃASSÂUFFER $12 + LDA ZÂEGINÚ 1+ STA ]? CLC SÃASSÂUFFER $13 + LDA ZÂEGINÚ ADC ZÅNDÚ STA SÃASSÂUFFER $14 + LDA ZÂEGINÚ 1+ ADC ZÅNDÚ 1+ STA \ ÓÔ:..STÌOAD CLV14OCT87 CHSL # LDA SÔIME STA SÃASSÂUFFER $10 + LDA 0>= ?[ CLSL # LDA SÔIME STA ]? PÒAMÏN STA CÄATAÍARK # LDA STÒEAD JSR STÅND JMP END-CODE ÌABEL LOADSYS \ LOAD AND START LOADNEXT JSR ÃÓ ?[ BRK ]? LOADNEXT JSR ÃÓ ?[ BRK ]? ORIGIN 8 - JMP \ ÆORTH-ÃOLD VECTOR ÌABEL BTLÅND BASE @ HEX ÃREATE G---- 7 ALLOT LOADSYS 0 <# #S ÁSCII G HOLD #CR HOLD #> G---- PLACE BASE ! : >LOWER ( STR--) COUNT BOUNDS ÄÏ É C@ $7F AND É C! ÌÏÏÐ ; G---- >LOWER FORGET >LOWER \ ÓÔ:WÂYTE W4BITS CLV16JUN87 ÌABEL WÂYTE HERE 3 + ÊSR \ WRITE BYTE ÌABEL W4BITS \ UPPER 4 ÂITS $04 # LDY [[ ZÂYTE LSR ÃÓ ?[ ZÒESERVÁÁ 1+ LDA SÔIME STA ]? $10 # LDA [[ PÔIMERÂÃTRL BIT 0<> ?] TIMERÂÓTART JSR PÃASS LDA $02 # EOR PÃASS STA Ãà ?[ $10 # LDA [[ PÔIMERÂÃTRL BIT 0<> ?] TIMERÂÓTART JSR PÃASS LDA $02 # EOR PÃASS STA ][ ZÃHECKÓUM LDA 0 # ADC ZÃHECKÓUM STA ZÃHECKÓUM 1+ LDA 0 # ADC ZÃHECKÓUM 1+ STA ZÒESERVÁÁ LDA SÔIME STA ]? DEY 0= ?] RTS END-CODE \ ÓÔ:ST×RITE CLV18JUN87 ÌABEL ST×RITE \ WRITES A BLOCK PHA CÓYNCÂYTEÃOUNT # LDX [[ CÓYNCÂYTE # LDA ZÂYTE STA WÂYTE ÊSR DEX 0= ?] PLA ZBYTE STA WÂYTE ÊSR 0 # LDY ZÃHECKÓUM STY ZÃHECKÓUM 1+ STY [[ [[ ZÂEGINÚ )Ù LDA ZÂYTE STA W4BITS JSR ZÂEGINÚ WÉNC W4BITS JSR ZÂEGINÚ LDA ZÅNDÚ CMP 0= ?] ZÂEGINÚ 1+ LDA ZÅNDÚ 1+ CMP 0= ?] ZÃHECKÓUM LDA ZÃHECKÓUM 1+ LDX ZÂYTE STA WÂYTE JSR TXA ZÂYTE STA WÂYTE JSR WÂYTE JMP END-CODE \ ÓÔ:SAVEÎAME CLV26JUL87 ÌABEL SAVEÎAME \ NO ERROR CHECKING! BL # LDA $0F # LDY [[ SÃASSÂUFFER ,Ù STA DEY 0= ?] ZÆILEÎAMEà LDY RAM [[ DEY 0>= ?[[ ZÆILEÎAMEÚ )Ù LDA SÃASSÂUFFER ,Ù STA ]]? ROM ÌABEL RSÒÔÓ RTS END-CODE \ ÓÔ:STÓAVE.. CLV16JUN87 ÌABEL STÓAVE ZÄEVICEÎR LDA CÄEVICEÓÔ # CMP 0<> ?[ SEC $0E # AND 0= ?[ CLC ]? XÓAVE JMP ]? TSX ZÔMPÓÐ STX SAVEÎAME JSR CLC XÐRESSÒEC JSR RSÒÔÓ BCS SEI XÃASSÐRTÏN JSR XÃASSÍOTORÏN JSR DELAYÍOTOR JSR ZÓECÁDD LDA SÃASSBUFFER &16 + STA ZÉÏÓTARTÚ LDA SÃASSÂUFFER &17 + STA ZÉÏÓTARTÚ 1+ LDA SÃASSÂUFFER &18 + STA SEC ZÐROGÅNDÚ LDA ZÉÏÓTARTÚ SBC SÃASSÂUFFER &19 + STA ZÐROGÅNDÚ 1+ LDA ZÉÏÓTARTÚ 1+ SBC SÃASSÂUFFER &20 + STA 0 # LDA SÃASSÂUFFER &21 + DUP STA 1+ DUP STA 1+ DUP STA 1+ STA PÔIMER 1+ STA SÃASSÂUFFER $100 U/MOD # LDA ZÂEGINÚ 1+ STA ZÅNDÚ 1+ STA # LDA ZÂEGINÚ STA CÃASSÂUFFERÅND # LDA ZÅNDÚ STA \ ÓÔ:..STÓAVE CLV16JUN87 CLSSH # LDA ZÒESERVÁÁ 1+ STA CLSSL # LDA ZÒESERVÁÁ STA PÔIMER STA $10 # LDA PÔIMERÂÃTRL STA CÈEADERÍARK # LDA ST×RITE JSR DELAYÍOTOR JSR ZÓECÁDD BIT 0< ?[ CHSSH # LDA ZÒESERVÁÁ 1+ STA CHSSL # LDA ZÒESERVÁÁ STA PÔIMER STA ]? ZÉÏÓTARTÚ LDA ZÂEGINÚ STA ZÉÏÓTARTÚ 1+ LDA ZÂEGINÚ 1+ STA ZÐROGÅNDÚ LDA ZÅNDÚ STA ZÐROGÅNDÚ 1+ LDA ZÅNDÚ 1+ STA PÒAMÏN STA CÄATAÍARK # LDA ST×RITE JSR DELAYÍOTOR JSR STÅND JMP END-CODE \ ÓÔ:SUPERTAPE SAVEBOOTER CLV10OCT87 : SUPERTAPE \ -- 7 DEVICE ! STÌOAD VÌOAD ! STÓAVE VÓAVE ! ." ÓÔ2.20 " ; Ü : (N" >IN STORE N" ; : BTL ( --[FROM ]TO ) [ ÂTLÂEG ] ÌITERAL [ ÂTLÅND ] ÌITERAL ; Ü : BTLÎAME ( --ADR COUNT) PAD $16 BL FILL (N" $10 UMIN PAD SWAP CMOVE G---- COUNT PAD $A + SWAP CMOVE PAD $10 ; : STÓAVÓYS ( --) \ ÎAME" FOLLOWS DEVICE STORE 1 DEVICE ! BTL BTLÎAME BSAVE 7 DEVICE ! ORIGIN $17 - BTL DROP (N" BSAVE BTL NIP HERE N" BSAVE ; \ ÌOADSCREEN FOR ÄECOMPILER 20OCT87RE \ BASED ON Æ83 BY È. ÌAXEN / Í. ÐERRY \NEEDS ÔOOLS ÖOCABULARY ÔOOLS .( ÄECOMPILER LOADING...) ÏNLYFORTH ÔOOLS ALSO DEFINITIONS \NEEDS DIS ' DROP Ü ÁLIAS DIS \ ÄISASSEMBLE IF POSSIBLE &1 &9 +THRU \\ CLEAR \ CASE DEFINING WORDS 20AUG85MAWE Ü : CASE: ( N -) ÃREATE , 0 ] ÄOES> 2+ SWAP 2* + PERFORM ; Ü : ASSOCIATIVE: ÃREATE , ( N -) ÄOES> ( N - INDEX) DUP @ -ROT DUP @ 0 ÄÏ 2+ 2DUP @ = ÉÆ 2DROP DROP É 0 0 ÌÅÁÖÅ ÔÈÅÎ ÌÏÏÐ 2DROP ; ÄEFER (SEE Ü ÖARIABLE MAXBRANCH Ü ÖARIABLE THENBRANCH \ DECOMPILE EACH TYPE OF WORD 29NOV85RE Ü : .WORD ( ÉÐ - ÉÐ') DUP @ >NAME .NAME 2+ ; Ü : .LIT ( ÉÐ - ÉÐ') .WORD DUP @ . 2+ ; Ü : .CLIT ( ÉÐ - ÉÐ') .WORD DUP C@ . 1+ ; Ü : .STRING ( ÉÐ - ÉÐ') CR .WORD COUNT 2DUP TYPE ASCII " EMIT SPACE + ; Ü : .DO ( ÉÐ - ÉÐ') ." ÄÏ " 4 + ; Ü : .LOOP ( ÉÐ - ÉÐ') ." ÌÏÏÐ " 4 + ; Ü : .EXIT ( ÉÐ - ÉÐ' F) DUP MAXBRANCH @ U< ÉÆ .WORD EXIT ÔÈÅÎ DUP @ [ ÆORTH ] ['] UNNEST = ÉÆ ." ; " ÅÌÓÅ .WORD ." ; -2 ALLOT " ÔÈÅÎ 0= ; \ BRANCH, ?BRANCH 29NOV85RE Ü : .TO ." BACK TO " .WORD DROP ; Ü : .BRANCH ( ÉÐ - ÉÐ') 2+ DUP @ 2DUP + SWAP 0< ÉÆ CR ." ÒÅÐÅÁÔ TO " .EXIT 0<> SWAP 2+ AND EXIT ÔÈÅÎ CR ." ÅÌÓÅ " DUP THENBRANCH ! DUP MAXBRANCH @ U> ÉÆ MAXBRANCH ! ÅÌÓÅ DROP ÔÈÅÎ 2+ ; Ü : .?BRANCH ( ÉÐ - ÉÐ') 2+ DUP @ 2DUP + SWAP 0< ÉÆ CR ." ÕÎÔÉÌ " .TO 2+ EXIT ÔÈÅÎ CR DUP 4 - @ [ ' BRANCH ] LITERAL = OVER 2- @ 0< AND ÉÆ ." ×ÈÉÌÅ " ÅÌÓÅ ." ÉÆ " DUP THENBRANCH ! ÔÈÅÎ DUP MAXBRANCH @ U> ÉÆ MAXBRANCH ! ÅÌÓÅ DROP ÔÈÅÎ 2+ ; \ DECOMPILE DOES> ;CODE ; 20OCT87RE Ü : DOES? ( ÉÐ - ÉÐ' F) DUP 3 + SWAP DUP C@ $4à = SWAP \ JMP-OPCODE 1+ @ ['] ÆORTH @ 1+ @ = \ (DODOES> AND ; Ü : .(;CODE ( ÉÐ - ÉÐ' F) 2+ DOES? ÉÆ CR ." ÄOES> " ÅÌÓÅ ." ;ÃODE " 3 - DIS 0 ÔÈÅÎ ; Ü : .COMPILE ( ÉÐ -- ÉÐ' ) .WORD .WORD ; \ CLASSIFY EACH WORD 20OCT87RE &18 ASSOCIATIVE: EXECUTION-CLASS ÆORTH ' LIT , ' CLIT , ' ?BRANCH , ' BRANCH , ' (ÄÏ , ' (." , ' (ABORT" , ' ÄOES> 4 + @ , \ (;CODE ' EXIT , ' ABORT , ' QUIT , ' 'QUIT , ' (QUIT , ' UNNEST , ' (" , ' (?ÄÏ , ' (ÌÏÏÐ , ' COMPILE , &19 CASE: .EXECUTION-CLASS .LIT .CLIT .?BRANCH .BRANCH .DO .STRING .STRING .(;CODE .EXIT .EXIT .EXIT .EXIT .EXIT .EXIT .STRING .DO .LOOP .COMPILE .WORD ; \ DECOMPILE A :-DEFINITION 20AUG85MAWE : .PFA ( CFA -) >BODY ÂÅÇÉÎ ?CR DUP DUP THENBRANCH @ = ÉÆ ." ÔÈÅÎ " ?CR ÔÈÅÎ @ EXECUTION-CLASS .EXECUTION-CLASS DUP 0= STOP? OR ÕÎÔÉÌ DROP ; : .IMMEDIATE ( CFA -) >NAME C@ DUP ?CR $40 AND ÉÆ ." ÉMMEDIATE " ÔÈÅÎ ?CR $80 AND ÉÆ ." RESTRICT" ÔÈÅÎ ; : .CONSTANT ( CFA -) DUP >BODY @ . ." ÃONSTANT " >NAME .NAME ; : .VARIABLE ( CFA -) DUP >BODY . ." ÖARIABLE " DUP >NAME .NAME CR ." ÖALUE = " >BODY @ . ; \ DISPLAY CATEGORY OF WORD 20OCT87RE : .: ( CFA -) ." : " DUP >NAME .NAME CR .PFA ; : .DOES> ( CFA -) CR ." ÄOES> " 2- .PFA ; : .USER-VARIABLE ( CFA -) DUP >BODY C@ . ." ÕSER-ÖARIABLE " DUP >NAME .NAME CR ." ÖALUE = " EXECUTE @ . ; : .DEFER ( CFA -) ." DEFERRED " DUP >NAME .NAME ." ÉS " >BODY @ (SEE ; : .OTHER ( CFA -) DUP >NAME .NAME DUP @ OVER >BODY = ÉÆ ." IS ÃODE" @ DIS EXIT ÔÈÅÎ DUP @ DOES? ÉÆ .DOES> DROP EXIT ÔÈÅÎ DROP ." MAYBE ÃODE" @ DIS ; \ ÃLASSIFY A WORD 22JUL85WE 5 ASSOCIATIVE: DEFINITION-CLASS ' QUIT @ , ' 0 @ , ' SCR @ , ' BASE @ , ' 'COLD @ , 6 CASE: .DEFINITION-CLASS .: .CONSTANT .VARIABLE .USER-VARIABLE .DEFER .OTHER ; \ ÔOP LEVEL OF ÄECOMPILER 20AUG85MAWE : ((SEE ( CFA -) MAXBRANCH OFF THENBRANCH OFF CR DUP DUP @ DEFINITION-CLASS .DEFINITION-CLASS .IMMEDIATE ; ' ((SEE ÉS (SEE ÆORTH DEFINITIONS : SEE ' (SEE ; \ ÃOMMODORE HOLE ÓCREENS 20OCT87RE ÏNLYFORTH : <INIT 0 $ÄÄ03 C! ; : GET ( -- 8B) ÂÅÇÉÎ $ÄÄ0Ä C@ $10 AND ÕÎÔÉÌ $ÄÄ01 C@ DUP $ÄÄ01 C! ; : <SYNC ( --) <INIT ÂÅÇÉÎ GET $55 = ÕÎÔÉÌ ÂÅÇÉÎ GET DUP $55 = ×ÈÉÌÅ DROP ÒÅÐÅÁÔ ABORT" ÓYNCÅRR" ; : SUM ( OLDSUM N -- NEWSUM N) SWAP OVER + SWAP ; : CHECK ( SUM.INT 8B.SUM.READ --) SWAP $ÆÆ AND - ABORT" ÃHÓUMÅRROR" ; --> \ ÃOMMODORE HOLE ÓCREENS 20OCT87RE : DOWNLOAD ( N --) <SYNC 0 SWAP BUFFER B/BLK BOUNDS ÄÏ GET SUM É C! ÌÏÏÐ GET CHECK UPDATE ; : DOWNTHRU ( START COUNT --) BOUNDS ÄÏ É DOWNLOAD ÌÏÏÐ ; --> \\ SYNC NEEDS: XX $55 $55 00 DATA \ ÃOMMODORE SENDSCREENS 20OCT87RE : >INIT $ÆÆ $ÄÄ03 C! ; : PUT ( 8B -) $ÄÄ01 C! ÂÅÇÉÎ STOP? ÉÆ <INIT TRUE ABORT" TERMINATED" ÔÈÅÎ $ÄÄ0Ä C@ $10 AND ÕÎÔÉÌ ; : >SYNC ( --) >INIT $10 0 ÄÏ $55 PUT ÌÏÏÐ 0 PUT ; : UPLOAD ( N --) >SYNC 0 SWAP BLOCK B/BLK BOUNDS ÄÏ É C@ SUM PUT ÌÏÏÐ $ÆÆ AND PUT <INIT ; : UPTHRU ( FROM TO -- ) 1+ SWAP ÄÏ É . CR É UPLOAD ÌÏÏÐ ; \ ÇRAPHIC ÌOAD-ÓCREEN 20OCT87RE (16 .( Ã64 ÏNLY ) \\ Ã) ÏNLYFORTH \NEEDS ÃODE .( ÁSSEMBLER??!) \\ \NEEDS LBYTE 1 +LOAD \NEEDS 100U/ &26 +LOAD ÖOCABULARY GRAPHIC ' GRAPHIC Ü ÁLIAS ÇRAPHICS ÇRAPHICS ALSO DEFINITIONS 2 &15 +THRU \ HIRES GRAPHIC &16 &20 +THRU \ SPRITES &21 &23 +THRU \ TURTLE GRAPHIC ÏNLYFORTH \ >BYTE HBYTE LBYTE 20OCT87RE ÃODE >BYTE ( 16B - 8BL 8BH) ÓÐ )Ù LDA PHA TXA ÓÐ )Ù STA ÓÐ 2DEC TXA ÓÐ )Ù STA PLA ÐUTA JMP END-CODE : HBYTE >BYTE NIP ; : LBYTE >BYTE DROP ; \ ÇRAPHICS CONSTANTS 20OCT87RE Ü $0288 ÃONSTANT SCRPAGE Ü $Å000 ÃONSTANT BITMAP Ü $Ä800 ÃONSTANT CHARSET Ü $Ã400 ÃONSTANT COLRAM Ü $Ã000 ÃONSTANT VIDRAM \ $Ã800 ÃONSTANT SPRBUF BITMAP HBYTE $40 /MOD 3 SWAP - Ü ÃONSTANT BANK $20 / 8 * COLRAM HBYTE $3Æ AND 4 / $10 * OR Ü ÃONSTANT BMOFFS VIDRAM HBYTE $3Æ AND 4 / $10 * CHARSET HBYTE $3Æ AND 4 / OR Ü ÃONSTANT TMOFFS $0314 Ü ÃONSTANT IRQVEC $ÅÁ31 >LABEL OLDIRQ $ÅÁ81 >LABEL IRQEND $ÆÆ6Å >LABEL SETTIMER \ ÇR MOVECHARSET CLRSCREEN 20OCT87RE Ü ÃODE MOVECHARSET SEI $32 # LDA 1 STA DEY 8 # LDX Î STY Î 2+ STY $Ä8 # LDA Î 1+ STA CHARSET HBYTE # LDA Î 3 + STA [[ [[ Î )Ù LDA Î 2+ )Ù STA INY 0= ?] Î 1+ INC Î 3 + INC DEX 0= ?] $36 # LDA 1 STA CLI INY ÎEXT JMP END-CODE : CLRSCREEN ( -- ) BITMAP &8000 ERASE ; \ ÇR ÖARIABLES (TEXT (HIRES 20OCT87RE Ü ÖARIABLE CBMKEY Ü ÖARIABLE SWITCHFLAG Ü ÖARIABLE TEXTBORDER Ü ÖARIABLE HIRESBORDER Ü ÖARIABLE SWITCHLINE Ü ÖARIABLE CHFLAG ÌABEL (TEXT $1 # LDA $Ä011 STA TMOFFS # LDA $Ä018 STA TEXTBORDER LDA $Ä020 STA RTS ÌABEL (HIRES $3 # LDA $Ä011 STA BMOFFS # LDA $Ä018 STA HIRESBORDER LDA $Ä020 STA RTS \ ÇR RASTERIRQ GRAPHICIRQ 20OCT87RE ÌABEL WINDOWHOME SWITCHLINE LDA SEC $30 # SBC .Á LSR .Á LSR .Á LSR SEC 1 # SBC $Ä6 CMP Ãà ?[ RTS ]? TAX INX 2 # LDY $Ãà STY $ÃÄ STY $ÃÅ LDA $Ä3 LDY $Ä1 )Ù STA 0 # LDY $ÃÆ STY CLC $ÆÆÆ0 JSR 0 # LDY $Ä1 )Y LDA $ÃÅ STA $Ãà STY RTS ÌABEL GRAPHICIRQ $28Ä LDA 2 # AND 0= ?[ OLDIRQ JMP ]? [[ $ÆÆ9Æ JSR $28Ä LDA 0= ?] CBMKEY ) JMP ÌABEL RASTERIRQ $Ä019 LDA $Ä019 STA $15 # LDX [[ DEX 0= ?] Î LDA ( ÂLIND!!) CHFLAG LDA 1 # EOR CHFLAG STA TAX 0= ?[ (HIRES JSR ][ (TEXT JSR ]? SWITCHLINE ,X LDA $Ä012 STA WINDOWHOME JSR $ÄÃ0Ä LDA 1 # AND GRAPHICIRQ BNE IRQEND JMP \ ÇR ÉÒÑ-HANDLING (WINDOW 20OCT87RE ÌABEL SETIRQ SEI GRAPHICIRQ >BYTE # LDA IRQVEC 1+ STA # LDA IRQVEC STA $Æ0 # LDA $Ä01Á STA $81 # LDA $ÄÃ0Ä STA CLI RTS Ü ÃODE RESETIRQ SEI OLDIRQ >BYTE # LDA IRQVEC 1+ STA # LDA IRQVEC STA $Æ0 # LDA $Ä01Á STA $81 # LDA $ÄÃ0Ä STA CLI ÎEXT JMP END-CODE ÌABEL (WINDOW RASTERIRQ >BYTE # LDA IRQVEC 1+ STA # LDA IRQVEC STA $7Æ # LDA $ÄÃ0Ä STA $Æ1 # LDA $Ä01Á STA SWITCHFLAG STX CHFLAG STX WINDOWHOME JMP \ ÇR TEXT HIRES WINDOW SWITCH 20OCT87RE ÃODE TEXT 1 # LDA SWITCHFLAG STA SETIRQ JSR (TEXT JSR ÎEXT JMP END-CODE ÃODE HIRES 2 # LDA SWITCHFLAG STA SETIRQ JSR (HIRES JSR ÎEXT JMP END-CODE Ü ÃODE SETWINDOW ( ROW -) SEI (WINDOW JSR CLI XYÎEXT JMP END-CODE : WINDOW ( ROW -) 8 * $30 + SWITCHLINE C! SETWINDOW ; ÌABEL SWITCH SWITCH CBMKEY ! SWITCHFLAG LDX 0= ?[ INX SWITCHFLAG STX SETIRQ JSR (TEXT JSR OLDIRQ JMP ]? 1 # CPX 0= ?[ INX SWITCHFLAG STX SETIRQ JSR (HIRES JSR OLDIRQ JMP ]? 0 # LDX SWITCHFLAG STX (WINDOW JSR OLDIRQ JMP END-CODE \ ÇR GRAPHIC FORTH 20OCT87RE ÆORTH DEFINITIONS : GRAPHIC ÇRAPHICS MOVECHARSET $ÄÄ00 C@ $Æà AND BANK OR $ÄÄ00 C! VIDRAM HBYTE SCRPAGE C! COLRAM C@ HIRESBORDER C! $Ä020 C@ TEXTBORDER C! $10Ä0 SWITCHLINE ! TEXT ; : NOGRAPHIC ÏNLYFORTH RESETIRQ $1 $Ä011 C! $17 $Ä018 C! 4 SCRPAGE C! TEXTBORDER C@ $Ä020 C! $ÄÄ00 C@ 3 OR $ÄÄ00 C! ; ÇRAPHICS DEFINITIONS \ ÇR ÃOLORS 20OCT87RE 0 ÃONSTANT BLK 1 ÃONSTANT WHT 2 ÃONSTANT RED 3 ÃONSTANT CYN 4 ÃONSTANT PUR 5 ÃONSTANT GRN 6 ÃONSTANT BLU 7 ÃONSTANT YEL 8 ÃONSTANT ORA 9 ÃONSTANT BRN $Á ÃONSTANT LRE $ ÃONSTANT GR1 $à ÃONSTANT GR2 $Ä ÃONSTANT LGR $Å ÃONSTANT LBL $Æ ÃONSTANT GR3 : BORDER ( COLOR -) DUP TEXTBORDER C! $Ä020 C! ; : SCREEN ( COLOR -) $Ä021 C! ; : COLORS ( BKGRND FOREGRND -) OVER HIRESBORDER C! $10 * OR COLRAM $03Æ8 ROT FILL ; : BACKGROUND ( COLOR -) COLRAM C@ $10 / COLORS ; : PENCOLOR ( COLOR -) COLRAM C@ $Æ AND SWAP COLORS ; \ ÇR ÂITTAB ÌABELS 20OCT87RE ÌABEL BITTAB $80 C, $40 C, $20 C, $10 C, $08 C, $04 C, $02 C, $01 C, Ü : >LABALLOT ( ADR N - ADR+N) OVER >LABEL + ; $60 ÃONSTANT POINTY $62 ÃONSTANT POINTX ÁSSEMBLER Î 2 >LABALLOT Y0 2 >LABALLOT X0 2 >LABALLOT Y1 2 >LABALLOT X1 2 >LABALLOT OFFSET 2 >LABALLOT DY 2 >LABALLOT DX 2 >LABALLOT CT 1 >LABALLOT IY 1 >LABALLOT IX 1 >LABALLOT AY 1 >LABALLOT AX 2 >LABALLOT BYTNR DROP \ ÇR (PLOT COMPUTE 20OCT87RE ÌABEL (PLOT ( X Y -) 2 # LDA SETUP JSR 3 # LDX [[ Y0 ,Ø LDA POINTY ,Ø STA DEX 0< ?] $Ã7 # LDA SEC Y0 SBC Y0 STA ÌABEL COMPUTE SEI 1 DEC Y0 LDA $Æ8 # AND PHA BYTNR STA 0 # LDA BYTNR 1+ STA CLC BYTNR ASL BYTNR 1+ ROL BYTNR ASL BYTNR 1+ ROL PLA BYTNR ADC BYTNR STA ÃÓ ?[ BYTNR 1+ INC ]? BYTNR ASL BYTNR 1+ ROL BYTNR ASL BYTNR 1+ ROL BYTNR ASL BYTNR 1+ ROL Y0 LDA 7 # AND BYTNR ORA BYTNR STA CLC X0 LDA $Æ8 # AND BYTNR ADC BYTNR STA X0 1+ LDA BYTNR 1+ ADC BYTNR 1+ STA BITMAP HBYTE # LDA BYTNR 1+ ORA BYTNR 1+ STA X0 LDA 7 # AND TAX BITTAB ,Ø LDA 0 # LDY CLC RTS \ ÇR PLOT FLIP CLPX 20OCT87RE ÃODE PLOT ( X Y -) (PLOT JSR BYTNR 1+ LDX BITMAP HBYTE # CPX CS ?[ BYTNR )Ù ORA BYTNR )Ù STA ]? ÌABEL ROMON 1 INC CLI XYÎEXT JMP END-CODE ÃODE FLIP ( X Y -) (PLOT JSR BYTNR 1+ LDX BITMAP HBYTE # CPX CS ?[ BYTNR )Ù EOR BYTNR )Ù STA ]? ROMON JMP END-CODE ÃODE UNPLOT ( X Y -) (PLOT JSR BYTNR 1+ LDX BITMAP HBYTE # CPX CS ?[ $ÆÆ # EOR BYTNR )Ù AND BYTNR )Ù STA ]? ROMON JMP END-CODE \\ COMPUTE DISABLES ÉÒÑ, THE WORDS PLOT, FLIP, UNPLOT AND LINE ENABLE THE ÉÒÑ AGAIN. ÎOT NICE, BUT THE ONLY WAS BECAUSE OF THE BRANCH IN 'LINE'. \ ÇR LINE 1 20OCT87RE ÃODE LINE ( X1 Y1 X0 Y0 -) 4 # LDA SETUP JSR ÌABEL (DRAWTO 3 # LDX [[ Y0 ,Ø LDA POINTY ,Ø STA DEX 0< ?] $Ã7 # LDA SEC Y1 SBC Y1 STA $Ã7 # LDA SEC Y0 SBC Y0 STA IX STY IY STY CT STY DEY AX STY AY STY CT 1+ STY DEY X1 LDA X0 CMP X1 1+ LDA X0 1+ SBC Ãà ?[ SEC X0 LDA X1 SBC DX STA X0 1+ LDA X1 1+ SBC DX 1+ STA IX STY ][ X1 LDA X0 SBC DX STA X1 1+ LDA X0 1+ SBC DX 1+ STA ]? Y1 LDA Y0 CMP Ãà ?[ SEC Y0 LDA Y1 SBC DY STA IY STY ][ Y0 SBC DY STA ]? DX 1+ LDA \ ÇR LINE 2 20OCT87RE 0= ?[ DX LDA DY CMP Ãà ?[ DY LDX DY STA DX STX IX LDA AY STA IY LDA AX STA INY IX STY IY STY ]? ]? DX 1+ LDA .Á LSR OFFSET 1+ STA DX LDA .Á ROR OFFSET STA SEC Ãà ?[ .( ÔRICK!! ) [[ IX LDA 0<> ?[ 0>= ?[ X0 WINC ][ X0 WDEC ]? ]? CLC Y0 LDA AX ADC Y0 STA CLC OFFSET LDA DY ADC OFFSET STA ÃÓ ?[ OFFSET 1+ INC ]? CT WINC DX LDA OFFSET CMP DX 1+ LDA OFFSET 1+ SBC Ãà ?[ SEC OFFSET LDA DX SBC OFFSET STA OFFSET 1+ LDA DX 1+ SBC OFFSET 1+ STA AY LDA 0<> ?[ 0>= ?[ X0 WINC ][ X0 WDEC ]? ]? CLC Y0 LDA IY ADC Y0 STA ]? \ ÇR LINE 3 FLIPLINE 20OCT87RE SWAP ]? .( ÐART 2 OF TRICK! ) COMPUTE JSR BYTNR 1+ LDX BITMAP HBYTE # CPX CS ?[ ÌABEL MODE BYTNR )Ù ORA BYTNR )Ù STA ]? 1 INC CLI DX LDA CT CMP DX 1+ LDA CT 1+ SBC Ãà ?] XYÎEXT JMP END-CODE ÃODE DRAWTO ( X1 Y1 -) 3 # LDY [[ POINTY ,Ù LDA Y1 ,Ù STA DEY 0< ?] 2 # LDA SETUP JSR (DRAWTO JMP END-CODE : FLIPLINE ( X1 Y1 X0 Y0 -) $51 ( EOR ) MODE C! LINE $11 ( ORA ) MODE C! ; \ BAD SELF-MODIFYING CODE \ ÓPRITE CONSTANTS 20OCT87RE $Ã800 ÃONSTANT SPRBUF Ü $Ä000 ÃONSTANT SPRBASE Ü $Ä010 ÃONSTANT XPOSHI $Ä015 ÃONSTANT SPRITE Ü $Ä017 ÃONSTANT YEXPAND $Ä01à ÃONSTANT 3COLORED Ü $Ä01Ä ÃONSTANT XEXPAND Ü $Ä025 ÃONSTANT SPRMCOL Ü $Ä027 ÃONSTANT SPRCOL Ü ÃREATE SBITTAB $01 C, $02 C, $04 C, $08 C, $10 C, $20 C, $40 C, $80 C, \ ÓPR SETBIT SET FORMSPRITE 20OCT87RE Ü ÃODE SETBIT ( BITNR ADR FL -) 3 # LDA SETUP JSR DEY Î 4 + LDX SBITTAB ,Ø LDA Î LDX 0= ?[ $ÆÆ # EOR Î 2+ )Ù AND ][ Î 2+ )Ù ORA ]? Î 2+ )Ù STA XYÎEXT JMP END-CODE : SET ( BITNR ADR -) ÔRUE SETBIT ; : RESET ( BITNR ADR -) ÆALSE SETBIT ; : GETFORM ( ADR MEM# -) $40 * SPRBUF + $40 CMOVE ; Ü : SPRITE! ( MEM# SPR# ADR -) $3Æ8 + + C! ; : FORMSPRITE ( MEM# SPR# -) >R SPRBUF $3Æ00 AND $40 / + DUP R@ VIDRAM SPRITE! R> COLRAM SPRITE! ; \ ÓPR MOVE SPRPOS 20OCT87RE : XMOVE ( X SPR# -) 2DUP 2* SPRBASE + C! XPOSHI ROT $ÆÆ > SETBIT ; : YMOVE ( Y SPR# -) 2* 1+ SPRBASE + C! ; : MOVE ( Y X SPR# -) UNDER XMOVE YMOVE ; : SPRPOS ( SPR# - Y X) DUP >R 2* 1+ SPRBASE + C@ R@ 2* SPRBASE + C@ R> SBITTAB + C@ XPOSHI C@ AND ÉÆ $100 + ÔÈÅÎ ; \ ÓPRITE ÑUALITIES 20OCT87RE : HIGH ( SPR# -) YEXPAND SET ; : LOW ( SPR# -) YEXPAND RESET ; : WIDE ( SPR# -) XEXPAND SET ; : SLIM ( SPR# -) XEXPAND RESET ; : BIG ( SPR# -) DUP HIGH WIDE ; : SMALL ( SPR# -) DUP LOW SLIM ; : BEHIND ( SPR# -) $Ä01 SET ; : INFRONT ( SPR# -) $Ä01 RESET ; : COLORED ( SPR# COL -) SWAP SPRCOL + C! ; \ ÓPR SPRCOLORS SETSPRITE 20OCT87RE : SPRCOLORS ( COL# COL# -) SPRMCOL 1+ C! SPRMCOL C! ; : SETSPRITE ( MEM# Y X COLOR SPR# -) UNDER >R COLORED R@ MOVE R@ UNDER FORMSPRITE SMALL R@ 3COLORED RESET R> SPRITE SET ; \ ÔU HEADING LEFT RIGHT 20OCT87RE Ü ÖARIABLE XPOS Ü ÖARIABLE YPOS Ü ÖARIABLE DEG Ü ÖARIABLE PEN Ü : 100*/ ( N1 N2 N3 - N4) &100 */ ; : HEADING ( - DEG) DEG @ ; : SETHEADING ( DEG -) DEG ! ; : RIGHT ( DEG -) DEG @ SWAP - &360 MOD DEG ! ; : LEFT ( DEG -) DEG @ + &360 MOD DEG ! ; ' CLRSCREEN ÁLIAS CS ' PENCOLOR ÁLIAS PC ' BACKGROUND ÁLIAS BG ' HIRES ÁLIAS FULLSCREEN ' WINDOW ÁLIAS SPLITSCREEN \ ÔU POSITIONS PEN HOME 20OCT87RE : XCOR ( - X) XPOS @ 100U/ ; : YCOR ( - Y) YPOS @ 100U/ ; : SETX ( X -) 100* XPOS ! ; : SETY ( Y -) 100* YPOS ! ; : SETXY ( X Y -) SETY SETX ; : PENDOWN PEN ON ; : PENUP PEN OFF ; : HOME &160 &96 SETXY &90 SETHEADING PENDOWN ; : DRAW CLRSCREEN HOME &20 WINDOW ; : NODRAW TEXT PAGE ; ' LEFT ÁLIAS LT ' RIGHT ÁLIAS RT ' SETHEADING ÁLIAS SETH ' PENDOWN ÁLIAS PD ' PENUP ÁLIAS PU \ ÔU FORWARD BACK 20OCT87RE : TLINE ( X1 Y1 X2 Y2 -) >R >R >R 100U/ R> 100U/ R> 100U/ R> 100U/ LINE ; : FORWARD ( DISTANCE -) >R XPOS @ YPOS @ OVER DEG @ COS R@ 100*/ + DUP XPOS ! OVER DEG @ SIN R> 100*/ + DUP YPOS ! PEN @ ÉÆ TLINE ÅÌÓÅ 2DROP 2DROP ÔÈÅÎ ; : BACK ( DISTANCE -) NEGATE FORWARD ; : TURTLESTATE ( - PEN BG PC) PEN C@ COLRAM C@ DUP &15 AND SWAP &16 / ; ' FORWARD ÁLIAS FD ' BACK ÁLIAS BK ' TURTLESTATE ÁLIAS TS \ ÇR ARC ELLIPSE CIRCLE 20OCT87RE : ARC ( HR VR STRT END -) >R >R 2DUP MAX &360 SWAP / R> 2* 2* R> 1+ 2* 2* SWAP ROT >R ÄÏ OVER É 2/ 2/ COS &10005 */ OVER É 2/ 2/ SIN &10005 */ PLOT R@ +ÌÏÏÐ R> 2DROP DROP ; : ELLIPSE ( X Y HR VR -) 2SWAP C-Y ! C-X ! M-FLAG ON 0 &90 ARC M-FLAG OFF ; : CIRCLE ( X Y R -) DUP 3 4 */ ELLIPSE ; A VOLKSFORTH 3.8-4 94 2A ÿ \ ÍATH ÌOAD-ÓCREEN 20OCT87RE ÏNLYFORTH BASE @ DECIMAL 1 2 +THRU \ ÔRIGONOMETRY 3 4 +THRU \ ROOTS 5 6 +THRU \ 100* 100U/ BASE ! \ ÍA SINUS-TABLE 20OCT87RE \ ÓINUS-ÔABLE FROM ÆÄ ÖOL ÉÖ/1 Ü : TABLE ( VALUES N -) ÃREATE 0 ÄÏ , ÌÏÏÐ ;CODE ( N - VALUE) ÓÐ Ø) LDA CLC 1 # ADC .Á ASL TAY × )Ù LDA ÓÐ Ø) STA INY × )Ù LDA 1 # LDY ÓÐ )Ù STA ÎEXT JMP END-CODE 10000 9998 9994 9986 9976 9962 9945 9925 9903 9877 9848 9816 9781 9744 9703 9659 9613 9563 9511 9455 9397 9336 9272 9205 9135 9063 8988 8910 8829 8746 8660 8572 8480 8387 8290 8192 8090 7986 7880 7771 7660 7547 7431 7314 7193 7071 6947 6820 6691 6561 6428 6293 6157 6018 5878 5736 5592 5446 5299 5150 5000 4848 4695 4540 4384 4226 4067 3907 3746 3584 3420 3256 3090 2924 2756 2588 2419 2250 2079 1908 1736 1564 1392 1219 1045 0872 0698 0523 0349 0175 0000 &91 Ü TABLE SINTABLE \ ÍA SIN, COS, TAN 20OCT87RE Ü : S180 ( DEG -- SIN*10000:SIN 0-180) DUP &90 > ÉÆ &180 SWAP - ÔÈÅÎ SINTABLE ; : SIN ( DEG -- SIN*10000) &360 MOD DUP 0< ÉÆ &360 + ÔÈÅÎ DUP &180 > ÉÆ &180 - S180 NEGATE ÅÌÓÅ S180 ÔÈÅÎ ; : COS ( DEG -- COS*10000) &360 MOD &90 + SIN ; : TAN ( DEG -- TAN*10000) DUP SIN SWAP COS ?DUP ÉÆ &100 SWAP */ ÅÌÓÅ 3 * ÔÈÅÎ ; \ ÍA SQRT 1 20OCT87RE ÃODE D2* ( D1 - D2) 2 # LDA SETUP JSR Î 2+ ASL Î 3 + ROL Î ROL Î 1+ ROL ÓÐ 2DEC Î 3 + LDA ÓÐ )Y STA Î 2+ LDA ÓÐ X) STA ÓÐ 2DEC Î 1+ LDA ÓÐ )Y STA Î LDA ÓÐ X) STA ÎEXT JMP END-CODE : DU< &32768 + ROT &32768 + ROT ROT D< ; Ü : EASY-BITS ( N1 -- N2) 0 ÄÏ >R D2* D2* R@ - DUP 0< ÉÆ R@ + R> 2* 1- ÅÌÓÅ R> 2* 3 + ÔÈÅÎ ÌÏÏÐ ; Ü : 2'S-BIT >R D2* DUP 0< ÉÆ D2* R@ - R> 1+ ÅÌÓÅ D2* R@ 2DUP U< ÉÆ DROP R> 1- ÅÌÓÅ - R> 1+ ÔÈÅÎ ÔÈÅÎ ; \ ÍA SQRT 2 20OCT87RE Ü : 1'S-BIT >R DUP 0< ÉÆ 2DROP R> 1+ ÅÌÓÅ D2* &32768 R@ DU< 0= NEGATE Ò> + ÔÈÅÎ ; : SQRT ( UD1 - U2) 0 1 8 EASY-BITS ROT DROP 6 EASY-BITS 2'S-BIT 1'S-BIT ; \\ : XX &16 * &62500 UM* SQRT 0 <# # # # ASCII . HOLD #S #> TYPE SPACE ; \ 100* 20OCT87RE ÃODE 100* ( N1 - N2) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA Î ASL Î 1+ ROL Î ASL Î 1+ ROL Î LDA Î 2+ STA Î 1+ LDA Î 3 + STA Î 2+ ASL Î 3 + ROL Î 2+ ASL Î 3 + ROL Î 2+ ASL Î 3 + ROL CLC Î LDA Î 2+ ADC Î STA Î 1+ LDA Î 3 + ADC Î 1+ STA Î 2+ ASL Î 3 + ROL CLC Î LDA Î 2+ ADC ÓÐ Ø) STA Î 1+ LDA Î 3 + ADC ÓÐ )Ù STA ÎEXT JMP END-CODE \ 100/ 20OCT87RE ÌABEL 4/+ Î 7 + LSR Î 6 + ROR Î 5 + ROR Î 4 + ROR Î 7 + LSR Î 6 + ROR Î 5 + ROR Î 4 + ROR CLC Î LDA Î 4 + ADC Î STA Î 1+ LDA Î 5 + ADC Î 1+ STA ÓÐ Ø) LDA Î 6 + ADC ÓÐ Ø) STA ÓÐ )Ù LDA Î 7 + ADC ÓÐ )Ù STA RTS ÃODE 100U/ ( U - N) Î STX Î 4 + STX ÓÐ Ø) LDA .Á ASL Î 1+ STA Î 5 + STA ÓÐ )Ù LDA .Á ROL ÓÐ Ø) STA Î 6 + STA TXA .Á ROL ÓÐ )Ù STA Î 7 + STA 4/+ JSR Î 7 + LSR Î 6 + ROR Î 5 + ROR Î 4 + ROR 4/+ JSR ÎEXT JMP END-CODE \\ FOR CSAVE CLOAD CLV10OCT87 ÔHE ÁSSEMBLER MUST BE LOADED SET ÌABELS ÓAVE PARAMETER STARTING AT Î ÅNABLE ÓYSÍESSAGES ÓTATUS TO 0 (SET DRV FOR DERROR? ÄEVICE#, ÓEC.ÁDDRESS, ÆILE# ÁDDRESS-OF-ÆILENAME ÌENGTH ÁDDRESS IN ØÙ ÏNE OF 8 ËERNALERRORS? CHECK ÓTATUS/DESTROY ÅÏÉ-ÂIT SEND BOTH BACK AS ÅRROR ÎUMBER \\ FOR ..CSAVE CLOAD CLV10OCT87 PREPARE ÐARAMETER (ØÒ=TO+1) ÐOINTER TO FROM IN ÁÒ AND ÂÓÁÖÅ ÅRROR? PREPARE ÐARAMETR (ØÒ=FROM) ÌOAD (NO ÖERIFY) ÂÌÏÁÄ TO+1 WILL BE GIVEN BACK PLACE ON THE ÆORTH ÓTACK ÅRROR? ÅRRORSOURCES FOR ÃÂÍ-ÒOUTINEN: (1) ËERNAL-ÒESULT (2) ÓTATUS-ÒEGISTER (3) ÄISK-ÅRRORCHANNEL \\ FOR ..CSAVE CLOAD ÌUXUS CLV10OCT87 ÔHIS ROUTINE IS USING THE ÂÁÓÉà ÂASIC-ÅRRORMESSAGES, SO THAT THE MESSAGES DOESN NEED TO BE DEFINED AGAIN. ÔHIS IS USING THE ÂÁÓÉà ÒÏÍ. ÔHE ÂÁÓÉà ÒOM SHOULD ONLY BE USED IF NO ÓITE ÅFFECTS OCCUR, WHICH IS THE CASE HERE. CREATES AN ÅRRORMESSAGE FROM ÅRROR- NUMBER ÉF NOT "DEVICE NOT PRESEN" IF IS QUERYING THE SERIAL BUS FOR DEVICE ERROR MESSAGE \\ FOR ÔAPEÖERSION CLV01AUG87 ÔHE ÔAPEVERSION WAS DEVELOPED FOR Ã16 WITH 64KÂ, BUT ALSO WORKS ON THE Ã64 ÉT CONISTS OF 3 PARTS Á VIRTUAL FLOPPY IN MEMORY (ÒAMDISK) ÁN ÉNTERFACE TO THE EXTERNAL ÄEVICE ÔAPE ÒECORDER ÓUPERTAPE LOADER (ONLY FOR Ã16) ÉNITIALIZING: INIT ÓUPERTAPE IF POSSIBLE REDEFINE AND ACTIVATE Ò/× IF ÁÕÔÏÌÏÁÄ ENABLED, LOAD ÒAMDISK \\ FOR ÒÄ: LOADSCREEN CLV05AUG87 ÔHIS ÒAMDISK IS USING A COMPRESSED FORMAT ÔO ALLOW SWITCHING OF RAMDISKS, THE CODE CONTAINS ONE VARIABLE (ÒÄ THAT CONTAINS A POINTER TO THE RAMDISK. ÁLL OTHER VARIABLES ARE STORED IN THE ÒAMDISK ÍEMORY AREA ÂINAERBLOCKS MUST BE MARKED WITH ÂÉÎÁÒÙ THIS ÒAMDISK SUPPORT ALL ÂLOCK ÆORTH- ×ORDS THAT USE Ò/× \\ ÆOR ÒÄ: CLV01AUG87 \ ÁLL ÐOINTERS ARE OFFSETS FROM ÆIRST RD ==0 ==> NO ÒAMDISK RD -->ÌENGTH OF ÐARAMETRBLOCK +2 -->CURRENT ÂLOCK +4 -->ÅND OF LAST ÂLOCK+1 +6 -->ÅND OF ÒAMDISK-ÁREA+1 +8 -->ÎUMBER OF CURRENT ÂLOCK +16-->ÎAME ÅND OF ÐARAMETERBLOCK 1.ÒÄ-ÂLOCK 2.ÒÄ-ÂLOCK . 0000 ADR-->CURRENT ÒÄ-ÂLOCK (ABSOLUTE ÁDDR) -->ÌENGTH (INCL. 4 BYTES ÒÄ-ÄATA) 2+-->ÂLOCKNUMBER 2+-->..ÄATA.. \\ FOR ÒÄ: CLV01AUG87 ÎÅ× CHECKS FOR ENOUGH SPACE AND SET CURRENT BLOCK TO FREE SPACE ÌÅÎ! STORES THE LENGTH OF NEW BLOCK AND PATCHES ÅÎÄ ÉF LENGTH IS=0 NOTHING HAPPENDS ÃREATES 0000 AT THE ÅND OF ÒAMDISK ÌÅÎ@ RETURNS LENGTH OF CURRENT ÂLOCK ÉF NOT AVAILABLE, RETURNS 0 ÄÅÌ DELETES CURRENT BLOCK AND PATCHES ÅÎÄ \\ FOR ÒÄ: CLV01AUG87 ÓÅÁÒÃÈ SET CURRENT BLOCK TO SEARCHED ÂLOCK, IF NOT FOUND, TO ÅÎÄ ÂLOCKNUMBER WILL BE STORED IN ÂÌË# ÂÉÎÁÒÙ DISABLES COMPRESSION OF ÂLOCK FOR EXAMPLE FOR ÂINARY-ÄATA Á BINARY BLOCK WILL BE DETECTED IF LENGTH IS $400 \\ FOR ÒÄ: C>7 7 >C CLV01AUG87 ÃONVERT ÃÂÍ-ÃHARS TO 7BIT ÁLL CHARS $C0..$E0 WILL BE $60..80 ÁLL OTHER >=$80 WILL BE $00..20 \\ FOR ÒÄ: CP1 CP2 CLV01AUG87 ÓTART ROUTINE FOR ÃÏÍÐÒÅÓÓ & ÅØÐÁÎÄ ÅNDROUTINE FOR ÃÏÍÐÒÅÓÓ & ÅØÐÁÎÄ \\ FOR ÒÄ: EXPAND COMPRESS CLV01AUG87 \\ FOR ÒÄ:RAMÒ/× CLV01AUG87 ÅÎÄ×ÒÉÔÅ REMOVES ÂLANKS AT END OF ÂLOCK AND SET ÌÅÎ! ÅÎÄÒÅÁÄ FILLS ÒEMINDER OF BLOCK WITH ÂLANK ÒÁÍÒ/× REPLACES THE Ò/×-ÒOUTINE (BINARY) ÂLOCKS IN FULL LENGTH WILL COPIED BY ÃÍÏÖÅ, SHORTER BLOCKS WILL BE COPIED WITH ÃÏÍÐÒÅÓÓ (WRITE) AND ÅØÐÁÎÄ (READ). \\ FOR ÒÄ:ID RDUSE.. CLV01AUG87 .ÒÄ PRINT INFORMATION ABOUT CURRENT ÒÄ ÉÄ! SET NAME OF ÒAMDISK ÉÄ" READS NAME OF ÒAMDISK ÒÄÕÓÅ SWITCHES (WITHOUT CHECKS) TO ÒÄ ÒÄÄÅÌ CLEARS ÒAMDISK ÒÄÎÅ× CREATES A NEW ÒAMDISK AND CHECKS (ALMOST) EVERYTHING \\ FOR ÒÄ: RDCHECK CLV01AUG87 ÒÄÃÈÅÃË CHECKS POINTER OF ÒAMDISK AND PRINTS TABLE OF CONTENTS \\ FOR ÓÔ:ÌOADÓCREEN CLV01AUG87 ÓUPERTAPE IS A FAST LOADER USING 3600 ÂD OR 7200 ÂD APPROX. 10 TIMES FSTER THEN THE ORIGINAL ÃÂÍ-ÒOUTINES ÕSAGE: ÄEVICEÎUMBER = 7 ==> ÓUPERTAPE ÓECÁDDRESS >=$80 ==> 7200 ÂD <$80 ==> 3600 ÂD ..EVERYTHING ELSE LIKE ÃÂÍ ÓTORAGEÆORMAT 8ÂIT PER ÂYTE, ÌOWBIT 1ST ÓELFREGULATING, ON EACH ÂITBORDER IS A EDGE-SWITCH ÉF THERE IS ANOTHERONE IN THE MIDDLE THE BIT IS ÂIT=0, ELSE=1. ÆORMAT: SYNC #$2A 25B:ÈEADER 2B:CHECKSUM SYNC #$C5 LEN:ÄATA 2B:CHECKSUM ÓYNC = 64B:#$16 ÈEADER=16B:ÎAME 1B:ÓECÁDD 2B:FROM 2B:LEN 4B:#$00 \\ FOR ÓÔ:ÌABELS. CLV16JUN87 -------- HARDWARE-ÁDDRESSES----------- 1 ÃASSETTENPORT 2 ÔIME FOR ÔIMER2 1 CONTROLLREGISTER FOR ÔIMER2 1 ×RITEACCESS SWITCHES TO ÒÁÍ 1 ×RITEACCESS SWITCHES TO ÒÏÍ -------- ÓYSTEM-ÖECTORS ------------- 2 ÓAVE-ÖECTOR OF ÓYSTEM WILL BE PATCHED 2 ÌOAD-ÖECTOR OF ÓYSTEM WILL BE PATCHED ----- ÉNPUT-ÐARAMETER ÌOAD/ÓAVE----- 1 ÄEVICE-ÎUMBER 1 ÓECUNDARYADDRESS (CONTROLS ÄEVICE) 2 ÐOINTER TO FILENAMES 1 ÎUMBER OF ÃHARS IN ÆILENAME 2 ÓTARTADDRESS FOR ÌÏÁÄ 2 ÓTARTADDRESS FOR ÓÁÖÅ 2 ÅNDADDRESS+1 FOR ÓÁÖÅ ----- ÏUTPUTE-ÐARAMETER FOR ÌOAD/ÓAVE -- 1 ÓTATUS ÆLAGS OF ÏÓ \\ ZU ÓÔ:..ÌABELS CLV16JUN87 -------- BENUTZTE ÓYSTEM-ÒOUTINEN ----- START ÃASSETTE ÍOTOR STOP ÃASSETTE ÍOTOR INIT ÃASSETTE ÐORT INIT ÃASSETTE ÐORT NORMAL ÌOAD-ÒOUTINE NORMAL ÓAVE-ÒOUTINE PRINT 'ÌOADING' OR 'ÖERIFYING' PRINT 'ÐRESS PLAY..' PRINT 'ÐRESS ÒECORD.. ' PRINT 'ÆOUND' PRINT 'ÓEARCHING' PRINT ONE CHAR -------- USED ÚEROPAGE-ÁDDRESSES ----- 2 ÁDDRESS OF CURRENT É/Ï ÂYTE 2 ÁDDRESS OF LAST É/Ï ÂYTE +1 1 NEXT ÂLOCK: ÖERIFY/-ÌOAD 1 NEXT ÂLOCK: ÈEADER/ÄATA 1 LAST ÓTATE OF ÃASSETTEPORT 1 ALREADY LOADED PART OF CURRENT ÂYTE 1 LAST LOADED BYTE \\ FOR ÓÔ:..ÌABELS CLV16JUN87 2 SHORT/LONG ÉMPULS FOR ÓAVE 2 ÃHECKSUM 1 ÓTACKPOINTER FOR ÅRROR ÅXIT ----- ADDITIONAL ÓYSTEMADDRESSES----- 1 ÔIME FOR NEXT ÔIMERÂÓTART C0 ÂUFFER FOR ÃASSETTEOPERATIONS - ÅND OF ÂUFFER, ÌOW-ÂYTE ----------- ÃONSTANTS -------------- ÄEVICEÎUMBER OF ÓUPERTAPE 1.ÂYTE OF ÈEADERBLOCK 1.ÂYTE OF ÄATABLOCK ÔIME 7600 ÂAUD LOADING ÔIME 3600 ÂAUD LOADING ÔIME 7600 ÂD SAVE LONG/SHORT ÉMPULS ÔIME 7600 ÂD SAVE LONG/SHORT ÉMPULS ÂYTE FOR ÓYNC-ÈEADER MIN. ÎUMBER OF ÓYNCÂYTES FOR ÌOADING ÎUMBER OF ÓYNCÂYTES FOR ÓAVING \\ FOR ÓÔ:MISC CLV28JUL87 ÓTART OF ÂOOTSTRAPLOADER (1) ÓTART ÔIMER ÎUMBER 2 (1) WITH TIME IN ÓÔÉÍÅ ×AIT-ÌOOP (1) THE ÓEQUENCE 'BRK BRK BIT BRK BRK' STOPS OVERWRITING DATA AT BOOTTIME IF A READ-ERROR OCCURS \\ FOR ÓÔ:STÅND ETC. CLV18JUN87 NO ÅRROR (ÂIT--) ÌOAD- " (ÂIT--) ÁÒ := ÅRRORÎR ÅÏÔ - " (ÂIT--) ÖERIFY- " (ÂIT--) ÓTOP- " ÓWITCH TO ÒÏÍ, PUSH ÅRROR ÐORT EXIT REPAIR ÓTACK XR-YR := ÌOAD-ÅNDÁDDRESS ÃÆ := ÅRROR, ENABLE ÉNTERRUPT \\ FOR ÓÔ:BITÒEAD CLV16JUN87 WAIT FOR TIMER (?) ÃARRY := 1 , IF LEVEL EQUAL == ÂIT=1 SAVE BIT ROTATE IN BYTE IF ÂIT=1: INCREMENT CHECKSUM WAIT FOR EDGE SAVE PORTSTATE, SET TIMER RETURN CURRENT BYTE \\ ZU ÓÔ:STÒEAD.. CLV28JUL87 ÄATA/OR ÈEADER,ÖERIFYERROR := 0 SYNCRONIZING READ ÂYTE NO ÓYNC ÂYTE? SEARCH FOR IT ÈEADER DETECTED READ ÂYTE UNTIL ÈEADER ENDS ÁÒ=ÂLOCK-KIND SEARCHED ÂLOCK ËIND? YES, READ IT SEARCHED FOR ÈEADER, DATA FOUND, CONT. OTHR ËUND? ÅRROR ÃHECKSUM := 0 ÒEAD BYTE \\ FOR ÓÔ:..STÒEAD CLV28JUL87 --- ÌOOP FROM ÌOAD-ÓTART TILL END ÃHECKSUM := ÃHECKSUM READ 2 ÂIT ONLY ÖERIFY? ELSE: LOAD ÂYTE READ 2 ÂIT COMPARE ÂYTE INCREMENT VERIFY ERROR READ 2 BIT POINTER TO NEXT BYTE NEW BYTE NEW BYTE --- END OF LOOP --- END OF LOOP \\ FOR ÓÔ:..STÒEAD C2V27JUL87 ÃHECKSUM-ÅRROR? ELSE ÓTATUS AND ÌOADÅRROR-ÅXIT READ BYTE ÃHECKSUM-ÅRROR? ÖERIFYERROR? \\ FOR ÓÔ:STÌOAD.. CLV16JUN87 WILL BE LOAD-VECTOR OF SYSTEM SAVE ÖERIFY AND ÌOAD, CLEAR STATUS FOR ÓUPERTAPE? IF NOT -> ÃÂÍ-ÒOUTINE SAVE STACK FOR ERROR HANDLING 'ÐRESS PLAY ON ÔAPE' ÓTOP?,THEN RETURN DISABLE ÉÒÑ SET TO LOAD 'ÓEARCHING...' ÉNITIALIZING 3600 ÂAUD/ÌOAD ÓEARCH ÈEADER AND ÌOAD 'ÆOUND ..' PRINT ÆILENAME \\ FOR ÓÔ:..STÌOAD CLV16JUN87 COMPARE ALL CHARS SAME AS IN ENTRED FILENAME? CONTINUE ENTERED ÃHAR '?' ? CONTINUE ÅND-ÏF-ÔAPE ? THEN ÎOTÆOUND ELSE: ENABLE ÓCREEN, CONT. SEARCH REPAIR ÖERIFY ÆLAG 'LOADING'/'VERIFYING' ÌOADÁDDRESS := FROM ÓYSTEM ÓECÁDD.=1? THEN LOADADDRESS FROM HEADER ÌOADÅND := ÌOADÁDDRESS +ÆILEÌENGTH \\ FOR ÓÔ:..STÌOAD C2V27JUL87 7200 ÂAUD/ÌOAD SAVED WITH 3600 ÂD (==ÓECADD>$80)? THEN 3600 ÂD/ÌOAD SWITCH TO ÒÁÍ, LOAD ÄATABLOCK ÅND ×ILL BE USED FOR ÂOOTSTRAPLOADER ÃREATES A STRING OF ÆORM 'G78B5', WITH ADDRESS ÌÏÁÄÓÙÓ WILL BE USED AS ÍONITOR-ÃOMMAND, WITH ADDRESS OF ÂOOTSTRAPLOADER S.A. ÓÁÖÅÂÏÏÔÅÒ ÔHIS ÓTRING CANNOT CONTAIN CAPITAL ÌETTERS \\ FOR ÓÔ:WÂYTE W4BITS CLV16JUN87 4 ÂITS --- ÌOOP OVER 4 ÂITS BIT=1?, SET FULL TIMER WAIT FOR TIMER START NEW WRITE EDGE BIT=0? WAIT FOR TIMER AND START NEW WRITE EDGE (ÂIT-BORDER) BIT=1? INCREMENT ÃHECKSUM SET HALF TIME --- ÅND OF LOOP \\ FOR ÒD:ST×RITE CLV18JUN87 ÁÒ=ÂLOCKËIND SAVE ÓYNCHRONISATIONÂYTES ..WRITE WRITE ÂLOCKËIND ÃHECKSUM:= 0 --- ÌOOP FOR 1ST TILL LAST ÂYTE UPPER 4 ÂITS LOWER 4 ÂITS WRITE --- ÌOOP... --- ..ÅND ÃHECKSUM.. ..WRITE ÌOW ÂYTE ..WRITE ÈIGH ÂYTE FEW ÅXTRABITS, ENSURES THAT LOADING WILL END \\ FOR ÓÔ:SAVEÎAME CLV01AUG87 WRITES ÆILEÎAME IN ÃASSETTEBUFFER ÃASSETTEÂUFFER [0..$10] := <BLANKS> ÃASSETTEÂUFFER [0..ÆILEÎAMEÌENGTH] := ÆILEÎAME \\ FOR ÓÔ:STÓAVE.. CLV01AUG87 WILL BY PACTHED INTO ÏÓ ÖECTOR ÄEVICEÎR = ÓUPERTAPE? ELSE: USE ÃÂÍ-ÓAVE-ÒOUTINE ÓTACKÐOINTER SAVED FOR ÅRRORHANDLING ÆILEÎAME IN ÂUFFER ' ÐRESS ÐLAY & ÒECORD ON ÔAPE' ÓÔÏÐ? ÉNITIALIZING ÓTARTADDRESS IN ÂUFFER -- CHANGE??? -- FOR ÃÏÐÙ? ÆILEÌENGTH ..CALCULATE ..AND ..WRITE INTO BUFFER ÃASSÂUFFER [$21..$24] := 0 ÔIME-ÈIGHÂYTE := 0 ÓAVEÓTARTÁDRESSE := ÃASSETTEÂUFFER ÓAVEÅNDÁDDRESS := ÃASSETT.ÂUFFER-ÅND \\ FOR ÓÔ:..ÓÔÓAVE CLV01AUG87 3600ÂAUD/SHORT ÓAVEÉMPULS (==ÂIT=0) /LONG ÓAVEÉMPULS (==ÂIT=1) SET ÔIMERÎUMMER2 ENABLED ÈEADER (==ÂUFFER) WRITE WRITE ÐAUSE 7200ÂD REQUESTED (==ÓECÁDD>=$80) ? THEN 7200ÂD/SHORT ÓAVEÉMPULS /LONG ÓAVEÉMPULS SET ÓAVEÂEGINÁDDRESS := FROM ÓYSTEM ÓAVEÅNDÁDDRESS := FROM ÓYSTEM ENABLE ÒÁÍ, WRITE ÄATA ÂLOCK WRITE ÐAUSE, FINISH \\ FOR ÓÔ:SUPERTAPE STÓAVÓYS CLV10OCT87 ÓÕÐÅÒÔÁÐÅ .. SET CURRENT DEVICE .. PATCHES ÏÓ VECTORS .. PRINTS MESSAGE !! Á ÓUPERTAPE-ÓYSTEM MUST BE SAVED IN !! 3 ÐARTS: !! 1. ÍINI-ÓUPERTAPE !! 2. ÐART OF ÓYSTEM BEFORE !! 3. ÐART OF ÓYSTEM AFTR !! ÐART 1 WILL BE SAVED IN ÃÂÍ-ÆORMAT !! AND IS LOADING ÐART 2,3 IN ÓÔ-ÆORMAT ÁTTACHE ÆILENAME TO GÌÏÁÄÓÙÓ 1. FROM ÂÕÆÆÉÎÉÔ TO EXCL. ÂÔÌ SAVE IN ÃÂÍ-ÆORMAT USE ÓÔ-ÆORMAT 2. STORE 3. " \ ÓIEVE BENCHMARK 20OCT87RE ÏNLYFORTH : ALLOT ( U --) DUP SP@ HERE - $180 - U> ABORT" NO ROOM" ALLOT ; &8192 ÃONSTANT SIZE ÃREATE FLAGS SIZE ALLOT : DO-PRIME ( -- #PRIMES ) FLAGS SIZE 1 FILL 0 SIZE 0 ÄÏ FLAGS É + C@ ÉÆ É 2* 3+ DUP É + ÂÅÇÉÎ DUP SIZE < ×ÈÉÌÅ 0 OVER FLAGS + C! OVER + ÒÅÐÅÁÔ 2DROP 1+ ÔÈÅÎ ÌÏÏÐ ; : BENCHMARK 9 0 ÄÏ DO-PRIME DROP ÌÏÏÐ DO-PRIME . ." ÐRIMES" ; : .PRIMES SIZE 0 ÄÏ FLAGS É + C@ ÉÆ É 2* 3+ . ÔÈÅÎ ?CR STOP? ÉÆ ÌÅÁÖÅ ÔÈÅÎ ÌÏÏÐ ; \ ÇRAPHIC-ÄEMOS ÌOADSCREEN 20OCT87RE ÏNLY ÆORTH ALSO DEFINITIONS \NEEDS ÇRAPHIC -&80 +LOAD ÇRAPHIC ALSO DEFINITIONS PAGE .( ÌOADING .....) 1 4 +THRU \ ÄEMO1,2,3,4 ÄEMO 5 +LOAD \ ÓINPLOT 6 &11 +THRU \ ÔURTLE DEMOS WAVE WAVE1 TRIANGLE LINES MOIRE SINPLOT ORNAMENT CIRCLES WORM COIL TOWN &20 WINDOW \ ÐLOT WAVE 20OCT87RE &100 Ü ÃONSTANT &100 &160 Ü ÃONSTANT &160 : WAVE CS RED CYN COLORS HIRES &100 0 ÄÏ &99 0 ÄÏ É DUP * Ê DUP * + &150 / 1 AND ÉÆ &160 Ê + &100 É + PLOT &160 Ê - &100 É + PLOT &160 Ê - &100 É - PLOT &160 Ê + &100 É - PLOT ÔÈÅÎ ÌÏÏÐ ÌÏÏÐ ; : WAVE1 CS BLU YEL COLORS HIRES &160 0 ÄÏ &99 0 ÄÏ É DUP * Ê DUP * + 100U/ 1 AND 0= ÉÆ &160 Ê + &100 É + PLOT &160 Ê - &100 É + PLOT &160 Ê - &100 É - PLOT &160 Ê + &100 É - PLOT ÔÈÅÎ ÌÏÏÐ ÌÏÏÐ ; \ LINEPLOT TRIANGLE 20OCT87RE Ü : GRINIT CLRSCREEN YEL BLU COLORS HIRES ; : TRIANGLE GRINIT 0 2 ÄÏ &160 0 ÄÏ É &199 &160 É 2/ Ê + FLIPLINE &320 É - &199 &160 É 2/ Ê + FLIPLINE 2 +ÌÏÏÐ -1 +ÌÏÏÐ TEXT ; \ LINEPLOT LINIES MOIRE 20OCT87RE : LINIES GRINIT &320 0 ÄÏ &320 0 ÄÏ É &198 Ê 0 LINE &35 +ÌÏÏÐ &35 +ÌÏÏÐ ; : MOIRE CLRSCREEN ORA RED COLORS HIRES &320 0 ÄÏ É &198 &319 É - 0 LINE 3 +ÌÏÏÐ &199 0 ÄÏ &319 &198 É - 0 É LINE 2 +ÌÏÏÐ ; \ LINEPLOT BOXES 20OCT87RE ÖARIABLE X0 ÖARIABLE Y0 ÖARIABLE X1 ÖARIABLE Y1 : BOX ( X1 Y1 X0 Y0 -) Y0 ! X0 ! Y1 ! X1 ! X1 @ Y0 @ X0 @ OVER FLIPLINE X1 @ Y1 @ OVER Y0 @ FLIPLINE X0 @ Y1 @ X1 @ OVER FLIPLINE X0 @ Y0 @ OVER Y1 @ FLIPLINE ; ÃREATE COLORTAB BLK C, LBL C, RED C, LRE C, PUR C, GRN C, BLU C, : BOXES GRINIT &10 3 ÄÏ &160 0 ÄÏ É DUP &318 É - &198 É - BOX Ê +ÌÏÏÐ É 3 - COLORTAB + C@ PENCOLOR ÌÏÏÐ ; \ ÇRAPHIC SINPLOT 20OCT87RE &10000 ÃONSTANT 10K : SINPLOT GRINIT &319 &96 0 &96 LINE &160 &197 &160 0 LINE &152 &160 NEGATE ÄÏ É &160 + &96 É SIN &96 10K */ + É &168 + &96 É 8 + SIN &96 10K */ + LINE 8 +ÌÏÏÐ &152 &160 NEGATE ÄÏ É &160 + &96 É COS &96 10K */ + É &168 + &96 É 8 + COS &96 10K */ + LINE 8 +ÌÏÏÐ ; \ ÔURTLE DEMOS 20OCT87RE Ü : TINIT ( -- ) CLRSCREEN HIRES \ SHOWTURTLE RED CYN COLORS ; Ü : SHOME ( -- ) TINIT &65 0 SETXY &90 SETH PENDOWN ; : POLYGON ( LENGTH EDGES -- ) &360 OVER / SWAP 0 ÄÏ OVER FORWARD DUP RIGHT ÌÏÏÐ 2DROP ; Ü : RING ( EDGES -- ) &200 OVER / SWAP &18 0 ÄÏ 2DUP VIELECK &20 RIGHT ÌÏÏÐ 2DROP ; : ORNAMENT ( -- ) TINIT HOME &10 3 ÄÏ CLRSCREEN É DUP 7 - ÉÆ RING ÅÌÓÅ DROP ÔÈÅÎ ÌÏÏÐ ; \ ÔURTLE DEMOS 1 20OCT87RE : CIRCLES ( -- ) TINIT 2 -1 ÄÏ HOME &10 0 ÄÏ &20 É 2* - &20 POLYGON XCOR &10 É 2/ - - SETX YCOR &10 É - Ê * - SETY ÌÏÏÐ 2 +ÌÏÏÐ ; \ ÔURTLE DEMOS 2 20OCT87RE Ü : (WORM ( LENGTH -- ) RECURSIVE DUP 5 < ÉÆ DROP EXIT ÔÈÅÎ DUP FORWARD &90 RIGHT 2- (WORM ; : WORM ( -- ) SHOME &190 (SCHNECKE ; Ü : (COIL ( LENGTH -- ) RECURSIVE DUP 5 < ÉÆ DROP EXIT ÔÈÅÎ DUP FORWARD &91 RIGHT 2- (COIL ; : COIL ( -- ) SHOME 5 FORWARD &190 (COIL ; \ ÔURTLE DEMOS 3 20OCT87RE Ü : STARTPOS &15 0 SETXY &90 SETHEADING ; Ü : CONTINUE ( -- ) &90 RIGHT PENUP &55 FORWARD PENDOWN &90 LEFT ; Ü : CHIMNEY XCOR YCOR &50 FD &30 RT &15 FD &30 LT &30 FD &90 RT &12 FD &90 RT 8 FD SETXY &90 SETHEADING ; Ü : HOUSE &50 4 POLYGON &50 FORWARD &30 RIGHT &50 3 POLYGON &30 LEFT &50 BACK &90 RIGHT &15 FORWARD &90 LEFT &20 4 POLYGON &90 LEFT &15 FORWARD &90 RIGHT CHIMNEY ; \ ÔURTLE DEMOS 4 20OCT87RE Ü : ROWOFHOUSES TINIT STARTPOS 4 0 ÄÏ HOUSE CONTINUE ÌÏÏÐ HOUSE ; Ü : HOUSEWINDOW XCOR YCOR PENUP &30 FD &90 RT &10 FD &90 LT PENDOWN &10 4 POLYGON &90 RT PENUP &20 FD &90 LT PENDOWN &10 4 POLYGON SETXY ; : TOWN HOUSEROW STARTPOS 4 0 ÄÏ HOUSEWINDOW CONTINUE ÌÏÏÐ HOUSEWINDOW ; \ ÔURTLE DEMOS 5 20OCT87RE Ü : (MEDAL ( LEN GRAD -- ) RECURSIVE STOP? 0= AND ?DUP ÉÆ OVER 3 / SWAP 1- 4 0 ÄÏ 2DUP (MEDAL 2 PICK FORWARD &90 RIGHT ÌÏÏÐ 2DROP ÔÈÅÎ DROP ; : MEDAL TINIT SHOME &192 5 (MEDAL ; \\ : (6MEDALS ( LEN GRAD -) RECURSIVE ?DUP ÉÆ OVER 3 / SWAP 1- 6 0 ÄÏ 2DUP (6MEDALS 2 PICK FORWARD &60 RIGHT ÌÏÏÐ 2DROP ÔÈÅÎ DROP ; : 6MEDALS TINIT SHOME &80 &55 SETXY &85 3 (6MEDALS ; \ ÓPRITE-ÄEMO 23OCT87RE \NEEDS GRAPHIC -&96 +LOAD ÏNLYFORTH GRAPHIC ALSO ÆORTH .( ÌOADING...) 1 4 +THRU \ ÓPRITE-ÄEMO 20OCT87RE ÃREATE ÓHAPES 5 $40 * ALLOT BLK @ 4 + BLOCK ÓHAPES 5 $40 * CMOVE : INIT ( -) GRAPHIC PAGE BLU BORDER BLU BACKGROUND 5 0 ÄÏ ÓHAPES É $40 * + É GETFORM ÌÏÏÐ GRN WHT SPRCOLORS 5 0 ÄÏ É 0 0 WHT É SETSPRITE ÌÏÏÐ 5 0 ÄÏ É SMALL É HIGH É 3COLORED SET É BEHIND ÌÏÏÐ ; \ ÓPRITE-ÄEMO 20OCT87RE : YPOS ( SPR# - Y) SPRPOS DROP ; : XPOS ( SPR# - X) SPRPOS NIP ; &26 ÃONSTANT ÄISTANCE : 1+0-1 ( N - +1/0/-1) DUP 0= NOT SWAP 0< 2* 1+ AND ; : FOLLOW-SPRITE ( SPR# -) >R R@ XPOS R@ 1- XPOS ÄISTANCE + OVER - 1+0-1 + &344 MIN R@ XMOVE PAUSE R@ YPOS R@ 1- YPOS OVER - 1+0-1 + R> YMOVE PAUSE ; \ ÓPRITE-ÄEMO 20OCT87RE : FOLLOW-CURSOR ( SPR# -) >R R@ XPOS ÃOL 8 * &33 + OVER - 1+0-1 + R@ XMOVE PAUSE R@ YPOS ÒOW 8 * &59 + OVER - 1+0-1 + R> YMOVE PAUSE ; : FOLLOW ( SPR# -) PAUSE DUP ÉÆ FOLLOW-SPRITE ÅÌÓÅ FOLLOW-CURSOR ÔÈÅÎ ; : KILLSPRITES ( -) 0 SPRITE C! ; : SLIDE-SPRITES ( -) 5 0 ÄÏ É FOLLOW É 1+ 0 ÄÏ É FOLLOW ÌÏÏÐ ÌÏÏÐ ; \\ : TESTSLIDE ( -) INIT ÂÅÇÉÎ SLIDE-SPRITES KEY DUP CON! 3 = ÕÎÔÉÌ ; \ ÓPRITE-ÄEMO 20OCT87RE \NEEDS TASKS .( ÔASKER? ) \\ $100 $100 ÔASK ÄEMO : SLIDE ( -) ÄEMO ACTIVATE INIT ÂÅÇÉÎ SLIDE-SPRITES ÒÅÐÅÁÔ ; : ENDSLIDE ( -) KILLSPRITES ÄEMO ACTIVATE STOP ; ªªª•UV•UV•ªª•€ •€ •ª •U`•U`•ª •€ •€ •€ •€ •€ •€ •€ ª€ ªª€ U`%UX•iV•‚V•‚V•‚V•‚V•‚V•‚V•‚V•‚V•‚V•‚V•iV%UX U`ª€ ªªª€•U`•UX•©V•‚V•‚V•©V•UX•U`•¥`•¥`•‰X•‰X•‚V•‚V•‚V•‚Vª‚ª ªªªª•UV•UVªVªV V V V V V V V V V V V V ª ªª‚ª•‚V•‚V•‚V•‚V•‚V•ªV•UV•UV•ªV•‚V•‚V•‚V•‚V•‚V•‚V•‚Vª‚ª ª \ TINY SPRITE EDITOR 06NOV87RE ÏNLYFORTH ÇRAPHIC ALSO DEFINITIONS \NEEDS SPRBUF ÃREATE SPRBUF $100 ALLOT \NEEDS >BYTE : >BYTE $100 /MOD ; Ü ÖARIABLE CBASE 2 CBASE ! Ü : WIDTH ( -- N ) &16 CBASE @ / ; Ü : (L: ( -- ) BASE PUSH CBASE @ BASE ! NAME NUMBER NAME NUMBER DROP >R >BYTE DROP R@ C! >BYTE R@ 1+ C! R> 2+ C! ; : L: (L: QUIT ; : #.R ( N WIDTH -- ) >R 0 <# R> 0 ÄÏ # ÌÏÏÐ #> TYPE ; : ARGUMENTS ( N -- ) DEPTH < NOT ABORT" ÁRGUMENTS?" ; --> \ TINY SPRITE EDITOR 06NOV87RE Ü ÃREATE SAVEAREA $1Á ALLOT Ü ÖARIABLE XSAVE Ü ÖARIABLE YSAVE Ü ÖARIABLE SAVED SAVED OFF Ü : SAVESPRITES ( -- ) SAVED @ ?EXIT SPRITE SAVEAREA $1Á CMOVE 0 SPRITE C! 7 SPRPOS XSAVE ! YSAVE ! SAVED ON ; : FERTIG ( -- ) SAVED @ NOT ?EXIT YSAVE @ XSAVE @ 7 MOVE SAVEAREA SPRITE $1Á CMOVE SAVED OFF ; Ü : SPRLINE ( ADR LINE -- ) BASE PUSH DUP 2* + + CR ." L: " CBASE @ BASE ! DUP COUNT WIDTH #.R COUNT WIDTH #.R C@ WIDTH #.R ." . $" HEX 4 #.R ; --> \ TINY SPRITE EDITOR 06NOV87RE Ü : SLIST ( MEM# -- ) $40 * SPRBUF + &21 0 ÄÏ DUP É SPRLINE STOP? ÉÆ ÌÅÁÖÅ ÔÈÅÎ ÌÏÏÐ DROP CR ." FERTIG" 0 0 AT QUIT ; : SED ( MEM# -- ) 1 ARGUMENTS &32 MIN PAGE DUP . ." SED \ 1 COLOR" SAVESPRITES 2 CBASE ! DUP $40 $128 YEL 7 SETSPRITE 7 3COLORED RESET 7 BIG SLIST ; : CED ( MEM# -- ) 1 ARGUMENTS &32 MIN PAGE DUP . ." CED \ 3 COLORS" SAVESPRITES 4 CBASE ! BLK GR2 SPRCOLORS DUP $40 $128 YEL 7 SETSPRITE 7 3COLORED SET 7 HIGH SLIST ; |