Benutzer-Werkzeuge

Webseiten-Werkzeuge


projects:ledit.blk

DOSEDIT style forth input line editor

Screen 0 not modified     
 0                                                                 
 1 \ Last change:   Screen  029                   14:33JWB03/03/87 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 1 not modified     
 0 \ LEDIT LOAD SCREEN                            11:29JWB11/23/85 
 1                                                                 
 2 ONLY FORTH DEFINITIONS ALSO                                     
 3                                                                 
 4     : LTASK ;                                                   
 5                                                                 
 6     2  35  THRU                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 2 not modified     
 0 \ Line editor variables                        09:49JWB02/07/86 
 1                                                                 
 2 ONLY EDITOR ALSO FORTH DEFINITIONS                              
 3                                                                 
 4 VARIABLE %MOD   \ Type-over/Insert flag.   True=Insert.         
 5 VARIABLE %BUF   \ Address of line buffer.                       
 6 VARIABLE %MLEN  \ Length of line buffer.                        
 7 VARIABLE %OFF   \ Offset to start of line.                      
 8 VARIABLE %ROW   \ Current row or vertical position on screen.   
 9 VARIABLE %POS   \ Current position in the line.                 
10 VARIABLE %DONE  \ Finished flag.  If true then quit.            
11 VARIABLE LKEY   \ Last key code pressed.                        
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 3 not modified     
 0 \ #R  POS@                                     09:49JWB02/07/86 
 1                                                                 
 2 : #R    ( --  n )  \ Leave n, characters to right of cursor.    
 3                                                                 
 4         %MLEN @    \ Fetch length of line buffer.               
 5         %POS @     \ Fetch current cursor position.             
 6         - ;        \ Subtract leaving number of characters to   
 7                    \ right of cursor.                           
 8                                                                 
 9 : POS@  ( --  adr ) \ Leave address of current cursor position. 
10                                                                 
11         %BUF @     \ Fetch address of line buffer.              
12         %POS @     \ Fetch current cursor position.             
13         + ;        \ Add leaving current address of cursor.     
14                                                                 
15                                                                 


Screen 4 not modified     
 0 \ CUR                                          09:49JWB02/07/86 
 1                                                                 
 2 : CUR   ( row col   -- ) \ Position cursor at  (col,row)        
 3                                                                 
 4         80 MOD          \ Calculate column position.            
 5         SWAP            \ Bring row to top of stack.            
 6         25 MOD          \ Calculate row position.               
 7         GOTOXY ;        \ Word that positions cursor.           
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 5 not modified     
 0 \ .POS                                         09:49JWB02/07/86 
 1                                                                 
 2 : .POS  ( --   -- ) \ Move cursor to its current position.      
 3                                                                 
 4         %POS @      \ Fetch current position in line.           
 5         %MLEN @     \ Fetch length of line buffer.              
 6         MOD         \ Divide leaving cursor position.           
 7         %OFF @ +    \ Fetch offset to start of line and add     
 8                     \ to cursor position.                       
 9         %ROW @      \ Fetch current row.                        
10         SWAP        \ Put (col,row) in proper order for CUR     
11         CUR ;       \ Position cursor at (col,row).             
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 6 not modified     
 0 \ !POS  +POS                                   09:49JWB02/07/86 
 1                                                                 
 2 : !POS  ( n    -- ) \ Set current position to n.                
 3                                                                 
 4         %MLEN @ MOD   \ Take top stack value and divide by      
 5                       \ length of line buffer, leaving remainder
 6         %POS ! ;      \ which is stored at current position in  
 7                       \ line.                                   
 8                                                                 
 9 : +POS  ( n    -- ) \ Increment current position by n.          
10                                                                 
11         %POS @ +      \ Fetch current position in line and add  
12         !POS ;        \ value "n" to it. Store back at current  
13                       \ position in line.                       
14                                                                 
15                                                                 


