Benutzer-Werkzeuge

Webseiten-Werkzeuge


projects:editor.blk

Mode-less full feature text editor

0 list Screen 0 not modified     
 0 \ VEDIT  - FORTHSTAR  SCREEN EDITOR            22:23JWB11/11/85 
 1 \ Last change:   Screen  068                   21:11JWB11/13/85 
 2 Before loading the editor make the following changes to your    
 3 UTILITY.BLK  Screen File.                                       
 4                                                                 
 5 DEFER EDIT   ' LIST IS EDIT  \ Screen 6 Line 14 :  add this line
 6                                                                 
 7    THEN  EDIT  ;   \ Screen 7 Line 15  replace LIST with EDIT   
 8                                                                 
 9 ALSO !!   The recompiled system will overwrite the file         
10           FORTH83.COM  on the disk in drive 1.                  
11                                                                 
12   DO YOU HAVE A BACKUP  INCASE SOMETHING GOES WRONG!!           
13                                                                 
14   PRESS   C   TO CONTINUE THE LOAD  ANY OTHER TO ABORT!!        
15                                                                 

1 list Screen 1 not modified     
 0 \ EDITOR LOAD BLOCK                            22:27JWB11/11/85 
 1 : ARE.YOU.SURE?  0 LIST  KEY ASCII C <> ABORT" LOAD CANCELED" ; 
 2   ARE.YOU.SURE?                                                 
 3 CR .( LOADING  VEDIT EDITOR AND REBUILDING  SYSTEM )            
 4 ONLY FORTH DEFINITIONS ' NOOP IS WHERE                          
 5  ' P!     >NAME    FENCE !  FORGET FUDGE  4 VIEW# !             
 6   FROM UTILITY.BLK   2 LOAD     CR .( UTL     LOADED )          
 7   FROM UTILITY.BLK  22 LOAD     CR .( SHADOW  LOADED ) CR       
 8    5 VIEWS   EDITOR.BLK  5 VIEW# !                              
 9    4 124 THRU  CR .( EDITOR LOADED ) 4 VIEW# !                  
10   FROM UTILITY.BLK  28 LOAD     CR .( DUMPING LOADED)           
11   FROM UTILITY.BLK  31 LOAD     CR .( SEEING  LOADED)           
12   FROM UTILITY.BLK  43 LOAD     CR .( SHOWING LOADED)           
13   FROM UTILITY.BLK  49 LOAD     CR .( BUGGING LOADED)           
14   FROM UTILITY.BLK  52 LOAD     CR .( TASKING LOADED)           
15   WARNING ON -->                                                

2 list Screen 2 not modified     
 0 \ Load up the system                           18:51jwb11/05/85 
 1   5  VIEW# !                                                    
 2 : HELLO   (S -- )                                               
 3    CR ." 8086 Forth 83 Model"                                   
 4    CR ." Version 2.1.0     01Jun84"                             
 5    CR ." Recompiled        08Nov87"                             
 6    CR ." VEDIT by JW Brown 13Nov85" CR                          
 7    START   ONLY FORTH ALSO DEFINITIONS   ;   ' HELLO IS BOOT    
 8                                                                 
 9 : MARK    (S -- )                                               
10    CREATE    DOES> (FORGET)  FORTH DEFINITIONS  ;               
11 MARK EMPTY     HERE FENCE !                                     
12 CR .( System has been loaded, Size = ) HERE U.                  
13 ( EXIT )  \ Remove brackets on EXIT when testing mods to EDITOR 
14                                                                 
15 SAVE-SYSTEM FORTH83.COM CR .( System saved as FORTH83.COM )     

4 list Screen 4 not modified     
 0 \ Define vocabularies, set up search order     23:16JWB11/04/85 
 1                                                                 
 2 ONLY FORTH DEFINITIONS VOCABULARY EDITOR                        
 3                                                                 
 4 ONLY FORTH ALSO ROOT   DEFINITIONS                              
 5                                                                 
 6 : EDITOR EDITOR ;                                               
 7                                                                 
 8 ONLY FORTH ALSO EDITOR ALSO DEFINITIONS  DECIMAL                
 9                                                                 
10 ORDER                                                           
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

5 list Screen 5 not modified     
 0 \ VIDEO-IO                                     23:15JWB11/04/85 
 1 \ Call video-io BIOS routines with type $10=16 INTerupt.        
 2 CODE VIDEO-IO  ( dx cx bx ax   dx' cx' bx' ax')                 
 3         AX POP          \ Pop all registers.                    
 4         BX POP                                                  
 5         CX POP                                                  
 6         DX POP                                                  
 7         RP PUSH         \ Save return stack pointer = BP        
 8         16 INT          \ Call video io routines.               
 9         RP POP          \ Restore return stack pointer.         
10         DX PUSH         \ Return all registers to user.         
11         CX PUSH                                                 
12         BX PUSH                                                 
13           1PUSH         \ Push AX and fall into NEXT            
14            END-CODE                                             
15                                                                 

6 list Screen 6 not modified     
 0                                                                 
 1  VARIABLE $KBF                                                  
 2 \ Leave true flag if KBF has changed.  New value in $KBF .      
 3 CODE KBF?  ( --  flag ) \ Was:  $KBF @ KBF DUP $KBF ! <>        
 4         2 # AH MOV      \ Function number 2 for kb flag         
 5             22 INT      \ Call KBF is returned in AL            
 6          AH AH SUB      \ Clear high byte of AX.                
 7      $KBF # DI MOV      \ Address of old KBF to DI              
 8     0 [DI]  BX MOV      \ Fetch old value of KBF                
 9          AX BX CMP      \ Compare new value with old.           
10 0= IF    AX AX SUB      \ Leave false flag if the same          
11  ELSE AX 0 [DI] MOV     \ Update $KBF and                       
12        -1 # AX MOV      \ return true if KBF has changed.       
13  THEN          1PUSH    \ Push AX and fall into NEXT            
14                END-CODE                                         
15                                                                 

7 list Screen 7 not modified     
 0 \ INIT-WINDOW                                  23:28JWB11/04/85 
 1 \ Scroll active page up.                                        
 2 CODE INIT-WINDOW ( ulc ulr lrc lrr atrib   -- )                 
 3           AX  POP   AL BH MOV   \ ulc=upper left column         
 4           AX  POP   AL DH MOV   \ ulr=upper left row            
 5           AX  POP   AL DL MOV   \ lrc=lower right column        
 6           AX  POP   AL CH MOV   \ lrr=lower right row           
 7           AX  POP               \ Attribute byte used.          
 8        AL CL  MOV               \ 07 is for normal text.        
 9    1536 # AX  MOV               \  1536 = 600 hex               
10           RP  PUSH                                              
11           16  INT                                               
12           RP  POP                                               
13           NEXT   END-CODE                                       
14                                                                 
15                                                                 

8 list Screen 8 not modified     
 0 \ GOTOXY  AT {KEY}                             18:43jwb11/05/85 
 1 \ Move cursor to new location at (col,row).                     
 2 CODE AT (S col row   -- )                                       
 3         AX POP          \ Get cursor row.                       
 4         DX POP          \ Get cursor column.                    
 5      AL DH MOV          \ Pack into DX for function call.       
 6      BH BH XOR          \ Set screen page number to zero.       
 7    2  # AH MOV          \ Function 2 is set cursor position.    
 8         16 INT          \ Call video io                         
 9            NEXT         \ Next word please.                     
10            END-CODE                                             
11 : GOTOXY  AT ;                                                  
12 \ Wait for key without checking break key!!                     
13 : {KEY} (S --  char )                                           
14          0 7  BDOS  255 AND  ;                                  
15                                                                 

9 list Screen 9 not modified     
 0 \ KBF  @DATE                                   18:43jwb11/05/85 
 1 \ Return the current state of the keybord flag  KB_FLAG         
 2 CODE KBF  ( --  kbf )                                           
 3         2 # AH MOV      \ Function number 2 for kb flag         
 4             22 INT      \ Call routine.                         
 5          AH AH SUB      \ Clear high byte of AX.                
 6                1PUSH    \ Push AX and fall into NEXT            
 7                END-CODE                                         
 8 \ Fetch date from DOS.  Returned in packed form, see (.DATE)    
 9 CODE @DATE ( --  year mmdd )                                    
10     42 ( 2A) # AH MOV                                           
11     33 ( 21)      INT                                           
12     CX            PUSH                                          
13     DX            PUSH                                          
14             NEXT  END-CODE                                      
15                                                                 

10 list Screen 10 not modified     
 0 \  @TIME  TSMH  TT SS MM HH                    18:49jwb11/05/85 
 1 \ Fetch time from DOS.  Returned packed in TSMH .               
 2 CREATE TSMH 4 ALLOT                                             
 3                                                                 
 4 : TTT TSMH    C@ ;   : SSS TSMH 1+  C@ ;                        
 5 : MMM TSMH 2+ C@ ;   : HHH TSMH 3 + C@ ;                        
 6                                                                 
 7 CODE  @TIME ( --  -- )                                          
 8     44 ( 2C) # AH MOV                                           
 9     33 ( 21)      INT                                           
10         TSMH # DI MOV                                           
11        DX  0 [DI] MOV                                           
12        CX  2 [DI] MOV                                           
13             NEXT  END-CODE                                      
14                                                                 
15                                                                 

11 list Screen 11 not modified     
 0 \ ATRIB VEMIT                                  20:18JWB11/07/85 
 1   VARIABLE  ATRIB    \ Current character attribute.             
 2                                                                 
 3 \ Emit character according to current attribute in ATRIB        
 4 CODE VEMIT   ( char   -- )                                      
 5        ATRIB # DI MOV     \ First output a space with           
 6         0 [DI] BX MOV     \ with the color attribute.           
 7         2336 # AX MOV     \ 0920HEX                             
 8            1 # CX MOV     \ Number of spaces to output.         
 9                16 INT     \ Bios function call.                 
10                AX POP     \ Fetch character to output.          
11           14 # AH MOV     \ Now output actual character         
12                16 INT     \ this time cursor will advance       
13        #OUT #  DI MOV     \ to the next legal position.         
14            0 [DI] INC     \ Increment FORTH's character count.  
15             NEXT    END-CODE                                    
 
12 list Screen 12 not modified     
 0 \  (KEY?)                                      20:07   03/14/86 
 1                                                                 
 2                                                                 
 3 \ Skan for key press returning true if key is down.             
 4 CODE (KEY?)  ( --  flag )                                       
 5                  1 # AH MOV                                     
 6                      22 INT                                     
 7         0= IF    0 # AX MOV        \ FALSE if no key press.     
 8            ELSE -1 # AX MOV        \ TRUE  if key pressed.      
 9            THEN                                                 
10                        1PUSH  END-CODE                          
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

13 list Screen 13 not modified     
 0 \  CUR@    CUR!                                23:58JWB11/04/85 
 1 CODE CUR@ ( --  rc )  \ Fetch cursor position as 16-bit word.   
 2         3 # AH MOV                                              
 3          BH BH SUB                                              
 4             16 INT                                              
 5             DX PUSH                                             
 6                NEXT                                             
 7                END-CODE                                         
 8 \ Restore cursor position, row in hi byte col in low byte.      
 9 CODE CUR! ( rc  -- )                                            
10         2 # AH MOV                                              
11          BH BH SUB                                              
12             DX POP                                              
13             16 INT                                              
14                NEXT                                             
15                END-CODE                                         

14 list Screen 14 not modified     
 0 \  MATCH                                       14:12JWB06/16/85 
 1 ASSEMBLER DEFINITIONS                                           
 2                                                                 
 3 LABEL MATCH2   \ Leaves flag & byte advance                     
 4         SI AX MOV       \ Current cursor address.               
 5            SI POP       \ Original cursor address.              
 6         SI AX SUB       \ Byte count to advance.                
 7         DI SI MOV       \ Restore interpretive pointer.         
 8  ( dx ax )   2PUSH      \ Flag, 0 no match, non zero match.     
 9                         \ Byte count to advance.                
10                                                                 
11 LABEL MATCH1                                                    
12         CX POP CX POP CX POP CX POP                             
13         MATCH2 #) JMP                                           
14 EDITOR DEFINITIONS                                              
15                                                                 

15 list Screen 15 not modified     
 0 \ MATCH                                        14:12JWB06/16/85 
 1                                                                 
 2 CODE    MATCH CLD       \ Set for auto increment.               
 3         SI DI MOV       \ Save interpretive pointer.            
 4            CX POP       \ String length.                        
 5            BX POP       \ String address.                       
 6            DX POP       \ Byte count to end of screen.          
 7            SI POP       \ Address of cursor on screen.          
 8            SI PUSH      \ Save copy of cursor address.          
 9 BEGIN      AL LODS      \ Fetch byte from screen.               
10     0 [BX] AL CMP       \ Compare with string.                  
11 0= IF      DX PUSH      \ Possible match, save                  
12            BX PUSH      \ current position.                     
13            CX PUSH                                              
14            SI PUSH                                              
15                                                                 

