M2-M8.txt

File: M2-M8.txt
Created: Sun Apr 21 00:02:19 2024

Index:

    1 
    2 rge, publish, distribute, sublic
    3  OF MERCHANTABILITY, FITNESS FOR
    4 is undefined.
    5 ( Error messages    2/4 )
    6 ( Error messages    3/4 )
    7 ( Error messages    4/4 )
    8 ( Get the list of errors )
    9 ." Assembler. "           CR
   10 ( Compile Phase )
   11 ( Autoexec 1/3 )
   12 ( Autoexec 2/3 )
   13 ( Autoexec 3/3 )
   18 .( Case-of structure. )   CR
   19 ( Case-Of structure  2/2 )
   20 .( Debugger. )            CR
   21 ( Debugger             2/6 )
   22 ( Debugger             3/6 )
   23 ( Debugger             4/6 )
   24 ( Debugger             5/6 )
   25 ( Debugger             6/6 )
   26 ( Stack viewer             )
   27 ( Longer memory dump )
   28 ( Vocabulary viewer        )
   29 ( Simple Word RENAMEr )
   30 ( 2CONSTANT )
   31 ( SET-FENCE )
   32 ( HIDE )
   33 ( USED-BY )
   34 ( DUMP WORDS )
   35 ( Restore AUTOEXEC )
   36 ( RECURSE - GDC )
   37 ( ?ESCAPE experiment       )
   38 ( RND Test )
   39 ( CHOOSE - Brodie )
   40 .( RND )
   41 ( Color and attributes  )
   42 ( AT TAB                   )
   43 ( POINT SCREEN$ )
   44 ( PLOT )
   45 ( DRAW                     )
   46 ( PAINT )
   47 ( PAINT )
   48 ( Mr Jones' keyboard test )
   49 ( Mr Jones' keyboard test )
   50 ( BLEEP )
   51 ( BLEEP )
   52 ( Pitch bend )
   53 ( KEYBOARD-TEST )
   55 ( MS delay )
   57 ( FRAMES )
   58 ( FRAMES )
   59 ( TEST )
   60 ( Interrupt Handler )
   61 ( Interrupt Handler )
   62 ( Interrupt Handler )
   63 ( Interrupt Handler )
   64 ( Interrupt Handler )
   65 ( Interrupt Handler )
   66 ( Interrupt Handler )
   67 ( Interrupt Handler )
   68 ( INTERRUPT - TEST )
   69 ( INTERRUPT )
   70 .( Compare Utility. ) CR
   71 ( COMPARE )
   72 ( SEARCH )
   73 ( SEARCH )
   74 ( LOCATE )
   75 ( LOCATE )
   76 \ S" ( strings )
   80 .( Full Screen Editor. ) CR
   81 ( Full Screen Editor )
   82 ( Full Screen Editor )
   83 ( Full Screen Editor )
   84 ( Full Screen Editor )
   85 ( Full Screen Editor )
   86 ( Full Screen Editor )
   87 ( Full Screen Editor )
   90 .( Line editor. )         CR
   91 ( Line Editor          2/6 )
   92 ( Line Editor          3/6 )
   93 ( Line Editor          4/6 )
   94 ( Line Editor          5/6 )
   95 ( Line Editor          6/6 )
   96 ( Editor Utility )
   98 ( Editor utility           )
   99 .( Call utility. )        CR
  100 ." Assembler. "           CR
  101 .( Z80 Assembler. ) CR
  102 ( Z80 Utility - Sys depend )
  103 ( Z80 Utility - Sys depend )
  104 ( Z80 System independ. )
  105 ( Z80 System independ. )
  106 ( Z80 Generate errors )
  107 ( Assembler Z80 )
  108 ( Assembler Z80 )
  109 ( Assembler Z80 )
  110 ( Assembler Z80 )
  111 ( Assembler Z80 )
  112 ( Assembler Z80 )
  113 ( Assembler Z80 )
  114 ( Assembler Z80 )
  115 ( Assembler Z80 )
  116 ( Assembler Z80 )
  117 ( Assembler Z80 )
  118 ( Assembler z80 )
  120 .( Z80 definitions. ) CR
  121 ( Z80 ) HEX
  122 ( Z80 ) HEX
  123 ( Z80 ) HEX
  124 ( Z80 immediate data )
  125 ( Z80 address )
  126 ( Z80 ) HEX
  127 ( Z80 relative jump )
  128 ( ED prefix )
  129 ( ED )
  130 ( ED )
  131 ( CB )
  132 ( IX IY )
  133 ( IX IY )
  134 ( IX IY )
  135 ( IX IY )
  136 ( IX IY )
  137 ( IX IY )
  138 ( IX IY )
  140 .( Z80 near structure )   CR
  141 ( Z80 Near struct. )
  142 ( Z80 Near struct. )
  143 ( Z80 Near struct. )
  144 ( Z80 Near struct. )
  145 ." Z80 far struct "
  146 ( TESTING )
  147 ( 128K memory BANK! TEST )
  148 ( 128K memory BANK! TEST )
  149 ( 128K memory BANK! TEST )
  150 ( TEST0 )
  151 ( TEST1 )
  152 ( TEST2 )
  153 ( TEST3 )
  154 ( TEST IF, THEN, )
  155 \ TEST
  156 \ TEST6
  157 \ TEST7
  158 \ TEST Z80N
  159 \ TEST Z80N
  160 .( Z80N Next extensions )
  161 ( Z80N Next extension )
  162 ( Z80N Next extension )
  166 ( White noise Egghead 3 )
  167 ( White noise Egghead 3 )
  168 ( White noise Egghead 3 )
  169 ( Checksum of a RAM chunk )
  170 \ BURP
  171 ( Dump many pages )
  179 ( CHECK NULL               )
  180 ( Fibonacci )
  181 ( DSQRT )
  182 ( Primality Test )
  183 ( TEST )
  201 ( DAA )
  202 ( DAA )
  203 ( U* )
  204 ( U* )
  205 ( U/   dn n -- r dq )
  206 ( U/ )
  207 ( U/ )
  208 ( UPPER )
  209 ( PICK )
  220 ( MOVE SP )
  221 ( MOVE RP )
  222 ( MOVE LIMIT )
  223 ( UP AND DOWN )
  225 ( ?DO LOOP )
  226 ( ?DO LOOP )
  227 ( ?DO LOOP )
  228 ( ?DO LOOP )
  229 ( POSTPONE )
  239 ( Rainbow effects )
  240 ( LARGE LETTER-F )
  250 \ BLOCK-SHIFT
  251 ( block move reorder )
  252 \ Print all blocsks to #13
  253 ( INITIALIZE-MMC )
  254 ( Microdrive Last Block )
  255 ( DR-1 BEGIN )
  287 ( GREY-SCREEN example )
  288 ( GREY-SCREEN example )
  292 ( GREY-SCREEN example )
  293 ( MMU7 = 40h )
  300 ( FAR-HL first example )
  301 ( FAR-HL first example )
  302 ( MMU7 / default bank )
  303 ( MMU7 / set bank )
  304 ( MMU7 / set bank 5 bits )
  305 ( MMU7 / set bank 6 bits )
  306 ( MMU7 / set bank 7 bits )
  307 ( MMU7 / first 16K RAM )
  308 ( MMU7 / first 16K RAM )
  309 ( MMU7 / first 16K RAM )
  310 ( MMU7 / first 16K RAM )
  311 ( MMU7 / 8th byte )
  312 ( MMU7 / 8th byte )
  313 ( MMU7 / 8th byte )
  314 ( MMU7 / 8th byte )
  315 ( MMU7 / 4th byte )
  316 ( MMU7 / 4th byte )
  317 ( MMU7 / 4th byte )
  318 ( MMU7 / 4th byte )
  320 ( MMU7 / simplest )
  321 ( MMU7 / simplest )
  322 ( MMU7 / simplest )
  323 ( MMU7 / simplest )
  324 ( MMU7 / simplest )
  325 ( MMU7 HEAP )
  326 ( MMU7 HEAP )
  327 ( MMU7 HEAP )
  328 ( MMU7 HEAP STRING )
  329 ( MMU7 HEAP STRING )
  330 ( MMU7 HEAP POINTE )
  331 \ TEST
  332 \ TEST
  360 ( F_OPEN )
  361 123
  380 ( .HELLO )
  382 ( DOT )
  384 ( .VER )
  385 ( .XVER )
  400 ( UDG utility )
  401 ( HASH Utility )
  402 ( NEEDS with HASH Utility )
  403 ( HASH Utility )
  508 ( DR-1 END )
  509 ( DR-2 BEGIN )
  537 ( VALUE TO )
  538 \ test
  600 .( Chomp.f )
  601 ( Chomp.f )
  602 ( Chomp.f )
  603 ( Chomp.f )
  604 ( Chomp.f )
  605 ( Chomp.f )
  606 ( Chomp.f )
  610 .( Chomp.f - UDG )
  611 ( Chomp.f - UDG )
  612 ( Chomp.f - UDG )
  613 ( Chomp.f - UDG )
  614 .( Chomp.f - maze )
  615 ( Chomp.f - maze )
  616 ( Chomp.f - maze )
  617 ( Chomp.f - maze )
  618 ( Chomp.f - maze )
  619 ( Chomp.f - maze )
  620 .( Chomp.f - Sprite )
  621 ( Chomp.f - Sprite )
  622 ( Chomp.f - Sprite )
  623 ( chomp.f - Sprite )
  624 ( Chomp.f - Sprite )
  625 ( Chomp.f - Sprite )
  626 ( Chomp.f - Sprite )
  627 ( Chomp.f - Sprite )
  628 ( Chomp.f - Sprite )
  629 ( Chomp.f )
  630 .( Chomp.f - trail )
  631 ( Chomp.f - trail )
  632 ( Chomp.f - trail )
  633 ( Chomp.f - trail )
  634 ( Chomp.f - trail )
  635 ( Chomp.f - trail )
  636 ( Chomp.f - trail )
  637 ( Chomp.f - trail )
  638 ( Chomp.f - trail )
  639 ( Chomp.f - trail )
  640 ( Chomp.f - ghost )
  641 ( Chomp.f - ghost )
  642 ( Chomp.f - ghost )
  643 ( Chomp.f - ghost )
  644 ( Chomp.f - ghost )
  645 ( Chomp.f - ghost )
  650 ( Chomp.f )
  651 ( Chomp.f )
  652 ( Chomp.f )
  653 ( Chomp.f - Interlude )
  654 ( Chomp.f )
  655 ( Chomp.f )
  656 ( Chomp.f )
  657 ( Chomp.f )
  658 ( Chomp.f )
  659 ( Chomp.f )
  660 ( Chomp.f )
  661 ( Chomp.f )
  662 ( Chomp.f )
  663 ( Chomp.f )
  664 ( Chomp.f )
  665 ( Chomp.f )
  666 ( Chomp.f )
  667 ( Ghost.f )
  762 ( DR-2 END )
  763 ( DR-3 BEGIN )
  777 1
  791 ( VALUE TO )
  792 \ test
 1016 ( DR-3 END )
 1017 ( DR-4 BEGIN )
 1022 ( Christmas Star )
 1045 ( VALUE TO )
 1046 \ test
 1111 \ 100 LOAD  \ NEEDS ASSEMBLER
 1270 ( DR-4 END )
 1271 ( DR-5 BEGIN )
 1299 ( VALUE TO )
 1300 \ test
 1524 ( DR-5 END )
 1525 ( DR-6 BEGIN )
 1553 ( VALUE TO )
 1554 \ test
 1560 ( DISCiPLE last block )
 1778 ( Mirodrive last block )

Scr# 1 
  0 
  1 v-Forth 1.6 MDR/MGT version
  2 
  3 MIT License
  4 
  5 Copyright (c)
  6 1990-2024 Matteo Vitturi
  7 
  8 Permission is hereby granted, fr
  9 ee of charge, to any person obta
 10 ining a copy of this software an
 11 d associated documentation files
 12  (the "Software"), to deal in th
 13 e Software without restriction,
 14 including without limitation the
 15  rights to use, copy, modify, me

Scr# 2 
  0 rge, publish, distribute, sublic
  1 ense, and/or sell copies of the
  2 Software, and to permit persons
  3 to whom the Software is furnishe
  4 d to do so, subject to the follo
  5 wing conditions:
  6 
  7 The above copyright notice and t
  8 his permission notice shall be i
  9 ncluded in all copies or substan
 10 tial portions of the Software.
 11 
 12 THIS SOFTWARE IS PROVIDED "AS IS
 13 ", WITHOUT WARRANTY OF ANY KIND,
 14  EXPRESS OR IMPLIED, INCLUDING B
 15 UT NOT LIMITED TO THE WARRANTIES

Scr# 3 
  0  OF MERCHANTABILITY, FITNESS FOR
  1  A PARTICULAR PURPOSE AND NONINF
  2 RINGEMENT. IN NO EVENT SHALL THE
  3  AUTHORS OR COPYRIGHT HOLDERS BE
  4  LIABLE FOR ANY CLAIMS, DAMAGES
  5 OR OTHER LIABILITY, WHETHER IN A
  6 N ACTION OF CONTRACT, TORT OR OT
  7 HERWISE, ARISING FROM, OUT OF OR
  8  IN CONNECTION WITH THE SOFTWARE
  9  OR THE USE OR OTHER DEALINGS IN
 10  THE SOFTWARE.
 11 
 12 
 13 
 14 
 15 

Scr# 4 
  0 is undefined.
  1 Stack is empty.
  2 Dictionary full.
  3 No such line.
  4 has already been defined.
  5 Invalid stream.
  6 No such block.
  7 Stack is full.
  8 Old dictionary is full.
  9 Tape error.
 10 Wrong array index.
 11 Invalid floating point.
 12 Heap full.
 13 Division by zero.
 14 
 15 

Scr# 5 
  0 ( Error messages    2/4 )
  1 Can't be executed.
  2 Can't be compiled.
  3 Syntax error.
  4 Bad definition end.
  5 is a protected word.
  6 Aren't loading now.
  7 Forget across vocabularies.
  8 RS loading error.
  9 Cannot open stream.
 10 Error at postit time.
 11 Inconsistent fixup.
 12 Unexpected fixup/commaer.
 13 Commaer data error.
 14 Commaer wrong order.
 15 Programming error.

Scr# 6 
  0 ( Error messages    3/4 )
  1 Programming error.
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 File not found.
 12 NextZXOS dos call error.
 13 NextZXOS pos error.
 14 NextZXOS read error.
 15 NextZXOS write error.

Scr# 7 
  0 ( Error messages    4/4 )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 8 
  0 ( Get the list of errors )
  1 MARKER FORGET-THIS
  2 DECIMAL
  3 : LIST-OF-ERRORS ( -- )
  4   3 0 DO
  5    I 1+ 16 * I 16 * DO
  6     I 2 .R ." :"
  7     I MESSAGE CR
  8    LOOP
  9    INVV ."   press any key..."
 10    TRUV CURS KEY DROP CR
 11   LOOP
 12 ;
 13 CR LIST-OF-ERRORS
 14 FORGET-THIS
 15 

Scr# 9 
  0 ." Assembler. "           CR
  1 \
  2 \ Load ASSEMBLER vocabulary
  3 \
  4 \ : CDEF CREATE ; \ TEMP
  5 DECIMAL 100 LOAD
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 10 
  0 ( Compile Phase )
  1 \ Assembler
  2 \  : BLANK BL FILL ;
  3 \  : BLANKS BL FILL ;
  4 \ DECIMAL 9 LOAD \ Assemble
  5 \ External file
  6 \ DECIMAL -11 LOAD \ F16m.f
  7 EXIT
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 11 
  0 ( Autoexec 1/3 )
  1 \ This is executed at first
  2 \ COLD start by AUTOEXEC
  3 \
  4 CR ." Starting AUTOEXEC"
  5 CR CR
  6 S0 PAD - U.
  7 ." bytes free in Dictionary."
  8 CR CR
  9 -->
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 12 
  0 ( Autoexec 2/3 )
  1 MARKER FORGET-TASK
  2 : ASK-Y/N ( -- )
  3   \ ask Y/n to continue
  4   ." Autoexec says:" CR
  5   ." Do you wish to load" CR
  6   ." Scr# 11 (Y/n) " CURS KEY
  7   DUP EMIT CR UPPER
  8   [ CHAR N ] LITERAL
  9   = IF ." ok "
 10     FORGET-TASK QUIT
 11   ELSE
 12     FORGET-TASK
 13   THEN ;
 14 ASK-Y/N -->
 15 

Scr# 13 
  0 ( Autoexec 3/3 )
  1 \ Line editor
  2   DECIMAL  90 LOAD
  3 \ Case-Of
  4   DECIMAL  18 LOAD
  5 \ Debugger
  6   DECIMAL  20 LOAD
  7 \ Full Screen Editor
  8   DECIMAL  80 LOAD
  9 \ Search utility
 10   DECIMAL  70 LOAD
 11   11 SCR !
 12 
 13 
 14 
 15 

Scr# 18 
  0 .( Case-of structure. )   CR
  1 : CASE
  2   ?COMP CSP @ !CSP 4 ;
  3   IMMEDIATE
  4 : (OF)
  5   OVER = DUP IF SWAP DROP
  6   THEN ;
  7 : OF
  8   4 ?PAIRS COMPILE (OF)
  9   COMPILE 0BRANCH HERE 0 ,
 10   5 ; IMMEDIATE
 11 : ENDOF
 12   5 ?PAIRS COMPILE BRANCH
 13   HERE 0 , SWAP 2 [COMPILE]
 14   THEN 4 ; IMMEDIATE
 15 -->

Scr# 19 
  0 ( Case-Of structure  2/2 )
  1 : ENDCASE
  2   4 ?PAIRS COMPILE DROP
  3   BEGIN SP@ CSP @ -
  4   WHILE 2 [COMPILE] THEN
  5   REPEAT CSP ! ; IMMEDIATE
  6 EXIT
  7 \ Example
  8 x CASE
  9 1 OF ... ENDOF
 10 2 OF ... ENDOF
 11 (else) ... ENDCASE
 12 
 13 
 14 
 15 

Scr# 20 
  0 .( Debugger. )            CR
  1 DECIMAL
  2 : (DUMP) ( a+4 a -- )
  3   DO I C@ 2 .R LOOP ;
  4 : DUMP   ( a -- )
  5   BASE @ SWAP HEX
  6   DUP 64 + SWAP DO CR
  7   I 0 4 D.R SPACE
  8   I 4 + I (DUMP) SPACE
  9   I 8 + I 4 + (DUMP) SPACE
 10   I 8 + I DO I C@
 11   127 AND DUP 32 <
 12   IF SPACE DROP
 13   ELSE EMIT THEN LOOP
 14   ?TERMINAL IF LEAVE THEN
 15   8 +LOOP BASE ! ; -->

Scr# 21 
  0 ( Debugger             2/6 )
  1 : .WORD >BODY NFA ID. ;
  2 : DEB-N ." Nfa: "
  3   NFA DUP U. C@ . CR ;
  4 : DEB-C ." Cfa: "
  5   CFA DUP U. @ U. CR ;
  6 : DEB-L ." Lfa: "
  7   LFA DUP U. @ ID. CR ;
  8 : DEB-P ." Pfa: " DUMP ;
  9 : DEB-LIT 2+ DUP @ . ;
 10 : DEB-BRN DUP @ .WORD INVV
 11   DEB-LIT TRUV ;
 12 : DEB-DOT DUP @ .WORD 2+
 13   COUNT 2DUP INVV TYPE + 2 -
 14   TRUV SPACE ;
 15 -->

Scr# 22 
  0 ( Debugger             3/6 )
  1 ' : @ CONSTANT <:>
  2 ' ABORT CONSTANT <AB>
  3 ' EXIT     CONSTANT <;S>
  4 ' (?DO)    CONSTANT <D>
  5 ' (+LOOP)  CONSTANT <+L>
  6 ' (LOOP)   CONSTANT <L>
  7 ' BRANCH   CONSTANT <B>
  8 ' 0BRANCH  CONSTANT <0B>
  9 ' LIT      CONSTANT <LIT>
 10 ' (.")     CONSTANT <.">
 11 ' QUIT     CONSTANT <Q>
 12 ' CONSTANT CONSTANT <C>
 13 ' VARIABLE CONSTANT <V>
 14 ' WARM     CONSTANT <!>
 15 -->

Scr# 23 
  0 ( Debugger             4/6 )
  1 : ?FWD
  2   DUP DUP @ U< IF INVV THEN ;
  3 : (DELOAD)
  4   CASE
  5   <D>   OF DEB-BRN ENDOF
  6   <+L>  OF DEB-BRN ENDOF
  7   <L>   OF DEB-BRN ENDOF
  8   <B>   OF DEB-BRN ENDOF
  9   <0B>  OF DEB-BRN ENDOF
 10   <LIT> OF DEB-LIT ENDOF
 11   <.">  OF DEB-DOT ENDOF
 12   DUP .WORD
 13   ENDCASE
 14 ; -->
 15 

Scr# 24 
  0 ( Debugger             5/6 )
  1 : DELOAD
  2  BEGIN
  3   ?FWD DUP @
  4   (DELOAD)
  5   CELL+
  6   TRUV ?TERMINAL
  7   OVER @ <AB> = OR
  8   OVER @ <Q>  = OR
  9   OVER @ <;S> = OR
 10   OVER @ <!>  = OR
 11  UNTIL ;
 12 -->
 13 
 14 
 15 

Scr# 25 
  0 ( Debugger             6/6 )
  1 : (SEE)
  2   BASE @ SWAP HEX >BODY
  3   DUP DEB-N  DUP DEB-L
  4   DUP DEB-C  DUP CFA @ <:> =
  5   IF
  6    DECIMAL DELOAD DROP BASE !
  7   ELSE
  8    SWAP BASE ! CFA DEB-P
  9   THEN ;
 10 \
 11 : SEE
 12   -FIND 0= 0 ?ERROR
 13   .  CR  (SEE) ;
 14 -->
 15 

Scr# 26 
  0 ( Stack viewer             )
  1 : DEPTH
  2   S0 @ SP@ - 2/ 1- ;
  3 : .S
  4   DEPTH IF
  5    CR DEPTH 1+ 1 DO
  6     S0 @ I CELLS - @ U.
  7    LOOP
  8   THEN ;
  9 : DEB ( n -- )
 10   ." debug " . .S ."  -- "
 11   R0 @ RP@ 2+ ?DO
 12    I @ U.
 13   2 +LOOP ;
 14 
 15 

Scr# 27 
  0 ( Longer memory dump )
  1 \ Utility to dump large
  2 \ interval of memory
  3 \ Usually 13 SELECT to re-
  4 \ direct to stream # 13
  5 : DUMPM ( a1 a2 -- )
  6  SWAP DO
  7   I DUMP
  8  64 +LOOP
  9 ;
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 28 
  0 ( Vocabulary viewer        )
  1 : ?VOCAB
  2  CR ." Current "
  3  CURRENT @ 4 - NFA ID.
  4  CR ." Context "
  5  CONTEXT @ 4 - NFA ID.
  6  CR ." VocLink "
  7  VOC-LINK @ 6 - NFA ID.
  8 ;
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 29 
  0 ( Simple Word RENAMEr )
  1 \ old and new names have
  2 \ the same length
  3 HEX
  4 : RENAME
  5  ' >BODY NFA DUP C@ 1F AND
  6  2DUP + >R
  7  BL WORD      20 ALLOT
  8  COUNT 1F AND ROT MIN
  9  >R SWAP 1+ R>
 10  CMOVE
 11  R@ C@ 80 OR R> C!
 12  -20 ALLOT ;
 13 DECIMAL
 14 
 15 

Scr# 30 
  0 ( 2CONSTANT )
  1 : 2CONSTANT
  2  <BUILDS SWAP , , DOES>
  3  2@
  4 ;
  5 : 2VARIABLE
  6  VARIABLE 0 , ;
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 31 
  0 ( SET-FENCE )
  1 HERE FENCE !
  2 HERE HEX 1C +ORIGIN !
  3 LATEST   0C +ORIGIN !
  4 HERE HEX 1E +ORIGIN !
  5 VOC-LINK @ 20 +ORIGIN !
  6 DECIMAL
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 32 
  0 ( HIDE )
  1 : HIDE
  2   ' >BODY LFA
  3   CONTEXT @
  4   BEGIN
  5   @ PFA LFA
  6   2DUP = OVER @ AND
  7   UNTIL
  8 ;
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 33 
  0 ( USED-BY )
  1 \ search memory for xt
  2 : USED-BY ( xt -- )
  3   HERE 0 +ORIGIN DO
  4   DUP I @ =
  5    IF I U. THEN
  6   LOOP
  7   -1 S0 @ DO
  8   DUP I @ =
  9    IF I U. THEN
 10   LOOP
 11   DROP ;
 12 HEX : EXAM FF58 EA40
 13   DO CR 2B EMIT I U.
 14   I USED-BY ?TERMINAL
 15   IF LEAVE THEN LOOP ;

Scr# 34 
  0 ( DUMP WORDS )
  1 : PRINTER 13 SELECT ;
  2 : DUMP-2-PRINTER
  3 0 HEX CONTEXT @ @
  4 BEGIN
  5  DUP PFA LFA @
  6  DUP 0= ?TERMINAL OR
  7 UNTIL DROP
  8 BEGIN VIDEO DUP ID. PRINTER
  9  CR ." \  " DUP ID. CR
 10  PFA DUP DEB-N DUP DEB-L
 11  DUP DEB-C DUP CFA @ <:> =
 12  IF DELOAD DROP
 13  ELSE DEB-P THEN
 14  DUP 0= ?TERMINAL OR
 15 CR CR UNTIL VIDEO ;

Scr# 35 
  0 ( Restore AUTOEXEC )
  1 \ The following sequence
  2 \ restores AUTOEXEC
  3 \ in the ABORT definition
  4 \
  5 \ ##  USE WITH CARE  ##
  6 \
  7 ' AUTOEXEC
  8 ' ABORT >BODY 6 CELLS +
  9 !
 10 BYE
 11 \
 12 \ and remember Scr# 220
 13 \ to move up or down LIMIT
 14 \ and patch MGT and #SEC
 15 

Scr# 36 
  0 ( RECURSE - GDC )
  1 : RECURSE ( -- )
  2   ?COMP
  3   LATEST PFA CFA ,
  4 ; IMMEDIATE
  5 \
  6 : GDC ( a b -- gdc )
  7   ?DUP IF
  8     TUCK MOD
  9     RECURSE
 10   THEN
 11 ;
 12 
 13 
 14 
 15 

Scr# 37 
  0 ( ?ESCAPE experiment       )
  1 CODE   ?ESCAPE
  2 HEX
  3  3E C, FE C, DB C, FE C,
  4  2F C, 5F C,
  5  3E C, F7 C, DB C, FE C,
  6  2F C,
  7  A3 C, E6 C, 01 C,
  8  26 C, 00 C, 6F C,
  9  E5 C, E9DD , ( PSH1 )
 10 SMUDGE DECIMAL
 11 : ESCAPE-TEST
 12   1000 0 DO [CHAR] . EMIT
 13     ?ESCAPE IF LEAVE THEN
 14   LOOP ;
 15 DECIMAL

Scr# 38 
  0 ( RND Test )
  1 : TEST
  2   0 SYS-SEED !
  3   32767 0 DO
  4     32767
  5     RND
  6     256 /MOD
  7     PLOT
  8     ?TERMINAL IF LEAVE THEN
  9   LOOP
 10 ;
 11 
 12 
 13 
 14 
 15 

Scr# 39 
  0 ( CHOOSE - Brodie )
  1 DECIMAL
  2 23670 CONSTANT SYS-SEED
  3 : RANDOM
  4   SYS-SEED @ 31421 *
  5   6927 + DUP SYS-SEED !
  6 ;
  7 : CHOOSE ( u1 -- u2 )
  8   RANDOM UM* NIP
  9 ;
 10 \
 11 : RANDOMIZE
 12   SYS-SEED ! ;
 13 EXIT
 14 
 15 

Scr# 40 
  0 .( RND )
  1 DECIMAL
  2 23670 CONSTANT SYS-SEED
  3 \ gives a pseudo-random
  4 \ between 0 and n
  5 : RND ( n -- rnd(n)
  6   1+ SYS-SEED @
  7   8191 UM* \ it was U*
  8   1.  D+
  9   16381 UM/MOD
 10   DROP DUP SYS-SEED !
 11   SWAP MOD ;
 12 \
 13 : RANDOMIZE
 14   SYS-SEED ! ;
 15 EXIT

Scr# 41 
  0 ( Color and attributes  )
  1 DECIMAL 99 LOAD \ CALL#
  2 HEX
  3 : PERM 0 1CAD CALL# DROP ;
  4 : BORDER. 2297 CALL# DROP ;
  5 DECIMAL
  6 : (COLOR)
  7   ROT AND SWAP EMITC EMITC
  8   PERM ;
  9 : INK. 16 7 (COLOR) ;
 10 : PAPER. 17 7 (COLOR) ;
 11 : FLASH. 18 1 (COLOR) ;
 12 : BRIGHT. 19 1 (COLOR) ;
 13 : INVERSE. 20 1 (COLOR) ;
 14 : OVER. 21 1 (COLOR) ;
 15 -->

Scr# 42 
  0 ( AT TAB                   )
  1 : AT.
  2   22 EMITC 31 AND SWAP
  3   21 MIN EMITC EMITC ;
  4 : TAB.
  5   23 EMITC EMITC 0 EMITC ;
  6 : LVIDEO
  7   2 23659 C! 1 SELECT ;
  8 : ATTR  ( x y --- b )
  9   SWAP 32 * + 22528 + C@ ;
 10 -->
 11 EXIT
 12 : VIDEO
 13   2 DEVICE !
 14   1 23659 C! 2 SELECT ;
 15 -->

Scr# 43 
  0 ( POINT SCREEN$ )
  1 CODE   POINT             HEX
  2 D1E1 , C5 C, E5DD , 454B ,
  3 CD C, 22AA , 47 C, 04 C,
  4 7E C, 07 C, 10 C, -3 C,
  5 21 C, 0000 , ED C, 6A C,
  6 E1DD , C1 C,
  7 E5 C, E9DD , ( PSH1 ) SMUDGE
  8 \
  9 CODE   SCREEN$  HEX
 10 D1E1 , C5 C, E5DD , 454B ,
 11 CD C, 2538 , CD C, 2BF1 ,
 12 1A C, 6F C, 26 , C1 C,
 13 E1DD , C1 C,
 14 E5 C, E9DD , ( PSH1 ) SMUDGE
 15 -->

Scr# 44 
  0 ( PLOT )
  1 \ 19 LOAD for CALL#
  2 HEX
  3 CODE   PLOT   HEX
  4   E1 C, D1 C, C5 C,
  5   45 C, 4B C, CD C, 22E5 ,
  6   C1 C,
  7   E9DD , ( NEXT ) SMUDGE
  8 \
  9 -->
 10 : CIRCLE
 11   ROT 0 >W SWAP 0 >W 0 >W
 12   232D CALL#
 13   ;
 14 \
 15 -->

Scr# 45 
  0 ( DRAW                     )
  1 CODE   (DRAW) HEX
  2  D1 C, E1 C, C5 C,
  3   4D C, 43 C, 5C C,
  4   CD C, 24BA ,
  5   C1 C,
  6   E9DD , ( NEXT ) SMUDGE
  7 : DRW1
  8   100 OVER +- SWAP ABS + ;
  9 : DRAW
 10   SWAP DRW1 SWAP DRW1
 11   (DRAW)
 12 ;
 13 DECIMAL
 14 -->
 15 

Scr# 46 
  0 ( PAINT )
  1 HEX
  2 : HIT ( x y dir -- )
  3   >R
  4   BEGIN
  5    2DUP PLOT
  6    R@ + ABS 0B0 MOD
  7    2DUP POINT
  8   UNTIL
  9   R> DROP 2DROP ;
 10 : HIT2 ( x y -- )
 11   2DUP 1 HIT -1 HIT
 12   ?TERMINAL IF QUIT THEN
 13 ;
 14 -->
 15 

Scr# 47 
  0 ( PAINT )
  1 DECIMAL
  2 : HITX ( x y dir -- )
  3   >R
  4   BEGIN
  5    SWAP R@ + 255 AND SWAP
  6    2DUP POINT 0=
  7   WHILE
  8    2DUP HIT2
  9   REPEAT
 10   R> DROP 2DROP ;
 11 : PAINT ( x y -- )
 12   2DUP HIT2
 13   2DUP 1 HITX -1 HITX ;
 14 
 15 

Scr# 48 
  0 ( Mr Jones' keyboard test )
  1 CODE KEYBOARD?
  2  POP   HL|
  3  LD    A'|  L|
  4  ANDN  7    N,
  5  INC   A'|
  6  LD    H'|  A|
  7  SRL    L|
  8  SRL    L|
  9  SRL    L|
 10  LDN   A'|   5  N,
 11  SUBA   L|
 12  LD    L'|  A|
 13  LDN   A'|  HEX FE N,
 14 -->
 15 

Scr# 49 
  0 ( Mr Jones' keyboard test )
  1  HERE
  2   RRCA DEC H'|
  3  JRF   NZ'| BACK,
  4  INA   HEX FE P,
  5  HERE
  6   RRA  DEC L'|
  7  JRF   NZ'| BACK,
  8  CCF
  9  RL    L|
 10  PSH1
 11 C;
 12 DECIMAL
 13 
 14 
 15 

Scr# 50 
  0 ( BLEEP )
  1 ( n1 = {3.5M/Hz-241}/8 )
  2 ( n2 = 1000 * ms / Hz )
  3 CODE   BLEEP HEX
  4 D9 C,            \ exx
  5 E1 C, D1 C,      \ pop hlde
  6 D9 C,            \ exx
  7 DD C, E5 C,      \ push ix
  8 D5 C, C5 C,      \ push debc
  9 D9 C,            \ exx
 10 CD C, 03B5 , \ CALL 03B5
 11 C1 C, D1 C,      \ pop  bcde
 12 DD C, E1 C,      \ pop  ix
 13 DD C, E9 C,      \ jp (ix)
 14 DECIMAL SMUDGE
 15 -->

Scr# 51 
  0 ( BLEEP )
  1 ( ms Hz -- n1 n2 )
  2 : BLEEP-CALC
  3 >R R@ 1000 */
  4 3500.000 R> UM/MOD
  5 241 - 8 /
  6 SWAP DROP ;
  7 ( BEEP pitch -- freq )
  8 : BEEP-PITCH
  9 69 SWAP -
 10 12 /MOD 14080
 11 SWAP 0 ?DO 2/ LOOP
 12 SWAP 0 ?DO 269 286 */ LOOP
 13 ;
 14 
 15 

Scr# 52 
  0 ( Pitch bend )
  1 CODE PITCH-BEND
  2 PUSH  BC|
  3 LDX   HL|  500  NN,
  4 LDN   B'|  250   N,
  5 HERE
  6 LDX   DE|    1  NN,
  7 PUSH  BC|  PUSH  HL|
  8 CALL  949 AA,
  9 POP   HL|  POP   BC|
 10 INCX  HL|
 11 DJNZ  BACK,
 12 POP   BC|
 13 NEXT C;
 14 
 15 

Scr# 53 
  0 ( KEYBOARD-TEST )
  1 : KEYBOARD-TEST
  2 BEGIN
  3  40 0 DO
  4   I KEYBOARD?
  5   IF I . CR THEN
  6  LOOP
  7  ?TERMINAL
  8 UNTIL
  9 ;
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 55 
  0 ( MS delay )
  1 \ at 3.5MHz n ms delay
  2 DECIMAL
  3 CODE ms ( n -- )
  4  POP DE|
  5  LD  D'|  B|
  6  LDN H'|  205  N,
  7  HERE   \ BEGIN,
  8   LD  B'|  H|
  9   HERE
 10    NOP
 11   DJNZ BACK,
 12   DEC  E'|
 13  JRF NZ'| BACK,
 14  LD  B'| D|
 15  NEXT C;

Scr# 57 
  0 ( FRAMES )
  1 CODE FRAMES@
  2  LDX  HL| HEX 5C78 NN,
  3  LD E'| (HL)|
  4  INCX HL|
  5  LD D'| (HL)|
  6  INCX HL|
  7  LD L'| (HL)|
  8  LDN H'| 0 N,
  9 PSH2 C;
 10 CODE 1FRAME
 11  LDX HL| HEX 5C78 NN,
 12  LD A'| (HL)|
 13  HERE CPA (HL)|
 14  JRF Z'| BACK,
 15  NEXT C; -->

Scr# 58 
  0 ( FRAMES )
  1 : T FRAMES@ D. ;
  2 : TT 1FRAME 1FRAME
  3   FRAMES@ ROT MS FRAMES@
  4   2SWAP DNEGATE D+ . . ;
  5 : TEST ( frames -- )
  6   400 18 DO
  7   I DUP . TT
  8   I 1+ DUP . TT
  9   I 2+ DUP . TT
 10   I 3 + DUP . TT
 11   CR 100 +LOOP
 12 ;
 13 
 14 
 15 

Scr# 59 
  0 ( TEST )
  1 HEX 5800
  2 CONSTANT ADDRESS
  3 20 VARIABLE DELAY    DELAY !
  4 : WAIT
  5   DELAY @ 0 DO 1FRAME LOOP
  6 ;
  7 : TEST1
  8   87 ADDRESS 2+ C!
  9   BEGIN
 10     00 ADDRESS C! WAIT
 11     3F ADDRESS C! WAIT
 12   ?TERMINAL
 13   UNTIL
 14 ;
 15 DECIMAL

Scr# 60 
  0 ( Interrupt Handler )
  1 HEX
  2 CODE ISR-EI
  3  FB C,
  4  E9DD , ( NEXT ) SMUDGE
  5 CODE ISR-DI
  6  F3 C,
  7  E9DD , ( NEXT ) SMUDGE
  8 CODE ISR-IM1
  9  56ED , ( IM 1 )
 10  E9DD , ( NEXT ) SMUDGE
 11 CODE ISR-IM2
 12  5EED , ( IM 2 )
 13  E9DD , ( NEXT ) SMUDGE
 14 -->
 15 

Scr# 61 
  0 ( Interrupt Handler )
  1 HEX
  2 CODE SETIREG
  3  E1 C,  ( POP HL )
  4  7D C,  ( LD A,L )
  5  47ED , ( LD I,A )
  6  E9DD , ( NEXT ) SMUDGE
  7 \
  8 : ISR-OFF
  9   ISR-DI
 10   3F SETIREG ISR-IM1
 11   ISR-EI
 12 ;
 13 \
 14   VARIABLE ISR-SAVE
 15 -->

Scr# 62 
  0 ( Interrupt Handler )
  1 CODE ISR-RET HEX
  2  ED C, 7B C, ISR-SAVE ,
  3  E1 C,             \ POP HL
  4  22 C, 30 +ORIGIN ,
  5  C1 C, D1 C, E1 C, \ BCDEHL
  6  D9 C, \ EXX
  7  C1 C, D1 C, E1 C, \ BCDEHL
  8  F1 C, 08 C, F1 C, \ AF AF'
  9  DD C, E1 C,       \ POP IX
 10 \
 11  C3 C, 0038 ,      \ JP 38
 12 SMUDGE
 13 -->
 14 
 15 

Scr# 63 
  0 ( Interrupt Handler )
  1 VARIABLE  ISR-XT
  2 ' ISR-RET ISR-XT !
  3 ' ISR-RET ,
  4 -->
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 64 
  0 ( Interrupt Handler )
  1 HEX
  2 CODE   ISR-SUB
  3  DD C, E5 C,       \ PUSH IX
  4  F5 C, 08 C, F5 C, \ AF AF'
  5  E5 C, D5 C, C5 C, \ HLDEBC
  6  D9 C,             \ EXX
  7  E5 C, D5 C, C5 C, \ HLDEBC
  8 \ RP
  9  2A C, 30 +ORIGIN ,
 10  E5 C,
 11  11 C, -10 ,
 12  19 C, ( ADD HL,DE )
 13  22 C, 30 +ORIGIN ,
 14 -->
 15 

Scr# 65 
  0 ( Interrupt Handler )
  1 \ SP
  2  ED C, 73 C, ISR-SAVE ,
  3 \
  4  21 C, -10 ,
  5  39 C, \ ADD HL,SP
  6  F9 C, \ LD  SP,HL
  7 \
  8  01 C, ISR-XT ,
  9        \ LD BC, ISR-XT
 10  E9DD , ( NEXT )
 11 SMUDGE
 12 -->
 13 
 14 
 15 

Scr# 66 
  0 ( Interrupt Handler )
  1 -->
  2 HEX
  3 : ISR-ON
  4   [ ' ISR-SUB >BODY ] LITERAL
  5   \ 63FF !
  6   0 +ORIGIN 1- !
  7   \ 63 LDIA
  8   0 + ORIGIN 1- 100 /
  9   SETIREG
 10   ISR-IM2
 11   ISR-EI
 12 ;
 13 DECIMAL
 14 
 15 

Scr# 67 
  0 ( Interrupt Handler )
  1 HEX
  2 : ISR-ON
  3   [ ' ISR-SUB >BODY ] LITERAL
  4   DUP ISR-DI
  5   18 FFFF C!
  6   C3 FFF4 C!
  7      FFF5 !
  8   C3 FFE2 C!
  9      FFE3 !
 10   39 SETIREG \ last ROM page
 11   ISR-IM2
 12   ISR-EI
 13 ;
 14 DECIMAL
 15 -->

Scr# 68 
  0 ( INTERRUPT - TEST )
  1 HEX
  2 : TEST
  3 80 57FF C!
  4 5701 5700 0FF CMOVE>
  5 5700 4700 100 CMOVE
  6 5700 4F00 100 CMOVE
  7 ;
  8 DECIMAL
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 69 
  0 ( INTERRUPT )
  1 ISR-OFF
  2 ' TEST ISR-XT !
  3 ISR-ON
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 70 
  0 .( Compare Utility. ) CR
  1 : COMPARE
  2   ( a1 c2 a2 c2 -- 1|0|-1 )
  3  ROT 2DUP SWAP - >R
  4  MIN (COMPARE)
  5  R> SWAP ?DUP IF
  6   SWAP DROP
  7  ELSE
  8   1 SWAP *
  9  THEN ;
 10 -->
 11 CREATE S1 ," Hello world"
 12 CREATE S2 ," Hallo world"
 13 CREATE S3 ," Hello world"
 14 CREATE S4 ," Hello world!"
 15 

Scr# 71 
  0 ( COMPARE )
  1 : SEARCH.TRC
  2  BLK @ 6 .R >IN @ 6 .R ;
  3 : SEARCH.SHOW
  4  BLK @ B/SCR /MOD 6 .R B/BUF *
  5  >IN @ + C/L /MOD 6 .R
  6  PAD C@ 1+ -  6 .R CR ;
  7 : SEARCH.SCR ( -- f )
  8  BL WORD COUNT
  9  PAD COUNT COMPARE ;
 10 : LOCATE.SCR ( -- f )
 11  BL WORD @ 14849 =
 12  IF SEARCH.SCR
 13  ELSE 1 THEN ;
 14 -->
 15 

Scr# 72 
  0 ( SEARCH )
  1 : SEARCH.BLK ( b -- )
  2  BLK @ >R >IN @ >R
  3  0 >IN !  BLK !
  4  BEGIN
  5   SEARCH.SCR
  6   0= IF SEARCH.SHOW THEN
  7   ?TERMINAL
  8   IF BLK ? >IN ? QUIT THEN
  9   HERE 1+ C@ 0=
 10  UNTIL
 11  R> >IN ! R> BLK !
 12 ;
 13 -->
 14 
 15 

Scr# 73 
  0 ( SEARCH )
  1 : BSEARCH ( n m "word" -- )
  2  BL TEXT
  3  CR ." Searching for "
  4  PAD COUNT TYPE CR
  5  ." Screen  Line  Char" CR
  6  1+ SWAP DO
  7   I SEARCH.BLK
  8   ?TERMINAL
  9   IF SEARCH.TRC LEAVE THEN
 10  LOOP
 11 ;
 12 : GREP       ( -- )
 13  1 #SEC BSEARCH
 14 ;
 15 -->

Scr# 74 
  0 ( LOCATE )
  1 : LOCATE.BLK ( b -- )
  2  BLK @ >R >IN @ >R
  3  0 >IN !  BLK !
  4  BEGIN
  5   LOCATE.SCR
  6   0= IF CLS
  7    BLK @ LIST QUIT THEN
  8   ?TERMINAL
  9   IF ." Stop" QUIT THEN
 10   HERE 1+ C@ 0=
 11  UNTIL
 12  R> >IN !  R> BLK !
 13 ;
 14 -->
 15 

Scr# 75 
  0 ( LOCATE )
  1 : LOCATE ( "word" -- )
  2  BL TEXT
  3  #SEC 1 DO
  4   I 05 MOD 42 + EMIT
  5   I 20 MOD IF 8 EMIT THEN
  6   I LOCATE.BLK
  7  LOOP
  8  ." Not found."
  9 ;
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 76 
  0 \ S" ( strings )
  1 : (S")
  2  R@ COUNT DUP 2+ R> + >R ;
  3 : S"  ( -- a n )
  4  STATE @ IF
  5   COMPILE (S") ,"
  6  ELSE
  7   HERE ," COUNT
  8  THEN
  9 ; IMMEDIATE
 10 \
 11 : TEST_S"
 12   1 .
 13   S" CIAO"
 14   2 . 3 .
 15 ;

Scr# 80 
  0 .( Full Screen Editor. ) CR
  1 DECIMAL   VARIABLE NROW
  2           VARIABLE NCOL
  3 : HOMEC 0 NROW ! 0 NCOL ! ;
  4 : ADDRC ( -- a )
  5   NROW @ LINE NCOL @ + ;
  6 : TO-SCR ( r c -- c r )
  7   0 + SWAP 2 + ;
  8 : AT-XY  ( c r -- )
  9   22 EMITC EMITC EMITC ;
 10 : HOME 0 0 AT-XY ;
 11 : BUZZ 7 EMIT ;
 12 : CURC! ADDRC C! UPDATE ;
 13 : CURC@ ADDRC C@ ;
 14 : RULER 3 0 DO
 15 ." +----.----" LOOP ;   -->

Scr# 81 
  0 ( Full Screen Editor )
  1 : UPC    NROW @  0 > IF -1
  2    NROW +! ELSE BUZZ THEN ;
  3 : DOWNC  NROW @ 15 < IF 1
  4    NROW +! ELSE BUZZ THEN ;
  5 : LEFTC  NCOL @  0 > IF -1
  6    ELSE UPC 31 THEN NCOL +! ;
  7 : RIGHTC NCOL @ 31 < IF 1
  8   ELSE DOWNC -31 THEN NCOL +! ;
  9 : PUTPAGE ." Screen # " SCR @ .
 10   CR RULER CR L/SCR 0 DO
 11   I SCR @ (LINE) TYPE CR
 12   LOOP RULER ;
 13 : REFRESH NROW @ SCR @
 14   OVER 0 TO-SCR AT-XY
 15   (LINE) TYPE ;   -->

Scr# 82 
  0 ( Full Screen Editor )
  1 : EDIT-FRAME 0 19 AT-XY
  2  ."  row:" 5 SPACES ."  col:"
  3  5 SPACES ."  hex:" CR
  4  ."  pad:" PAD COUNT 27 MIN TYPE
  5  0 21 AT-XY ."  cmd:" 4 SPACES
  6  ."  Q U  D S I R H  P  B N"
  7  26 0 AT-XY INVV ."  edit "
  8  TRUV ;
  9 : EDIT-STAT CURC@
 10   25 19 AT-XY HEX DUP 3 .R
 11   DECIMAL
 12   15 19 AT-XY NCOL @ 3 .R
 13   05 19 AT-XY NROW @ 3 .R
 14 ;
 15 -->

Scr# 83 
  0 ( Full Screen Editor )
  1 : KEYB CURS KEY ;
  2 : KEYBE KEYB DUP EMIT ;
  3 : KEYBD KEYBE 10 DIGIT DROP ;
  4 : BYTE KEYBD 4 LSHIFT
  5        KEYBD + ;
  6 : UNDO B/SCR 0 DO
  7   SCR @ B/SCR * I + BLOCK
  8   CELL- 0 SWAP ! LOOP ;
  9 : DONEC [ HEX ]
 10   8F 26 +ORIGIN C!
 11   5F 28 +ORIGIN C! ;
 12 : INITC CURC@ BL MAX
 13      26 +ORIGIN C!
 14   8F 28 +ORIGIN C! ;
 15 DECIMAL -->

Scr# 84 
  0 ( Full Screen Editor )
  1 : CMD 6 21 AT-XY DONEC KEYB
  2   UPPER BL MAX DUP EMIT CASE
  3  [CHAR] P OF BYTE CURC! ENDOF
  4  [CHAR] H OF NROW @ H   ENDOF
  5  [CHAR] S OF NROW @ S   ENDOF
  6  [CHAR] R OF NROW @ RE  ENDOF
  7  [CHAR] I OF NROW @ INS ENDOF
  8  [CHAR] D OF NROW @ D   ENDOF
  9 [CHAR] N OF 1 SCR +! HOMEC ENDOF
 10  [CHAR] B OF -1 SCR +!
 11                   HOMEC ENDOF
 12  [CHAR] U OF UNDO BUZZ  ENDOF
 13  [CHAR] Q OF ."  ok" QUIT ENDOF
 14 ENDCASE 0 0 AT-XY
 15 PUTPAGE EDIT-FRAME ; -->

Scr# 85 
  0 ( Full Screen Editor )
  1 : DELC NCOL @ 0 >
  2   IF -1 NCOL +! THEN
  3   ADDRC DUP 1+ SWAP C/L
  4   NCOL @ - 1- CMOVE UPDATE
  5   BL NROW @ LINE C/L + 1- C!
  6 ;
  7 : INSC
  8   ADDRC DUP 1+ C/L
  9   NCOL @ - 1- CMOVE> BL
 10   ADDRC C! UPDATE ;
 11 -->
 12 
 13 
 14 
 15 

Scr# 86 
  0 ( Full Screen Editor )
  1 : CTRLC
  2   CASE
  3    08 OF LEFTC    ENDOF
  4    09 OF RIGHTC   ENDOF
  5    10 OF DOWNC    ENDOF
  6    11 OF UPC      ENDOF
  7    12 OF DELC REFRESH   ENDOF
  8    13 OF DOWNC 0 NCOL ! ENDOF
  9    07 OF CMD      ENDOF
 10   ENDCASE
 11 ;
 12 -->
 13 
 14 
 15 

Scr# 87 
  0 ( Full Screen Editor )
  1 : EDIT CLS
  2  HOMEC PUTPAGE EDIT-FRAME
  3  BEGIN
  4   EDIT-STAT INITC \ CURC@
  5   NROW @ NCOL @ TO-SCR 2DUP
  6   AT-XY KEYB ?TERMINAL
  7   IF DROP 0 INSC REFRESH
  8   THEN
  9   DUP BL < IF
 10    >R AT-XY EMIT R> CTRLC
 11   ELSE
 12    CURC! AT-XY DROP CURC@
 13    EMIT RIGHTC
 14   THEN
 15  AGAIN ; \ Quit using EDIT+Q

Scr# 90 
  0 .( Line editor. )         CR
  1 -->
  2 \ See .pdf documentation.
  3 \ Inverse/True Video
  4 : INVV
  5   [ HEX 14 ] LITERAL EMITC
  6   1 EMITC
  7 ;
  8 : TRUV
  9   [ HEX 14 ] LITERAL EMITC
 10   0 EMITC
 11 ;
 12 DECIMAL
 13 --> \ Continue LOADing
 14     \ on next Screen.
 15 

Scr# 91 
  0 ( Line Editor          2/6 )
  1 : TEXT ( c -- ) \ to pad
  2   HERE C/L 1+ BLANK  WORD
  3   PAD  C/L 1+ CMOVE ;
  4 : LINE ( n -- a ) \ address
  5   DUP         0< 3 ?ERROR
  6   DUP L/SCR < 0= 3 ?ERROR
  7   SCR @ (LINE) DROP ;
  8 : -MOVE ( a n -- ) \ to line
  9   LINE C/L CMOVE UPDATE ;
 10 : E ( n -- ) \ blank line n
 11   LINE C/L BLANK  UPDATE ;
 12 : H ( n -- ) \ hold to pad
 13   LINE PAD 1+ C/L CMOVE
 14   C/L PAD C! ;
 15 -->

Scr# 92 
  0 ( Line Editor          3/6 )
  1 : RE ( n -- ) \ replace from pad
  2   PAD 1+ SWAP -MOVE ;
  3 : D ( n -- ) \ delete line n
  4   DUP H L/SCR 1- DUP ROT
  5   ?DO I 1+ LINE I -MOVE
  6   LOOP E ;
  7 : S ( n -- ) \ shift line n
  8   DUP 1 MAX L/SCR 1- DO
  9   I 1- LINE I -MOVE
 10   -1 +LOOP E ;
 11 : INS ( n -- ) \ insert from pad
 12   DUP S RE ; -->
 13 
 14 
 15 

Scr# 93 
  0 ( Line Editor          4/6 )
  1 : P ( n -- ) \ put line n
  2   126 TEXT RE ;
  3 : L ( -- ) \ list current
  4   SCR @ LIST ;
  5 : N ( -- ) \ next screen
  6   1 SCR +! L ;
  7 : B ( -- ) \ back screen
  8   -1 SCR +! L ;
  9 : BCOPY ( scr dest -- )
 10   DUP SCR ! SWAP BLOCK SWAP
 11   BLOCK B/BUF CMOVE UPDATE ;
 12 -->
 13 : BCLEAR ( scr --- )
 14   SCR ! L/SCR 0 DO
 15   I E LOOP ;

Scr# 94 
  0 ( Line Editor          5/6 )
  1 : WHERE
  2   DUP B/SCR /MOD DUP SCR !
  3   ." Screen# " DECIMAL . CR
  4   B/BUF * ROT + C/L /MOD DUP
  5   3 .R SPACE
  6   ROT B/SCR / (LINE)
  7   -TRAILING TYPE
  8   CR 2+ SPACES [CHAR] ^ EMIT
  9   SPACE ;
 10 -->
 11 \ quick reference
 12 [TIB] <> [PAD]  <>  [BLOCK]
 13               H E RE
 14      TEXT     D S INS
 15 

Scr# 95 
  0 ( Line Editor          6/6 )
  1 : .PAD
  2   PAD COUNT -TRAILING TYPE ;
  3 : SAVE
  4   UPDATE FLUSH ;
  5 : UNUSED SP@ PAD - ;
  6 : ROOM UNUSED U.
  7   ." bytes free." CR ;
  8 -->
  9 \
 10 \ omitted:
 11 : BMOVE OVER SWAP BCOPY
 12   BCLEAR ;
 13 EXIT
 14 
 15 

Scr# 96 
  0 ( Editor Utility )
  1 : NN ( -- )
  2   SCR @ DUP 20 + INDEX
  3   20 SCR +! ;
  4 : BB ( -- )
  5   NN -40 SCR +! ;
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 98 
  0 ( Editor utility           )
  1 \ multiple BCOPY
  2 : MBCOPY ( b1 b2 n --- )
  3  FLUSH
  4  >R 2DUP > IF
  5   R> 0 DO 2DUP BCOPY
  6   1 + SWAP 1 + SWAP
  7   46 EMIT LOOP
  8  ELSE
  9   R@ + 1 - SWAP R@ + 1 - SWAP
 10   0 R> DO 2DUP BCOPY
 11   1 - SWAP 1 - SWAP
 12   46 EMIT -1 +LOOP
 13  THEN
 14  2DROP ;
 15 

Scr# 99 
  0 .( Call utility. )        CR
  1 CODE  CALL# ( n1 a -- n2 ) HEX
  2 D9 C,             \ exx
  3 E1 C, C1 C,       \ pop hlbc
  4 79 C, D9 C,       \ ld a,c exx
  5 DD C, E5 C,       \ push ix
  6 D5 C, C5 C,       \ push debc
  7 D9 C,             \ exx
  8 CD C, HERE 0B + , \ call hl
  9 D9 C,             \ exx
 10 C1 C, D1 C,       \ pop bcde
 11 DD C, E1 C,       \ pop ix
 12 D9 C, E5 C,       \ exx pushbc
 13 D9 C,             \ exx
 14 DD C, E9 C,       \ jp ix
 15 SMUDGE

Scr# 100 
  0 ." Assembler. "           CR
  1 \ Loads ASSEMBLER vocabulary
  2 FORTH DEFINITIONS
  3 MARKER FORGET-ASSEMBLER
  4 RENAME CODE MCOD
  5 \
  6 \ there are 4 zones:
  7 DECIMAL 101 LOAD \ tools
  8 DECIMAL 120 LOAD \ Z80
  9 DECIMAL 140 LOAD \ structure
 10 \ DECIMAL 160 LOAD \ Z80N
 11 ." Done " CR
 12 EXIT
 13 
 14 
 15 

Scr# 101 
  0 .( Z80 Assembler. ) CR
  1 : INVERT -1 XOR ;
  2 : @+ >R R@ CELL+ R> @ ;
  3 : !+ >R R@ ! R> CELL+ ;
  4 : @- 0 CELL+ - >R R@ @ R> ;
  5 1 VARIABLE TABL1 1 ,
  6          1 TABL1 !
  7 : ROTLEFT  TABL1 + @
  8   UM* \ U*
  9   OR ;
 10 \
 11 CHAR - CONSTANT &-
 12 CHAR ~ CONSTANT &~
 13 -->
 14 
 15 

Scr# 102 
  0 ( Z80 Utility - Sys depend )
  1 VOCABULARY ASSEMBLER IMMEDIATE
  2 FORTH DEFINITIONS HEX
  3 : % COMPILE ' <NAME ;
  4 \ : % POSTPONE ' <NAME ;
  5 : %ID. ID. ;
  6 : %>BODY PFA CELL+ ;
  7 : %BODY> 0 CELL+ - NFA ;
  8 : %>CODE PFA CFA CELL+ ;
  9 : IGNORE? 1+ C@ &~ = ;
 10 : (>NEXT%) PFA LFA @ ;
 11 : VOCEND?
 12   @ FFFF AND A081 = ;
 13 : >NEXT% BEGIN (>NEXT%)
 14   DUP 1+ C@ &- - UNTIL ;
 15 -->

Scr# 103 
  0 ( Z80 Utility - Sys depend )
  1 : STARTVOC ' ASSEMBLER 2 +
  2   CELL+ @ ;
  3 : IS-A <BUILDS
  4   0 ,
  5   DOES>
  6   @ SWAP %>CODE @ = ;
  7 : REMEMBER HERE LATEST
  8   (>NEXT%) %>BODY ! ;
  9   IMMEDIATE
 10 : CONTAINED-IN OVER AND = ;
 11 -->
 12 
 13 
 14 
 15 

Scr# 104 
  0 ( Z80 System independ. )
  1 \ 0 VARIABLE TABLE FF ,
  2 \ FFFF , FFFFFF , FFFFFFFF ,
  3 \ : FIRSTBYTES CELLS TABLE
  4 \   + @ AND ;
  5 0 VARIABLE TALLY-BI TALLY-BI !
  6 0 VARIABLE TALLY-BY TALLY-BY !
  7 0 VARIABLE TALLY-BA TALLY-BA !
  8 0 VARIABLE ISS      ISS      !
  9 0 VARIABLE ISL      ISL      !
 10 0 VARIABLE PREVIOUS PREVIOUS !
 11 : !TALLY 0 TALLY-BY !
 12  0 TALLY-BI ! 0 TALLY-BA !
 13  0 PREVIOUS ! ;
 14 -->
 15 

Scr# 105 
  0 ( Z80 System independ. )
  1 : AT-REST? TALLY-BI @ 0=
  2  TALLY-BY @ 0= AND ;
  3 : BADPAIRS? DUP 2 * AND
  4  AAAAAAAA AND ;
  5 : BAD?
  6  TALLY-BA @ BADPAIRS? ;
  7 : COMPATIBLE?
  8  TALLY-BA @ OR BADPAIRS?
  9  0= ;
 10 DECIMAL
 11 -->
 12 
 13 
 14 
 15 

Scr# 106 
  0 ( Z80 Generate errors )
  1 : CHECK26 AT-REST? 0=
  2   26 ?ERROR ;
  3 : CHECK27 BAD? 27 ?ERROR ;
  4 : CHECK31 2DUP SWAP
  5   CONTAINED-IN 0= 31 ?ERROR ;
  6 : CHECK33 2DUP SWAP INVERT
  7   CONTAINED-IN 0= 33 ?ERROR ;
  8 : CHECK28 2DUP AND 28 ?ERROR ;
  9 : CHECK29 2DUP OR -1 -
 10   29 ?ERROR ;
 11 : CHECK30 DUP PREVIOUS @ <
 12   30 ?ERROR DUP PREVIOUS ! ;
 13 HEX
 14 -->
 15 

Scr# 107 
  0 ( Assembler Z80 )
  1 : OR!
  2   >R R@ @ CHECK28 OR R> ! ;
  3 : OR!U >R R@ @ OR R> ! ;
  4 : AND! >R INVERT R@ @
  5   CHECK29 AND R> ! ;
  6 -->
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 108 
  0 ( Assembler Z80 )
  1 : >DATA %>BODY ;
  2 : >BI %>BODY CELL+ ;
  3 : >BY %>BODY 2 CELLS + ;
  4 : >BA %>BODY 3 CELLS + ;
  5 : >CNT %>BODY 4 CELLS + ;
  6 : >DIS %>BODY 5 CELLS ;
  7 : CORRECT,-
  8   ISL @ 1 CELLS - ALLOT ;
  9 : !POSTIT
 10   HERE ISS ! 0 PREVIOUS ! ;
 11 : TALLY:, @+ TALLY-BI !
 12   @+ TALLY-BY ! @+ TALLY-BA !
 13   @ ISL ! ;
 14 -->
 15 

Scr# 109 
  0 ( Assembler Z80 )
  1 : POSTIT CHECK26 !POSTIT
  2   HERE ISS ! @+ , TALLY:,
  3   CORRECT,- ;
  4 IS-A IS-CBPI : CBPI CHECK33
  5 <BUILDS , , , , 1 , DOES>
  6 REMEMBER CB C, POSTIT ;
  7 IS-A IS-EDPI : EDPI CHECK33
  8 <BUILDS , , , , 1 , DOES>
  9 REMEMBER ED C, POSTIT ;
 10 IS-A IS-DDPI : DDPI CHECK33
 11 <BUILDS , , , , 1 , DOES>
 12 REMEMBER DD C, POSTIT ;
 13 IS-A IS-FDPI : FDPI CHECK33
 14 <BUILDS , , , , 1 , DOES>
 15 REMEMBER FD C, POSTIT ; -->

Scr# 110 
  0 ( Assembler Z80 )
  1 IS-A IS-1PI : 1PI CHECK33
  2 <BUILDS , , , , 1 , DOES>
  3 REMEMBER POSTIT ;
  4 IS-A IS-2PI : 2PI CHECK33
  5 <BUILDS , , , , 2 , DOES>
  6 REMEMBER POSTIT ;
  7 IS-A IS-3PI : 3PI CHECK33
  8 <BUILDS , , , , 3 , DOES>
  9 REMEMBER POSTIT ;
 10 : IS-PI >R  R@ IS-1PI
 11  R@ IS-2PI  R@ IS-3PI  OR OR
 12  R@ IS-CBPI R@ IS-EDPI OR OR
 13  R@ IS-DDPI R@ IS-FDPI OR OR
 14  R> DROP ;
 15 -->

Scr# 111 
  0 ( Assembler Z80 )
  1 : TALLY:|
  2   @+ TALLY-BI AND!
  3   @+ TALLY-BY OR!
  4   @  TALLY-BA OR!U ;
  5 : FIXUP> @+ ISS @ OR!
  6   TALLY:| CHECK27 ;
  7 IS-A IS-XFI : XFI CHECK31
  8 <BUILDS , , , , DOES>
  9 REMEMBER FIXUP> ;
 10 : CORRECT-R 0 CELL+ ISL @
 11 - ROTLEFT ;
 12 -->
 13 
 14 
 15 

Scr# 112 
  0 ( Assembler Z80 )
  1 : TALLY:|R @+ CORRECT-R
  2  TALLY-BI AND! @+ TALLY-BY OR!
  3  @ TALLY-BA OR!U ;
  4 : FIXUP< @+ CORRECT-R ISS
  5  @ OR! TALLY:|R CHECK27 ;
  6 IS-A IS-XFIR : XFIR CHECK31
  7 <BUILDS , , , , DOES>
  8 REMEMBER FIXUP< ;
  9 : TALLY:,, CELL+ @+ CHECK30
 10 TALLY-BY AND! @ TALLY-BA
 11 OR!U ;
 12 : COMMA @+ >R TALLY:,,
 13  CHECK27 R> EXECUTE ;
 14 -->
 15 

Scr# 113 
  0 ( Assembler Z80 )
  1 IS-A IS-COMMA
  2 : COMMAER
  3 <BUILDS , 0 , , , , , DOES>
  4 REMEMBER COMMA ;
  5 0 VARIABLE PRO-TALLY
  6   2 CELLS ALLOT
  7 : T! PRO-TALLY !+ !+ !+ DROP ;
  8 : T@ PRO-TALLY 3 CELLS +
  9   @- @- @- DROP ;
 10 -->
 11 
 12 
 13 
 14 
 15 

Scr# 114 
  0 ( Assembler Z80 )
  1 : 1FAMILY, 0 DO DUP >R T@
  2   R> 1PI OVER + LOOP
  3   DROP DROP ;
  4 : 2FAMILY, 0 DO DUP >R T@
  5   R> 2PI OVER + LOOP
  6   DROP DROP ;
  7 : 3FAMILY, 0 DO DUP >R T@
  8   R> 3PI OVER + LOOP
  9   DROP DROP ;
 10 : XFAMILY| 0 DO DUP >R T@
 11   R> XFI OVER + LOOP
 12   DROP DROP ;
 13 : XFAMILY|R 0 DO DUP >R T@
 14   R> XFIR OVER + LOOP
 15   DROP DROP ; -->

Scr# 115 
  0 ( Assembler Z80 )
  1 : CBFAMILY, 0 DO DUP >R T@
  2   R> CBPI OVER + LOOP
  3   DROP DROP ;
  4 : EDFAMILY, 0 DO DUP >R T@
  5   R> EDPI OVER + LOOP
  6   DROP DROP ;
  7 -->
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 116 
  0 ( Assembler Z80 )
  1 : DDFAMILY, 0 DO DUP >R T@
  2   R> DDPI OVER + LOOP
  3   DROP DROP ;
  4 : FDFAMILY, 0 DO DUP >R T@
  5   R> FDPI OVER + LOOP
  6   DROP DROP ;
  7 \
  8 -->
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 117 
  0 ( Assembler Z80 )
  1 ' ASSEMBLER ' ;CODE >BODY
  2 4 CELLS + ! ( PATCH! )
  3 : CODE ?EXEC MCOD
  4   [COMPILE] ASSEMBLER
  5   !TALLY !CSP ; IMMEDIATE
  6 : C; CURRENT @ CONTEXT !
  7   ?EXEC CHECK26 CHECK27
  8   SMUDGE ; IMMEDIATE
  9 : LABEL ?EXEC 0 VARIABLE
 10   SMUDGE -2 ALLOT
 11   [COMPILE] ASSEMBLER !CSP ;
 12   IMMEDIATE
 13 DECIMAL
 14 \ -->
 15 

Scr# 118 
  0 ( Assembler z80 )
  1 FORTH DEFINITIONS
  2 EXIT
  3 : CODE-NONAME
  4   ?EXEC :NONAME
  5   [COMPILE] ASSEMBLER
  6   !TALLY !CSP ; IMMEDIATE
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 120 
  0 .( Z80 definitions. ) CR
  1 ASSEMBLER DEFINITIONS HEX
  2 0 1 0 800 ' C,
  3   COMMAER N,
  4 0 0 CELL+ 0 200 ' ,
  5   COMMAER NN,
  6 0 0 CELL+ 0 400 ' ,
  7   COMMAER AA,
  8 0 1 0 100 ' C,
  9   COMMAER P,
 10 0 1 0 1000 ' C,
 11   COMMAER D,
 12 -->
 13 
 14 
 15 

Scr# 121 
  0 ( Z80 ) HEX
  1 00 00 00 T!
  2 08 07 8 1FAMILY,
  3   RLCA RRCA RLA  RRA
  4   DAA  CPL  SCF  CCF
  5 08 00 2 1FAMILY,
  6   NOP  EXAFAF
  7 08 E3 4 1FAMILY,
  8   EX(SP)HL  EXDEHL  DI  EI
  9 00 00 238 T!
 10 08 00 8 XFAMILY|
 11    00| 08| 10| 18|
 12    20| 28| 30| 38|
 13 00 00 238 C7 1PI    RST
 14 -->
 15 \ RST 38|  DAA

Scr# 122 
  0 ( Z80 ) HEX
  1 00 00 07 T!
  2 01 00 8 XFAMILY|
  3   B|  C|    D|  E|
  4   H|  L| (HL)|  A|
  5 08 80 8 1FAMILY,
  6  ADDA ADCA SUBA SBCA
  7  ANDA XORA ORA  CPA
  8 00 00 00 76 1PI HALT
  9 -->
 10 \ ADDA B|
 11 \ HALT
 12 
 13 
 14 
 15 

Scr# 123 
  0 ( Z80 ) HEX
  1 00 00 30 T!
  2 10 00 4 XFAMILY|
  3   BC| DE| HL| SP|
  4 01 02 2 1FAMILY,
  5   LD(X)A INCX
  6 01 09 3 1FAMILY,
  7   ADDHL  LDA(X)  DECX
  8 00 0200 30 01 1PI LDX
  9 00 00 30 30 XFI AF|
 10 00 00 30 T!
 11 04 C1 2 1FAMILY,
 12   POP PUSH
 13 -->
 14 \ LD(X)A BC|
 15 \ LDX BC| nn NN,

Scr# 124 
  0 ( Z80 immediate data )
  1 HEX
  2 00 0100 00 T!
  3 08 D3 2 1FAMILY,
  4   OUTA  INA
  5 00 0800 00 T!
  6 08 C6 8 1FAMILY,
  7   ADDN ADCN SUBN SBCN
  8   ANDN XORN ORN  CPN
  9 00 00 00 T!
 10 10 C9 4 1FAMILY,
 11   RET EXX JPHL LDSPHL
 12 -->
 13 \ OUTA n P,   INA n P,
 14 \ ADDN n N,
 15 

Scr# 125 
  0 ( Z80 address )
  1 00 0400 00 T!
  2 08 22 4 1FAMILY,
  3   LD()HL LDHL() LD()A LDA()
  4 0A C3 2 1FAMILY,
  5   JP CALL
  6 00 00 38 T!
  7 08 00 8 XFAMILY|
  8   B'| C'| D'| E'|
  9   H'| L'| (HL)'| A'|
 10 01 04 2 1FAMILY,
 11   INC DEC
 12 00 00 3F 40 1PI LD
 13 00 0800 38 06 1PI LDN
 14 -->
 15 \ LD B'| C| LD()A nn AA,

Scr# 126 
  0 ( Z80 ) HEX
  1 00 00 138 T!
  2 08 00 8 XFAMILY|
  3   NZ|  Z|  NC|  CY|
  4   PO| PE|   P|   M|
  5 00 00 138 C0 1PI  RETF
  6 00 0400 138 T!
  7 02 C2 2 1FAMILY,
  8  JPF CALLF
  9 -->
 10 \ JPF Z| aa AA,
 11 \ CALLF PO| aa AA,
 12 \ RETF NC|
 13 \ and CY| instead of C|
 14 
 15 

Scr# 127 
  0 ( Z80 relative jump )
  1 HEX
  2 00 1000 00 T!
  3 08 10 2 1FAMILY,
  4   DJNZ JR
  5 00 00 218 T!
  6 08 00 4 XFAMILY|
  7   NZ'| Z'| NC'| CY'|
  8 00 1000 218 20 1PI JRF
  9 -->
 10 \ JRF Z'| d D,
 11 \ JR d D,
 12 \ DJNZ d D,
 13 
 14 
 15 

Scr# 128 
  0 ( ED prefix )
  1 00 00 30 T!
  2 08 42 2 EDFAMILY,
  3  SBCHL  ADCHL
  4 00 0400 30 T!
  5 08 43 2 EDFAMILY,
  6   LD()X  LDX()
  7 00 00 38 T!
  8 01 40 2 EDFAMILY,
  9   IN(C)  OUT(C)
 10 -->
 11 \ SBCHL BC| ADCHL SP|
 12 \ LDX() BC| nn AA,
 13 \ LD()X SP| nn AA,
 14 \ IN(C) L'|
 15 \ OUT(C) H'|

Scr# 129 
  0 ( ED )
  1 00 00 00 T!
  2 01 44 4 EDFAMILY,
  3   NEG RETN IM0 LDIA
  4 02 4D 2 EDFAMILY,
  5   RETI LDRA
  6 01 56 2 EDFAMILY,
  7   IM1 LDAI
  8 01 5E 2 EDFAMILY,
  9   IM2 LDAR
 10 08 67 2 EDFAMILY,
 11   RRD RLD
 12 -->
 13 
 14 
 15 

Scr# 130 
  0 ( ED )
  1 00 00 00 T!
  2 01 A0 4 EDFAMILY,
  3   LDI  CPI  INI  OUTI
  4 01 A8 4 EDFAMILY,
  5   LDD  CPD  IND  OUTD
  6 01 B0 4 EDFAMILY,
  7   LDIR CPIR INIR OTIR
  8 01 B8 4 EDFAMILY,
  9   LDDR CPDR INDR OTDR
 10 -->
 11 
 12 
 13 
 14 
 15 

Scr# 131 
  0 ( CB )
  1 00 00 07 T!
  2 08 00 8 CBFAMILY,
  3   RLC  RRC  RL  RR
  4   SLA  SRA  SLL SRL
  5 00 00 43F T!
  6 40 40 3 CBFAMILY,
  7   BIT  RES  SET
  8 00 00 438 T!
  9 08 00 8 XFAMILY|
 10   0| 1| 2| 3| 4| 5| 6| 7|
 11 -->
 12 \ RLC B|
 13 \ BIT 3| B|
 14 \ RES 3| B|
 15 \ SET 3| B|

Scr# 132 
  0 ( IX IY )
  1 HEX
  2 00 00 00 T!
  3 02 E3 1 DDFAMILY,
  4   EX(SP)IX
  5 02 E3 1 FDFAMILY,
  6   EX(SP)IY
  7 \
  8 10 E9 2 DDFAMILY,
  9   JPIX  LDSPIX
 10 10 E9 2 FDFAMILY,
 11   JPIY  LDSPIY
 12 \
 13 -->
 14 \
 15 

Scr# 133 
  0 ( IX IY )
  1 HEX
  2 00 00 30 T!
  3 00 09 1 DDFAMILY, ADDIX
  4 00 09 1 FDFAMILY, ADDIY
  5 \
  6 00 0400 00 T!
  7 08 22 2 DDFAMILY,
  8   LD()IX LDIX()
  9 08 22 2 FDFAMILY,
 10   LD()IY  LDIY()
 11 -->
 12 \ ADDIX IX|  ADDIX SP|
 13 \ LD()IY aa AA,
 14 \ LDIY() aa AA,
 15 

Scr# 134 
  0 ( IX IY )
  1 : I)
  2 HERE 1 - C@
  3 HERE 2 - C@ CB - IF
  4 -1 ALLOT SWAP C, C,
  5 ELSE
  6 -2 ALLOT SWAP C, CB C, C,
  7 THEN ;
  8 00 00 07 T!
  9 00 06 1 XFAMILY| (I
 10 : (IX+  (I  DD I) ;
 11 : (IY+  (I  FD I) ;
 12 -->
 13 \ LD B'| (IY+ d )|
 14 \ ADCA   (IY+ d )|
 15 \ SRA    (IY+ d )|

Scr# 135 
  0 ( IX IY )
  1 HEX
  2 : )|
  3   HERE 1 - C@
  4   HERE 2 - C@
  5   CB = IF SWAP THEN
  6   HERE 1 - C! C, ;
  7 \
  8 : IXY| ( n -- )
  9  DUP HERE 2 - C@ - IF
 10   HERE 1- C@
 11   -1 ALLOT SWAP C, C,
 12  THEN ;
 13 -->
 14 
 15 

Scr# 136 
  0 ( IX IY )
  1 HEX
  2 \ INC DEC  (IX'+ d )|
  3 \ LDN  (IX'+ d )|  n N,
  4 00 00 38 T!
  5 00 30 1 XFAMILY|   (I'
  6 : (IX'+ (I' DD I) ;
  7 : (IY'+ (I' FD I) ;
  8 \
  9 \ LD(IX+ d )|  r|
 10 00 00 07 T!
 11 00 70 1 DDFAMILY, LD(IX+
 12 00 70 1 FDFAMILY, LD(IY+
 13 : )'| ' EXECUTE )| ;
 14 -->
 15 

Scr# 137 
  0 ( IX IY )
  1 \ LDIXL A|
  2 00 00 07 T!
  3 08 60 2
  4    DDFAMILY, LDIXH LDIXL
  5 08 60 2
  6    FDFAMILY, LDIYH LDIYL
  7 -->
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 138 
  0 ( IX IY )
  1 HEX
  2 : IX| HL| DD IXY| ;
  3 : IY| HL| FD IXY| ;
  4 : IXL| L| DD IXY| ;
  5 : IXH| H| DD IXY| ;
  6 : IYL| L| FD IXY| ;
  7 : IYH| H| FD IXY| ;
  8 \ LDX IY| nn NN,
  9 \ POP IY|  LD A'| IXL|
 10 FORTH DEFINITIONS
 11 DECIMAL
 12 
 13 
 14 
 15 

Scr# 140 
  0 .( Z80 near structure )   CR
  1 ASSEMBLER DEFINITIONS HEX
  2 \
  3 : NEXT JPIX ;
  4 : PSH1 PUSH HL|  JPIX ;
  5 : PSH2 PUSH DE| PUSH HL|
  6   JPIX ;
  7 : HOLDPLACE HERE 0 D, ;
  8 : DISP, OVER -
  9   1 - SWAP C! ;
 10 : BACK,
 11  HOLDPLACE SWAP DISP, ;
 12 \
 13 : | ;
 14 -->
 15 

Scr# 141 
  0 ( Z80 Near struct. )
  1 : THEN, HERE DISP, ;
  2 : ELSE, JR HOLDPLACE
  3   SWAP THEN, ;
  4 FORTH DEFINITIONS
  5 DECIMAL
  6 EXIT
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 142 
  0 ( Z80 Near struct. )
  1 EXIT
  2 \
  3 : IF, JRF Z'|
  4   HOLDPLACE ;
  5 : -IF, JRF NZ'|
  6   HOLDPLACE ;
  7 : <IF, JRF CY'|
  8   HOLDPLACE ;
  9 : -<IF, JRF NC'|
 10   HOLDPLACE ;
 11 
 12 
 13 
 14 
 15 

Scr# 143 
  0 ( Z80 Near struct. )
  1 EXIT
  2 : BEGIN, HERE ;
  3 : UNTIL, IF, SWAP DISP, ;
  4 : -UNTIL, -IF, SWAP DISP, ;
  5 : <UNTIL, <IF, SWAP DISP, ;
  6 : -<UNTIL, -<IF, SWAP DISP, ;
  7 : WHILE, IF, ;
  8 : -WHILE, -IF, ;
  9 : <WHILE, <IF, ;
 10 : -<WHILE, -<IF, ;
 11 : REPEAT, JR HOLDPLACE
 12   ROT DISP, THEN, ;
 13 -->
 14 
 15 

Scr# 144 
  0 ( Z80 Near struct. )
  1 EXIT
  2 : DJNZ,
  3   DJNZ HOLDPLACE
  4   SWAP DISP, ;
  5 FORTH DEFINITIONS
  6 DECIMAL
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 145 
  0 ." Z80 far struct "
  1 : THEN' HERE SWAP ! ;
  2 : HOLDPLACE' HERE 0 AA, ;
  3 : IF' JPF Z| HOLDPLACE' ;
  4 : ELSE' JP HOLDPLACE
  5         SWAP THEN' ;
  6 : BEGIN' HERE ;
  7 : UNTIL' IF' DROP THEN' ;
  8 : WHILE' IF' ;
  9 : REPEAT' ELSE' DROP THEN' ;
 10 DECIMAL
 11 FORTH DEFINITIONS
 12 
 13 
 14 
 15 

Scr# 146 
  0 ( TESTING )
  1 : T?
  2  TALLY-BY ?
  3  TALLY-BI ?
  4  TALLY-BA ?
  5 ;
  6 : H?
  7  HEX
  8  HERE 8 - DUMP
  9 ;
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 147 
  0 ( 128K memory BANK! TEST )
  1 HEX
  2 \ BANKM : 5B5C
  3 : ?BANK BASE @
  4   5B5C C@ 2 BASE ! .
  5   BASE ! ;
  6 : TEST
  7   BANK!
  8   C000 @ U.
  9   10 BANK!
 10 ;
 11 
 12 
 13 
 14 
 15 

Scr# 148 
  0 ( 128K memory BANK! TEST )
  1 \ between 0 and 7
  2 \ set bank n at C000
  3 CODE BANK! ( n -- )
  4  LDAR
  5  DI
  6  EXAFAF
  7  LD   D'|   B|
  8  LD   E'|   C|
  9  POP  BC|
 10  LDX  HL|  HEX  5B5C NN,
 11  LD   A'| (HL)|
 12  ANDN HEX  F8  N,
 13  ORA   C|
 14  LDX  BC|  HEX  7FFD NN,
 15 -->

Scr# 149 
  0 ( 128K memory BANK! TEST )
  1  OUT(C) A'|
  2  LD  (HL)'|   A|
  3  LD     B'|   D|
  4  LD     C'|   E|
  5  EXAFAF
  6  JPF    PO|  HERE 3 + A,
  7  EI
  8  NEXT
  9 C;
 10 \
 11 HEX
 12 : BANK@
 13  5B5C @ 7 AND
 14 ;
 15 

Scr# 150 
  0 ( TEST0 )
  1 CODE TEST0
  2  RLCA RRCA RLA RRA
  3  DAA CPL SCF CCF
  4  NOP EXAFAF EX(SP)HL EXDEHL
  5  DI EI HALT RET EXX
  6  JPHL LDSPHL
  7  RST 00| RST 38|
  8  ADDA B| ADCA C| SUBA D|
  9  SBCA E| ANDA H| XORA L|
 10  ORA (HL)| CPA A|
 11  LD(X)A BC| LDA(X) DE|
 12  INCX HL| DECX SP|
 13  ADDHL BC| ADDHL SP|
 14 C;
 15 -->

Scr# 151 
  0 ( TEST1 )
  1 CODE TEST1
  2  LDX  BC| 1234 NN,
  3  LDX  SP| 5678 NN,
  4  PUSH AF| POP HL|
  5  OUTA 254 P, INA 254 P,
  6  ADDN 1 N, ADCN 2 N,
  7  SUBN 3 N, SBCN 4 N,
  8  ANDN 5 N, XORN 6 N,
  9  ORN  7 N, CPN  8 N,
 10  LD()HL 1234 AA,
 11  LDHL() 1234 AA,
 12  LD()A  1234 AA,
 13  LDA()  1234 AA,
 14 C;
 15 -->

Scr# 152 
  0 ( TEST2 )
  1 CODE TEST2
  2  JP 1234 AA, CALL 1234 AA,
  3  INC B'| DEC A'|
  4  LD D'| E|  LD (HL)'| A|
  5  LDN B'| 1 N, LDN A'| 8 N,
  6  JPF Z| 1234 AA,
  7  CALLF M| 1234 AA,
  8  RETF PE|
  9  DJNZ -10 D, JR +10 D,
 10  JRF NZ'| +10 D,
 11  JRF CY'| -10 D,
 12  SBCHL DE| ADCHL SP|
 13  LDX() BC| 1234 AA,
 14  LD()X SP| 1234 AA,
 15 C; -->

Scr# 153 
  0 ( TEST3 )
  1 CODE TEST3
  2  IN(C) D'|  OUT(C) E'|
  3  NEG RETN IM0 LDIA RETI LDRA
  4  IM1 LDAI IM2 LDAR RRD RLD
  5  LDI   CPI   INI   OUTI
  6  LDD   CPD   IND   OUTD
  7  LDIR  CPIR  INIR  OTIR
  8  LDDR  CPDR  INDR  OTDR
  9  RLC B| RRC C| RL D| RR E|
 10  SLA H| SRA L| SRL (HL)|
 11  BIT 2| D|  BIT 3| E|
 12  RES 4| H|  RES 5| L|
 13  SET 6| (HL)| SET 7| A|
 14 C;
 15 EXIT

Scr# 154 
  0 ( TEST IF, THEN, )
  1 CODE TEST4
  2 BEGIN,
  3 NOP NOP NOP
  4 END,
  5 NEXT
  6 C;
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 155 
  0 \ TEST
  1 CODE TEST5
  2 INCX IX|  DECX IY|
  3 PUSH IX|  POP  IY|
  4 EX(SP)IX  JPIY
  5 LDSPIX    LDSPIY
  6 ADDIX BC| ADDIX DE|
  7 ADDIX IX| ADDIX SP|
  8 ADDIY BC| ADDIY DE|
  9 ADDIY IY| ADDIY SP|
 10 LD()IX 4 AA, LDIX() 3 AA,
 11 LD()IY 5 AA, LDIY() 6 AA,
 12 LDX IX| 7 NN,
 13 LDX IY| 8 NN,
 14 C;
 15 

Scr# 156 
  0 \ TEST6
  1 CODE TEST6
  2  ADCA (HL)|
  3  ADCA (IY+ 9 )|
  4  INC (HL)'|
  5  INC (IY'+ 9 )|
  6  LDN (HL)'|      5 N,
  7  LDN (IY'+ 9 )|  5 N,
  8  SRA  (HL)|
  9  SRA (IY+  9 )|
 10  SET 0| (HL)|
 11  SET 0| (IY+ 9 )|
 12  LDIX() 1234 AA,
 13 C;
 14 EXIT
 15 

Scr# 157 
  0 \ TEST7
  1 CODE TEST7
  2     LDX HL| 0 NN,
  3     BIT 5| (IY+ 1 )|
  4     IF, INC L'| THEN,
  5 PSH1 C;
  6 \
  7 : KEYIN
  8   BEGIN
  9   TEST7
 10   ?ESCAPE
 11   UNTIL ;
 12 
 13 
 14 
 15 

Scr# 158 
  0 \ TEST Z80N
  1 HEX CODE TEST8
  2  TESTN FF N,
  3  SWAPNIB MIRRORA
  4  LDIX LDDX LDIRX LDDRX
  5  LDWS LDPIRX
  6  OUTINB JP(C)
  7  PIXELDN PIXELAD SETAE
  8  BSLADE,B BSRADE,B BSRLDE,B
  9  BSRFDE,B BRLCDE,B
 10  MUL
 11  ADDHL,A ADDDE,A ADDBC,A
 12  ADDBC, 07654 NN,
 13  NEXTREGA 3 P,
 14  NEXTREG  3 P, 4 N,
 15  PUSHN 07654 LH,  NEXT C;

Scr# 159 
  0 \ TEST Z80N
  1 HEX CODE TEST9
  2  DECIMAL
  3  NEXTREG 87 P, 1 N,
  4  NEXTREGA 87 P,
  5 NEXT C;
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 160 
  0 .( Z80N Next extensions )
  1 ASSEMBLER DEFINITIONS HEX
  2 : <, 100 /MOD C, C, ;
  3 0 1 0 4000 ' <, COMMAER LH,
  4 \
  5 00 0900 00 91 EDPI NEXTREG
  6 \ NEXTREG reg P, n N,
  7 00 0100 00 92 EDPI NEXTREGA
  8 \  NEXTREGA r P,
  9 00 4000 00 8A EDPI PUSHN
 10 \   PUSHN nn LH,
 11 00 0800 00 27 EDPI TESTN
 12 \  TESTN n N,
 13 -->
 14 
 15 

Scr# 161 
  0 ( Z80N Next extension )
  1 ASSEMBLER DEFINITIONS HEX
  2 00 00 00 T!
  3 01 23 2 EDFAMILY,
  4  SWAPNIB MIRRORA
  5 08 A4 4 EDFAMILY,
  6  LDIX LDDX LDIRX LDDRX
  7 12 A5 2 EDFAMILY,
  8  LDWS LDPIRX
  9 08 90 2 EDFAMILY,
 10  OUTINB JP(C)
 11 01 93 3 EDFAMILY,
 12  PIXELDN PIXELAD SETAE
 13 -->
 14 
 15 

Scr# 162 
  0 ( Z80N Next extension )
  1 01 28 5 EDFAMILY,
  2  BSLADE,B BSRADE,B BSRLDE,B
  3  BSRFDE,B BRLCDE,B
  4 01 30 4 EDFAMILY,
  5  MUL
  6  ADDHL,A ADDDE,A ADDBC,A
  7 00 0200 00 T!
  8 01 34 3 EDFAMILY,
  9  ADDHL, ADDDE, ADDBC,
 10 \ ADDBC, nn NN,
 11 \
 12 FORTH DEFINITIONS DECIMAL
 13 
 14 
 15 

Scr# 166 
  0 ( White noise Egghead 3 )
  1 CODE WHITE-NOISE
  2  DI  PUSH BC|
  3 HERE CALL HERE AA,
  4  EI  POP  BC|  NEXT
  5 HERE SWAP 1+ !
  6 HERE LDN  E'|  250  N,
  7      LDX  HL|    0 NN,
  8 HERE PUSH DE|
  9      LDN  B'|   32  N,
 10 HERE PUSH BC|
 11      LD   A'| (HL)|
 12      INCX HL|
 13      ANDN 248 N,
 14      OUTA 254 P,
 15      LD   A'|   E|  -->

Scr# 167 
  0 ( White noise Egghead 3 )
  1      CPL
  2 HERE DEC  A'|
  3      JRF NZ'| BACK,
  4      POP  BC|
  5      DJNZ     BACK,
  6      POP  DE|
  7      LD   A'|    E|
  8      SUBN 24 N,
  9      CPN  30 N,
 10      RETF  Z|
 11      RETF CY|
 12      LD   E'|    A|
 13 -->
 14 
 15 

Scr# 168 
  0 ( White noise Egghead 3 )
  1      CPL
  2 \
  3 HERE LDN  B'| 40 N,
  4 HERE DJNZ BACK,
  5      DEC  A'|
  6      JRF NZ'| BACK,
  7      JR       BACK,
  8 C;
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 169 
  0 ( Checksum of a RAM chunk )
  1 CODE CHECKSUM ( a n -- n2 )
  2  POP    DE|
  3  POP    HL|
  4  XORA    A|
  5  INC    D'|
  6 HERE DUP
  7  XORA (HL)|
  8  INCX   HL|
  9  DEC    E'|
 10  JRF   NZ'|  BACK,
 11  DEC    D'|
 12  JRF   NZ'|  BACK,
 13  LD     E'|  A|
 14  PUSH  DE|
 15  NEXT  C;

Scr# 170 
  0 \ BURP
  1 \ Example
  2 : BURP
  3 [ HEX ] 7999 6000
  4 DO
  5  I HEX . I DECIMAL . CR
  6  ?TERMINAL IF QUIT THEN
  7 [ HEX ] 100
  8 +LOOP
  9 ;
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 171 
  0 ( Dump many pages )
  1 \ Dumps from a1 to a2
  2 DECIMAL
  3 : MDUMP ( a1 a2 -- )
  4  SWAP DO
  5   I DUMP
  6  64 +LOOP
  7 ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 179 
  0 ( CHECK NULL               )
  1 : J RP@ 6 + @ ;
  2 : CHECKNULL
  3 #SEC 1 DO
  4 I .
  5 I BLOCK @ 2020 = IF
  6 ." WRONG " THEN
  7 CR
  8 ?ESCAPE IF QUIT THEN
  9 LOOP
 10 ;
 11 
 12 
 13 
 14 
 15 

Scr# 180 
  0 ( Fibonacci )
  1 ( n -- d )
  2 \ n must be between 0 and 46
  3 : FIBO ( n -- d )
  4  0. ROT
  5  ?DUP IF
  6   1- 1. ROT
  7   0 DO
  8    2SWAP 2OVER
  9    D+
 10   LOOP
 11   2SWAP 2DROP
 12  THEN
 13 ;
 14 
 15 

Scr# 181 
  0 ( DSQRT )
  1 \ Extract square root of d
  2 \ between 0 and 268435455
  3 : DSQRT ( d -- n )
  4  2DUP D+ 2DUP D+
  5  0 [ HEX ] 8000
  6  0E 0 DO
  7   SWAP DROP
  8   >R 2DUP R@ UM/MOD
  9   R> + 1 RSHIFT
 10  LOOP 1 RSHIFT
 11  >R DROP 2DROP R>
 12 ;
 13 
 14 
 15 

Scr# 182 
  0 ( Primality Test )
  1 : ?PRIME ( d -- f )
  2  2DUP DSQRT 1+
  3  2 DO
  4   2DUP I UM/MOD DROP
  5   0= IF
  6    2DROP 0. LEAVE
  7   THEN
  8  LOOP
  9  OR 0= 0= ;
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 183 
  0 ( TEST )
  1 : TEST
  2 40 20 DO
  3  I . I 0 T CR
  4  KEY DROP
  5  LOOP
  6 ;
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 201 
  0 ( DAA )
  1 HEX
  2 CODE TEST-DAA
  3  POP HL|
  4  LD A'| L|
  5  CPN 10 N,
  6  SBCN 69 N,
  7  DAA
  8  LD L'| A|
  9  PSH1
 10  C;
 11 
 12 
 13 
 14 
 15 

Scr# 202 
  0 ( DAA )
  1 HEX
  2 CODE T
  3  POP HL|
  4  CPL CPL
  5  LD A'| L|
  6  DAA
  7  LD L'| A|
  8  PSH1
  9  C;
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 203 
  0 ( U* )
  1 CODE U*
  2  POP DE|
  3  POP HL|
  4  PUSH BC|
  5 \
  6  LD  C'|  L|
  7  LD  B'|  H|
  8  LDX HL| 0 NN,
  9  LDN A'| DECIMAL 16 N,
 10  HERE \ BEGIN,
 11   ADDHL HL|
 12   RL E|
 13   RL D|
 14   JRF NC'| HOLDPLACE
 15 -->

Scr# 204 
  0 ( U* )
  1    ADDHL BC|
  2    JRF NC'| HOLDPLACE
  3     INCX DE|
  4    HERE DISP, \ THEN,
  5   HERE DISP, \ THEN,
  6   DEC A'|
  7  JRF NZ'| HOLDPLACE
  8  SWAP DISP, \ -UNTIL,
  9  EXDEHL
 10 \
 11  POP BC|
 12  PSH2
 13  C;
 14 
 15 

Scr# 205 
  0 ( U/   dn n -- r dq )
  1 CODE U/
  2  POP  DE| \ Divisor
  3  POP  HL| \ High
  4  POP  IX| \ Low
  5  PUSH BC|
  6  LD   A'|    H|
  7  LD   C'|    L|
  8  LDX  HL|    0  NN,
  9  LDN  B'| DECIMAL 32 N,
 10  HERE DUP \ BEGIN,
 11   ADDIX IX|
 12   RL     C|
 13   RLA
 14   ADCHL HL|
 15 -->

Scr# 206 
  0 ( U/ )
  1   JRF CY'| HOLDPLACE
  2    SBCHL DE|
  3    JRF NC'| HOLDPLACE
  4     ADDHL DE|
  5     ROT DJNZ HOLDPLACE
  6     SWAP DISP,
  7    SWAP ELSE,
  8     ORA A|  SBCHL DE|
  9    SWAP THEN,
 10    INC IX|
 11   THEN,
 12  DNJZ BACK,
 13 -->
 14 
 15 

Scr# 207 
  0 ( U/ )
  1  LD   D'|  A|
  2  LD   E'|  C|
  3  POP  BC|
  4  PUSH HL|
  5  PUSH IX|
  6  PUSH DE|
  7  NEXT
  8 C;
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 208 
  0 ( UPPER )
  1 CODE UPPER ( c1 -- c2 )
  2 POP   HL|
  3 LD A'| L|
  4 CPN HEX 61 N,
  5 JRF CY'| HOLDPLACE
  6  CPN HEX 7B N,
  7  JRF NC'| HOLDPLACE
  8   SUBN HEX 20 N,
  9  HERE DISP,
 10 HERE DISP,
 11 LD L'| A|
 12 PSH1
 13 C;
 14 DECIMAL
 15 

Scr# 209 
  0 ( PICK )
  1 CODE PICK ( n -- v-nth )
  2  POP   HL|
  3  ADDHL HL|
  4  ADDHL SP|
  5  LD    A'|  (HL)|
  6  INCX  HL|
  7  LD    H'|  (HL)|
  8  LD    L'|     A|
  9  PSH1
 10 C;
 11 
 12 
 13 
 14 
 15 

Scr# 220 
  0 ( MOVE SP )
  1 \ Use: HEX D900 MOVE-SP
  2 \ or   HEX F840 MOVE-SP
  3 HEX
  4 : MOVE-SP ( a -- )
  5   DUP 16 +ORIGIN !
  6   DUP 12 +ORIGIN !
  7   DUP        S0  !
  8   DUP        TIB !
  9   S0 @ SP!
 10 ;
 11 DECIMAL
 12 -->
 13 
 14 
 15 

Scr# 221 
  0 ( MOVE RP )
  1 \ Use: HEX D9A0 MOVE-RP
  2 \ or   HEX F8E0 MOVE-RP
  3 HEX
  4 : MOVE-RP ( a -- )
  5   DUP R0 @ 80 -
  6   SWAP 80 - C0 CMOVE
  7   DUP 14 +ORIGIN !
  8   DUP 2E +ORIGIN !
  9   DUP         R0 !
 10 ;
 11 \
 12 DECIMAL
 13 -->
 14 
 15 

Scr# 222 
  0 ( MOVE LIMIT )
  1 \ Use: HEX E000 MOVE-LIMIT
  2 \ or   HEX FF58 MOVE-LIMIT
  3 HEX
  4 : MOVE-LIMIT ( a -- )
  5   DUP LIMIT !
  6   DUP 24 +ORIGIN !
  7   60C - DUP FIRST !
  8   DUP USE !
  9   DUP PREV !
 10   22 +ORIGIN !
 11  3 [ ' #BUFF 2 + ] LITERAL !
 12 ;
 13 DECIMAL
 14 -->
 15 

Scr# 223 
  0 ( UP AND DOWN )
  1 HEX
  2 : UP
  3   FF58 MOVE-LIMIT
  4   F8E0 MOVE-RP
  5   F840 MOVE-SP
  6 ;
  7 : DOWN
  8   D900 MOVE-SP
  9   D9A0 MOVE-RP
 10   E000 MOVE-LIMIT
 11 ;
 12 DECIMAL
 13 
 14 
 15 

Scr# 225 
  0 ( ?DO LOOP )
  1 : BACK-
  2  BACK
  3  SP@ CSP @ -
  4  IF 2+ [COMPILE] THEN
  5  THEN
  6  ?CSP CSP !
  7 ;
  8 -->
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 226 
  0 ( ?DO LOOP )
  1 : ?DO
  2  COMPILE (?DO)
  3  CSP @ !CSP
  4  HERE 0 , 0
  5  HERE 3
  6 ; IMMEDIATE
  7 \
  8 : DO
  9  COMPILE (DO)
 10  CSP @ !CSP
 11  HERE 3
 12 ; IMMEDIATE
 13 -->
 14 
 15 

Scr# 227 
  0 ( ?DO LOOP )
  1 : LOOP
  2  3 ?PAIRS
  3  COMPILE (LOOP)
  4  BACK-
  5 ; IMMEDIATE
  6 \
  7 : +LOOP
  8  3 ?PAIRS
  9  COMPILE (+LOOP)
 10  BACK-
 11 ; IMMEDIATE
 12 
 13 
 14 
 15 

Scr# 228 
  0 ( ?DO LOOP )
  1 : TYPE
  2  OVER + SWAP
  3  ?DO
  4   I C@ EMIT
  5  LOOP
  6 ;
  7 : TEST
  8  0 0
  9  ?DO I . CR LOOP
 10 ;
 11 
 12 
 13 
 14 
 15 

Scr# 229 
  0 ( POSTPONE )
  1 DECIMAL
  2 : POSTPONE
  3  ?COMP -FIND \ xt b f
  4  0= 0 ?ERROR
  5  192 < IF
  6   COMPILE COMPILE
  7  THEN
  8  ,
  9 ; IMMEDIATE
 10 EXIT
 11 : TIF
 12  POSTPONE 0BRANCH HERE 0 ,
 13  2 ; IMMEDIATE
 14 
 15 

Scr# 239 
  0 ( Rainbow effects )
  1 HEX CODE SYNC
  2  76 C,
  3  E9DD , ( NEXT ) SMUDGE
  4 : RAINBOW
  5 BEGIN
  6  SYNC
  7  0A 0 DO
  8    7 0 DO
  9       I FFFE P!
 10     LOOP
 11   LOOP
 12  ?TERMINAL
 13 UNTIL
 14 ;
 15 DECIMAL

Scr# 240 
  0 ( LARGE LETTER-F )
  1 : STAR   42 EMIT ;
  2 : STARS   0 DO STAR LOOP ;
  3 : MARGIN CR 15 SPACES ;
  4 : BLIP   MARGIN STAR ;
  5 : BAR    MARGIN 5 STARS ;
  6 : F      BAR BLIP BAR
  7          BLIP BLIP CR ;
  8 F
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 250 
  0 \ BLOCK-SHIFT
  1 \ change line 3
  2 : BLOCK-SHIFT
  3   99 118
  4  DO
  5  I . ." TO " I 1+ . CR
  6  I I 1+ BCOPY
  7  ?TERMINAL IF LEAVE THEN
  8  -1
  9  +LOOP
 10 ;
 11 
 12 
 13 
 14 
 15 

Scr# 251 
  0 ( block move reorder )
  1 \ Utility used while
  2 \ reordering all screens
  3 DECIMAL  3 LOAD
  4 DECIMAL 41 LOAD
  5 : BLOCK-SHIFT
  6  CLS
  7  350 1 DO
  8   0. AT. I . SPACE
  9   I I 10000 +
 10   BCOPY
 11   ?TERMINAL IF LEAVE THEN
 12  LOOP
 13 ;
 14 
 15 

Scr# 252 
  0 \ Print all blocsks to #13
  1 : >OUTPUT 13
  2  DUP DEVICE ! SELECT ;
  3 : PRINT-ALL-BLOCKS
  4  >OUTPUT
  5  ." This list is produced "
  6  ." via Scr# 252 " CR CR
  7  1001 1 DO
  8   VIDEO I 5 .R
  9   I BLOCK >OUTPUT I LIST CR
 10   VIDEO
 11   5 0 DO 8 EMITC LOOP
 12   ?TERMINAL IF LEAVE THEN
 13  LOOP
 14  VIDEO CR ;
 15 

Scr# 253 
  0 ( INITIALIZE-MMC )
  1 \ this erases blocks from
  2 \ # 302 up
  3 
  4 : INITIALIZE-MMC
  5 #SEC
  6 302
  7 DO I . I BCLEAR
  8 ?TERMINAL IF LEAVE THEN
  9 LOOP
 10 ;
 11 
 12 
 13 
 14 
 15 

Scr# 254 
  0 ( Microdrive Last Block )
  1 \ At least one block should
  2 \ be unusable due to the
  3 \ ring-junction on the tape
  4 \ so this block shouldn't be
  5 \ available.
  6 \ More: Real cartridges can
  7 \ have up to 85-90 K
  8 \ This means 170-180 blocks.
  9 \
 10 \ This Forth system uses Micro-
 11 \ drives #2 to #8 to store
 12 \ 889 KBytes of Screen Data
 13 \
 14 \ See Screen # 1778
 15 

Scr# 255 
  0 ( DR-1 BEGIN )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 287 
  0 ( GREY-SCREEN example )
  1 HEX
  2 CODE GREY-SCREEN
  3  PUSH BC|
  4  LDX  HL|  4000  NN,
  5  LDX  DE|  AA55  NN,
  6  LDX  BC|  000C  NN,
  7 HERE HERE
  8  LD   A'|  (HL)|
  9  XORA  E|
 10  LD (HL)'|    A|
 11  INCX HL|
 12  DJNZ BACK,
 13 -->
 14 
 15 

Scr# 288 
  0 ( GREY-SCREEN example )
  1 HERE
  2  LD   A'|  (HL)|
  3  XORA  D|
  4  LD (HL)'|    A|
  5  INCX HL|
  6  DJNZ BACK,
  7  DEC  C'|
  8  JRF NZ'| BACK,
  9  POP BC|
 10 NEXT C;
 11 DECIMAL
 12 
 13 
 14 
 15 

Scr# 292 
  0 ( GREY-SCREEN example )
  1 HERE
  2  LD   A'|  (HL)|
  3  XORA  D|
  4  LD (HL)'|    A|
  5  INCX HL|
  6  DJNZ BACK,
  7  DEC  C'|
  8  JRF NZ'| BACK,
  9  POP BC|
 10 NEXT C;
 11 DECIMAL
 12 
 13 
 14 
 15 

Scr# 293 
  0 ( MMU7 = 40h )
  1 ( MMU7 = 41h )
  2 ( MMU7 = 42h )
  3 ( MMU7 = 43h )
  4 ( MMU7 = 44h )
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 ( DEFAULT = 01h )

Scr# 300 
  0 ( FAR-HL first example )
  1 \ encode address 0000-3FFF
  2 \ to 8K-page #64-#79 and
  3 \ offset from E000h but
  4 \ rounded at 8 bytes
  5 CODE FAR-HL
  6  POP  HL|
  7  LD   A'|  H|
  8  ANDN HEX 0C0 N,
  9  JPF  NZ| (NEXT) 1- AA,
 10  LD   A'|  H|
 11  RRA
 12  ORN  HEX 080 N,
 13  RRA
 14  NEXTREGA DECIMAL 87 P,
 15 -->

Scr# 301 
  0 ( FAR-HL first example )
  1  ADDHL HL|
  2  ADDHL HL|
  3  ADDHL HL|
  4  LD   A'|  H|
  5  ORN  HEX 0E0 N,
  6  LD   H'|  A|
  7  PSH1
  8 C;
  9 \
 10 DECIMAL
 11 CODE NEAR-HL
 12  LDN  A'|  1  N,
 13  NEXTREGA 87 P,
 14  NEXT
 15 C;

Scr# 302 
  0 ( MMU7 / default bank )
  1 \
  2 \ reset MMU7 to default 1
  3 \
  4 DECIMAL
  5 CODE MMU7-01
  6  NEXTREG 87 P, 1 N,
  7  NEXT
  8 C;
  9 -->
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 303 
  0 ( MMU7 / set bank )
  1 \
  2 \ set MMU7 to 8K page given
  3 \ n betwen 0 and 223
  4 \
  5 DECIMAL
  6 CODE MMU7 ( n -- )
  7  POP  HL|
  8  LD   A'|  H|
  9  DECIMAL
 10  NEXTREGA 87 P,
 11  NEXT
 12 C;
 13 \
 14 
 15 

Scr# 304 
  0 ( MMU7 / set bank 5 bits )
  1 \
  2 \ set MMU7 to 64+n  8K block
  3 \ n between 0 and 31
  4 \
  5 CODE MMU7 ( n -- )
  6  POP  HL|
  7  LD   A'|  H|
  8  ANDN HEX 1F N,
  9  ORN  HEX 040 N,
 10  DECIMAL
 11  NEXTREGA 87 P,
 12  NEXT
 13 C;
 14 \
 15 

Scr# 305 
  0 ( MMU7 / set bank 6 bits )
  1 \
  2 \ set MMU7 to 64+n  8K block
  3 \ n between 0 and 63
  4 \
  5 CODE MMU7 ( n -- )
  6  POP  HL|
  7  LD   A'|  H|
  8  ANDN HEX 3F N,
  9  ORN  HEX 040 N,
 10  DECIMAL
 11  NEXTREGA 87 P,
 12  NEXT
 13 C;
 14 \
 15 

Scr# 306 
  0 ( MMU7 / set bank 7 bits )
  1 \
  2 \ set MMU7 to 64+n  8K block
  3 \ n between 0 and 127
  4 \
  5 CODE MMU7 ( n -- )
  6  POP  HL|
  7  LD   A'|  H|
  8  ANDN HEX 7F N,
  9  ORN  HEX 040 N,
 10  DECIMAL
 11  NEXTREGA 87 P,
 12  NEXT
 13 C;
 14 \
 15 

Scr# 307 
  0 ( MMU7 / first 16K RAM )
  1 \ Given a lower 16K address
  2 \ returns 8K-page #64+n
  3 \ and offset a from E000
  4 \
  5 CODE +FAR ( a1 -- a2 n )
  6  LDX  DE|  0 NN,
  7  POP  HL|
  8  LD   A'|  H|
  9  ANDN HEX 0C0 N,
 10  JRF NZ'| HOLDPLACE
 11  LD   A'|  H|
 12  RRA
 13  ORN  HEX 080 N,
 14  RRA
 15 -->

Scr# 308 
  0 ( MMU7 / first 16K RAM )
  1  LD   E'|  A|
  2  ADDHL HL|
  3  ADDHL HL|
  4  ADDHL HL|
  5  LD   A'|  H|
  6  ORN  HEX 0E0 N,
  7  LD   H'|  A|
  8 \
  9  HERE DISP,
 10  EXDEHL
 11  PSH2
 12 C;
 13 -->
 14 
 15 

Scr# 309 
  0 ( MMU7 / first 16K RAM )
  1 \ reverse of +FAR
  2 \ encodes a FAR address
  3 \ 8K-page in bits 2-5 of H
  4 \ bits 0-1 of H and L is the
  5 \ rounded address
  6 CODE -FAR ( a2 b -- a1 )
  7  POP  DE|
  8  POP  HL|
  9  LD   A'|  E|
 10  DEC  E'|
 11  JRF  Z'| HOLDPLACE
 12  ANDN HEX 0F N,
 13  RLA RLA
 14 -->
 15 

Scr# 310 
  0 ( MMU7 / first 16K RAM )
  1 \
  2  RR H|  RR L|
  3  RR H|  RR L|
  4  RR H|  RR L|
  5  ANDA H|
  6  LD  H'|  A|
  7  PSH1
  8 C;
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 311 
  0 ( MMU7 / 8th byte )
  1 \ Decode bits 2-7 of H as
  2 \ 8K-page #64-#127
  3 \ lower bit of H and L is
  4 \ offset rounded at 8 byte
  5 \
  6 CODE >FAR ( a1 -- a2 n )
  7  POP  HL|
  8  LD   A'|  H|
  9  ANDN HEX FC N,
 10  RRA RRA
 11  ORN  HEX 40 N,
 12  LDN  D'| 0 N,
 13  LD   E'|  A|
 14 -->
 15 

Scr# 312 
  0 ( MMU7 / 8th byte )
  1 \
  2  ADDHL HL|
  3  ADDHL HL|
  4  ADDHL HL|
  5  LD   A'|  H|
  6  ORN  HEX E0 N,
  7  LD   H'|  A|
  8  EXDEHL
  9  PSH2
 10 C;
 11 -->
 12 
 13 
 14 
 15 

Scr# 313 
  0 ( MMU7 / 8th byte )
  1 \ reverse of >FAR
  2 \ encodes a FAR address
  3 \ 8K-page in bits 2-7 of H
  4 \ bits 0-1 of H and L is the
  5 \ address rounded at 8 byte
  6 \
  7 CODE <FAR ( a2 b -- a1 )
  8  POP  DE|
  9  POP  HL|
 10  LD   A'|  E|
 11  DEC  E'|
 12  JRF  Z'| HOLDPLACE
 13  ANDN HEX 3F N,
 14  RLA RLA
 15 -->

Scr# 314 
  0 ( MMU7 / 8th byte )
  1 \
  2  RR H|  RR L|
  3  RR H|  RR L|
  4  RR H|  RR L|
  5  ANDA H|
  6  LD  H'|  A|
  7  PSH1
  8 C;
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 315 
  0 ( MMU7 / 4th byte )
  1 \ Decode bit 3-7 of H as
  2 \ 8K-page #64-95
  3 \ lower bit of H and L is
  4 \ offset rounded at 4th byte
  5 \
  6 CODE >FAR ( a1 -- a2 n )
  7  POP  HL|
  8  LD   A'|  H|
  9  ANDN HEX F8 N,
 10  RRA RRA RRA
 11  ORN  HEX 40 N,
 12  LDN  D'| 0 N,
 13  LD   E'|  A|
 14 -->
 15 

Scr# 316 
  0 ( MMU7 / 4th byte )
  1 \
  2 \
  3  ADDHL HL|
  4  ADDHL HL|
  5  LD   A'|  H|
  6  ORN  HEX E0 N,
  7  LD   H'|  A|
  8  EXDEHL
  9  PSH2
 10 C;
 11 -->
 12 
 13 
 14 
 15 

Scr# 317 
  0 ( MMU7 / 4th byte )
  1 \ reverse of >FAR
  2 \ encodes a FAR address
  3 \ 8K-page in bits 3-7 of H
  4 \ bits 0-2 of H and L is the
  5 \ address rounded at 4 byte
  6 \
  7 CODE <FAR ( a2 b -- a1 )
  8  POP  DE|
  9  POP  HL|
 10  LD   A'|  E|
 11  DEC  E'|
 12  JRF  Z'| HOLDPLACE
 13  ANDN HEX 3E N,
 14  RLA RLA RLA
 15 -->

Scr# 318 
  0 ( MMU7 / 4th byte )
  1 \
  2 \
  3  RR H|  RR L|
  4  RR H|  RR L|
  5  ANDA H|
  6  LD  H'|  A|
  7  PSH1
  8 C;
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 320 
  0 ( MMU7 / simplest )
  1 \ Decode bits 765 of H as
  2 \ 8K-page #64-#71
  3 \ lower bit of H and L is
  4 \ offset from E000h
  5 \
  6 CODE >FAR ( a1 -- a2 n )
  7  POP  HL|
  8  LD   A'|  H|
  9  ANDN HEX  E0 N,
 10  RLCA
 11  RLCA
 12  RLCA
 13 -->
 14 
 15 

Scr# 321 
  0 ( MMU7 / simplest )
  1 \
  2  ORN  HEX  40 N,
  3 \
  4  LD   E'|  A|
  5  LDN  D'|  00 N,
  6  LD   A'|  H|
  7  ORN  HEX  E0 N,
  8  LD   H'|  A|
  9  EXDEHL
 10  PSH2
 11 C;
 12 -->
 13 
 14 
 15 

Scr# 322 
  0 ( MMU7 / simplest )
  1 \ reverse of >FAR
  2 \ encodes a FAR address
  3 \ 8K-page in bits 765 of H
  4 \ lower bits of HL are
  5 \ offset at E000h
  6 \
  7 CODE <FAR ( a2 b -- a1 )
  8  POP  DE|
  9  POP  HL|
 10  LD   A'|  E|
 11  ANDN HEX  07 N,
 12  RRCA
 13  RRCA
 14  RRCA
 15 -->

Scr# 323 
  0 ( MMU7 / simplest )
  1 \
  2  LD   D'|  A|
  3  LD   A'|  H|
  4  ANDN HEX  1F N,
  5  ORA   D|
  6  LD   H'|  A|
  7  PSH1
  8 C;
  9 -->
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 324 
  0 ( MMU7 / simplest )
  1 \ visual test
  2 : T
  3  CR HEX
  4  DUP 0 6 D.R CR
  5  >FAR
  6  2DUP  D.  CR
  7  <FAR
  8      0 6 D.R CR
  9 ;
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 325 
  0 ( MMU7 HEAP )
  1 DECIMAL
  2 \
  3 \ Heap Pointer
  4 0 VARIABLE HP     HP !
  5 \
  6 : HP@ HP @ ;
  7 : HP+! HP +! ;
  8 \
  9 \ Current page
 10 64 VARIABLE CURPAGE   CURPAGE !
 11 -->
 12 
 13 
 14 
 15 

Scr# 326 
  0 ( MMU7 HEAP )
  1 \ translate far address a1
  2 \ to E000 offset a2
  3 \ preparing the correct page
  4 \ This word must be used
  5 \ very close to any ! or @
  6 : FAR ( a1 -- a2 )
  7  >FAR     \ offset page
  8  DUP MMU7 \ a3 n
  9  CURPAGE !
 10 ;
 11 -->
 12 
 13 
 14 
 15 

Scr# 327 
  0 ( MMU7 HEAP )
  1 \ reserve n bytes on heap
  2 \ returns pointer to
  3 \ first byte allocated
  4 \
  5 : HEAP ( n -- a )
  6  HP@ >R
  7  HP+!
  8  R>
  9 ;
 10 -->
 11 
 12 
 13 
 14 
 15 

Scr# 328 
  0 ( MMU7 HEAP STRING )
  1 \ STRING"  ( -- a )
  2 \ Accepts a string and
  3 \ store it to heap
  4 \ returns a pointer to
  5 \ a counted string
  6 \
  7 : STRING"
  8  [CHAR] " WORD
  9  DUP C@ 1+ >R
 10  HP@ FAR
 11  R@ CMOVE
 12  R@ HP+!
 13  R>
 14 ;
 15 -->

Scr# 329 
  0 ( MMU7 HEAP STRING )
  1 \ given a pointer
  2 \ prints the counted string
  3 \
  4 : .STRING
  5   FAR
  6   COUNT TYPE
  7 ;
  8 -->
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 330 
  0 ( MMU7 HEAP POINTE )
  1 : POINTER ( a -- cccc )
  2  <BUILDS
  3   ,
  4  DOES>
  5   CELL+ @
  6   FAR
  7 ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 331 
  0 \ TEST
  1 STRING" HELLO WORLD"
  2 POINTER HELLO
  3 \
  4 HELLO .STRING
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 332 
  0 \ TEST
  1 : Q CR
  2  ." HP  " HP@ U. CR
  3  ." P   " CURPAGE ? CR
  4 ;
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 360 
  0 ( F_OPEN )
  1 CREATE FNAME  ," F15m.f    "
  2 CREATE BLOCKS ," !Blocks   "
  3 : CHNL@+ CHNL @ + ;
  4 : STRCPY COUNT ROT SWAP CMOVE ;
  5 : F_CLOSE
  6   71 CHNL@+ BLOCKS STRCPY
  7   14 CHNL@+ BLOCKS STRCPY ;
  8 : F_OPEN
  9   54 53 CHNL@+ C! \ HDNAME.10
 10    8 25 CHNL@+ C! \ CHDRIV
 11   -1 13 CHNL@+ C! \ CHREC
 12   71 CHNL@+ FNAME  STRCPY
 13   14 CHNL@+ FNAME  STRCPY ;
 14 
 15 

Scr# 361 
  0 123
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 380 
  0 ( .HELLO )
  1 CODE .HELLO
  2 HERE
  3  INA HEX FE P,
  4  CPL
  5  ANDN 0F N,
  6 JRF NZ'| BACK,
  7 NEXT C;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 382 
  0 ( DOT )
  1 HEX
  2 : DOT
  3 -FIND 0= 0 ?ERROR
  4 DROP CELL+ 0D SELECT
  5 BEGIN
  6  DUP C@ EMITC
  7  DUP 2@ + -2 -
  8 WHILE
  9  1+
 10 REPEAT
 11 DROP CR VIDEO
 12 ;
 13 
 14 
 15 

Scr# 384 
  0 ( .VER )
  1 0 VARIABLE .VER     .VER !
  2 ASSEMBLER RET
  3  LD()X SP| HEX 3FFE AA,
  4  LDX   SP| HEX 3FF0 NN,
  5  CALL  0103 AA,
  6  LD    A'|   D|
  7  ANDN  0F0 N,
  8  RRA RRA RRA RRA
  9  ADDN  030 N,
 10  RST   10|
 11  LD    A'|   D|
 12  ANDN  00F N,
 13  ADDN  030 N,
 14  RST   10|
 15 -->

Scr# 385 
  0 ( .XVER )
  1  LDX() SP| HEX 3FFE AA,
  2 RET
  3 RET FORTH 0FFFF , 0FFFF ,
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 400 
  0 ( UDG utility )
  1 DECIMAL
  2 : UDG@ 65 - 8 * 23675 @ + ;
  3 : UDG+ 79 + ;
  4 : [UDG]
  5 CHAR UDG+ [COMPILE] LITERAL
  6 ; IMMEDIATE
  7 : BIN 2 BASE ! 8 .R
  8 DECIMAL ;
  9 : .UDG CR
 10 UDG@ DUP 8 + SWAP DO
 11  I C@ BIN CR
 12 LOOP DECIMAL ;
 13 
 14 
 15 

Scr# 401 
  0 ( HASH Utility )
  1 : HASH ( a -- n )
  2   0 SWAP
  3   COUNT 31 AND BOUNDS
  4   ?DO
  5     11 UM* +
  6     I C@ 127 AND BL -
  7     XOR
  8   LOOP
  9   ABS 701 MOD
 10 ;
 11 : 'HASH
 12   BL WORD HASH
 13 ;
 14 -->
 15 

Scr# 402 
  0 ( NEEDS with HASH Utility )
  1 : NEEDS
  2   >IN @ >R
  3   -FIND 0=
  4   IF
  5     R> >IN !
  6     'HASH 1000 + LOAD
  7   THEN
  8 ;
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 403 
  0 ( HASH Utility )
  1 : TEST
  2   CONTEXT @ @
  3   BEGIN
  4     DUP HASH 3 .R SPACE
  5     DUP ID.    CR
  6     PFA LFA @
  7     DUP 0=
  8     ?TERMINAL OR
  9   UNTIL
 10   DROP
 11 ;
 12 
 13 
 14 
 15 

Scr# 508 
  0 ( DR-1 END )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 509 
  0 ( DR-2 BEGIN )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 537 
  0 ( VALUE TO )
  1 : VALUE ( x ccc -- )
  2         ( -- n )
  3  [COMPILE] CONSTANT
  4 ; IMMEDIATE
  5 \
  6 : TO ( n -- ccc )
  7  ' >BODY
  8  STATE @ IF
  9   COMPILE LIT
 10   , COMPILE !
 11  ELSE
 12             !
 13  THEN
 14 ; IMMEDIATE
 15 

Scr# 538 
  0 \ test
  1 123 VALUE XXX
  2 456 VALUE YYY
  3 789 VALUE ZZZ
  4 XXX    TO ZZZ
  5 : TEST
  6  ZZZ TO YYY
  7 ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 600 
  0 .( Chomp.f )
  1 MARKER TASK
  2 FORTH DEFINITIONS CASEOFF
  3 FLUSH EMPTY-BUFFERS
  4 decimal  18 load  \ CASE
  5 decimal  26 load  \ .S
  6 decimal  39 load
  7 decimal  50 load
  8 decimal  41 load
  9 decimal 601 load
 10 decimal 610 load
 11 decimal 630 load
 12 decimal 650 load
 13 decimal 660 load
 14 
 15 

Scr# 601 
  0 ( Chomp.f )
  1 CODE sync-vid HEX
  2  76 C,       \ halt
  3  DD C, E9 C, \ jp (ix)
  4  smudge
  5 \
  6 : c+! ( n a )
  7   tuck c@ + swap c! ;
  8 \
  9 : d+! ( n a )
 10   tuck 2@      \ a n d
 11   rot s>d  d+  \ a d+n
 12   rot 2! ;
 13 decimal
 14 -->
 15 

Scr# 602 
  0 ( Chomp.f )
  1 : bin ( n -- )
  2   base @ swap 2 base !
  3   8 .r  base ! ;
  4 \ double equals
  5 : D= ( d1 d2 -- f )
  6   rot =      \ l1 l2 h2=h1
  7   swap rot   \ h1=h2 l2 l1
  8   = and ;
  9 \ true if n between a and b
 10 : between ( n a b -- f )
 11   rot tuck < 0= \ a n b>n
 12   swap rot < 0= \ b>n n>a
 13   and ;
 14 -->
 15 

Scr# 603 
  0 ( Chomp.f )
  1 : six-emitc
  2   emitc emitc emitc
  3   emitc emitc emitc ;
  4 \
  5 : sync-emit
  6   sync-vid
  7   emitc emitc emitc emitc
  8   emitc emitc emitc emitc
  9   emitc emitc emitc emitc ;
 10 \
 11 -->
 12 
 13 
 14 
 15 

Scr# 604 
  0 ( Chomp.f )
  1 decimal 23560 constant LASTK
  2    variable total 0 ,
  3    variable score 0 ,
  4    variable high-score 0 ,
  5    variable counting
  6    variable lives
  7    variable hunt
  8 -->
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 605 
  0 ( Chomp.f )
  1 : pill-on
  2   -1 hunt !
  3   10  total d+!
  4   0 counting ! ;
  5 \
  6 : bip ( n1 n2 -- n3 n4 )
  7   beep-pitch
  8   bleep-calc
  9   swap ;
 10 \
 11 : 2lit ( n1 n2 -- )
 12   [compile] literal
 13   [compile] literal
 14 ; immediate -->
 15 

Scr# 606 
  0 ( Chomp.f )
  1   char 8  value    key-right
  2   char 5  value    key-left
  3   char 7  value    key-up
  4   char 6  value    key-down
  5        9  value    key+right
  6        8  value    key+left
  7       11  value    key+up
  8       10  value    key+down
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 610 
  0 .( Chomp.f - UDG )
  1 decimal
  2 : UDG+ ( c1 -- c2 )
  3  upper 79 + ;
  4 \ compile and UDG literal
  5 : [UDG] ( -- )
  6  char UDG+ [compile] literal ;
  7  IMMEDIATE
  8 \ given c return UDG address
  9 : UDG@ ( c -- a )
 10  upper 65 - 8 * 23675 @ + ;
 11 \ given c print binary repres.
 12 : .UDG ( c -- )
 13  cr UDG@ dup 8 + swap do
 14   i c@ bin cr
 15  loop ; -->

Scr# 611 
  0 ( Chomp.f - UDG )
  1 : UDGize ( a -- )
  2  count over + swap do
  3   i c@ upper [char] A [char] U
  4   between if
  5    i c@ upper UDG+ i c!
  6   then
  7  loop ;
  8 \
  9 : Gtype ( a c -- )
 10  over + swap ?do
 11   i c@ emitc loop ;
 12 : UDGs
 13   [char] V [char] A do
 14    i UDG+ emitc loop ;
 15 -->

Scr# 612 
  0 ( Chomp.f - UDG )
  1 create UDG_1
  2 hex
  3 FF00 , 0000 , 0000 , 0000 , \ A
  4 0000 , 0000 , 0000 , 00FF , \ B
  5 FF00 , 0000 , 0000 , 00FF , \ C
  6 F800 , 0204 , 0202 , 0202 , \ D
  7 1F00 , 4020 , 4040 , 4040 , \ E
  8 3F00 , 8040 , 4080 , 003F , \ F
  9 FC00 , 0102 , 0201 , 00FC , \ G
 10 0202 , 0202 , 0402 , 00F8 , \ H
 11 4040 , 4040 , 2040 , 001F , \ I
 12 0202 , 0202 , 0202 , 0202 , \ J
 13 -->
 14 
 15 

Scr# 613 
  0 ( Chomp.f - UDG )
  1 hex
  2 1800 , 4224 , 4242 , 4242 , \ K
  3 4242 , 4242 , 2442 , 0018 , \ L
  4 4040 , 4040 , 4040 , 4040 , \ M
  5 4242 , 4242 , 4242 , 4242 , \ N
  6 0000 , 7C38 , 7C7C , 0038 , \ O
  7 3E1C , 0F1F , 3E1F , 001C , \ P
  8 2200 , 7F77 , 3E7F , 001C , \ Q
  9 1C00 , 7C3E , 7C78 , 1C3E , \ R
 10 3800 , FE7C , EEFE , 0044 , \ S
 11 7E38 , DB5A , FFFF , 93FF , \ T
 12 0602 , 140A , EE24 , 66EE , \ U
 13 UDG_1 5C7B ! \ UDG
 14 -->
 15 

Scr# 614 
  0 .( Chomp.f - maze )
  1 decimal
  2 21 constant maze-h
  3 21 constant maze-w
  4 create maze-run
  5 24 21 * allot
  6 create maze-base
  7 -->
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 615 
  0 ( Chomp.f - maze )
  1 ," EAAAAAAAAANAAAAAAAAAD "
  2 ," M.........N.........J "
  3 ," M.EAD.EAD.N.EAD.EAD.J "
  4 ," MOM J.M J.N.M J M JOJ "
  5 ," M.IBH.IBH.L.IBH.IBH.J "
  6 ," M...................J "
  7 ," M.FCG.K.FCACG.K.FCG.J "
  8 ," M.....N...N...N.....J "
  9 ," IBBBB.MCG.L.FCJ.BBBBH "
 10 ,"     J.N.......N.M     "
 11 ," BBBBH.L.E---D.L.IBBBB "
 12 -->
 13 
 14 
 15 

Scr# 616 
  0 ( Chomp.f - maze )
  1 ," /.......M   J.......\ "
  2 ," AAAAD.K.I---H.K.EAAAA "
  3 ,"     J.N.... ..N.N     "
  4 ," BBBBH.L.FCACG.L.IBBBB "
  5 ," M.........N.........J "
  6 ," MOFCD.FCG.L.FCG.ECGOJ "
  7 ," M...N...........N...J "
  8 ," AAD.L.FCCCCCCCG.L.EAA "
  9 ,"   J...............M   "
 10 ,"    AAAAAAAAAAAAAAA    "
 11 -->
 12 
 13 
 14 
 15 

Scr# 617 
  0 ( Chomp.f - maze )
  1 decimal
  2 : maze-copy ( a1 a2 -- )
  3  maze-h 0 do
  4   2dup 24 cmove
  5   dup udgize
  6   swap 24 + swap 24 +
  7  loop
  8  2drop ;
  9 \
 10 : set-maze-run
 11   maze-base
 12   maze-run
 13   maze-copy ;
 14 set-maze-run
 15 -->

Scr# 618 
  0 ( Chomp.f - maze )
  1 : maze^ ( x y -- a )
  2  maze-run + swap 1-
  3  24 * + ;
  4 \
  5 : maze@ ( x y -- c )
  6  maze^ c@ ;
  7 \
  8 : maze! ( c x y -- )
  9  maze^ c! ;
 10 \
 11 -->
 12 
 13 
 14 
 15 

Scr# 619 
  0 ( Chomp.f - maze )
  1 : maze.
  2  0 0 at.
  3  22 1 do
  4   025 23 - i 16 +
  5   beep-pitch bleep-calc
  6  loop
  7  maze-run
  8  22 1 do
  9   cr space
 10   dup count gtype 24 +
 11  >R bleep R>
 12  loop
 13  drop
 14 ;
 15 -->

Scr# 620 
  0 .( Chomp.f - Sprite )
  1 create Array   6 08 * allot
  2   variable Sprite^
  3 0 value    Sprite-no \
  4 : sprite# ( n -- )
  5   dup 3 lshift array +
  6   sprite^ ! to sprite-no ;
  7 \
  8 : sprite ( -- a )
  9   sprite^ @ ;
 10 \
 11 : all-ghost  ( v i -- )
 12   32 Array  + swap Array  +
 13   do dup i c! 08 +loop
 14   drop ;
 15 -->

Scr# 621 
  0 ( Chomp.f - Sprite )
  1 \ creates an index of Ghost
  2 : index-of ( n -- )
  3   <builds c, does> c@ + ;
  4 \ creates a ghost pointer
  5 : name-of  ( n -- creates )
  6   <builds c, does> c@ dup
  7   3 lshift Array + sprite^ !
  8   to sprite-no ;
  9 -->
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 622 
  0 ( Chomp.f - Sprite )
  1 \ array index by name
  2 0 name-of Inky
  3 1 name-of Pinky
  4 2 name-of Blinky
  5 3 name-of Ted
  6 \
  7 0 index-of face
  8 1 index-of color
  9 2 index-of x-pos
 10 3 index-of y-pos
 11 4 index-of dir
 12 5 index-of x-pre
 13 6 index-of y-pre
 14 7 index-of maze
 15 -->

Scr# 623 
  0 ( chomp.f - Sprite )
  1 \ shorthand for x-pos,y-pos
  2 : xy-pos@  ( -- x y )
  3   sprite
  4   dup    x-pos c@
  5   swap   y-pos c@ ;
  6 : xy-pre@  ( -- x y )
  7   sprite
  8   dup    x-pre c@
  9   swap   y-pre c@ ;
 10 : xy-pre! ( x y -- )
 11   >R sprite x-pre c!
 12   R> sprite y-pre c! ;
 13 \
 14 -->
 15 

Scr# 624 
  0 ( Chomp.f - Sprite )
  1 : Ghost-color ( -- )
  2  Inky   1 sprite color c!
  3  Pinky  3 sprite color c!
  4  Blinky 5 sprite color c!
  5  Ted    2 sprite color c!
  6 ;
  7 : Ghost-white ( -- )
  8  7  0 color  all-ghost
  9 ;
 10 ghost-color
 11 -->
 12 
 13 
 14 
 15 

Scr# 625 
  0 ( Chomp.f - Sprite )
  1 : Ghost-init  ( -- )
  2  12 0 x-pos  all-ghost
  3  11 0 y-pos  all-ghost
  4  55 0 dir    all-ghost
  5  bl 0 maze   all-ghost
  6  Inky   10 sprite y-pos c!
  7  Inky   xy-pos@ xy-pre!
  8  Pinky  12 sprite y-pos c!
  9  Pinky  xy-pos@ xy-pre!
 10  Ted    11 sprite x-pos c!
 11  Ted    xy-pos@ xy-pre!
 12  Blinky xy-pos@ xy-pre!
 13  [char] T udg+
 14  0 face all-ghost
 15 ; -->

Scr# 626 
  0 ( Chomp.f - Sprite )
  1 4 name-of Pacman
  2 : pacman-init
  3   Pacman [char] R@ UDG+
  4      sprite face  c!
  5   14 sprite x-pos c!
  6   12 sprite y-pos c!
  7   14 sprite x-pre c!
  8   12 sprite y-pre c!
  9    6 sprite color c!
 10   56 sprite dir   c!
 11   bl sprite maze  c!
 12 ;
 13 ghost-init
 14 pacman-init
 15 -->

Scr# 627 
  0 ( Chomp.f - Sprite )
  1 5 name-of Cherry
  2 : cherry-init
  3   Cherry [char] U UDG+
  4      sprite face  c!
  5   14 sprite x-pos c!
  6   12 sprite y-pos c!
  7   14 sprite x-pre c!
  8   12 sprite y-pre c!
  9    2 sprite color c!
 10   00 sprite dir   c!
 11   bl sprite maze  c!
 12 ;
 13 cherry-init -->
 14 
 15 

Scr# 628 
  0 ( Chomp.f - Sprite )
  1 \ draw current sprite
  2 : sprite-put ( -- )
  3   sprite face  c@
  4   sprite color c@   16
  5   xy-pos@ swap      22
  6   sprite maze  c@
  7   xy-pre@ swap      22
  8   4 16
  9   sync-emit
 10 ;
 11 \ usage:
 12 \ Blinky  sprite-put
 13 -->
 14 
 15 

Scr# 629 
  0 ( Chomp.f )
  1 : init-all
  2   ghost-init
  3   pacman-init
  4   cherry-init
  5   00 counting !
  6   key-right LASTK c!
  7 ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 630 
  0 .( Chomp.f - trail )
  1 : ?pac-trail  ( c -- )
  2  case
  3   bl       of 1 endof
  4   [char] . of 1 endof
  5   [udg]  U of 1 endof
  6   [udg]  O of 1 endof
  7   [char] / of 1 endof
  8   [char] \ of 1 endof
  9   0 swap
 10  endcase ;
 11 -->
 12 
 13 
 14 
 15 

Scr# 631 
  0 ( Chomp.f - trail )
  1 : ?ghost-trail  ( c -- )
  2  case
  3   bl       of 1 endof
  4   [char] . of 1 endof
  5   [udg]  U of 1 endof
  6   [udg]  O of 1 endof
  7   [char] - of 1 endof
  8   0 swap
  9  endcase ;
 10 -->
 11 
 12 
 13 
 14 
 15 

Scr# 632 
  0 ( Chomp.f - trail )
  1 : go-right
  2   Pacman
  3   xy-pos@      1+      maze@
  4   dup [char] \ = if
  5    1 sprite y-pos c!
  6   then
  7   ?pac-trail if
  8    [char] R@ UDG+
  9    sprite face  c!
 10    1  sprite y-pos c+!
 11 \ else 2 choose if key-up
 12 \  else key-down then
 13 \  sprite dir c!
 14   then ;
 15 -->

Scr# 633 
  0 ( Chomp.f - trail )
  1 : go-left
  2   Pacman
  3   xy-pos@      1-      maze@
  4   dup [char] / = if
  5    21 sprite y-pos c!
  6   then
  7   ?pac-trail if
  8    [char] P UDG+
  9     sprite face  c!
 10    -1 sprite y-pos c+!
 11 \ else 2 choose if key-up
 12 \  else key-down then
 13 \  sprite dir c!
 14   then ;
 15 -->

Scr# 634 
  0 ( Chomp.f - trail )
  1 : go-up
  2   Pacman
  3   xy-pos@ swap 1- swap maze@
  4   ?pac-trail if
  5    [char] Q UDG+
  6    sprite face  c!
  7    -1 sprite x-pos c+!
  8 \ else 2 choose if
  9 \  key-right else key-left then
 10 \  sprite dir c!
 11   then ;
 12 -->
 13 
 14 
 15 

Scr# 635 
  0 ( Chomp.f - trail )
  1 : go-down
  2   Pacman
  3   xy-pos@ swap 1+ swap maze@
  4   ?pac-trail if
  5    [char] S UDG+
  6    sprite face  c!
  7    1  sprite x-pos c+!
  8 \ else 2 choose if
  9 \  key-left else key-right then
 10 \  sprite dir c!
 11   then ;
 12 -->
 13 
 14 
 15 

Scr# 636 
  0 ( Chomp.f - trail )
  1 : pacman-move ( c -- )
  2  case
  3  key-right of go-right endof
  4  key-left  of go-left  endof
  5  key-up    of go-up    endof
  6  key-down  of go-down  endof
  7  endcase ;
  8 \
  9 : pacman-eat-dot ( c -- )
 10   [char] . = if
 11    1  score d+!
 12 \  [ 12 -12 bip ] 2lit
 13 \  bleep
 14   then ;
 15 -->

Scr# 637 
  0 ( Chomp.f - trail )
  1 : pacman-eat-pill ( c -- )
  2   [udg] O = if
  3    -1 hunt !
  4    10 score d+!
  5    10 total d+!
  6    [ 50 25 bip ] 2lit bleep
  7    [ 50 39 bip ] 2lit bleep
  8    0 counting !
  9    ghost-white
 10   then ;
 11 \
 12 -->
 13 
 14 
 15 

Scr# 638 
  0 ( Chomp.f - trail )
  1 : pacman-walk ( c -- )
  2   >r r@ [udg]  O =
  3      r@ [char] . = or
  4      r> [udg]  U = or
  5   0= if
  6    pacman
  7    xy-pos@ xy-pre@ d=
  8    0= if
  9 \   [ 12 -14 bip ] 2lit
 10 \   bleep
 11    then
 12   then
 13 ;
 14 -->
 15 

Scr# 639 
  0 ( Chomp.f - trail )
  1 : pacman-eat-cherry ( c -- )
  2   [udg] U = if
  3    10 score d+!
  4    10 total d+!
  5    [ 50 29 bip ] 2lit bleep
  6    [ 50 36 bip ] 2lit bleep
  7   then ; -->
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 640 
  0 ( Chomp.f - ghost )
  1 : ghost-right ( c -- )
  2   xy-pos@ 1+ maze@
  3   ?ghost-trail if
  4      1  sprite y-pos c+!
  5   else
  6    2 choose if
  7     key-down
  8    else
  9     key-up
 10    then
 11    sprite dir c!
 12   then
 13 ;
 14 -->
 15 

Scr# 641 
  0 ( Chomp.f - ghost )
  1 : ghost-left  ( c -- )
  2   xy-pos@ 1- maze@
  3   ?ghost-trail if
  4     -1  sprite y-pos c+!
  5   else
  6    2 choose if
  7     key-up
  8    else
  9     key-down
 10    then
 11    sprite dir c!
 12   then
 13 ;
 14 -->
 15 

Scr# 642 
  0 ( Chomp.f - ghost )
  1 : ghost-down  ( c -- )
  2   xy-pos@ swap 1+ swap maze@
  3   ?ghost-trail if
  4      1  sprite x-pos c+!
  5   else
  6    2 choose if
  7     key-right
  8    else
  9     key-left
 10    then
 11    sprite dir c!
 12   then
 13 ;
 14 -->
 15 

Scr# 643 
  0 ( Chomp.f - ghost )
  1 : ghost-up    ( c -- )
  2   xy-pos@ swap 1- swap maze@
  3   ?ghost-trail if
  4     -1  sprite x-pos c+!
  5   else
  6    2 choose if
  7     key-left
  8    else
  9     key-right
 10    then
 11    sprite dir c!
 12   then
 13 ;
 14 -->
 15 

Scr# 644 
  0 ( Chomp.f - ghost )
  1 : ghost-move ( c -- )
  2  case
  3   key-right of
  4    ghost-right endof
  5   key-left  of
  6    ghost-left  endof
  7   key-up    of
  8    ghost-up    endof
  9   key-down  of
 10    ghost-down  endof
 11  endcase ;
 12 \
 13 -->
 14 
 15 

Scr# 645 
  0 ( Chomp.f - ghost )
  1 : ghost-decision ( -- )
  2   xy-pos@ xy-pre@ d= if
  3    4 choose
  4    case
  5    0 of key-left  endof
  6    1 of key-down  endof
  7    2 of key-up    endof
  8    3 of key-right endof
  9    endcase
 10   then
 11   sprite dir c!
 12 ;
 13 
 14 
 15 

Scr# 650 
  0 ( Chomp.f )
  1 : init-display
  2  0 paper. 0 border. 4 ink.
  3  cls maze.
  4  0 20 at. ." high "
  5  high-score 2@
  6  <# # # # # # # #> type
  7  5 0 do
  8   i  sprite#
  9   sprite-put
 10  loop
 11 ;
 12 -->
 13 
 14 
 15 

Scr# 651 
  0 ( Chomp.f )
  1 : inter-hunt
  2   0 27 do
  3    10 i at. sync-vid
  4    7 16 bl emit emitc emitc
  5    [udg] T emitc sync-vid
  6    bl bl emitc emitc
  7    6 16 emitc emitc
  8    [udg] P emitc
  9    bl emit sync-vid
 10    bleep
 11    ?terminal if quit then
 12   -1 +loop ;
 13  -->
 14 
 15 

Scr# 652 
  0 ( Chomp.f )
  1 : inter-flee
  2   28 1 do
  3    10 i at. sync-vid
  4    3 16 bl emit emitc emitc
  5    [udg] T emitc sync-vid
  6    bl bl emitc emitc
  7    6 16 emitc emitc
  8    [udg] R@ emitc
  9    sync-vid
 10    bleep
 11    ?terminal if quit then
 12   1 +loop ;
 13  -->
 14 
 15 

Scr# 653 
  0 ( Chomp.f - Interlude )
  1 : inter-sound
  2   27 0 do
  3    012 i bip swap
  4   01 +loop
  5   1 28 do
  6    012 i bip swap
  7   -1 +loop ;
  8 \
  9 : interlude
 10   inter-sound cls
 11   10 30 at.
 12   [udg]  O  emitc
 13   inter-flee
 14   inter-hunt ;
 15 -->

Scr# 654 
  0 ( Chomp.f )
  1 : catch? ( -- f )
  2   pacman xy-pos@
  3   inky   xy-pos@ d=
  4   pacman xy-pos@
  5   pinky  xy-pos@ d=
  6   pacman xy-pos@
  7   blinky xy-pos@ d=
  8   pacman xy-pos@
  9   ted    xy-pos@ d=
 10   or or or ;
 11 -->
 12 
 13 
 14 
 15 

Scr# 655 
  0 ( Chomp.f )
  1 : ghost-eaten ( n -- )
  2   sprite#
  3   12 sprite x-pos c!
  4   12 sprite y-pos c!
  5   bl sprite maze  c!
  6   10 score d+!
  7   10 total d+!
  8   [  5 20 bip ] 2lit bleep
  9   [  5 10 bip ] 2lit bleep
 10   [ 10 10 bip ] 2lit bleep
 11 ;
 12 -->
 13 
 14 
 15 

Scr# 656 
  0 ( Chomp.f )
  1 : ghost-catch
  2   -1 lives +!
  3   lives @ 0= if
  4    high-score 2@ score 2@
  5    dnegate d+ 0< if
  6      score 2@ high-score 2!
  7     then
  8    0. score 2!
  9    179. total 2!
 10   then
 11   init-all
 12   interlude
 13   init-display ;
 14 -->
 15 

Scr# 657 
  0 ( Chomp.f )
  1 : catch!
  2   hunt @ 1 = if
  3    ghost-catch
  4   else
  5    4 0 do
  6     i sprite# xy-pos@
  7     pacman    xy-pos@ d= if
  8      i ghost-eaten
  9     then
 10    loop
 11   then ;
 12 -->
 13 
 14 
 15 

Scr# 658 
  0 ( Chomp.f )
  1 : count-down
  2   hunt @ -1 = if 1 counting +!
  3    56 counting @ < if
  4     ghost-color then
  5    57 counting @ < if
  6     ghost-white then
  7    58 counting @ < if
  8     ghost-color then
  9    59 counting @ < if
 10     ghost-white then
 11    60 counting @ < if
 12     ghost-color
 13     1 hunt ! then
 14   then
 15 ; -->

Scr# 659 
  0 ( Chomp.f )
  1 : put-cherry
  2   100 choose 0= if
  3    cherry sprite-put
  4    [udg] U xy-pos@ maze!
  5   then ;
  6 \
  7 : key-decode ( c1 -- c2 )
  8   case
  9   key+up of key-up endof
 10   key+down of key-down endof
 11   key+left of key-left endof
 12   key+right of key-right endof
 13   dup
 14   endcase ;
 15 

Scr# 660 
  0 ( Chomp.f )
  1 : move-pacman
  2   pacman xy-pos@ xy-pre!
  3   LASTK key-decode c@
  4 \ sprite dir c@
  5   pacman-move sprite-put
  6   xy-pos@ maze@
  7   bl xy-pos@ maze!
  8   catch? if catch! then
  9   dup pacman-eat-dot
 10   dup pacman-eat-pill
 11   dup pacman-eat-cherry
 12       pacman-walk
 13 ;
 14 -->
 15 

Scr# 661 
  0 ( Chomp.f )
  1 : move-four-ghosts
  2   4 0 do
  3    i sprite# xy-pos@ xy-pre!
  4 \  ghost-decision
  5    sprite dir c@ ghost-move
  6 \  LASTK c@      ghost-move
  7    sprite-put
  8    xy-pos@ maze@
  9    sprite maze c!
 10    catch? if catch! then
 11   loop
 12 ; -->
 13 
 14 
 15 

Scr# 662 
  0 ( Chomp.f )
  1 : dashboard
  2   0  1 at.
  3   6 16 emitc emitc \ yellow
  4   [udg] P emitc
  5   7 16 emitc emitc \ white
  6   bl emitc lives ?
  7   0  6 at. ." score "
  8   score 2@
  9   <# # # # # # # #> type
 10 ;
 11 -->
 12 
 13 
 14 
 15 

Scr# 663 
  0 ( Chomp.f )
  1 : debug
  2   2 24 at. 6 16 emitc emitc
  3   pacman xy-pos@ swap . .
  4   3 24 at. LASTK c@ .
  5 \ 22 1 at. hex sprite 8 +
  6 \ sprite (dump) decimal
  7   5 24 at. total 2@ D.
  8   7 24 at. counting @ .
  9   9 24 at.
 10   sprite maze c@ emitc
 11   0 0 at. .s
 12   11 24 at. hunt @ .
 13 \ 22 22 at. ." KEY" key drop
 14 ;
 15 -->

Scr# 664 
  0 ( Chomp.f )
  1 : heart-beat
  2   move-pacman
  3   move-four-ghosts
  4   put-cherry
  5   count-down
  6   dashboard
  7 \ debug
  8 ;
  9 : T heart-beat ;
 10 : C catch? . ;
 11 : M init-display ;
 12 -->
 13 
 14 
 15 

Scr# 665 
  0 ( Chomp.f )
  1 : phase-complete
  2   score 2@ total 2@ d= if
  3    179  total D+!
  4    init-all
  5    set-maze-run
  6    interlude
  7    init-display
  8    key-right LASTK c!
  9   then ;
 10 -->
 11 
 12 
 13 
 14 
 15 

Scr# 666 
  0 ( Chomp.f )
  1 : run-game
  2   begin
  3    lives @
  4   while
  5    heart-beat
  6    phase-complete
  7    ?terminal if quit then
  8   repeat
  9 ;
 10 -->
 11 
 12 
 13 
 14 
 15 

Scr# 667 
  0 ( Ghost.f )
  1 : game
  2   3 lives !
  3   0 paper. 0 border. 4 ink.
  4   1 bright. perm
  5 \ interlude
  6   179. total 2!
  7   0.   score 2!
  8   init-all
  9   set-maze-run
 10   init-display
 11   run-game
 12   22 0 at.
 13 ;
 14 
 15 

Scr# 762 
  0 ( DR-2 END )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 763 
  0 ( DR-3 BEGIN )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 777 
  0 1
  1 2
  2 3
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 791 
  0 ( VALUE TO )
  1 : VALUE ( x ccc -- )
  2         ( -- n )
  3  [COMPILE] CONSTANT
  4 ; IMMEDIATE
  5 \
  6 : TO ( n -- ccc )
  7  ' >BODY
  8  STATE @ IF
  9   COMPILE LIT
 10   , COMPILE !
 11  ELSE
 12             !
 13  THEN
 14 ; IMMEDIATE
 15 

Scr# 792 
  0 \ test
  1 123 VALUE XXX
  2 456 VALUE YYY
  3 789 VALUE ZZZ
  4 XXX    TO ZZZ
  5 : TEST
  6  ZZZ TO YYY
  7 ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1016 
  0 ( DR-3 END )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1017 
  0 ( DR-4 BEGIN )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1022 
  0 ( Christmas Star )
  1 4 constant m
  2 variable x variable y
  3 : XMAS* CR
  4  m 2* 1+ m 2* NEGATE DO
  5   i ABS y !
  6   m 2* 1+ m 2* NEGATE DO
  7    i ABS x !
  8    m x @ < m y @ < AND
  9    x @ y @ m - <   OR
 10    y @ x @ m - <   OR
 11    IF BL ELSE [CHAR] * THEN
 12    EMIT
 13   LOOP CR
 14  LOOP CR KEY
 15 ;

Scr# 1045 
  0 ( VALUE TO )
  1 : VALUE ( x ccc -- )
  2         ( -- n )
  3  [COMPILE] CONSTANT
  4 ; IMMEDIATE
  5 \
  6 : TO ( n -- ccc )
  7  ' >BODY
  8  STATE @ IF
  9   COMPILE LIT
 10   , COMPILE !
 11  ELSE
 12             !
 13  THEN
 14 ; IMMEDIATE
 15 

Scr# 1046 
  0 \ test
  1 123 VALUE XXX
  2 456 VALUE YYY
  3 789 VALUE ZZZ
  4 XXX    TO ZZZ
  5 : TEST
  6  ZZZ TO YYY
  7 ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1111 
  0 \ 100 LOAD  \ NEEDS ASSEMBLER
  1 CODE I HEX
  2   LDHL() 30 +ORIGIN AA,
  3 HERE
  4   LD     E'|  (HL)|
  5   INCX   HL|
  6   LD     D'|  (HL)|
  7   PUSH   DE|
  8   JPHL   C;
  9 CODE I' HEX
 10   LDHL() 30 +ORIGIN AA,
 11   INCX   HL|
 12   INCX   HL|
 13   JR     BACK, C;
 14 CODE DUMMY
 15   JPHL   C;

Scr# 1270 
  0 ( DR-4 END )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1271 
  0 ( DR-5 BEGIN )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1299 
  0 ( VALUE TO )
  1 : VALUE ( x ccc -- )
  2         ( -- n )
  3  [COMPILE] CONSTANT
  4 ; IMMEDIATE
  5 \
  6 : TO ( n -- ccc )
  7  ' >BODY
  8  STATE @ IF
  9   COMPILE LIT
 10   , COMPILE !
 11  ELSE
 12             !
 13  THEN
 14 ; IMMEDIATE
 15 

Scr# 1300 
  0 \ test
  1 123 VALUE XXX
  2 456 VALUE YYY
  3 789 VALUE ZZZ
  4 XXX    TO ZZZ
  5 : TEST
  6  ZZZ TO YYY
  7 ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1524 
  0 ( DR-5 END )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1525 
  0 ( DR-6 BEGIN )
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1553 
  0 ( VALUE TO )
  1 : VALUE ( x ccc -- )
  2         ( -- n )
  3  [COMPILE] CONSTANT
  4 ; IMMEDIATE
  5 \
  6 : TO ( n -- ccc )
  7  ' >BODY
  8  STATE @ IF
  9   COMPILE LIT
 10   , COMPILE !
 11  ELSE
 12             !
 13  THEN
 14 ; IMMEDIATE
 15 

Scr# 1554 
  0 \ test
  1 123 VALUE XXX
  2 456 VALUE YYY
  3 789 VALUE ZZZ
  4 XXX    TO ZZZ
  5 : TEST
  6  ZZZ TO YYY
  7 ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

Scr# 1560 
  0 ( DISCiPLE last block )
  1 DISCiPLE disk has 80 tracks
  2 for 10 sectors each.
  3 
  4 First 40 sectors are system
  5 reserved.
  6 
  7 This Forth system uses Drive
  8 #2 and uses a low-level
  9 direct access to sectors.
 10 
 11 This appears as a single
 12 text file 780 KBytes long.
 13 
 14 
 15 

Scr# 1778 
  0 ( Mirodrive last block )
  1 Emulator provides 8 micro-
  2 drive units.
  3 
  4 The first unit is used to
  5 keep the system loader and
  6 the other 7 units are used
  7 to store blocks.
  8 
  9 This Forth System uses a
 10 low-level direct access to
 11 sectors.
 12 
 13 This appears as a single
 14 file spread across 7
 15 cartridges.