Screen 7 not modified     
 0 \ +.POS  HOM                                   09:49JWB02/07/86 
 1                                                                 
 2 : +.POS ( n    -- ) \ Increment by n and display at new location
 3                                                                 
 4         +POS        \ Increments current position by "n"        
 5         .POS ;      \ Moves cursor to its current position.     
 6                                                                 
 7                                                                 
 8 : HOM   ( --   -- )     \ To begining of line, type-over mode.  
 9                                                                 
10         %POS OFF    \ Set current position in line to zero.     
11         .POS        \ Move cursor to current position in line.  
12         %MOD OFF ;  \ Set insert mode to false.                 
13                                                                 
14                                                                 
15                                                                 


Screen 8 not modified     
 0 \ !CHAR  ECHO                                  09:49JWB02/07/86 
 1                                                                 
 2 : !CHAR ( char   -- )   \ Store character at current position.  
 3                                                                 
 4         POS@ C!     \ Fetch address of current cursor position  
 5                     \ and store character there.                
 6         1 +.POS ;   \ Increment cursor position by one and      
 7                     \ display at new location.                  
 8                                                                 
 9 : ECHO  ( char   -- )   \ Echo character and store character.   
10                                                                 
11         DUP  (CONSOLE)  \ Output character to console device.   
12         !CHAR ;         \ Store character at current position.  
13                                                                 
14                                                                 
15                                                                 


Screen 9 not modified     
 0 \ CTYPE                                        09:49JWB02/07/86 
 1                                                                 
 2 : CTYPE  ( adr cnt   -- ) \ Send string to console only.        
 3                                                                 
 4         0 ?DO           \ Set up loop with character count.     
 5             COUNT       \ Fetch char from adr and increment     
 6                         \ adr by one.                           
 7             (CONSOLE)   \ Output char to current console device.
 8           LOOP          \ Loop back.                            
 9           DROP ;        \ Clean up stack.                       
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 10 not modified     
 0 \ .LIN                                         09:49JWB02/07/86 
 1                                                                 
 2 : .LIN  ( --   -- )     \ Update entire line.                   
 3         %POS @     \ Fetch current position in line.            
 4         HOM        \ Move cursor to beginning of line.          
 5         %BUF @     \ Fetch address of line buffer.              
 6         %MLEN @    \ Fetch length of line buffer.               
 7         CTYPE      \ Output entire line buffer to console.      
 8         %POS !     \ Restore previous cursor position in line   
 9         .POS   ;   \ and move cursor to the current position.   
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 11 not modified     
 0 \ RUB                                          09:49JWB02/07/86 
 1                                                                 
 2 : RUB   ( --   -- )     \ Rub out character behind cursor.      
 3                                                                 
 4         -1 +.POS     \ Decrement current cursor position by one 
 5         BL  ECHO     \ Store a blank and echo to console.       
 6         -1 +.POS ;   \ Echo incremented cursor position by one  
 7                      \ so we must decrement by one again.       
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 12 not modified     
 0 \ MEOL                                         09:49JWB02/07/86 
 1                                                                 
 2 : MEOL  ( --   -- )     \ Move to end of line.                  
 3                                                                 
 4         %BUF @ %MLEN @  \ Get address and length of line buffer.
 5         -TRAILING       \ Leave length excluding trailing spaces
 6         %MLEN @ 1- MIN  \ Leave line buffer length minus one    
 7                         \ or string length whichever is smaller.
 8         !POS DROP .POS  \ Move cursor to that position.         
 9         %MOD OFF ;      \ Turn off insert mode.                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 13 not modified     
 0 \ DEOL  DEALL                                  09:49JWB02/07/86 
 1                                                                 
 2 : DEOL  ( --   -- )     \ Delete to end of field.               
 3                                                                 
 4         POS@  #R   \ Get cursor position leaving number of      
 5                    \ characters to right of cursor.             
 6         BL FILL    \ Blanks from right of cursor to end of line.
 7         .LIN ;     \ Update entire line.                        
 8                                                                 
 9                                                                 