16 list Screen 16 not modified     
 0 \ MATCH                                        14:12JWB06/16/85 
 1                                                                 
 2 BEGIN       CX DEC      \ Decrement string length.              
 3         MATCH1 JE      \ If zero we have a match.               
 4             DX DEC      \ Decrement bytes to end of screen.     
 5      MATCH1    JE       \ If zero we are at end of screen.      
 6             BX INC      \ Increment string address.             
 7             AL LODS     \ Get next byte from screen.            
 8      0 [BX] AL CMP      \ Compare with string byte.             
 9 0<> UNTIL   SI POP      \ Restore pointers and counts.          
10             CX POP                                              
11             BX POP                                              
12             DX POP                                              
13 THEN        DX DEC      \ Decrement byte to end of screen       
14 0= UNTIL    MATCH2 #) JMP                                       
15         END-CODE                                                

17 list Screen 17 not modified     
 0 \ (OF)                                         14:12JWB06/16/85 
 1 \ EQUIVALENT TO   OVER = IF  DROP                               
 2 CODE (OF)                                                       
 3            AX   POP    BX  POP                                  
 4        BX  AX   CMP                                             
 5      0<> IF BX  PUSH                                            
 6      0 [IP] IP  MOV                                             
 7                 NEXT                                            
 8      THEN   IP  INC                                             
 9             IP  INC                                             
10                 NEXT END-CODE                                   
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

18 list Screen 18 not modified     
 0 \ CASE OF ENDOF ENDCASE                        14:12JWB11/08/87 
 1 ( see FORTH DIMENSIONS, II/3 page 37 )                          
 2                                                                 
 3 : CASE          CSP @ !CSP TRUE ; IMMEDIATE                     
 4                                                                 
 5 : OF            ?CONDITION COMPILE (OF) ?>MARK ; IMMEDIATE      
 6                                                                 
 7 : ENDOF         COMPILE BRANCH ?>MARK                           
 8                 2SWAP  ?>RESOLVE TRUE  ; IMMEDIATE              
 9                                                                 
10 : ENDCASE       ?CONDITION  COMPILE DROP BEGIN SP@              
11                 CSP @ = 0= WHILE ?>RESOLVE                      
12                           REPEAT CSP ! ; IMMEDIATE              
13                                                                 
14                                                                 
15                                                                 

19 list Screen 19 not modified     
 0 \ FIRSTF  NEXTF                                14:50   11/10/85 
 1 \ Search for first match of file spec at adr.                   
 2 CODE FIRSTF ( adr   flag )                                      
 3            DX  POP      \ Offset of ASCIIZ file specification.  
 4          CX CX XOR      \ Set attribute to 0 for normal files.  
 5       78 #  AH MOV      \ Searh for first match.                
 6             33 INT                                              
 7 U>= IF   AX AX XOR  THEN   \ Carry flag set if error.           
 8               1PUSH        \ Push AX containing the error code. 
 9            END-CODE                                             
10 \ Search for next file match.                                   
11 CODE NEXTF  ( --   flag )                                       
12       79 #  AH MOV      \ Search for next match.                
13             33 INT                                              
14 U>= IF   AX AX XOR  THEN      \ Carry set if error.             
15               1PUSH END-CODE  \ Push error flag.                

20 list Screen 20 not modified     
 0 \ DBUFF ADD*.*  ADD*.*?                        15:21JWB11/10/85 
 1  128 CONSTANT DBUFF                                             
 2 \ Add *.* to file spec at adr.                                  
 3 : ADD*.*  ( adr  adr )                                          
 4           DUP " *.*" ROT COUNT  +   SWAP CMOVE                  
 5                  DUP C@ 3 + OVER C! ;                           
 6 \ Add *.* if null spec or drive spec only.                      
 7 : ADD*.*? ( adr  adr )                                          
 8          DUP C@ 0=                      \ Null spec?            
 9          IF   ADD*.*                    \ Add *.* if so.        
10          ELSE DUP C@ 2 =                \ Maybe drive only.     
11               IF DUP 2+ C@ ASCII : =    \ Is it drive spec?     
12                    IF  ADD*.*           \ Add *.* if so.        
13          THEN THEN THEN ;                                       
14                                                                 
15                                                                 

21 list Screen 21 not modified     
 0 \ DISP-FNAME                                   15:35JWB11/10/85 
 1 \ Display a filename and size from DOS scratch area at HERE     
 2 : DISP-FNAME                                                    
 3      #OUT @ IF 3 SPACES   THEN DBUFF 42 + DBUFF 30 +            
 4          DO   I  C@ ?DUP                                        
 5               IF    DUP BL >                                    
 6                     IF   DUP ASCII A >=                         
 7                          OVER ASCII Z <= AND                    
 8                          IF   32 OR THEN                        
 9                     THEN VEMIT                                  
10                     ELSE  LEAVE                                 
11                THEN                                             
12          LOOP    12 #OUT @ 20 MOD - SPACES                      
13          DBUFF 26 + DUP @ SWAP 2+ @ 6 D.R ;                     
14                                                                 
15                                                                 

22 list Screen 22 not modified     
 0 \ (DIR)                                        15:35JWB11/10/85 
 1 \ Display directory based on file spec at adr.                  
 2 : (DIR)  ( adr   -- )                                           
 3    ADD*.*?  DBUFF                                               
 4    26 BDOS DROP           \ Set data transfer area  scratch pad.
 5    DUP DUP C@ + 1+ 0 SWAP C!                                    
 6    1+  FIRSTF 0=                  \ Any match?                  
 7       IF 6 3 AT     6 3  #OUT OFF                               
 8           BEGIN  DISP-FNAME  #OUT @ 50 >                        
 9           IF  1+ 2DUP AT     #OUT OFF THEN  \ More files?       
10           NEXTF  UNTIL 2DROP                                    
11   THEN  ;                                                       
12                                                                 
13                                                                 
14                                                                 
15                                                                 

23 list Screen 23 not modified     
 0 \ 3DROP FUNCTION-KEYS                          14:13JWB06/16/85 
 1 : 3DROP  DROP 2DROP ;                                           
 2                                                                 
 3     27 CONSTANT ESC                                             
 4     13 CONSTANT RETURN                                          
 5     10 CONSTANT LF                                              
 6     82 CONSTANT INS                                             
 7     59 CONSTANT F1                                              
 8     83 CONSTANT DEL                                             
 9     60 CONSTANT F2                                              
10     15 CONSTANT BACK-TAB                                        
11     61 CONSTANT F3                                              
12     75 CONSTANT LEFT-ARROW                                      
13                                                                 
14                                                                 
15                                                                 

24 list Screen 24 not modified     
 0 \ VIDEO MODES                                  20:37JWB11/06/85 
 1    2 BASE !                                                     
 2 : -BLINK     ATRIB  @ 01111111 AND ATRIB ! ;                    
 3 : BLINK      ATRIB  @ 10000000  OR ATRIB ! ;                    
 4   DECIMAL                                                       
 5 \ Type n bytes of string at adr using current atribute byte.    
 6 : VTYPE  ( adr  n   -- )                                        
 7          0 ?DO COUNT VEMIT LOOP DROP ;                          
 8                                                                 
 9 \ Set cursor type.  Start line = sl  End line = el              
10 \ Function 1 of type $10 int.                                   
11 : SET-CURSOR  ( sl el    -- )                                   
12       SWAP FLIP + 0 SWAP 0 256                                  
13       VIDEO-IO 2DROP 2DROP ;                                    
14                                                                 
15                                                                 

25 list Screen 25 not modified     
 0 \  BIG  LITTLE AND NO  CURSORS                 20:39JWB11/06/85 
 1 \ Make a big cursor.                                            
 2 : BIG-CURSOR ( --  -- )                                         
 3         0 6 SET-CURSOR  ;                                       
 4 \ Make a little cursor.                                         
 5 : LITTLE-CURSOR ( --  -- )                                      
 6         6 7 SET-CURSOR  ;                                       
 7 \ Make no cursor.                                               
 8 : NO-CURSOR ( --  -- )                                          
 9         8 8 SET-CURSOR ;                                        
10 : -NO-CURSOR ( --  -- )                                         
11              0 8 SET-CURSOR ;                                   
12 : SELECT-CURSOR ( --  -- )                                      
13         KBF  128 AND                                            
14         IF BIG-CURSOR                                           
15         ELSE LITTLE-CURSOR THEN  ;                              

26 list Screen 26 not modified     
 0 \ CHK .INS .CAP .NUM .SRL .STAMP               22:57jwb11/06/85 
 1  VARIABLE $INS  5 , ," INS"   VARIABLE $NUM 10 , ," NUM"        
 2  VARIABLE $CAP 15 , ," CAP"   VARIABLE $SRL 20 , ," SRL"        
 3  VARIABLE $AUTO     $AUTO OFF                                   
 4 : CHK \ nf ofaddr                                               
 5     2DUP  @ =  OVER  2+ @ CUR!                                  
 6     IF   4 + COUNT VTYPE   DROP                                 
 7     ELSE 2DROP 3 SPACES THEN  ;                                 
 8 : .STAMP ( --  -- ) CUR@ 25 CUR!  $AUTO @                       
 9     IF           ." STAMP"            ELSE ."      " THEN CUR! ;
10  HEX : .INS  ( kbf  -- ) 80 AND $INS CHK ;                      
11      : .CAP  ( kbf  -- ) 40 AND $CAP CHK ;                      
12      : .NUM  ( kbf  -- ) 20 AND $NUM CHK ;                      
13      : .SRL  ( kbf  -- ) 10 AND $SRL CHK ;                      
14      : $INIT 80 $INS ! 40 $CAP ! 20 $NUM ! 10 $SRL ! ; DECIMAL  
15                                                                 

27 list Screen 27 not modified     
 0 \ FUNCTION KEYS                                14:13JWB06/16/85 
 1     62 CONSTANT F4                                              
 2     77 CONSTANT RIGHT-ARROW                                     
 3     63 CONSTANT F5                                              
 4     72 CONSTANT UP-ARROW                                        
 5     64 CONSTANT F6                                              
 6     80 CONSTANT DOWN-ARROW                                      
 7     65 CONSTANT F7                                              
 8     71 CONSTANT HOME                                            
 9     66 CONSTANT F8                                              
10     79 CONSTANT END                                             
11     67 CONSTANT F9                                              
12     73 CONSTANT PG-UP                                           
13     68 CONSTANT F10                                             
14     81 CONSTANT PG-DN                                           
15    115 CONSTANT ^LEFT-ARROW                                     

28 list Screen 28 not modified     
 0 \ FUNCTION KEYS                                14:13JWB06/16/85 
 1     94 CONSTANT ^F1                                             
 2    116 CONSTANT ^RIGHT-ARROW                                    
 3     95 CONSTANT ^F2                                             
 4     96 CONSTANT ^F3                                             
 5     97 CONSTANT ^F4                                             
 6    119 CONSTANT ^HOME                                           
 7     98 CONSTANT ^F5                                             
 8    117 CONSTANT ^END                                            
 9     99 CONSTANT ^F6                                             
10    132 CONSTANT ^PG-UP                                          
11    100 CONSTANT ^F7                                             
12    118 CONSTANT ^PG-DN                                          
13                                                                 
14                                                                 
15                                                                 

29 list Screen 29 not modified     
 0 \  FUNCTION KEYS                               08:31JWB06/22/85 
 1    101 CONSTANT ^F8                                             
 2    102 CONSTANT ^F9     48 CONSTANT ALTB                        
 3    103 CONSTANT ^F10    50 CONSTANT ALTM                        
 4    104 CONSTANT ALTF1   46 CONSTANT ALTC                        
 5     22 CONSTANT ALTU    31 CONSTANT ALTS                        
 6    105 CONSTANT ALTF2   30 CONSTANT ALTA                        
 7     49 CONSTANT ALTN    34 CONSTANT ALTG                        
 8    106 CONSTANT ALTF3   24 CONSTANT ALTO                        
 9    107 CONSTANT ALTF4   32 CONSTANT ALTD                        
10    108 CONSTANT ALTF5   23 CONSTANT ALTI                        
11    109 CONSTANT ALTF6   20 CONSTANT ALTT                        
12    110 CONSTANT ALTF7                                           
13    111 CONSTANT ALTF8                                           
14    112 CONSTANT ALTF9                                           
15    113 CONSTANT ALTF10                                          
 
30 list Screen 30 not modified     
 0 \ VARIABLES                                    09:15JWB06/20/85 
 1   VARIABLE     $SCRATCH                                         
 2 : HELD         $SCRATCH  @  +  ;                                
 3 : SCREEN       $SCRATCH  @  1024 +  +  ;                        
 4 : BACKBUF      $SCRATCH  @  2048 +  +  ;                        
 5 : SEARCHBUF    $SCRATCH  @  3072 +  +  ;                        
 6 : REPLACEBUF   $SCRATCH  @  3136 +  +  ;                        
 7 : INSBUF       $SCRATCH  @  3392 +  +  ;                        
 8   VARIABLE CURSOR                                               
 9   VARIABLE SCREEN#                                              
10   VARIABLE $INSERT                                              
11   VARIABLE TAB#                                                 
12   VARIABLE HOLD-DEPTH                                           
13   VARIABLE <MATCH>                                              
14   VARIABLE $TITLE       63 ALLOT                                
15   VARIABLE $SECONDS                                             

