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.