10 : DEALL ( --   -- )     \ Delete entire line.                   
11                                                                 
12         %BUF @ %MLEN @  \ Get address and length of line buffer.
13         BL FILL         \ Fill line with blanks.                
14         .LIN            \ Update entire line.                   
15         HOM ;           \ Move cursor to beginning of line.     


Screen 14 not modified     
 0 \ DCHAR                                        09:49JWB02/07/86 
 1                                                                 
 2 \ Delete character at cursor position and close gap created.    
 3 : DCHAR ( --   -- )                                             
 4                                                                 
 5         POS@ 1+ POS@            \ From adr and To adr           
 6         #R MOVE                 \ Number to move, move string   
 7         BL %BUF @ %MLEN @ 1- + C! \ Put blank in line buf at eol
 8         POS@ #R -TRAILING       \ Cursor position and number of 
 9                                 \ char less trailing blanks.    
10         1+ CTYPE                \ Add one to cursor and send    
11         .POS ;                  \ string to console. Move cursor
12                                 \ to current position.          
13                                                                 
14                                                                 
15                                                                 


Screen 15 not modified     
 0 \ ICHAR                                        09:49JWB02/07/86 
 1                                                                 
 2 \ Insert character char  at current position and update display.
 3 : ICHAR ( char   -- )                                           
 4                                                                 
 5         #R >R POS@ DUP R@ + 1- C@ BL =  \ Blank at end of line? 
 6         IF   DUP 1+  R@ 1-      \ Yes, set up from adr to adr.  
 7              MOVE POS@ C!       \ Move string, insert character.
 8              POS@ R@ -TRAILING  \ Strip off trailing blanks.    
 9              CTYPE   1 +.POS    \ Output to console and move    
10                                 \ cursor one to right.          
11         ELSE BEEP 2DROP         \ No, beep then clean up stack. 
12         THEN R> DROP ;          \ Clean up return and parameter 
13                                 \ stack.                        
14                                                                 
15                                                                 


Screen 16 not modified     
 0 \ OVER-STRIKE  INSERT                          09:49JWB02/07/86 
 1                                                                 
 2 : OVER-STRIKE ( --  -- )  \ Set over-strike mode.               
 3                                                                 
 4   %MOD @ IF             \ If insert mode then                   
 5   LITTLE-CURSOR         \ set cursor to small                   
 6   %MOD OFF              \ set over-strike mode                  
 7   THEN ;                \ otherwise continue.                   
 8                                                                 
 9                                                                 
10 : INSERT     ( --  -- )   \ Set insert mode.                    
11                                                                 
12   %MOD @ NOT IF         \ If over-strike mode then              
13   BIG-CURSOR            \ set cursor to large                   
14   %MOD ON               \ set insert mode                       
15   THEN ;                \ otherwise continue.                   


Screen 17 not modified     
 0 \ L-ARROW  R-ARROW  CLR                        09:49JWB02/07/86 
 1                                                                 
 2 : L-ARROW  ( --  -- )      \ Move cursor left one position.     
 3         -1 +.POS OVER-STRIKE ;                                  
 4                                                                 
 5 : R-ARROW  ( --  -- )      \ Move cursor right one position.    
 6         1 +.POS OVER-STRIKE ;                                   
 7                                                                 
 8                                                                 
 9 : CLR  ( --  -- )          \ Clear screen, & redisplay at home. 
10                                                                 
11   0 0 79 24 15 INIT-WINDOW  \ Clear screen.                     
12   %ROW OFF   .LIN ;        \ Update entire first line.          
13                                                                 
14                                                                 
15                                                                 


Screen 18 not modified     
 0 \ INSS  +TRANS   -TRANS                        10:05JWB02/07/86 
 1                                                                 
 2 : INSS ( --  -- )          \ Insert/overstrike  toggle.         
 3    %MOD @ IF  OVER-STRIKE  ELSE  INSERT THEN ;                  
 4                                                                 
 5 : +TRANS ( --  -- )    \                                        
 6         %POS @ %MLEN @ 1- <     \ Cursor at end of line?        
 7         IF  POS@  @ 256 /MOD    \ Transpose two char at cursor. 
 8             ECHO  ECHO          \ Echo and store both char.     
 9             L-ARROW             \ Reposition cursor.            