31 list Screen 31 not modified     
 0 \ $REPLACE PREV-FILE $DIRECTORY                14:13JWB06/16/85 
 1   VARIABLE $INITIALS     3 ALLOT                                
 2   VARIABLE $REPLACE                                             
 3   VARIABLE PREV-FILE   B/FCB ( 42 ) ALLOT                       
 4   VARIABLE CUR-FILE    B/FCB        ALLOT                       
 5   VARIABLE OLD-FILE                                             
 6   VARIABLE $DIRECTORY                                           
 7   VARIABLE BROWSING                                             
 8 \ Open a new screen file give address of counted string.        
 9 : OPEN-SCR   \  addr  ---                                       
10         COUNT CUR-FILE [ DOS ] (!FCB) [ EDITOR ]                
11         CUR-FILE [ DOS ] !FILES                                 
12         IN-FILE @ DUP 15 BDOS  DOS-ERR?  TUCK NOT               
13         IF   DUP FILE-SIZE 1- SWAP MAXREC# !                    
14         THEN  [ EDITOR ] ;                                      
15                                                                 

   32 list Screen 32 not modified     
 0 \ SPLIT .DATE TIME@ (.TIME) .TIME              18:46jwb11/05/85 
 1 : SPLIT ( hilo   hi lo )                                        
 2         256 /MOD SWAP ;                                         
 3                                                                 
 4 : (.DATE)  ( --   addr count )                                  
 5       @DATE  SWAP  1900 -                                       
 6        0  <#  #  #  2DROP ASCII / HOLD  SPLIT                   
 7             0 #  #  ASCII / HOLD  2DROP  0 #  #  #>  ;          
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

33 list Screen 33 not modified     
 0 \  .TIME  .DATE                                18:48jwb11/05/85 
 1                                                                 
 2 \ Format the time ready for typing.                             
 3 : (.TIME) ( --  adr count )                                     
 4      @TIME                                                      
 5     SSS  0 <# # # ASCII : HOLD 2DROP                            
 6     MMM  0    # # ASCII : HOLD 2DROP                            
 7     HHH  0    # # #> ;                                          
 8                                                                 
 9                                                                 
10                                                                 
11 : .TIME (.TIME) VTYPE ;                                         
12                                                                 
13 : .DATE (.DATE) VTYPE ;                                         
14                                                                 
15                                                                 

 34 list Screen 34 not modified     
 0 \ CLOCK   PCKEY <KEY>                           22:04   11/12/85
 1 : SS+5 5 $SECONDS +! ;                                          
 2 : .CLOCK ( --  -- )                                             
 3         @TIME SSS   $SECONDS @  2DUP 60 = SWAP 5 < AND          
 4         IF $SECONDS OFF THEN  >=                                
 5         IF  NO-CURSOR 32 CUR!   .TIME                           
 6                     SELECT-CURSOR SS+5 THEN ;                   
 7 : PCKEY ( --  char|code 0 )                                     
 8         BEGIN (KEY?) NOT                                        
 9         WHILE  CUR@ KBF?                                        
10         IF    NO-CURSOR  KBF DUP                                
11              .INS  DUP .NUM  DUP                                
12              .CAP  .SRL SELECT-CURSOR                           
13         THEN    .CLOCK   CUR!                                   
14         REPEAT  {KEY}  DUP                                      
15          0= IF {KEY} SWAP THEN ;                                

   35 list Screen 35 not modified     
 0 \ MODE  .STATE  #IN                            22:55jwb11/06/85 
 1 : <KEY> ( --  n )                                               
 2         BEGIN PCKEY DUP 0= WHILE BEEP 2DROP REPEAT ;            
 3 : .STATE CUR@ KBF                                               
 4          DUP .INS DUP .CAP DUP .NUM .SRL  .STAMP                
 5                      SELECT-CURSOR CUR! ;                       
 6                                                                 
 7 : #IN  ( --- n )                                                
 8   0 BEGIN                                                       
 9   KEY                                                           
