A COLLECTION OF TOOLS, aids, aliases and extentions   09dec84japthat may be a prerequsite to other extentions writen by me.                                                                     It is here that I first try out ideas as an overlay to F83.                                                                                                                                     The screens are 83 standard FORTH Laxen/Perry Model 2.1.1       They may be copied and improved, but they may not be sold.                                                                           John A. Peters                   F.I.G. Librarian               121 Santa Rosa Ave.              c/o FIG Tree BBS               San Francisco, CA 94112          (415) 538-3580 300 bps                                                                         Phone Voice (415) 239-5393 8-9 am or after 7 pm                 or Computer Language Mag. BBS 957-9370 SF 1200-300 bps                                                                     \ LOADER BLOCK                                        27nov84japCR .( Loading ) FILE? CR                                         8 VIEWS TOOLS.BLK                                              2   CAPACITY 2 /   THRU                                         Title Tools_&_Improvements                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      \ Tools                                               27nov84jap: RE  scr @ ;  ( -- )                                             variable TEMP                                                 : ANY?   ( n1, n2-etc count target -- )                           DUP 1+ ROLL TEMP !  0 SWAP 0 DO SWAP TEMP @ = OR LOOP ;       : YES?   ( n -- )                                                 ascii y ASCII Y 2 ANY? ;                                      : INCREMENTER   ( -- )  \ A defining word.                        CREATE   0 ,   DOES>   1 OVER +! @ ;                          : PATCH   ( New Old -- )     BEEP                                 [COMPILE] ' [COMPILE] ' >BODY DUP >R ! ['] EXIT R> 2+ ! ;                                                                                                                                                                                                                                                                                                                                     \ Configure the HELLO and the Printer                 08DEC84JAP' EPSON IS INIT-PR                                              ' (WHERE) IS WHERE   .( WHERE feature is activated.) cr         : HELLO                                                           CR ." 8080 Forth 83 Model 2.1.1"                                CR ." Released on April 1, 1983"                                cr ." No Visible Support Software"                              cr ." Box 1344, 2000 Center Street"                             cr ." Berkeley, California 94704"    cr                         CR ." Tools-Mods by John A. Peters"                             CR ." (415) 239-5393 Let's talk Forth"                          CR ." Latest compilation was on       08DEC84JAP " CR           EMPTY-BUFFERS  ONLY FORTH  ALSO DEFINITIONS DEFAULT ;           ' HELLO IS BOOT                                               : STAMPER [ EDITOR ] ID 3 BLOCK 11 C/L * +  40 + ID-LEN 1-        CMOVE UPDATE SAVE-BUFFERS ;                                   \ Alias plus DO-THRU and DO-TO                        06dec84jap: DO-THRU   ( from thru -- )                                       compile 1+  compile swap  compile (?DO)  ?>mark ;  immediate : DO-TO   ( from thru -- )                                         COMPILE 1+  COMPILE 1  COMPILE (?DO)  ?>mark ; IMMEDIATE     : E-B   ( -- )      EMPTY-BUFFERS  ." Buffers Empty " ;         : SAVE-BUFFERS  ( -- )   N  SCR @  BLOCK DROP  B  ( CP/M buff )  ( redefined )  SAVE-BUFFERS ;                                  .( to include flushing thru the CP/M buffer too.) cr            : S-B   ( n-- )     SAVE-BUFFERS   ." Buffers Saved " ;         : S-S   ( -- )  CR ." Saving the System "  SAVE-SYSTEM  ;       : C-F   ( n -- <filename.typ> )  CREATE-FILE ;                                                                                                                                                                                                                                                                                  \ Intellegent pre-buffered LISTing                    06dec84jap: GET-SCR#   ( -- )                                               [ EDITOR ] DONE ( Listing on top of the editor is messy.) CR    DEPTH 0= IF  SCR @  THEN DUP   SCR ! ;                        : L   ( -- )  dark GET-SCR#    LIST ;                             .( Intellegent to choose the stack or SCR ) cr                : STOP-IT?  ( -- f )  ASCII Q  ASCII q  27 ( ESC ) 3   ANY? ;   : ETC   ( scr -- )                                                 BEGIN   DUP   DARK LIST                                         DUP 1+  BLOCK DROP  KEY bl =                                    WHILE   1+ DUP  SCR !   REPEAT   ." Quit Etc." ;                                                                                                                                                                                                                                                                                                                                             \ Editor and Shadow improvements                      05dec84jap: %MARK  ( scr -- )  ASCII % SWAP BLOCK ! ;                     : WIPE-COLONS  ( n -- )                                           1 15 1+ SWAP DO  DUP BLOCK I C/L * +  C/L 2 DELETE              LOOP DROP ;                                                   : SM  ( n -- )    \ n is the source screen number                 1 ?ENOUGH  DUP [ SHADOW ] >SHADOW SWAP OVER  [ FORTH ] COPY     DUP %MARK  WIPE-COLONS ;                                      : SHADOW-MAKER   ( n -- ) SM ;  \ Just an alias.                SHADOW DEFINITIONS                                              : MORE  ( n -- ) DUP 2 / HOP   CAPACITY DUP 2 / SWAP 2 PICK       [ FORTH ] MORE CONVEY   DROP ;   FORTH DEFINITIONS                                                                                                                                                                                                                                                                            \ EDITOR DEFINITIONS \                                07dec84jap                                                                : NOW  ( n -- )  SCR ! ;                                        EDITOR DEFINITIONS                                              : KILL  ( n -- )                                                  SCR @ BLOCK   SWAP   C/L * +   C/L BLANK   UPDATE ;           FORTH DEFINITIONS                                               : IND   DEPTH 0= IF 0 THEN   CR FILE?  IND ;                      .( Starts at zero if stack empty gives file name.) cr         : INDD  ( -- )  \ Stops at shadows                                0  CAPACITY 2 /MOD + 1-  INDEX ;                              : inddd                                                           0 block dup  64 type cr  64 + dup   64 type cr  64 + dup        64 type  indd ;                                                                                                                                                                               EDITOR DEFINITIONS \                                  27nov84jap: SL  ( -- )   COL# NEGATE C ;               \ Start of line.   : EL  ( -- )  C/L COL# -   1-  C  ;          \ End of line.     : NL  ( -- )  C/L  C ;                       \ Next line.       : VV  ( -- )  SL   C/L C ;                   \ Down one line.   : TAP ( n -- )  OUT @ NEGATE SWAP SPACES ;                      : OF  ( n -- )  DO-TO   ['] EXECUTE   LOOP ; \ n Lines do       FORTH DEFINITIONS                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               \ CLIST  by Dudley  ( Needs word wrap but is OK )     01APR84JAPVARIABLE CH                                                     : CELLS   2 * ;                                                 : CLIST    CR                                                      BL WORD DROP                                                    CONTEXT @  PAD #THREADS CELLS   CMOVE                           BEGIN PAD #THREADS LARGEST                                       DUP                                                              IF DUP L>NAME 1+ C@ 127 AND HERE 1+ C@ =                          IF DUP L>NAME .ID CH @ 20 >                                        IF CR 0 ELSE 20                                                 THEN CH C!                                                   THEN    @ SWAP ! 1                                            THEN 0=                                                       UNTIL DROP ;                                                 \ Word wrap can be added, see WORDS for an example.             \ System stuff                                        06dec84jap: MOUNT   EMPTY-BUFFERS [ DOS ] RESET ;                         \ : A:  [ DOS ] RESET   0 SELECT ." Drive A"  ;   cr            \ : B:  [ DOS ] RESET   1 SELECT ." Drive B"  ;                 \ .( Reset added. ) cr                                          : QUIET  ( -- )  8 5 PC! ;                                      : KEY-LOUD  ( -- ) 0 5 PC! ;                                    : TURNKEY   ( word -- )  ['] IS BOOT ;                                                                                          : "LOADER" ( --a\l) " LOADER.BLK" ;                             : OPENCOMP ( --) ['] "LOADER" IS SOURCE >IN OFF                    OPEN ['] (SOURCE) IS SOURCE ;                                                                                                                                                                                                                                                                                                EDITOR DEFINITIONS \ Experimental                     27nov84jap: Q   ( -- )                                                      [ EDITOR ]  EDITING? @                                          IF  PREVIOUS ( order ) EDITING? OFF  >UPDATE OFF DONE           CR ." Quit screen " SCR ? ." W/O saving."                       ELSE ." Not in Editor "                   THEN ;              FORTH DEFINITIONS                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               \ Configure to my tastes.                             08dec84japFORTH DEFINITIONS                                               : (WHERE)   ( pos scr -- )   DISK-ERROR @ 0=                       IF  EDIT [ EDITOR ]  'WORD COUNT 'FIND   PLACE 1- C THEN  ;   .( Better factorng here ) cr                                     ' (WHERE) IS WHERE                                            : (LOC)   ( acf -- )  @VIEW   ?DUP                                 #out @ dup 40 >  if cr else 60 swap - spaces then               1+ IF   2* VIEW-FILES + @             2DUP >BODY .FILE           ." Scr."  (.) type drop                                        ELSE  ." may be in current file: "  FILE? ." screen " DUP .     THEN  drop ;                                                 : LOC  ( -- )  [ DOS ] '   (LOC) ;                              : SEE  ( -- )  ' DUP (SEE)   #out @ 45 > if                       cr then 8 spaces    (LOC)  ; .( Shows screen and file # )     : VOC?  ( -- )  CURRENT @ BODY> >NAME .ID ;                     \ LOOK documents a word on the dommand line.          27nov84jap: SCHROLL  ( -- )  [ EDITOR ]                                     0 17 AT  DX BLOT  DX 18 AT  -LINE  DX 23 AT  #OUT OFF           [ FORTH ] ;                                                   : .NEXT-LINE  ( adr -- ) [ EDITOR ] SCHROLL 64 + DUP 64 TYPE ;  : HERALD ( scr offset f -- )                                      IF   SWAP BLOCK +  .NEXT-LINE .NEXT-LINE .NEXT-LINE  DROP       ELSE 2DROP THEN  ;                                            : (LOOK)  ( 'word len scr --  offset f )                          2 PICK BLOCK  64 + 1023 64 -  SEARCH ;                        : LOOK  ( scr <word> -- scr offset flag )                         BL WORD COUNT (LOOK) ;                                                                                                                                                                                                                                                                                                        \ VIEW is factored and extended. LOC DOCUMENT DOC     01dec84jap: (VIEW)   ( <word> -- scr )   [ DOS ]  ' @VIEW  ?DUP             IF   2* VIEW-FILES + @   2DUP >BODY                             ." is in " .FILE  ." screen " .   EXECUTE OPEN-FILE             ELSE  ." VIEW-FILE # not initalized screen " DUP .              THEN  ;                                                                                                                       : VIEW  ( word -- )   (VIEW)  dark LIST ;                       \ : LOC   ( word -- )   (VIEW)  DROP ; \ bad opens file!        : DOCUMENT  ( word -- )   (VIEW)  CAPACITY 2 / +                  ." shadowed by " DUP . LIST ;                                 : DOC  ( word -- )                                                (VIEW)   CAPACITY 2 / +  'WORD COUNT 1+ (LOOK)  HERALD ;      : #FILE  ( n -- ) \ opens n file                                  2* view-files + @  execute [ dos ] open-file [ forth ]          FILE? ." now open." cr ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      exit READ READ-LINE #LINES (READ)                     09dec84japVariable LEAVE?                                                 : ?ESC ( Chr --  Chr )  DUP ESC = IF  TOCONSOLE                    ." ++ LOCAL FORTH ++"  ABORT  THEN ;                         cr .( From MODEM.BLK screen 4 lines 8 - 9 ) cr                  : READ-LINE     ( addr -- )   C/L                                 0 ?DO   COUNT key? if key ?esc drop then                        DUP  ASCII ^  =    IF  TRUE LEAVE? !   DROP  LEAVE  THEN        EMIT   LOOP DROP CR ;                                         Defer READ                                                      15 Constant #LINES                                              : (READ)  ( scr -- )                                              FALSE LEAVE? !                                                  BLOCK 64 +   #LINES 0   DO  DUP I C/L * +   READ-LINE           LEAVE? @   IF LEAVE  THEN  LOOP DROP ;                        ' (READ) is READ  \ For now till I revector it later.           \ Q ( As in Quit The Editor )                         21MAY84JAPEDITOR DEFINITIONS                                              : Q  ( -- )                                                       [ EDITOR ]  EDITING? @                                          IF  PREVIOUS  EDITING? OFF >UPDATE OFF   DISK-ERROR OFF         ." QUIT screen " SCR ? ." without saveing buffers."             THEN ;                                                        FORTH DEFINITIONS                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               \ RELOAD (RELOAD) RESCIND HAVE   ( aka AGAIN )        25OCT84JAP: HAVE                                                            DEFINED NIP 0<> ;                                             : RESCIND                                                         >IN @ BEGIN DUP >IN ! HAVE WHILE DUP >IN ! FORGET REPEAT        DROP ;                                                        : (RELOAD)                                                        ['] BL IS CREATE   >IN @  RESCIND  >IN ! BL ;                 : RELOAD                                                          ['] (RELOAD) IS CREATE RE LOAD ;                                      \S                                                        How to make it rember where it is while executing from the    load command called THRU  ?                                                                                                                                                                                                                                     % notes                                               08nov84japSee the file load.blk.  That is where the view field is         installed for each file created since the original release.         You will want to do the same for the files you create.      Look on screen one and two of that file.                            We are hoping to change the view field algorithim to make   more file numbers available.  Right now we are limited to 16.   Here is the new one that s/b used.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              % ANY?  TEMP  RE                                      27nov84japRE  ( -- )  Example  RE LOAD                                    TEMP  a variable used to temporarily store the sample.          ANY?  ( n1,n2,etc count-of-samples target -- )                    Check for any one of the samples that matches the target.     YES?   ( n -- f )                                                 Return a true flag if user types either Y or y .              INCREMENTER   ( -- )                                              Incrementer NEXT-ONE will count up one each time it is called.PATCH  ( Patch new old -- )  A quick dirty and dangerous way to   A defininge word i.e. INCREMENTER  NEXT-TARGET                  In this case Next-target will count up returning a number       higher by one, each time it is called.                                                                                                                                                                                                                        % PRINTER CONVERT TO EPSON                            27nov84japEPSON is installed in the defered word INIT-PR.                                                                                 HELLO+  Here is where I added my name to the greeting.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          % AIDS AND TOOLS  LOC CA A P E-B S-B ( Trick )        06NOV84JAPDO-THRU  Automatically sets up the DO part of a look by adding           the 1+ and the SWAP for a one based loop (Not zero)    DO-TO  Compile all the elements required to set up for a               do loop that will count to the specified number.         E-B  Short hand for empty-buffers.                              S-B  Tricks the 1k CP/M buffer in to being saved also!          S-S  Short for Save-system  (Follow it with a file mame)        C-F  Short for Create-File    "    "    "  "  "    "                                                                                                                                                                                                                                                                                                                                                                                                                                                                            % GET-SCR#  L  Q?  ETC                                1JULY84JAPGET-SCR#                                                          If depth is 0 then fetch the number at SCR.                                                                                   L  Intellegent version of list.                                 ETC  ( n -- )                                                     Lists screens one after the other.  To save time it prebuffers  the screen after the one listed.  Updates SCR.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                % EDITOR IMPROVEMENTS AND PERSONAL TASTE CHANGES      08nov84jap%MARK  ( scr -- )                                                 Mark the shadow screen with a percent mark in the corner.     WIPE-COLINS and move the words over to the left margin.           Used in the preperation of shadow screens.                    MS  ( n -- )  Make a shadow of the source screen at the >SHADOW   location with the words moved to the left border.               Put the shadow screen number in to SCR incase you want to editMAKE-SHADOW  ( n -- ) Make a shadow screen with the colins        deleted ready for you to over type to make documentation.     MORE  ( n -- ) This version of MORE is in the SHADOW vocabulary.  It CONVEYS the shadows properly, to maintain the relationship   to the source and work properly with the alternate command.^                                                                                                                                                                                                  % EDITOR AIDS AND ALISES   S Q                        25NOV84JAP                                                                NOW ( n -- )  Make n the current screen in SCR.                                                                                 KILL  ( n -- )  Kill the line, w/o closing it up.                                                                               INDD  Index.  Starts at the number on the stack or else at zero.                                                                IND   Index from zero to just before the shadow screens.                                                                                                                                                                                                                                                                                                                                                                                                                                                                        % WORD-OF  Give me the ID of the Nth word in <word>   06NOV84JAPWORD-OF  ( n WORD-OF <word> -- )                                Zero based   each word counts as one                            EXAMPLE:   6 word of VIEW  ( CR )  VIEW-FILES                   SL     Start of the line.                                       EL     End of the line.                                         NL     Next line, same position horizontally.                   V      Down one lilne, same position.                           Q      Up one line,  "        "                                 TAP                                                             OF                                                                                                                                                                                                                                                                                                                                                                                              % CLIST  by Dudley                                    08nov84japCH is the location that the APPLE hardware stores the location  of the cursor.  In this case we are faking it as it is not      available                                                       CLIST                                                              Show a Character List of all the words in the vocabulary that   start with the character <c>.  May require caps.                   This word is not finished.  It is from the Apple version.    However the translation brought to light the fact that the      Lyons version of 6502 f83 forth does not have the link field    in front of the name field as does the L.P. F83.  The link      field was moved in to the front to speed up the search          during compilation                                              Word wrap can be added using WORDS as a model...                   See HUNT as a better and more versitile word.                                                                             \ a: b:                                               03NV84JAP A:   Reset the drive and select drive A.                        B:   Reset the drive and select drive B.                                                                                                                                                        QUIET the keyboard click                                                                                                        TURNKEY  Install an application run type command to start at                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    %EXPERIMENTAL Q (As in Quit)                         08nov84jap                                                                Q   ( -- )                                                        Quit the Editor                                                 A way to get out of the editor w/o having to save any changes.  I haven't used it much but it is noce to have.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                % LOC  GET-SCR  LOOK DOC                              24nov84jap(WHERE)                                                           fixes a bug in the find buffer offset.  See the 1-  after the word place.  Installs the fixed version.                        LOC  ( word -- ) ( Short for Locate. )                            Locate the screen number of the source along with the           name of the file and print it on the screen.                  DOCUMENT  ( <word> -- )                                            name of the file and print it on the screen.                                                                                 DOCUMENT                                                           List the full screen of documentation describing the word.      It works like VIEW with the addition of CAPACITY 2 / + .        A candidate for factoring...                                                                                                                                                                 \ LOOKS LOOK HERALD                                   03NV84JAP SCHROLL  ( -- )                                                   Like CR but only affects the command lines with out disturbing  the 16 lines of the editor.                                   .NEXT-LINE  ( adr -- ) Print the next line of the documentaton. HERALD  ( scr offset f -- )                                       Print the first three lines of the shadow screen under the      curent screen from the OFFSET returned by SEARCH.             (LOOK)  ( 'word len scr --  offset f )                            Look for a word in a screen ignoring the index line.          LOOK  ( scr <word> -- scr offset f )                              Parse the word entered for (LOOK)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   23nov84jap                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      08nov84jap                                                                Q  ( -- ) Quit the editor w/o saving the buffer.                    In case don't want to save the cchanges.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    % RELOAD (RELOAD) RESCIND HAVE                        20OCT84JAPHAVE   Check to see if we HAVE the word in the dictionary.                                                                      RESCIND    As long as we still have one in the dictionary keep   forgetting it from a loop till there are none.  ( danger )                                                                     (RELOAD)   Look through the dictionary and forget the first     word on the screen and then load the screen.  (Reload) is       vectored in to BL (first word in create) by RELOAD.                                                                             RELOAD   ( -- )                                                 Forget the first word compiled from the screen and recompile    The result is a clean dictionary instead of a bunch of duplicatewords as is the usual result of a re load.                                                                                      Note: The BL is merely the first word of CREATE's definition.