10         THEN ;                  \                               
11                                                                 
12                                                                 
13 : -TRANS ( --  -- )                                             
14         %POS @                                                  
15         IF -1 +.POS  +TRANS L-ARROW  THEN ;                     


Screen 19 not modified     
 0 \ BK.PTR  PR.PTR                               09:50JWB02/07/86 
 1 256 CONSTANT BK.SIZE    \ Size of command line backup buffer.   
 2     VARIABLE BK.PTR     \ Pointer to top of backup buffer.      
 3     VARIABLE PR.PTR     \ Pointer to previous line in bkup buf. 
 4     CREATE   BK.BUF  BK.SIZE ALLOT    \ This is the backup buf. 
 5 \ Leave address of the top of the backup buffer.                
 6 : BK.ADR ( --  adr )                                            
 7         BK.BUF  BK.PTR @ + ;                                    
 8                                                                 
 9 \ Increment pointer to top of backup buffer by n.               
10 : +BK.PTR ( n  -- ) BK.PTR +! ;                                 
11 \ Leave address of the previous line.                           
12 : PR.ADR ( --  adr )                                            
13         BK.BUF  PR.PTR @ + ;                                    
14 \ Increment pointer to previous line by n.                      
15 : +PR.PTR ( n  -- )  PR.PTR +! ;                                


Screen 20 not modified     
 0 \ DELETE-1ST-LINE  NO-ROOM?  MAKE-ROOM         09:50JWB02/07/86 
 1 \ Delete first line in backup buffer and adjust pointer counts. 
 2 : DELETE-1ST-LINE ( --  -- )                                    
 3         BK.BUF 1+ C@ 2+ >R                                      
 4         BK.BUF R@ + BK.BUF  BK.PTR @ R@ - CMOVE                 
 5         R> NEGATE DUP +BK.PTR  +PR.PTR  ;                       
 6                                                                 
 7 \ Leave a true flag if there is no room for string of size n.   
 8 : NO-ROOM?  ( n   flag )                                        
 9        2+ BK.SIZE  BK.PTR @  -  <  NOT ;                        
10                                                                 
11 \ Delete lines till there is room for string of size n.         
12 : MAKE-ROOM ( n   -- )                                          
13         BEGIN  DUP  NO-ROOM?                                    
14         WHILE  DELETE-1ST-LINE                                  
15         REPEAT DROP ;                                           


Screen 21 not modified     
 0 \ SAVE-LINE                                    09:50JWB02/07/86 
 1   VARIABLE   RLFLAG                                             
 2                                                                 
 3 : RLFLAG?  RLFLAG @ ;                                           
 4                                                                 
 5 \ Save current line in the backup buffer.                       
 6 : SAVE-LINE ( --  -- )                                          
 7    %BUF @ %MLEN @ -TRAILING ?DUP        \ adr & count of line   
 8    IF   DUP MAKE-ROOM                   \ Make room if required 
 9         BK.ADR OFF  DUP BK.ADR 1+ C!    \ Save line count.      
10         TUCK BK.ADR 2+ SWAP CMOVE       \ Move the line.        
11         2+   +BK.PTR                    \ Update pointers.      
12         BK.PTR @ PR.PTR !                                       
13         RLFLAG  ON                                              
14    ELSE DROP  THEN  ;                                           
15                                                                 


Screen 22 not modified     
 0 \ <LINE   >LINE                                09:50JWB02/07/86 
 1 \ Decrement previous line pointer to start of the previous line.
 2 : <LINE    ( -- -- )                                            
 3         PR.PTR @ 0 <=                   \ At bottom of bkup buf?
 4         IF   BK.PTR @ PR.PTR !  THEN    \ If so point to top!!  
 5         BEGIN -1 +PR.PTR  PR.ADR C@     \ Now back up one line. 
 6         0= UNTIL ;                                              
 7                                                                 
 8 \ Increment previous line pointer to start of the next line.    
 9 : >LINE    ( --  -- )                                           