10   DUP 13 =  IF DROP EXIT THEN                                   
11   DUP 8 =   IF VEMIT 32 VEMIT 8 VEMIT 10 / ELSE                 
12                DUP 48 < OVER 57 > OR IF DROP 7 VEMIT            
13                ELSE DUP VEMIT 48 - SWAP 10 * + THEN THEN        
14   AGAIN ;                                                       
15                                                                 

    36 list Screen 36 not modified     
 0 \ CLEARSCREEN  SW -SW                          18:17JWB11/09/85 
 1 \ Clear entire screen.                                          
 2 : CLEARSCREEN   ( --  -- )                                      
 3        0  0  79 24 ATRIB @ INIT-WINDOW  0  0  AT      ;         
 4                                                                 
 5 \ Swap in our vectors for EMIT AND KEY .                        
 6 : SW   ( --  -- )                                               
 7       ['] VEMIT IS EMIT                                         
 8       ['] <KEY>  IS KEY  ;                                      
 9                                                                 
10 \ Restore original routines for EMIT AND KEY .                  
11 : -SW  ( --  -- )                                               
12       ['] (EMIT) IS EMIT                                        
13       ['] (KEY)  IS KEY  ;                                      
14                                                                 
15                                                                 

  37 list Screen 37 not modified     
 0 \  STAMP-PAD                                   23:09JWB06/23/85 
 1                                                                 
 2 \ Set up screen title as comment with time date and initials.   
 3 : STAMP-PAD ( --  -- )                                          
 4               $TITLE  42 +  22 BLANK                            
 5      ( $205C or "\ " )  8284  $TITLE !                          
 6    (.DATE)     $TITLE  55 +  SWAP  CMOVE                        
 7    (.TIME) 3 - $TITLE  47 +  SWAP  CMOVE                        
 8    $INITIALS  COUNT $TITLE  52 +  SWAP  CMOVE  ;                
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

   38 list Screen 38 not modified     
 0 \ DATE-SCREEN                                  23:14JWB06/23/85 
 1                                                                 
 2                                                                 
 3 \ Stamp current screen with time, initials and date.            
 4 : DATE-SCREEN  ( --  -- )                                       
 5        0  SCREEN  $TITLE  42 CMOVE  STAMP-PAD                   
 6        $TITLE  0  SCREEN  C/L CMOVE  ;                          
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
 
   39 list Screen 39 not modified     
 0 \ DATE-SCR0                                    23:13JWB06/23/85 
 1 \ Stamp second line of screen 0 with date and last screen       
 2 \ modified.                                                     
 3 : DATE-SCR0  ( --  -- )                                         
 4    $TITLE  C/L BLANK                                            
 5    " Last change:   Screen "  $TITLE  2+  SWAP  CMOVE           
 6     0  <#  #  #  #  #>  $TITLE  25 +  SWAP  CMOVE               
 7    STAMP-PAD  $TITLE  0  BLOCK C/L + C/L CMOVE  UPDATE  ;       
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

 40 list Screen 40 not modified     
 0 \ CURSOR-CHK @(CURSOR)                         16:28JWB06/22/85 
 1 \ Store top of stack as current cursor value                    
 2 : CURSOR!  ( n  -- )                                            
 3         CURSOR ! ;                                              
 4 \ Fetch current value of cursor.                                
 5 : CURSOR@  ( --  n )                                            
 6         CURSOR @  ;                                             
 7 \ Check for out of bounds cursor.                               
 8 : CURSOR-CHK    ( --  -- )                                      
 9         CURSOR@  1024 + 1024 MOD CURSOR! ;                      
10 \ Fetch storrage address corresponding to current cursor.       
11 : ADCUR   ( --  adr )                                           
12       CURSOR@ SCREEN  ;                                         
13 \ Fetch character stored at current cursor location.            
14 : @(CURSOR)  ( --  char )                                       
15         ADCUR   C@  ;                                           

  41 list Screen 41 not modified     
 0 \ !(CURSOR  .CURSOR   CHAR-TO-EOL              20:49JWB11/06/85 
 1 \ Store character at current cursor position.                   
 2 : !(CURSOR)  ( char  -- )                                       
 3        ADCUR  C!  ;                                             
 4                                                                 
 5 \ Print current cursor position.                                
 6 : .CURSOR  ( --  -- )                                           
 7        CURSOR@  C/L /MOD  2DUP  SWAP  NO-CURSOR                 
 8        50 1 AT     0 <# # # BL HOLD 2DROP 0 # # #> VTYPE        
 9        6 3 D+ AT     SELECT-CURSOR ;                            
10                                                                 
11 \ Return character count to end of current line.                
12 : CHAR-TO-EOL  ( --  n )                                        
13         C/L CURSOR@ OVER MOD - ;                                
14                                                                 
15                                                                 

 42 list Screen 42 not modified     
 0 \ +.CURSOR .LINE ?LINE                         20:49JWB11/06/85 
 1 \ Add n to current current cursor and print it.                 
 2 : +.CURSOR  ( n  -- )                                           
 3        CURSOR  +!  CURSOR-CHK  .CURSOR  ;                       
 4                                                                 
 5 \ Print line n of the current screen.                           
 6 : .LINE   ( n  -- )                                             
 7         DUP  3  +  6 SWAP  AT                                   
 8         C/L *  SCREEN C/L VTYPE ;                               
 9                                                                 
10 \ Return number of line that cursor is currently on.            
11 : ?LINE   ( --  n )                                             
12         CURSOR@ C/L /  ;                                        
13 \ Leave true flag if there is a blank at the end of the line.   
14 : BLANK-AT-END?  ( --  flag )                                   
15         ?LINE 1+ C/L * 1- SCREEN C@ BL = ;                      
 
    43 list Screen 43 not modified     
 0 \ ?LINE64* .LINE-TO-END MOVE-LINE              08:46JWB06/22/85 
 1                                                                 
 2 \ Return currsor position of start of line containing cursor.   
 3 : ?LINE64*   ( --  n )                                          
 4         ?LINE C/L *  ;                                          
 5                                                                 
 6 \  Reprint the line the cursor is currently on.                 
 7 : .LINE-TO-END   ( --  -- )                                     
 8         ?LINE  .LINE  ;                                         
 9                                                                 
10 \ Move line n1  to line n2 .                                    
11 : MOVE-LINE   ( n1 n2  -- )                                     
12        SWAP C/L *  SCREEN  SWAP C/L *  SCREEN                   
13        C/L CMOVE  ;                                             
14                                                                 
15                                                                 


Screen 44 not modified     
 0 \ MOVE-HOLD SCROLLDOWN  .CLEAN                 18:29JWB11/09/85 
 1 \                                                               
 2 : MOVE-HOLD  ( n1  n2    -- )                                   
 3               SWAP C/L *  HELD                                  
 4               SWAP C/L *  HELD C/L CMOVE ;                      
 5 \ Scroll screen down one line.                                  
 6 : SCROLLDOWN  ( x y x' y'  -- )                                 
 7    FLIP  +  -ROT   FLIP  + ATRIB @ FLIP 1793  \ $701=1793       
 8    VIDEO-IO  2DROP  2DROP  ;                                    
 9                                                                 
10 \ Wipe  reading or writing off upper right corner.              
11 : .CLEAN  ( --  -- )                                            
12      NO-CURSOR CUR@ 56 1 AT                                     
13       ."   F1 = HELP   "                                        
14      CUR!  SELECT-CURSOR ;                                      
15                                                                 


Screen 45 not modified     
 0 \ SCROLLUP .SCREEN#                            20:42JWB11/07/85 
 1 \ Scroll screen up one line.                                    
 2 : SCROLLUP ( x y x' y'  -- )                                    
 3    FLIP   + -ROT   FLIP  +                                      
 4    ATRIB @ FLIP 1537 ( $601=1537 )                              
 5    VIDEO-IO  2DROP  2DROP  ;                                    
 6                                                                 
 7                                                                 
 8 \ Print screen number and current editing file.                 
 9 : .SCREEN#  ( --  -- )                                          
10        .STATE    6 1  AT                                        
11        ." Screen # " SCREEN#  @  .  SPACE                       
12        19 1  AT   BROWSING @                                    
13        IF ." Browsing" ELSE ."  Editing" THEN                   
14        ."  file: " FILE? ;                                      
15                                                                 


Screen 46 not modified     
 0 \ .WRITING  .READING                           14:18JWB06/23/85 
 1                                                                 
 2                                                                 
 3 : .WRITING  ( --  -- )                                          
 4      NO-CURSOR CUR@  56 1  AT                                   
 5                BLINK  ."   Writing disk" -BLINK                 
 6      CUR! SELECT-CURSOR ;                                       
 7 : .READING  ( --  -- )                                          
 8      NO-CURSOR CUR@ 56 1 AT                                     
 9                BLINK  ."   Reading disk" -BLINK                 
10      CUR! SELECT-CURSOR ;                                       
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 47 not modified     
 0 \ PRINT-SCREEN                                 20:49JWB11/06/85 
 1 \ Send current screen to the printer.                           
 2 : PRINT-SCREEN ( --  -- )                                       
 3         -SW  PRINTING ON CR                                     
 4          SCREEN# @  7 SPACES                                    
 5         ." Screen#" 4 .R 3 SPACES FILE?                         
 6          3 SPACES  .DATE SPACE .TIME                            
 7         16 0 DO  CR   I 6 .R  SPACE                             
 8              0 SCREEN I C/L * + C/L -TRAILING TYPE              
 9              LOOP                                               
10         CR  PRINTING OFF SW  ;                                  
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 48 not modified     
 0 \ PUSH-TO-PROCEED @(SCREEN#) CLEAR-PROMPT      19:56JWB11/11/85 
 1                                                                 
 2 \ Prompt for key press to continue.                             
 3 : PUSH-TO-PROCEED  ( --  -- )                                   
 4       ." Press any key to continue. " KEY  DROP ;               
 5                                                                 
 6                                                                 
 7 \ Fetch screen n to the editing & backup buffer areas.          
 8 : @(SCREEN#)  ( n  -- )                                         
 9       .READING  SCREEN#  @  BLOCK  0  SCREEN                    
10       1024 CMOVE  0  SCREEN  0  BACKBUF  1024 CMOVE  ;          
11                                                                 
12                                                                 
13 \ Clear n lines of prompt area below screen.                    
14 : CLEAR-PROMPT  ( n  -- )   1 MAX 5 MIN 19 +                    
15        0  20 ROT 79 SWAP  ATRIB @ INIT-WINDOW 6 20 AT     ;     


Screen 49 not modified     
 0 \ !(SCREEN#                                    08:53JWB06/22/85 
 1 \ Store current screen in a FORTH buffer and mark as updated.   
 2 : !(SCREEN#)  ( --  -- )                                        
 3    .WRITING  SCREEN#  @                                         
 4    BLOCK  0  SCREEN  SWAP                                       
 5    2DUP  1024 COMP 0=                                           
 6      IF 2DROP                                                   
 7      ELSE $AUTO  @                                              
 8         IF DATE-SCREEN                                          
 9         THEN 1024 CMOVE  UPDATE  $AUTO  @                       
10         IF SCREEN#  @  DATE-SCR0                                
11         THEN                                                    
12      THEN ;                                                     
13                                                                 
14                                                                 
15                                                                 


Screen 50 not modified     
 0 \ #RECORDS DISPLACEMENT ?SCREENS CHECK-SCR     21:01JWB11/13/85 
 1 \ Return n, the maximum number of records in current file.      
 2 : #RECORDS ( --  n )                                            
 3        FILE @ [ DOS ] MAXREC# [ EDITOR ] @ 1+ ;                 
 4                                                                 
 5 \ Return offset n, to the alternate or shadow screen.           
 6 : DISPLACEMENT  ( --  n )                                       
 7        #RECORDS 0 16 UM/MOD NIP ;                               
 8                                                                 
 9 \ Return the number n, of the last screen in current file.      
10 : ?SCREENS  ( --  n )                                           
11        #RECORDS 0 8 UM/MOD NIP 1- ;                             
12                                                                 
13 \ Do not allow n to exceed the last available screen.           
14 : CHECK-SCREEN  ( n    n')                                      
15         0 MAX       ?SCREENS  MIN  ;                            


Screen 51 not modified     
 0 \  SHADOW-SCR IBUF IMOV                        19:58JWB11/11/85 
 1 \ Convert screen n to corresponding shadow s.                   
 2 : SHADOW-SCR ( n   s )                                          
 3         DISPLACEMENT 2DUP < IF + ELSE - THEN ;                  
 4   VARIABLE IPTR                                                 
 5 : IBUF ( --  adr )    \ Leave pointer into insert buffer.       
 6         0 INSBUF IPTR @  256 MOD + ;                            
 7 : IMOV ( --  -- )     \ Move character under cursor to ins buf. 
 8         $KBF @ 16 AND  \ Is scroll lock down?                   
 9         IF   IPTR @ 256 <                                       
10              IF   @(CURSOR) IBUF C! 1 IPTR +!                   
11              ELSE 2 CLEAR-PROMPT ." Insert buffer full!" CR     
12                   BEEP PUSH-TO-PROCEED .CURSOR                  
13              THEN                                               
14         THEN ;                                                  
15                                                                 


Screen 52 not modified     
 0 \ IBLANK  BORDER                               20:05JWB11/11/85 
 1 : IBLANK ( --  -- )   \ Clear insert buffer to blanks.          
 2         IPTR OFF IBUF 256 BLANK ;                               
 3 \ Display screen border and exit prompt.                        
 4 : BORDER  ( --  -- )                                            
 5    CLEARSCREEN  PAD  64 196 FILL  5 2  AT                       
 6    218 VEMIT  PAD  64 VTYPE                                     
 7    191 VEMIT  5 19 AT      192 VEMIT                            
 8    PAD  64 VTYPE  217 VEMIT  16 0                               
 9      DO 5 I  3  +  AT      179 VEMIT                            
10        70 I  3  +  AT      179 VEMIT                            
11      LOOP     72  5 AT ."  PRESS"                               
12               72  7 AT ."   Esc "                               
13               72  9 AT ."   TO"                                 
14               72 11 AT ."  EXIT"                                
15               72 13 AT ." EDITOR"  ;                            


Screen 53 not modified     
 0 \ SCAN+<>  SCAN+=                              09:28JWB06/22/85 
 1 : SCAN+<>  ( char to.adr from.adr   count )                     
 2         2DUP =                  \ Return 0 if there is          
 3         IF  3DROP 0             \ nothing to search.            
 4         ELSE 0 ROT ROT          \ Otherwise scan memory         
 5           DO OVER I C@ <>       \ from low to high until        
 6              ?LEAVE 1+          \ a missmatch is found.         
 7           LOOP NIP THEN ;       \ Return with count to mismatch.
 8                                                                 
 9 : SCAN+=   ( char to.adr from.adr   count )                     
10         2DUP =                  \ Return 0 if there is nothing  
11         IF  3DROP 0             \ to search.                    
12         ELSE 0 ROT ROT          \ Other wise scan memory from   
13           DO OVER I C@ =        \ low to high until             
14              ?LEAVE 1+          \ a match is found.             
15           LOOP NIP THEN ;       \ Return with count to match.   


Screen 54 not modified     
 0 \                                              09:00JWB06/22/85 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 55 not modified     
 0 \ .BLANK-SCREEN .SCREEN                        20:07JWB11/11/85 
 1 \ Clear interior of screen window to blanks.                    
 2 : .BLANK-SCREEN ( --  -- )                                      
 3     6 3  69 18 ATRIB @ INIT-WINDOW  ;                           
 4 \ Display screen contents and headings.                         
 5 : .SCREEN  ( --   -- )                                          
 6    42 0  AT     .DATE                                           
 7    52 0  AT      ."  FORTHSTAR 2.1 "                            
 8             .SCREEN#   .BLANK-SCREEN  16 0                      
 9      DO I C/L *  SCREEN C/L -TRAILING  DUP                      
10         IF 6 I  3  +  AT      VTYPE                             
11         ELSE 2DROP                                              
12         THEN                                                    
13      LOOP .CLEAN  .CURSOR  ;                                    
14                                                                 
15                                                                 


Screen 56 not modified     
 0 \ NEW-SCREEN .SCREEN-TO-END CLEAR-PROMPT       20:50JWB11/06/85 
 1 \ Display a new screen.                                         
 2 : NEW-SCREEN ( --   -- )                                        
 3                @(SCREEN#)   CURSOR  OFF  .SCREEN  ;             
 4                                                                 
 5 \ Redisplay lines from cursor to the end of the screen.         
 6 : .SCREEN-TO-END ( --  -- )                                     
 7    6 ?LINE  3  +  69 18 ATRIB @ INIT-WINDOW                     
 8    16 ?LINE                                                     
 9      DO I C/L *  SCREEN C/L -TRAILING  DUP                      
10         IF 6 I  3  +  AT      VTYPE                             
11         ELSE 2DROP                                              
12         THEN                                                    
13      LOOP .CURSOR  ;                                            
14                                                                 
15                                                                 


Screen 57 not modified     
 0 \ .HOLD  WAIT.DIGIT                            18:36JWB11/09/85 
 1 \ Display the top of the line stack.                            
 2 : .HOLD ( --  -- )                                              
 3      HOLD-DEPTH  @                                              
 4      IF 0 24 79 24 ATRIB @  INIT-WINDOW                         
 5       0 24 AT     HOLD-DEPTH @ 3 .R SPACE                       
 6       0 HELD 64 -TRAILING  VTYPE                                
 7      ELSE 0  24 79 24 ATRIB @ INIT-WINDOW                       
 8      THEN ;                                                     
 9 \ Wait n seconds for key press and convert to digit 1 ... 9     
10 : WAIT.DIGIT \ n   1 ...9                                       
11         0 SWAP 2000 * 0                                         
12         ?DO (KEY?)                                              
13             IF DROP PCKEY DUP 0= IF 2DROP 0 THEN LEAVE THEN     
14         LOOP                                                    
15         48 - 1 MAX 9 MIN  ;                                     


Screen 58 not modified     
 0 \ NEXT-SCREEN PREV-SCREEN +MOVE                14:16JWB06/16/85 
 1 \ Go to screen n.                                               
 2 : GO-SCR  ( n   -- )                                            
 3         CURSOR@ >R !(SCREEN#) CHECK-SCREEN                      
 4         SCREEN# ! NEW-SCREEN  R> CURSOR! ;                      
 5 \ Go to next screen.                                            
 6 : NEXT-SCREEN ( --  -- )                                        
 7     SCREEN# @ ( 2 WAIT.DIGIT +) 1+ GO-SCR .CURSOR ;             
 8 \ Go to previous screen.                                        
 9 : PREV-SCREEN ( --  -- )                                        
10     SCREEN#  @ ( 2 WAIT.DIGIT -) 1- GO-SCR .CURSOR ;            
11 \ Move lines from cursor to end up one ( down on screen).       
12 : +MOVE   ( --  -- )                                            
13      ?LINE  15 <                                                
14      IF ?LINE  1+  15                                           
15         DO I  1-  I  MOVE-LINE  -1  +LOOP THEN ;                


Screen 59 not modified     
 0 \ -MOVE  ASK-SCR  FIRST-SCR LAST-SCR           09:22JWB06/22/85 
 1 \ Move lines from cursor to bottom down one ( up on screen).    
 2 : -MOVE  ( --  --  )                                            
 3      ?LINE  15 -                                                
 4      IF 15 ?LINE                                                
 5         DO I  1+  I  MOVE-LINE     LOOP                         
 6      THEN ;                                                     
 7 \ Prompt for input of new screen number.                        
 8 : ASK-SCR  ( --  n )                                            
 9         ." Enter screen number : "   #IN  ;                     
10 \ Move to first screen of this file.                            
11 : FIRST-SCR ( --  -- )                                          
12             0 GO-SCR .CURSOR ;                                  
13 \ Move to the last screen of this file.                         
14 : LAST-SCR  ( --  -- )                                          
15             ?SCREENS GO-SCR .CURSOR ;                           


Screen 60 not modified     
 0 \ GO-SHADOW   PUSH-LINE   POP-LINE             20:14JWB11/11/85 
 1 \ Toggle between current screen and its shadow screen.          
 2 : GO-SHADOW ( --  -- )                                          
 3         SCREEN# @ SHADOW-SCR GO-SCR .CURSOR ;                   
 4 \ Push current line to line stack and display it.               
 5 : PUSH-LINE ( --  -- )                                          
 6     -1  14 DO I  DUP  1+  MOVE-HOLD  -1 +LOOP                   
 7      ?LINE64*  SCREEN  0  HELD C/L CMOVE  HOLD-DEPTH            
 8      @  1+  16 MIN  HOLD-DEPTH  !  .HOLD  .CURSOR  ;            
 9 \ Pop line from line stack.                                     
10 : POP-LINE ( -- -- )                                            
11     0  HELD  ?LINE64*  SCREEN C/L CMOVE  ?LINE                  
12    .LINE C/L HELD  0  HELD  960 CMOVE  960 HELD C/L BLANK       
13    HOLD-DEPTH  @  1-  0  MAX  HOLD-DEPTH  !  .HOLD  .CURSOR ;   
14                                                                 
15                                                                 


Screen 61 not modified     
 0 \ SPLIT-LINE SPREAD-LINE                       20:17JWB11/11/85 
 1 \ Split line at current currsor position.                       
 2 : SPLIT-LINE ( --  -- )                                         
 3    +MOVE  ADCUR           C/L BLANK                             
 4    .SCREEN-TO-END  ;                                            
 5 \ Insert blank line at current curssor postion.                 
 6 : SPREAD-LINE ( --  -- )                                        
 7      ?LINE  15 -  DUP                                           
 8      IF ?LINE  1  -  14                                         
 9         DO I  DUP  1  +  MOVE-LINE  -1                          
10         +LOOP                                                   
11      THEN ?LINE64*  SCREEN C/L BLANK                            
12      IF 6 ?LINE  3  +  69 18 SCROLLDOWN                         
13      ELSE 15 .LINE  .CURSOR                                     
14      THEN ;                                                     
15                                                                 


Screen 62 not modified     
 0 \ DELETE-LINE                                  20:17JWB11/11/85 
 1 \ Delete line at current currsor position and move rest up.     
 2 : DELETE-LINE ( --  -- )                                        
 3      ?LINE  15 -  DUP                                           
 4      IF   ?LINE  1  + C/L *  SCREEN                             
 5           DUP C/L -  OVER  1024                                 
 6           SCREEN  SWAP  -  CMOVE                                
 7      THEN 15 C/L *  SCREEN C/L BLANK                            
 8      IF 6 ?LINE  3  +  69 18 SCROLLUP                           
 9      ELSE 15 .LINE  .CURSOR                                     
10      THEN ;                                                     
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 63 not modified     
 0 \ FORWARD BACKUP PUT-CHAR TAB-RIGHT            20:20JWB11/11/85 
 1 \ Move cursor forward one position.                             
 2 : FORWARD ( --  -- )                                            
 3         1 +.CURSOR  ;                                           
 4 \ Back cursor up one position.                                  
 5 : BACKUP  ( --  -- )                                            
 6        -1  +.CURSOR  ;                                          
 7 \ Store character and display it.                               
 8 : PUT-CHAR ( char  -- )                                         
 9      DUP VEMIT !(CURSOR) FORWARD  ;                             
10 \ Mover right to the next tab stop.                             
11 : TAB-RIGHT ( --  -- )                                          
12    TAB#  @  CURSOR@  C/L MOD                                    
13    OVER  /  OVER  *  ?LINE64* +  +                              
14    CURSOR!  CURSOR-CHK  .CURSOR  ;                              
15                                                                 


Screen 64 not modified     
 0 \ TAB-LEFT TAB-UP +TRANSPOSE                   20:22JWB11/11/85 
 1 \ Move to the next tabstop on the left.                         
 2 : TAB-LEFT ( --  -- )                                           
 3    TAB#  @  CURSOR@  C/L MOD                                    
 4    OVER  /  OVER  *  ?LINE64* + SWAP  -                         
 5    CURSOR!  CURSOR-CHK  .CURSOR  ;                              
 6 \ Move cursor up one position.                                  
 7 : TAB-UP  ( --  -- )                                            
 8            -64 +.CURSOR  ;                                      
 9 \ Transpose character under cursor with the one in front of it. 
10 : +TRANSPOSE ( --  -- )                                         
11         CURSOR@ 1024 <                                          
12         IF  ADCUR           @ 256 /MOD                          
13             PUT-CHAR                                            
14             PUT-CHAR  BACKUP                                    
15         THEN ;                                                  


Screen 65 not modified     
 0 \ TAB-DOWN ERASE-SCREEN  -TRANSPOSE            20:24JWB11/11/85 
 1                                                                 
 2 \ Move cursor down one position.                                
 3 : TAB-DOWN  ( --   -- )                                         
 4             C/L +.CURSOR  ;                                     
 5                                                                 
 6 \ Erase current screen to blanks.                               
 7 : ERASE-SCREEN  ( --  -- )                                      
 8    0 SCREEN  1024 BLANK  .BLANK-SCREEN                          
 9    CURSOR  OFF .SCREEN#   .CURSOR  ;                            
10                                                                 
11 \ Transpose character under cursor with the one behind it.      
12 : -TRANSPOSE ( --  -- )                                         
13         CURSOR@                                                 
14         IF  BACKUP  +TRANSPOSE BACKUP  THEN ;                   
15                                                                 


Screen 66 not modified     
 0 \ ERASE-TO-END ERASE-LINE                      21:04JWB11/13/85 
 1                                                                 
 2 \ Erase from cursor to end of screen with blanks.               
 3 : ERASE-TO-END ( --  -- )                                       
 4    ADCUR  1024 CURSOR@ -                                        
 5    BLANK  .SCREEN-TO-END  ;                                     
 6                                                                 
 7 \ Erase line that the cursor is on with blanks.                 
 8 : ERASE-LINE  ( --  -- )                                        
 9     ?LINE64* DUP CURSOR!                                        
10     SCREEN C/L  BLANK .LINE-TO-END  .CURSOR  ;                  
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 67 not modified     
 0 \ ERASE-EOL (DELC) DELETE-CHAR                 21:04JWB11/13/85 
 1 \ Erase line from cursor to end with blanks.                    
 2 : ERASE-EOL  ( --  -- )                                         
 3       ADCUR  CHAR-TO-EOL                                        
 4       2DUP BLANK  VTYPE  .CURSOR  ;                             
 5 \ Delete character under cursor.  Display not refreshed.        
 6 : (DELC) ( --  -- )                                             
 7      IMOV CHAR-TO-EOL ADCUR                                     
 8      2DUP  DUP 1+ SWAP ROT CMOVE                                
 9      + 1- BL SWAP C!  ;                                         
10 \ Delete character under cursor and refresh display.            
11 : DELETE-CHAR  ( --  -- )                                       
12         (DELC)                                                  
13         ADCUR  CHAR-TO-EOL                                      
14         -TRAILING 1+ VTYPE .CURSOR ;                            
15                                                                 


Screen 68 not modified     
 0 \ (INS-CHAR)   SPREAD-CHAR  INSERT-CHAR        21:11JWB11/13/85 
 1 \ Insert char at cursor position and advance cursor n positions.
 2 : (INS-CHAR) ( char n  -- )                                     
 3         SWAP                            \ c n                   
 4         ADCUR  CHAR-TO-EOL              \ n c a e               
 5         2DUP + 1- C@ BL =               \ n c a e flag          
 6         IF 2DUP SWAP DUP 1+             \                       
 7            ROT 1- CMOVE>                                        
 8            ROT 2 PICK C!                                        
 9            -TRAILING VTYPE  +.CURSOR                            
10         ELSE  2DROP 2DROP BEEP THEN ;                           
11 \ Insert a blank at cursor position but do not advance cursor.  
12 : SPREAD-CHAR    ( --  --  )  BL 0 (INS-CHAR) ;                 
13 \ Insert char at cursor postion and advance one position.       
14 : INSERT-CHAR    ( char  -- )    1 (INS-CHAR) ;                 
15                                                                 


Screen 69 not modified     
 0 \ DELETE-CHARLFT NOT-EMPTY-LINE?               21:05JWB11/13/85 
 1                                                                 
 2 \ Delete character behind cursor.                               
 3 : DELETE-CHARLFT ( --  -- )                                     
 4      CURSOR@ C/L MOD  0=                                        
 5      IF BEEP                                                    
 6      ELSE -1  CURSOR  +!  .CURSOR  DELETE-CHAR                  
 7      THEN ;                                                     
 8                                                                 
 9 \ Leave true flag if rest of line is not blank.                 
10 : NOT-EMPTY-LINE? ( --  flag )                                  
11      ADCUR  CHAR-TO-EOL                                         
12      -TRAILING NIP 0<> ;                                        
13                                                                 
14                                                                 
15                                                                 


Screen 70 not modified     
 0 \ IGET   BACKSPACE                             20:28JWB11/11/85 
 1                                                                 
 2 \ Insert character from ins buf at current cursor position.     
 3 : IGET ( --  -- )                                               
 4     IPTR @  0<> BLANK-AT-END?  AND                              
 5     IF   -1 IPTR +! IBUF C@ 0 (INS-CHAR)                        
 6     ELSE BEEP THEN ;                                            
 7                                                                 
 8 \ Backup and erase character behind cursor.                     
 9 : BACKSPACE ( --  -- )                                          
10      CURSOR@ C/L MOD  0=                                        
11      IF BEEP                                                    
12      ELSE -1 +.CURSOR BL !(CURSOR)                              
13            BL  VEMIT  .CURSOR                                   
14      THEN ;                                                     
15                                                                 


Screen 71 not modified     
 0 \ CURSOR-RIGHTWORD                             20:29JWB11/11/85 
 1 \ Move cursor right one word.  Word traversed goes to the       
 2 \ insert buffer if scroll lock is on.                           
 3 : CURSOR-RIGHTWORD ( --  -- )                                   
 4      BEGIN CURSOR@  1+  DUP  1023 >                             
 5         IF DROP  TRUE                                           
 6         ELSE IMOV CURSOR!  @(CURSOR)  BL  =                     
 7              DUP IF IMOV THEN                                   
 8         THEN                                                    
 9      UNTIL                                                      
10      BEGIN CURSOR@  1+  DUP  1023 >                             
11         IF DROP  TRUE                                           
12         ELSE CURSOR!  @(CURSOR)  BL  >                          
13         THEN                                                    
14      UNTIL .CURSOR  ;                                           
15                                                                 


Screen 72 not modified     
 0 \ CURSOR-LEFTWORD                              20:32JWB11/11/85 
 1 \ Move cursor left one word.                                    
 2 : CURSOR-LEFTWORD ( --  -- )                                    
 3      @(CURSOR)  BL  >                                           
 4      IF -1 CURSOR +!   CURSOR-CHK                               
 5      THEN @(CURSOR)  BL  =                                      
 6      IF BEGIN  CURSOR@  1-  DUP  0<                             
 7            IF   DROP  TRUE                                      
 8            ELSE CURSOR!  @(CURSOR)  BL  <>                      
 9            THEN                                                 
10         UNTIL                                                   
11      THEN                                                       
12      BEGIN -1 CURSOR +!                                         
13         CURSOR@ 0<                                              
14         @(CURSOR)  BL  =  OR                                    
15      UNTIL FORWARD ;                                            


Screen 73 not modified     
 0 \ FIND-CHARACTER INSERT-WORDRIGHT              20:34JWB11/11/85 
 1 \ Move cursor to first occurance of inputed character.          
 2 : FIND-CHARACTER ( --  -- )                                     
 3         KEY 1 CURSOR +!                                         
 4         0 SCREEN  1023 +                                        
 5         0 SCREEN CURSOR@ +                                      
 6         SCAN+=  +.CURSOR ;                                      
 7                                                                 
 8 \ Insert word from the insert buffer.                           
 9 : INSERT-WORDRIGHT ( -- -- )                                    
10      IPTR @ 0<> IBUF 1- C@ BL = AND                             
11 IF   BEGIN BLANK-AT-END? IPTR @ 0<> IBUF 1- C@ BL = AND AND     
12      WHILE IGET REPEAT                                          
13 THEN BEGIN BLANK-AT-END? IPTR @ 0<> IBUF 1- C@ BL <> AND AND    
14      WHILE IGET REPEAT  ;                                       
15                                                                 


Screen 74 not modified     
 0 \ DELETE-WORDRIGHT                             20:35JWB11/11/85 
 1 \ Delete word to the right of the cursor.                       
 2 : DELETE-WORDRIGHT ( --  -- )                                   
 3      NOT-EMPTY-LINE?                                            
 4      IF @(CURSOR)  BL  >                                        
 5         IF BEGIN (DELC)  @(CURSOR)  BL  =                       
 6            UNTIL                                                
 7         THEN NOT-EMPTY-LINE?                                    
 8         IF BEGIN (DELC)  @(CURSOR)  BL <>                       
 9            UNTIL                                                
10         THEN .LINE-TO-END  .CURSOR                              
11      THEN ;                                                     
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 75 not modified     
 0 \ PULL-NEXT-LINE                               20:39JWB11/11/85 
 1 \ Pull line next line ( below cursor ) over to the right        
 2 \ of the screen.  Used in  JOIN-LINE.                           
 3 : PULL-NEXT-LINE ( --  -- )                                     
 4      ?LINE  1+ C/L *                                            
 5      DUP  SCREEN  C@  32 =                                      
 6      IF   CURSOR@  >R  CURSOR!                                  
 7           .CURSOR  DELETE-WORDRIGHT                             
 8           R>  CURSOR!  .CURSOR                                  
 9      ELSE DROP                                                  
10      THEN ;                                                     
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 76 not modified     
 0 \ MOVE-UPTO-BLANK                              20:40JWB11/11/85 
 1 \                                                               
 2                                                                 
 3 : MOVE-UPTO-BLANK ( adr1 adr2 n   n' )                          
 4      BEGIN DUP  1-  3  PICK  +                                  
 5      C@  32 <>  OVER  0<>  AND                                  
 6      WHILE 1-                                                   
 7      REPEAT DUP  DUP  >R                                        
 8      IF CMOVE                                                   
 9      ELSE DROP  2DROP                                           
10      THEN R>  ;                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 77 not modified     
 0 \ JOIN-LINE                                    20:41JWB11/11/85 
 1 \ Join line under cursor to the one containing the cursor.      
 2 : JOIN-LINE ( --  -- )                                          
 3      ?LINE  15 -                                                
 4      IF ?LINE64*  SCREEN C/L -TRAILING  DUP  63 <               
 5         IF PULL-NEXT-LINE  1+  DUP  >R  +  ?LINE  1+            
 6         C/L *  SCREEN  SWAP C/L R>  -  MOVE-UPTO-BLANK          
 7          ?LINE  1+ C/L *  SCREEN  SWAP  BLANK  ?LINE  .LINE     
 8          PULL-NEXT-LINE  ?LINE  1+ C/L *  SCREEN C/L            
 9          -TRAILING  SWAP  DROP  0=                              
10            IF CURSOR@  >R C/L CURSOR  +!  DELETE-LINE  R>       
11             CURSOR!  .CURSOR                                    
12            ELSE .SCREEN-TO-END                                  
13            THEN                                                 
14         ELSE 2DROP                                              
15       THEN  THEN ;                                              


Screen 78 not modified     
 0 \ END-OF-SCREEN  START-OF-SCREEN               21:11JWB11/08/85 
 1                                                                 
 2 \ Move to end of screen.                                        
 3 : END-OF-SCREEN  ( --  -- )                                     
 4      0 SCREEN  1023 -TRAILING                                   
 5      NIP CURSOR! .CURSOR ;                                      
 6                                                                 
 7 \ Move to start of screen.                                      
 8 : START-OF-SCREEN  ( --  -- )                                   
 9         CURSOR OFF .CURSOR ;                                    
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 79 not modified     
 0 \ END-OF-LINE  START-OF-LINE                   20:42JWB11/11/85 
 1                                                                 
 2 \ Move to end of the line.                                      
 3 : END-OF-LINE ( --  -- )                                        
 4         ?LINE64* DUP SCREEN C/L -TRAILING                       
 5         NIP + CURSOR! .CURSOR ;                                 
 6                                                                 
 7 \ Move to the start of the line.                                
 8 : START-OF-LINE ( --  -- )                                      
 9         ?LINE64* CURSOR! .CURSOR ;                              
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 80 not modified     
 0 \ STRING-INPUT                                 21:14JWB11/08/85 
 1                                                                 
 2 \ Fetch string from user and return character count.            
 3 : STRING-INPUT  ( --  n )                                       
 4      HERE  1+  30 EXPECT                                        
 5      SPAN @ DUP  HERE C!      ;                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 81 not modified     
 0 \          .SCH-TARGET                         20:45JWB11/06/85 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5 : .SCH-TARGET                                                   
 6       1 CLEAR-PROMPT  ." Find string: " ASCII " VEMIT           
 7       0 SEARCHBUF          COUNT  VTYPE  ASCII " VEMIT          
 8       0 REPLACEBUF  C@                                          
 9       IF   4 SPACES  ." Replace with: " ASCII " VEMIT           
10            0 REPLACEBUF    COUNT  VTYPE  ASCII " VEMIT          
11       ELSE 4 SPACES  ." (Press any key to cancel.)"             
12       THEN ;                                                    
13                                                                 
14                                                                 
15                                                                 


Screen 82 not modified     
 0 \ .SCH-NO-FIND .SCH-ILLEGAL                    20:46JWB11/06/85 
 1                                                                 
 2                                                                 
 3 : .SCH-NO-FIND  ( --  -- )                                      
 4          1 CLEAR-PROMPT ." Can't find: " ASCII " VEMIT          
 5          0 SEARCHBUF  COUNT  VTYPE  ASCII " VEMIT  BEEP         
 6          PUSH-TO-PROCEED  ;                                     
 7                                                                 
 8 : .SCH-ILLEGAL ( --  -- )                                       
 9        1 CLEAR-PROMPT  ." No FIND argument" BEEP                
10        PUSH-TO-PROCEED  ;                                       
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 83 not modified     
 0 \ .SCH-ABORTED SEARCH-INPUT                    21:16JWB11/08/85 
 1                                                                 
 2                                                                 
 3 : .SCH-ABORTED  ( --  -- )                                      
 4          1 CLEAR-PROMPT  ." Search aborted" BEEP                
 5          PUSH-TO-PROCEED  ;                                     
 6                                                                 
 7 : SEARCH-INPUT ( --  -- )                                       
 8        1 CLEAR-PROMPT                                           
 9        ." String to find <return> : "                           
10        STRING-INPUT ?DUP                                        
11        IF DUP  >R  0  SEARCHBUF  C!                             
12           HERE  1+  1  SEARCHBUF                                
13           R>  CMOVE                                             
14        THEN ;                                                   
15                                                                 


Screen 84 not modified     
 0 \ REPLACE-INPUT                                09:40JWB06/22/85 
 1                                                                 
 2                                                                 
 3 : REPLACE-INPUT                                                 
 4          1 CLEAR-PROMPT  ." Replace with <return> : "           
 5          STRING-INPUT  ?DUP                                     
 6          IF DUP  >R  0  REPLACEBUF  C!                          
 7             HERE  1+  1  REPLACEBUF R>  CMOVE                   
 8          THEN ;                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 85 not modified     
 0 \ .REP-ILLEGAL .REP-MISSING                    20:44JWB11/11/85 
 1 \ Display replace error message.                                
 2 : .REP-ILLEGAL ( --  -- )                                       
 3    1 CLEAR-PROMPT   ." REPLACE argument too long"               
 4    BEEP   ;                                                     
 5                                                                 
 6 \ Display replace error message.                                
 7 : .REP-MISSING ( --  -- )                                       
 8    1 CLEAR-PROMPT                                               
 9    ." Missing FIND or REPLACE argument" BEEP   ;                
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 86 not modified     
 0 \ REPLACE-VALIDATE                             20:45JWB11/11/85 
 1                                                                 
 2 \ Validate search and replace arguments.                        
 3 : REPLACE-VALIDATE ( --  -- )                                   
 4    0  SEARCHBUF  C@  0=  0  REPLACEBUF  C@                      
 5    0=  OR                                                       
 6      IF .REP-MISSING  0                                         
 7      ELSE 0  SEARCHBUF  C@  0  REPLACEBUF  C@  <                
 8         IF .REP-ILLEGAL  0                                      
 9         ELSE 1                                                  
10         THEN                                                    
11      THEN ;                                                     
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 87 not modified     
 0 \ SEARCH-SCREEN SEARCH-ADJUST                  20:47JWB11/11/85 
 1                                                                 
 2                                                                 
 3 \ Search screen n.                                              
 4 : SEARCH-SCREEN  (           )                                  
 5    BLOCK  OVER  +  OVER  1024 SWAP  -  1                        
 6    SEARCHBUF  0  SEARCHBUF  C@  MATCH  ROT  +  SWAP             
 7      IF 1                                                       
 8      ELSE DROP  0                                               
 9      THEN ;                                                     
10                                                                 
11                                                                 
12 : SEARCH-ADJUST   0  SEARCHBUF  C@  -  ;                        
13                                                                 
14                                                                 
15                                                                 


Screen 88 not modified     
 0 \ SEARCH-TO-END                                23:38JWB06/23/85 
 1                                                                 
 2 : SEARCH-TO-END                                                 
 3      !(SCREEN#)  FLUSH  .READING  SCREEN#  @                    
 4      BEGIN CUR@ .CLOCK CUR! (KEY?)                              
 5         IF DROP  .SCH-ABORTED  0  $REPLACE  !                   
 6          CURSOR-LEFTWORD  KEY  DROP  EXIT                       
 7         THEN 1+  DUP  ?SCREENS >                                
 8         IF DROP  EMPTY-BUFFERS  .SCH-NO-FIND  0  $REPLACE  !    
 9          CURSOR-LEFTWORD  EXIT                                  
10         ELSE 0  OVER  SEARCH-SCREEN                             
11            IF SEARCH-ADJUST  CURSOR!  SCREEN#  !                
12             @(SCREEN#)  .SCREEN  .CLEAN EXIT                    
13            THEN                                                 
14         THEN                                                    
15    AGAIN ;                                                      


Screen 89 not modified     
 0 \ SEARCH-FILE                                  23:07JWB06/20/85 
 1                                                                 
 2                                                                 
 3 : SEARCH-FILE ( --  -- )                                        
 4          -1  $REPLACE  !                                        
 5          CURSOR-RIGHTWORD  CURSOR@                              
 6          SCREEN#  @  SEARCH-SCREEN                              
 7          IF   SEARCH-ADJUST  CURSOR!                            
 8          ELSE SEARCH-TO-END                                     
 9          THEN ;                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 90 not modified     
 0 \ REPLACE-STRING                               10:51JWB11/10/85 
 1                                                                 
 2 : REPLACE-STRING ( --  -- )                                     
 3      $REPLACE  @                                                
 4      IF  ADCUR            0                                     
 5          SEARCHBUF  C@  BLANK  0                                
 6          REPLACEBUF  COUNT                                      
 7          ADCUR            SWAP  CMOVE                           
 8          .CURSOR  ADCUR                                         
 9          0  SEARCHBUF  C@  VTYPE                                
10      THEN ;                                                     
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 91 not modified     
 0 \ HLP1                                         10:48JWB11/10/85 
 1                                                                 
 2                                                                 
 3 : HLP1 ( --  -- )                                               
 4      2 20 AT 24 VEMIT ."  or ^E cursor up"                      
 5      2 21 AT 25 VEMIT ."  or ^X cursor down"                    
 6      2 22 AT 26 VEMIT ."  or ^D cursor right"                   
 7      2 23 AT 27 VEMIT ."  or ^S cursor left"                    
 8     26 20 AT ." aD transpose right"                             
 9     26 21 AT ." aS transpose left"                              
10     26 22 AT 17 VEMIT 217 VEMIT ."   new line"                  
11     26 23 AT ." F1 more help"                                   
12     52 20 AT ." ^Home  start of text"                           
13     52 21 AT ."  Home  start of line"                           
14     52 22 AT ."  End   end of line"                             
15     52 23 AT ." ^End   end of text"    ;                        


Screen 92 not modified     
 0 \ HLP2                                         13:44JWB11/10/85 
 1                                                                 
 2 : HLP2  ( --  --  )                                             
 3    2 20 AT  26 VEMIT  221 VEMIT ."  or ^I tab right"            
 4    2 21 AT 222 VEMIT   27 VEMIT ."  or ^O tab left"             
 5    2 22 AT  94 VEMIT   26 VEMIT ."  or ^F word right"           
 6    2 23 AT  94 VEMIT   27 VEMIT ."  or ^A word left"            
 7   26 20 AT ." ^Q followed by any"                               
 8   29 21 AT    ." character will"                                
 9   29 22 AT    ." move to its"                                   
10   29 23 AT    ." first occurance"                               
11   52 20 AT ." F7 find string"                                   
12   52 21 AT ." ^L find again"                                    
13   52 22 AT ." F8 find & replace"                                
14   52 23 AT ." F1 more help" ;                                   
15                                                                 


Screen 93 not modified     
 0 \ HLP3                                         17:56JWB11/09/85 
 1                                                                 
 2 : HLP3   ( --  -- )                                             
 3     1 20 AT ." ^G  delete char "                                
 4     1 21 AT  17 VEMIT  196 VEMIT ."   backsp & erase"           
 5     1 22 AT ." DEL backsp & delete"                             
 6     1 23 AT ." ^C see ins buf"                                  
 7    22 20 AT ." ^T delete word"    22 21 AT ." ^R recall word"   
 8    22 22 AT ." ^B clr ins buf"    22 23 AT ." ^V recall char"   
 9    41 20 AT ." ^Y delete line"    41 21 AT ." ^U erase line"    
10    41 22 AT ." aU  erase to EOL"  41 23 AT ." INS insert toggle"
11    61 20 AT ." ^N  insert line"   61 21 AT ." aN split line"    
12    61 22 AT ." ^W insert space"   61 23 AT ." F1 more help"  ;  
13                                                                 
14                                                                 
15                                                                 


Screen 94 not modified     
 0 \ HLP4                                         10:48JWB11/10/85 
 1                                                                 
 2 : HLP4   ( --  -- )                                             
 3     1 20 AT ."  PgUp previous screen"                           
 4     1 21 AT ." ^R    recall word"                               
 5     1 22 AT ." ^PgUp first screen"                              
 6    26 20 AT ."  PgDn next screen"                               
 7    26 21 AT ." ^C    see ins buf"                               
 8    26 22 AT ." ^PgDn last screen"                               
 9    52 20 AT ." ^Z enter new screen"                             
10    52 21 AT ." aA shadow  screen"                               
11    52 22 AT ." F1 more help"  ;                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 95 not modified     
 0 \ HLP5                                         17:56JWB11/09/85 
 1                                                                 
 2 : HLP5   ( --  -- )                                             
 3     1 20 AT ." ^J = join lines"                                 
 4     1 21 AT ." ^P = print screen"                               
 5     1 22 AT ." aB = Better colors?"                             
 6    21 20 AT ." aC = copy 1 screen"                              
 7    21 21 AT ." aD = +transpose"                                 
 8    21 22 AT ." aG = get directory"                              
 9    41 20 AT ." aI = screen index"                               
10    41 21 AT ." aM = copy many scrs"                             
11    41 22 AT ." aO = open new file"                              
12    61 20 AT ." aS = -transpose"                                 
13    61 21 AT ." aT = set tab stops"                              
14    61 22 AT ." ESC= exit editor"                                
15    61 23 AT ." F1 = more help"    ;                             


Screen 96 not modified     
 0 \ HLP6                                         10:04JWB11/10/85 
 1 : HLP6   ( --  -- )                                             
 2     1 20 AT ." aF2 set stamp"                                   
 3     1 21 AT ." F2  date stamp"                                  
 4     1 22 AT ." F3  push line"                                   
 5    18 20 AT ." F4 push & Delete"                                
 6    18 21 AT ." F5 pop line"                                     
 7    18 22 AT ." F6 spread & pop"                                 
 8    38 20 AT ." F7 find string"                                  
 9    38 21 AT ." F8 find&replace"                                 
10    38 22 AT ." F9 erase screen"                                 
11    58 20 AT ." aF9 erase to EOS"                                
12    58 21 AT ." F10 restore screen"                              
13    58 22 AT ." F1  more help"  ;                                
14                                                                 
15                                                                 


Screen 97 not modified     
 0 \ HLP0                                         10:41JWB11/10/85 
 1 : HLP0   ( --  -- )                                             
 2    1 20 AT ." ^A word left"        1 21 AT ." ^C see ins buf"   
 3    1 22 AT ." ^D cursor right"     1 23 AT ." ^E cursor up"     
 4    1 24 AT ." ^F word right"      21 20 AT ." ^G delete under"  
 5   21 21 AT ." ^H delete behind"   21 22 AT ." ^I tab forward"   
 6   21 23 AT ." ^J join lines"      21 24 AT ." ^L repeat find"   
 7   41 20 AT ." ^N ins new line"    41 21 AT ." ^O tab backward"  
 8   41 22 AT ." ^P print screen"    41 23 AT ." ^Q quick to char" 
 9   41 24 AT ." ^S cursor right"    61 20 AT ." ^T delete word"   
10   61 21 AT ." ^U blank line"                                    
11   61 22 AT ." ^W ins blank char"                                
12   61 23 AT ." ^Y delete line"                                   
13   61 24 AT ." ^Z new screen"    ;                               
14                                                                 
15                                                                 


Screen 98 not modified     
 0 \ +HELP .MENU                                  10:48JWB11/10/85 
 1   VARIABLE  VHELP                                               
 2                                                                 
 3 : +HELP  ( -- -- )  \ Increment to next help screen.            
 4    VHELP @ 1+ 7 MOD  VHELP ! ;                                  
 5                                                                 
 6 : .MENU  ( --  -- )                                             
 7    .CLEAN  5  CLEAR-PROMPT                                      
 8    CASE  VHELP @    DUP IF .HOLD THEN                           
 9    0 OF  HLP0 ENDOF     1 OF  HLP1  ENDOF                       
10    2 OF  HLP2  ENDOF    3 OF  HLP3  ENDOF                       
11    4 OF  HLP4  ENDOF    5 OF  HLP5  ENDOF                       
12    6 OF  HLP6  ENDOF                                            
13    ENDCASE .CURSOR  ;                                           
14                                                                 
15                                                                 


Screen 99 not modified     
 0 \                                              10:03JWB11/10/85 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 100 not modified     
 0 \ CERROR                                       14:09JWB11/10/85 
 1 \ Screen color if we have an error.                             
 2    79 CONSTANT CERROR                                           
 3    31 CONSTANT CNORMAL                                          
 4    14 CONSTANT CBROWSE                                          
 5       VARIABLE ERRORS                                           
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 101 not modified     
 0 \ COLOR-INPUT                                  20:56JWB11/11/85 
 1                                                                 
 2                                                                 
 3 \ Choose the text background and forground colors.              
 4 : COLOR-INPUT ( --  -- )                                        
 5         15 ATRIB !                                              
 6         CLEARSCREEN 0 2 AT                                      
 7         128 0 DO I ATRIB ! I 4 .R LOOP                          
 8           15 ATRIB !  CR CR                                     
 9         ." Choose text color  : "      #IN                      
10         1 MAX 127 MIN  ATRIB !                                  
11         CLEARSCREEN BORDER .SCREEN .MENU .HOLD .CURSOR ;        
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 102 not modified     
 0 \ SET-STAMP  SHOW-IBUF                         20:51JWB11/11/85 
 1 \ Reset initials for auto date stamp.                           
 2 : SET-STAMP  ( --  -- )                                         
 3     $AUTO DUP @ IF OFF ELSE ON THEN                             
 4     $AUTO @                                                     
 5     IF $INITIALS  C@  0=                                        
 6        IF 1 CLEAR-PROMPT ." Enter your initials: "              
 7            HERE  20 EXPECT  SPAN  @  3  MIN  $INITIALS          
 8            C!  HERE  $INITIALS  1+  SPAN  @  3  MIN             
 9            CMOVE   1 CLEAR-PROMPT                               
10        THEN                                                     
11     THEN  .STAMP  .MENU .CURSOR ;                               
12 \ Display contents of insert buffer.                            
13 : SHOW-IBUF ( --  -- )                                          
14      4 CLEAR-PROMPT  0 INSBUF IPTR @ VTYPE                      
15      CR PUSH-TO-PROCEED .MENU .CURSOR ;                         


Screen 103 not modified     
 0 \ ONE-COPY COPY-ABORT                          10:49JWB11/10/85 
 1     VARIABLE <INCR> VARIABLE FINI?                              
 2 \ Copy one screen to another.                                   
 3 : ONE-COPY  ( --  -- )                                          
 4         !(SCREEN#) .CLEAN 2 CLEAR-PROMPT                        
 5          ." Enter screen # to copy from : " #IN  SCREEN#  !     
 6          @(SCREEN#)  6 21  AT                                   
 7          ." Enter screen # to copy to :   " #IN  SCREEN#  !     
 8         !(SCREEN#) 2 CLEAR-PROMPT  NEW-SCREEN                   
 9         .MENU .HOLD .CURSOR ;                                   
10                                                                 
11 \ Send copy abort message.                                      
12 : .CPY-ABORT ( --  -- )                                         
13          6 21 AT                                                
14         ." MULTIPLE BLOCK COPY ABORTED!!" BEEP ;                
15                                                                 


Screen 104 not modified     
 0 \ (TRANSFER)                                   20:59JWB11/11/85 
 1 \ Copy screem range, first thru last to destination.            
 2 : (TRANSFER) ( first last dest  -- )                            
 3      2  PICK  -  DUP  0<                                        
 4      IF    1 <INCR> !  SWAP  1+  ROT                            
 5      ELSE -1 <INCR> !  ROT ROT THEN                             
 6      ?DO  I  DUP  .READING                                      
 7           3 CLEAR-PROMPT ." Coppying screen # " .               
 8           SCREEN#  !  CUR@  NEW-SCREEN   .CLOCK CUR!            
 9           I OVER  +  DUP  ." to screen # " . .WRITING           
10           6 21 AT     ." Press any key to abort copying!"       
11           BLOCK  0  SCREEN  SWAP  1024 CMOVE                    
12           (KEY?) IF .CPY-ABORT LEAVE THEN                       
13           UPDATE  FLUSH <INCR>  @ +LOOP DROP  ;                 
14                                                                 
15                                                                 


Screen 105 not modified     
 0 \ MULTI-COPY                                   20:52JWB11/11/85 
 1 : MULTI-COPY                                                    
 2         !(SCREEN#) .CLEAN 3 CLEAR-PROMPT                        
 3      ." First source screen # :      " #IN  6 21  AT            
 4      ." Last source screen # :       " #IN  6 22  AT            
 5      ." First destination screen # : " #IN  (TRANSFER)          
 6      3 CLEAR-PROMPT NEW-SCREEN   .MENU .HOLD .CURSOR ;          
 7 \ Convert word to upper case.                                   
 8 : UCASE   HERE  SWAP  OVER  +  SWAP                             
 9      ?DO I  C@  97 122 WITHIN                                   
10         IF 32 I CTOGGLE THEN LOOP ;                             
11 \ Get screen filen name from user.                              
12 : FILENAME-INPUT ( --  adr )                                    
13      BEGIN 1 CLEAR-PROMPT  ." Enter screen file name :   "      
14       STRING-INPUT  ?DUP                                        
15      UNTIL UCASE  HERE  ;                                       


Screen 106 not modified     
 0 \ DRIVE-INPUT                                  20:53JWB11/11/85 
 1                                                                 
 2 : DRIVE-INPUT                                                   
 3      STRING-INPUT  DUP  UCASE                                   
 4      IF HERE  1+  C@  DUP  96 >                                 
 5         IF 32 -                                                 
 6         THEN 64 -  1  MAX  63 MIN                               
 7      ELSE 0 25  BDOS   1+  8 VEMIT  DUP                         
 8       64 +  VEMIT                                               
 9      THEN ;                                                     
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 107 not modified     
 0 \ QUICK INDEX                                  18:51jwb11/05/85 
 1 : QUICK-INDEX                                                   
 2      !(SCREEN#) .CLEAN  2 CLEAR-PROMPT                          
 3      ." Enter first screen #  : " #IN CHECK-SCREEN 6 21 AT      
 4      ." Enter final screen #  : " #IN CHECK-SCREEN 2DUP <       
 5    IF  SAVE-BUFFERS  CLEARSCREEN    15 1 AT                     
 6       ." Index for screen file  "  FILE? CR CR  1+ SWAP         
 7     DO  I 3 .R SPACE I BLOCK 2+ 14 VTYPE                        
 8         #OUT @ 60 >                                             
 9         IF    CR                                                
10         ELSE #OUT @ 20 MOD 20 SWAP - SPACES  THEN               
11         (KEY?) IF KEY 13 = ?LEAVE CR PUSH-TO-PROCEED CR THEN    
12     LOOP  CR   PUSH-TO-PROCEED  SSS   5 MOD 5 * $SECONDS !      
13     BORDER .STATE .MENU .HOLD NEW-SCREEN                        
14    ELSE 2DROP THEN ;                                            
15                                                                 


Screen 108 not modified     
 0 \ $DIR                                         13:59JWB11/10/85 
 1 \ Default drive input string.                                   
 2 : $DIR ( --  adr n )                                            
 3        " C:*.*" ;                                               
 4                                                                 
 5 : OPEN-NEW-FILE ( --  -- )                                      
 6            !(SCREEN#)                                           
 7            FILE @  PREV-FILE  42 CMOVE  FLUSH                   
 8            FILE @ [ DOS ]  CLOSE [ EDITOR ]                     
 9            FILENAME-INPUT  OPEN-SCR                             
10            IF 1 CLEAR-PROMPT                                    
11               ." Can't find: " FILE? PREV-FILE CUR-FILE         
12            42 CMOVE [ DOS ] OPEN-FILE [ EDITOR ]                
13            ELSE  SCREEN# OFF                                    
14            THEN  NEW-SCREEN   ;                                 
15                                                                 


Screen 109 not modified     
 0 \  QUICK-DIR  ANOTHER-SEARCH                   21:00JWB11/11/85 
 1 \ Lists files on specified drive.                               
 2 : QUICK-DIR  ( --  -- )                                         
 3         !(SCREEN#) 1 CLEAR-PROMPT CURSOR@                       
 4         ." Enter drive:file - " STRING-INPUT  DROP              
 5         .BLANK-SCREEN                                           
 6         HERE (DIR) .CLEAN                                       
 7         1 CLEAR-PROMPT PUSH-TO-PROCEED .MENU                    
 8         NEW-SCREEN CURSOR! .CURSOR  ;                           
 9 \ Repeat previous search and replace.                           
10 :  ANOTHER-SEARCH  ( --  -- )                                   
11           !(SCREEN#)  0  0 REPLACEBUF  C!  0 SEARCHBUF  C@      
12           IF .SCH-TARGET  SEARCH-FILE                           
13           ELSE .SCH-ILLEGAL                                     
14           THEN  .CLEAN  .MENU .CURSOR   ;                       
15                                                                 


Screen 110 not modified     
 0 \ BACK-SPACE-KEY  RETURN-KEY  TABSET           21:01JWB11/11/85 
 1 : BACK-SPACE-KEY ( --  -- )                                     
 2           KBF 128 AND ( check for insert mode )                 
 3           IF   DELETE-CHARLFT                                   
 4           ELSE BACKSPACE  @   THEN   ;                          
 5 \ Move to next line.                                            
 6 : RETURN-KEY ( --  -- )                                         
 7       ?LINE 1+ 16 MOD C/L *  DUP SCREEN C/L -TRAILING           
 8        NIP + CURSOR!  CURSOR-CHK  .CURSOR   ;                   
 9 \ Reset the current tab stops.                                  
10 : TABSET  ( --  -- )                                            
11         1 CLEAR-PROMPT ." Tab stops are now set at "            
12         TAB# @ .  ." enter new setting : "  #IN                 
13         2 MAX 63 MIN TAB# ! .MENU  .CURSOR ;                    
14                                                                 
15                                                                 


Screen 111 not modified     
 0 \  ENTER-SCR                                   17:58JWB06/22/85 
 1 : ENTER-SCR ( --  -- )                                          
 2      1 CLEAR-PROMPT ASK-SCR GO-SCR                              
 3      .MENU .CURSOR ;                                            
 4 : FIND-IT ( --  -- )                                            
 5          !(SCREEN#)  0  0  REPLACEBUF  C!                       
 6           .CLEAN SEARCH-INPUT  0  SEARCHBUF  C@                 
 7           IF .SCH-TARGET  SEARCH-FILE                           
 8           ELSE .SCH-ILLEGAL                                     
 9           THEN .CLEAN .MENU  .CURSOR  ;                         
10 : SEARCH-FOR-IT ( --  -- )                                      
11           !(SCREEN#)  .CLEAN SEARCH-INPUT                       
12           REPLACE-INPUT  REPLACE-VALIDATE                       
13           IF .SCH-TARGET  SEARCH-FILE  REPLACE-STRING           
14           THEN .CLEAN .MENU .CURSOR  ;                          
15                                                                 


Screen 112 not modified     
 0 \ (IBM)                                        21:50JWB11/07/85 
 1 : (IBM)                                                         
 2   DUP                                                           
 3   CASE                                                          
 4   BACK-TAB    OF TAB-LEFT          ENDOF                        
 5  ^HOME        OF START-OF-SCREEN   ENDOF                        
 6  ^END         OF END-OF-SCREEN     ENDOF                        
 7   HOME        OF START-OF-LINE     ENDOF                        
 8   END         OF END-OF-LINE       ENDOF                        
 9  ^PG-UP       OF FIRST-SCR         ENDOF                        
10  ^PG-DN       OF LAST-SCR          ENDOF                        
11   PG-UP       OF PREV-SCREEN       ENDOF                        
12   LEFT-ARROW  OF BACKUP            ENDOF                        
13  ^LEFT-ARROW  OF CURSOR-LEFTWORD   ENDOF                        
14  ^RIGHT-ARROW OF CURSOR-RIGHTWORD  ENDOF                        
15                                                                 


Screen 113 not modified     
 0 \ (IBM) ...                                    21:51JWB11/07/85 
 1   RIGHT-ARROW OF FORWARD           ENDOF                        
 2    UP-ARROW   OF TAB-UP            ENDOF                        
 3    DOWN-ARROW OF TAB-DOWN          ENDOF                        
 4    PG-DN      OF NEXT-SCREEN       ENDOF                        
 5    INS        OF .STATE            ENDOF                        
 6    ALTA       OF GO-SHADOW         ENDOF                        
 7    ALTB       OF COLOR-INPUT       ENDOF                        
 8    ALTG       OF QUICK-DIR         ENDOF                        
 9    ALTT       OF TABSET            ENDOF                        
10    ALTO       OF OPEN-NEW-FILE     ENDOF                        
11    ALTI       OF QUICK-INDEX       ENDOF                        
12    F1         OF +HELP .MENU       ENDOF                        
13    ALTF2      OF SET-STAMP         ENDOF                        
14    F7         OF FIND-IT           ENDOF                        
15    ENDCASE                                                      


Screen 114 not modified     
 0 \ (IBM) ...                                    18:27JWB11/09/85 
 1    BROWSING @ IF DROP ELSE                                      
 2    CASE                                                         
 3                                                                 
 4    DEL        OF DELETE-CHAR   ENDOF                            
 5    ALTC       OF ONE-COPY      ENDOF                            
 6    ALTD       OF +TRANSPOSE    ENDOF                            
 7    ALTM       OF MULTI-COPY    ENDOF                            
 8    ALTN       OF SPLIT-LINE    ENDOF                            
 9    ALTU       OF ERASE-EOL     ENDOF                            
10    ALTS       OF -TRANSPOSE    ENDOF                            
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 115 not modified     
 0 \ (IBM) ..                                     22:04JWB06/20/85 
 1    F2 OF DATE-SCREEN 0 .LINE                                    
 2            2 CURSOR! .CURSOR        ENDOF                       
 3    F3 OF PUSH-LINE  TAB-DOWN          ENDOF                     
 4    F4 OF PUSH-LINE  DELETE-LINE       ENDOF                     
 5    F5 OF HOLD-DEPTH  @                                          
 6          IF POP-LINE  TAB-UP THEN     ENDOF                     
 7    F6 OF HOLD-DEPTH  @                                          
 8          IF SPREAD-LINE POP-LINE THEN ENDOF                     
 9       F8  OF  SEARCH-FOR-IT ENDOF                               
10       F9  OF  ERASE-SCREEN  ENDOF                               
11    ALTF9  OF  ERASE-TO-END  ENDOF                               
12      F10  OF  0  BACKBUF  0                                     
13               SCREEN  1024 CMOVE    CURSOR OFF .SCREEN  ENDOF   
14    ENDCASE  THEN  ;                                             
15                                                                 


Screen 116 not modified     
 0                                                                 
 1 :  CONTROL-CHAR                                                 
 2     DUP                                                         
 3     CASE                                                        
 4     1 OF CURSOR-LEFTWORD   ENDOF                                
 5     2 OF  IBLANK           ENDOF                                
 6     3 OF  SHOW-IBUF        ENDOF                                
 7     5 OF  TAB-UP           ENDOF                                
 8     4 OF  FORWARD          ENDOF                                
 9     6 OF  CURSOR-RIGHTWORD ENDOF                                
10     9 OF  TAB-RIGHT        ENDOF                                
11    12 OF  ANOTHER-SEARCH   ENDOF                                
12    13 OF  RETURN-KEY       ENDOF                                
13    15 OF  TAB-LEFT         ENDOF                                
14                                                                 
15                                                                 


Screen 117 not modified     
 0 \ (EDIT)                                       11:39JWB11/11/85 
 1                                                                 
 2    16 OF  CLEARSCREEN 1 1 AT PRINT-SCREEN  CLEARSCREEN          
 3           BORDER .SCREEN .MENU .HOLD .CURSOR        ENDOF       
 4    17 OF  FIND-CHARACTER   ENDOF                                
 5    19 OF  BACKUP           ENDOF                                
 6    24 OF  TAB-DOWN         ENDOF                                
 7    26 OF  ENTER-SCR        ENDOF                                
 8  ESC  OF  !(SCREEN#) FINI? ON  ENDOF                            
 9    ENDCASE                                                      
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 118 not modified     
 0 \ (EDIT)                                       18:25JWB11/09/85 
 1     BROWSING @ IF DROP ELSE                                     
 2     CASE                                                        
 3     7 OF  DELETE-CHAR      ENDOF                                
 4    BS OF  BACK-SPACE-KEY   ENDOF                                
 5    10 OF  JOIN-LINE        ENDOF                                
 6    14 OF  SPREAD-LINE      ENDOF                                
 7    18 OF  INSERT-WORDRIGHT ENDOF                                
 8    20 OF  DELETE-WORDRIGHT ENDOF                                
 9    21 OF  ERASE-LINE       ENDOF                                
10    22 OF  IGET             ENDOF                                
11    23 OF  SPREAD-CHAR      ENDOF                                
12    25 OF  DELETE-LINE      ENDOF                                
13    ENDCASE  THEN ;                                              
14                                                                 
15                                                                 


Screen 119 not modified     
 0 \ (EDIT) ...                                   11:40JWB11/11/85 
 1 : (EDIT)    BORDER  .MENU   .STATE                              
 2         @(SCREEN#) .SCREEN                                      
 3      ERRORS @                                                   
 4      IF ATRIB @ CERROR ATRIB ! .LINE-TO-END                     
 5         CURSOR-LEFTWORD ATRIB ! THEN                            
 6      BEGIN PCKEY  DUP 31 >                                      
 7      IF  BROWSING @ NOT                                         
 8          IF KBF   128 AND                                       
 9             IF    INSERT-CHAR                                   
10             ELSE  PUT-CHAR THEN                                 
11          ELSE  DROP  THEN                                       
12      ELSE  ?DUP                                                 
13            IF    CONTROL-CHAR                                   
14            ELSE  (IBM)   THEN                                   
15      THEN FINI? @ UNTIL  ;                                      


Screen 120 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 121 not modified     
 0 \ (VEDIT)                                      23:19JWB11/09/85 
 1 ONLY FORTH ALSO DOS ALSO FORTH DEFINITIONS                      
 2 : (VEDIT)  ( scr#   -- )                                        
 3         [ EDITOR ] DECIMAL 1 ?ENOUGH   DUP SCR !                
 4         TIB   DP @ - 4056 U<                                    
 5         IF   ." Not enough memory to EDIT"                      
 6         ELSE  DP  @  DUP  $SCRATCH  !                           
 7           3684 +  DP  !                                         
 8           HOLD-DEPTH  OFF  0  SEARCHBUF                         
 9           64 ERASE  0  REPLACEBUF  64 ERASE                     
10           8 TAB# !  FINI? OFF  IBLANK                           
11           FILE @ CUR-FILE 42 CMOVE FILE @ OLD-FILE !            
12           CUR-FILE  !FILES OPEN-FILE  SW  $INIT                 
13           TSMH OFF $SECONDS OFF  BROWSING @                     
14           IF  CBROWSE  ELSE  CNORMAL THEN  ATRIB !              
15           0 MAX ?SCREENS MIN SCREEN# ! (EDIT)                   


Screen 122 not modified     
 0 \ (VEDIT) ..                                   23:19JWB11/09/85 
 1             15 ATRIB !                                          
 2             BORDER .STATE  NEW-SCREEN  0 20 AT                  
 3             SCREEN# @ SCR !                                     
 4             FILE @  PREV-FILE  42 CMOVE                         
 5             FLUSH  FILE @  CLOSE   $SCRATCH @ DP !  -SW         
 6             ." You were editing screen # " SCREEN#  @  .        
 7             ." of " FILE? CR                                    
 8             ." Source file and disk directory updated." CR      
 9             OLD-FILE  @ !FILES OPEN-FILE                        
10             ." Current file is : " FILE?   LITTLE-CURSOR        
11          THEN  CR  ;  FORTH                                     
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 123 not modified     
 0 \ <WHERE>                                      14:10JWB11/10/85 
 1                                                                 
 2 : <WHERE> ( pos scr   -- )                                      
 3         CR R> R> R> 2DUP >R >R SPACE TYPE SPACE >R              
 4         2DUP ." Screen " . ." Line "  C/L / .                   
 5         ORDER  DISK-ERROR @ 0= [ EDITOR ]                       
 6         KEY BL = AND                                            
 7         IF SWAP  CURSOR! ERRORS ON (VEDIT) THEN  ;  FORTH       
 8                                                                 
 9 ' <WHERE> IS WHERE                                              
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 124 not modified     
 0 \  VEDIT  VED BROWSE                           14:10JWB11/10/85 
 1                                                                 
 2 : BROWSE  ( scr#  -- )                                          
 3         [ EDITOR ] BROWSING ON                                  
 4         CURSOR OFF ERRORS OFF  (VEDIT) ;  FORTH                 
 5 ' BROWSE IS EDIT                                                
 6 : VEDIT  ( scr#  -- )                                           
 7         [ EDITOR ] BROWSING OFF                                 
 8         CURSOR OFF ERRORS OFF  (VEDIT) ;  FORTH                 
 9 : VED  ( --  -- )                                               
10        [ EDITOR ]  BROWSING OFF                                 
11        SCR @ 0 MAX ?SCREENS MIN                                 
12        CURSOR OFF  ERRORS OFF  (VEDIT) ;  FORTH                 
13                                                                 
14                                                                 
15                                                                 


Screen 125 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 126 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 127 not modified     
 0                                                                 
 1 ONLY EDITOR ALSO FORTH ALSO                                     
 2 \ Leave true flag if KBF has changed.  New value in $KBF .      
 3 CODE KBF?  ( --  flag ) \ Was:  $KBF @ KBF DUP $KBF ! <>        
 4         2 # AH MOV      \ Function number 2 for kb flag         
 5             22 INT      \ Call KBF is returned in AL            
 6          AH AH SUB      \ Clear high byte of AX.                
 7      $KBF # DI MOV      \ Address of old KBF to DI              
 8     0 [DI]  BX MOV      \ Fetch old value of KBF                
 9          AX BX CMP      \ Compare new value with old.           
10 0= IF    AX AX SUB      \ Leave false flag if the same          
11  ELSE AX 0 [DI] MOV     \ Update $KBF and                       
12        -1 # AX MOV      \ return true if KBF has changed.       
13  THEN          1PUSH    \ Push AX and fall into NEXT            
14                END-CODE                                         
15 : TEST CLEARSCREEN BEGIN CR KBF? U. $KBF ? KEY? UNTIL ;         


Screen 128 not modified     
 0 \                                              18:23jwb11/05/85 
 1 ONLY EDITOR ALSO FORTH ALSO DEFINITIONS                         
 2                                                                 
 3 CREATE TSMH  4 ALLOT                                            
 4 CODE  @TIME ( --  -- )                                          
 5     44 ( 2C) # AH MOV                                           
 6     33 ( 21)      INT                                           
 7         TSMH # DI MOV                                           
 8        DX  0 [DI] MOV                                           
 9        CX  2 [DI] MOV                                           
10             NEXT  END-CODE                                      
11 : TT TSMH C@ ; : SS TSMH 1+ C@ ;  : MM TSMH 2+ C@ ;             
12 : HH TSMH 3 + C@ ;                                              
13 : TEST CLEARSCREEN                                              
14        BEGIN 1 1 AT @TIME HH 3 U.R MM 3 U.R                     
15                           SS 3 U.R TT 3 U.R   KEY? UNTIL ;      


Screen 129 not modified     
 0 \ ?MODE                                        23:09JWB11/04/85 
 1 \ Read current video mode.                                      
 2 \ 0 = 40x25 bw          3 = 80x25 color  4 = 320x200 color      
 3 \ 1 = 40x25 color       5 = 320x200 bw                          
 4 \ 2 = 80x25 bw          6 = 640x200 bw                          
 5 \                                                               
 6 CODE ?MODE   ( --  mode )                                       
 7         15 # AH MOV             \ Read video state is #15.      
 8              16 INT             \ Call video io routines.       
 9           AH AH SUB             \ Clear high byte.              
10                 1PUSH           \ Push AX which contains mode.  
11                 END-CODE                                        
12 \ Note Function 15 of   16 INT  also returns:                   
13 \ Number of columns on the screen in  AH  and current active    
14 \ page in BH.  Both of these are ignored by ?MODE               
15 : MODE!  0 0 0 VIDEO-IO 2DROP 2DROP ;                           

projects/editor.blk.txt · Zuletzt geändert: 2013-06-06 21:27 von 127.0.0.1