10         PR.PTR @  BK.PTR @ <            \ Not at top of bk buf? 
11         IF BEGIN  1 +PR.PTR  PR.ADR C@  \ Then move forward one 
12            0= UNTIL                     \ line in bkup buf.     
13         THEN                                                    
14         PR.PTR @ BK.PTR @ >=            \ Did we reach the top? 
15         IF PR.PTR OFF  THEN  ;          \ If so point to bottom.


Screen 23 not modified     
 0 \ RECALL-LINE  -RECALL-LINE +RECALL-LINE       11:27JWB11/23/85 
 1 \ Move previous line to the editing buffer.                     
 2 : RECALL-LINE ( --  -- )                                        
 3       %BUF @ %MLEN @ BL FILL            \ Clear editing buffer. 
 4       RLFLAG?                                                   
 5       IF    PR.ADR  1+                                          
 6             COUNT %MLEN @ MIN   \ From adr and count.           
 7             %BUF @ SWAP CMOVE   \ To adr and moveit.            
 8       THEN .LIN MEOL   ;        \ Display & move to end.        
 9 \ Back up one line and move it to editing buffer.               
10 : -RECALL-LINE ( --  -- )                                       
11    RLFLAG? IF <LINE THEN   RECALL-LINE ;                        
12 \ Move forward one line then move it to the editing buffer.     
13 : +RECALL-LINE ( --  -- )                                       
14    RLFLAG? IF >LINE THEN  RECALL-LINE ;                         
15                                                                 


Screen 24 not modified     
 0 \ Read screen location.  SC@                   18:06JWB11/25/85 
 1 ALSO                                                            
 2 CODE  SC@   ( --  char )                                        
 3         8 #  AH MOV                                             
 4           BH BH SUB 16 INT AH AH SUB                            
 5        128 # AX CMP                                             
 6 U>= IF  32 # AL MOV  THEN                                       
 7         31 # AX CMP                                             
 8 U<  IF  32 # AL MOV  THEN                                       
 9                 1PUSH END-CODE  PREVIOUS                        
10 : +MARK  ( n  -- )                                              
11         CUR@ 0 ROT  AT ATRIB @ SC@                              
12         112 ATRIB ! VEMIT ATRIB ! CUR! ;                        
13 : -MARK  ( n  -- )                                              
14         CUR@ 0 ROT  AT SC@  VEMIT   CUR! ;                      
15                                                                 


Screen 25 not modified     
 0 \  READ-SCREEN                                 15:21JWB11/25/85 
 1  VARIABLE SLINE                                                 
 2 : SINC   SLINE @ 1+   25 MOD SLINE ! ;                          
 3 : SDEC   SLINE @ 24 + 25 MOD SLINE ! ;                          
 4                                                                 
 5  CREATE SLINE-BUF   80 ALLOT                                    
 6                                                                 
 7 \ Copy line n of screen into SLINE-BUF .                        
 8 : READ-SCREEN  ( n  -- )                                        
 9         25 MOD  CUR@ >R                                         
10         80 0 DO  I OVER AT SC@                                  
11                  SLINE-BUF I + C!                               
12              LOOP  DROP                                         
13         R> CUR!  ;                                              
14                                                                 
15                                                                 


Screen 26 not modified     
 0 \                                              09:50JWB02/07/86 
 1 \ Recall next line from screen.                                 
 2 : +RECALL-SLINE  ( --  -- )                                     
 3    NO-CURSOR                                                    
 4    SLINE @ -MARK SINC SLINE @ DUP +MARK READ-SCREEN             
 5    %BUF @ %MLEN @ BL FILL                                       
 6    SLINE-BUF 79 -TRAILING %MLEN @ MIN %BUF @ SWAP CMOVE         
 7    .LIN  MEOL  LITTLE-CURSOR ;                                  
 8                                                                 
 9 \ Recall previous line from screen.                             
10 : -RECALL-SLINE ( --  -- )                                      
11    NO-CURSOR                                                    
12    SLINE @ -MARK SDEC SLINE @ DUP +MARK READ-SCREEN             
13    %BUF @ %MLEN @ BL FILL                                       
14    SLINE-BUF 79 -TRAILING %MLEN @ MIN %BUF @ SWAP CMOVE         
15    .LIN  MEOL LITTLE-CURSOR ;                                   


Screen 27 not modified     
 0 \  F-WORD B-WORD                               13:42JWB03/03/87 
 1  : F-WORD  ( --  -- )                                           
 2         BEGIN   POS@ C@ BL <>                                   
 3         WHILE   1 +POS   REPEAT                                 
 4         BEGIN   POS@ C@ BL =                                    
 5         WHILE   1 +POS   REPEAT  .POS ;                         
 6                                                                 
 7  : B-WORD ( --  -- )                                            
 8         BEGIN  POS@ C@ BL <>                                    
 9         WHILE  -1 +POS  REPEAT                                  
10         BEGIN  POS@ C@ BL =                                     
11         WHILE  -1 +POS  REPEAT                                  
12         BEGIN  POS@ C@ BL <>                                    
13         WHILE  -1 +POS  REPEAT                                  
14         1 +.POS ;                                               
15                                                                 


Screen 28 not modified     
 0 \  D-WORD  F-CHAR                              14:32JWB03/03/87 
 1  : D-WORD ( --  -- )                                            
 2         POS@ C@ BL <> IF                                        
 3         BEGIN  POS@ C@ BL <>                                    
 4         WHILE  -1 +POS  REPEAT                                  
 5         1 +POS .POS                                             
 6         BEGIN  POS@ C@ BL <>                                    
 7         WHILE  DCHAR                                            
 8         REPEAT DCHAR  THEN ;                                    
 9                                                                 
10 : PCKEY ( --   n flag )                                         
11         {KEY}                                                   
12             ?DUP IF TRUE ELSE {KEY} FALSE THEN ;                
13                                                                 
14                                                                 
15                                                                 


Screen 29 not modified     
 0 \                                              14:33JWB03/03/87 
 1 \ Clear backup buffer.                                          
 2 : CLR.BK.BUF ( --  -- )                                         
 3   RLFLAG  OFF                                                   
 4   BK.BUF BK.SIZE BL FILL                                        
 5   BK.PTR OFF PR.PTR OFF ;                                       
 6                                                                 
 7  : F-CHAR  ( --   -- )                                          
 8         PCKEY                                                   
 9         IF  %MLEN @ %POS @ 1+                                   
10             DO I %BUF @ + C@ OVER =                             
11                IF  I !POS LEAVE THEN                            
12             LOOP  .POS                                          
13         THEN DROP ;                                             
14                                                                 
15                                                                 


Screen 30 not modified     
 0 \  RET  PCKEY                                  14:24JWB03/03/87 
 1 : DBOL  ( --  -- )                                              
 2     SLINE-BUF 80 BL FILL                                        
 3     POS@ SLINE-BUF #R DUP >R CMOVE                              
 4     %BUF @ %MLEN @ BL FILL                                      
 5     SLINE-BUF %BUF @ R> CMOVE .LIN  HOM ;                       
 6                                                                 
 7                                                                 
 8 : RET   ( --   -- )     \ Finished, move to eol, set %DONE ON   
 9        SLINE @  -MARK  MEOL  %DONE ON OVER-STRIKE  ;            
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 31 not modified     
 0 \ CTRL.KEY                                     14:17JWB03/03/87 
 1 : CTRL.KEY                                                      
 2         CASE                                                    
 3 CONTROL M OF RET                     ENDOF                      
 4 CONTROL H OF RUB                     ENDOF                      
 5 CONTROL L OF CLR                     ENDOF                      
 6 CONTROL Q OF F-CHAR                  ENDOF                      
 7 CONTROL S OF L-ARROW                 ENDOF                      
 8 CONTROL T OF D-WORD                  ENDOF                      
 9 CONTROL D OF R-ARROW                 ENDOF                      
10 CONTROL I OF 5 +.POS OVER-STRIKE     ENDOF                      
11 CONTROL U OF DEALL                   ENDOF                      
12        27 OF DEALL                   ENDOF                      
13 CONTROL X OF DEOL                    ENDOF                      
14         ( OTHERS ) ( BEEP )                                     
15         ENDCASE ;                                               


Screen 32 not modified     
 0 \  FUNC.KEY                                    09:51JWB02/07/86 
 1                                                                 
 2 : FUNC.KEY                                                      
 3         CASE                                                    
 4   31 OF  -TRANS         ENDOF       32 OF  +TRANS         ENDOF 
 5   75 OF  L-ARROW        ENDOF       77 OF  R-ARROW        ENDOF 
 6   71 OF  HOM            ENDOF       79 OF  MEOL           ENDOF 
 7   81 OF  +RECALL-LINE   ENDOF       73 OF  -RECALL-LINE   ENDOF 
 8   83 OF  DCHAR          ENDOF       82 OF  INSS           ENDOF 
 9   80 OF  +RECALL-SLINE  ENDOF       72 OF  -RECALL-SLINE  ENDOF 
10  117 OF  DEOL           ENDOF      119 OF  DBOL           ENDOF 
11  115 OF  B-WORD         ENDOF      116 OF  F-WORD         ENDOF 
12  132 OF  CLR.BK.BUF     ENDOF                                   
13         ( OTHERS ) ( BEEP )                                     
14         ENDCASE ;                                               
15                                                                 


Screen 33 not modified     
 0 \ (LEDIT)                                      09:51JWB02/07/86 
 1 \ Edit line of length len at address adr. If flag is true move  
 2 \ to beginning of line, if false move to end of line.           
 3 : (LEDIT)  ( adr len flag   -- )                                
 4         -ROT 79 MIN 2DUP %MLEN ! %BUF !                         
 5         %POS OFF  %DONE OFF   7 ATRIB !                         
 6         CUR@ 256 /MOD  %ROW !  %OFF !                           
 7         -TRAILING CTYPE IF HOM ELSE MEOL THEN                   
 8         BEGIN PCKEY 2DUP FLIP + LKEY !                          
 9         IF   DUP  31 < IF  CTRL.KEY                             
10                        ELSE %MOD @ IF ICHAR ELSE ECHO THEN THEN 
11         ELSE FUNC.KEY  THEN                                     
12         %DONE @ UNTIL SAVE-LINE  ;                              
13                                                                 
14                                                                 
15                                                                 


Screen 34 not modified     
 0 \  LEDIT  <LEDIT  <EXPECT>                     09:51JWB02/07/86 
 1 ALSO FORTH DEFINITIONS                                          
 2                                                                 
 3 \ Edit line of length n at adr. Begin by displaying string at   
 4 \ adr and then sit cursor at end of string.                     
 5 : LEDIT ( adr n   -- )                                          
 6         FALSE (LEDIT) ;                                         
 7 \ As above, but put cursor at beginning of line.                
 8 : <LEDIT ( adr n   -- )                                         
 9         TRUE (LEDIT) ;                                          
10                                                                 
11 : <EXPECT> ( adr n   -- )                                       
12         2DUP BL FILL 2DUP <LEDIT -TRAILING                      
13         PRINTING @ IF 2DUP HOM TYPE THEN                        
14         DUP SPAN !  #OUT ! DROP SPACE ;                         
15                                                                 


Screen 35 not modified     
 0 \ NEW-EXP  OLD-EXP                             09:51JWB02/07/86 
 1 : NEW-EXP  ['] <EXPECT> ['] EXPECT 2+ !                         
 2            ['] EXIT     ['] EXPECT 4 + ! ;                      
 3                                                                 
 4 : OLD-EXP  ['] DUP      ['] EXPECT 2+ !                         
 5            ['] SPAN     ['] EXPECT 4 + ! ;                      
 6                                                                 
 7 ONLY FORTH ALSO                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
projects/ledit.blk.txt · Zuletzt geändert: 2013-06-06 21:27 von 127.0.0.1