Benutzer-Werkzeuge

Webseiten-Werkzeuge


projects:edit.blk

Number input and editing words

1 list Screen 1 not modified     
 0 \                                              14:21JWB04/16/87 
 1                                                                 
 2                                                                 
 3  FROM LEDIT.BLK  OK   \ Loads the line editor from LEDIT.BLK    
 4  2 11 THRU                                                      
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

2 list Screen 2 not modified     
 0 \ ANY-SIGN?  SKIP-BLANKS                       14:15JWB04/16/87 
 1 ONLY EDITOR ALSO FORTH DEFINITIONS                              
 2 \ Leave a true flag if string begins with a -ve sign.           
 3 \ Note we assume a counted string!!  adr is 1 less than the     
 4 \ the first string character.                                   
 5 : ANY-SIGN? ( adr   adr' flag )                                 
 6         DUP 1+ C@ DUP ASCII - =    \ Increment adr , check for -
 7         IF    DROP 1+ TRUE         \ Leave true flag if found.  
 8         ELSE  ASCII + =            \ Allow a +sign if desired.  
 9               IF    1+  THEN       \ Increment past + sign      
10               FALSE                 \ and leave false flag.     
11         THEN ;                                                  
12 \ Move up to first non blank of string.  Actually adr' points   
13 \ to position before first non blank!!                          
14 : SKIP-BLANKS ( adr  adr' )                                     
15         BEGIN 1+ DUP C@ BL <> UNTIL  1-  ;                      

3 list Screen 3 not modified     
 0 \ ED_CONVERT                                   14:16JWB04/16/87 
 1 \ This routine edits a string and converts to double number.    
 2 : ED_CONVERT  ( adr n cur   cur adr n dn )                      
 3         BEGIN DUP CUR!          \ a n c  Position cursor.       
 4           -ROT 2DUP  LEDIT      \ c a n  Edit string.           
 5           OVER 1- SKIP-BLANKS   \ c a n  Move up to non-blank   
 6           ANY-SIGN?             \ c a n a' flg                  
 7           >R 0 0 ROT -1         \ c a n dn a' -1                
 8           BEGIN  DPL !  CONVERT \ c a n dn a"                   
 9             DUP C@  ASCII . =   \ c a n dn a" flg               
10             WHILE 0 REPEAT      \ c a n dn a" 0                 
11             C@ BL <>            \ c a n dn flag                 
12         WHILE 2DROP R> DROP BEEP      \ c a n                   
13               ASCII ? 2 PICK C! ROT   \ a n c                   
14         REPEAT R> ?DNEGATE            \ c a n dn                
15         DPL @ 0< IF DPL OFF THEN ;    \ DPL=0 if .pt not entered

4 list Screen 4 not modified     
 0 \ (#ED)                                        14:17JWB04/16/87 
 1 \ Fetch a double number using field with of n  using adr  for   
 2 \ and input buffer.  Invalid input is marked by ?  and user is  
 3 \ required to repeat until he makes a valid number.             
 4 : (#ED)  ( adr n   dn )                                         
 5         CUR@ ED_CONVERT               \ cur adr n dn            
 6         >R >R                         \ Save double number.     
 7         1+ ROT + CUR!                 \ Restore cursor.         
 8         DROP R> R> ;                  \ Recover our number.     
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

5 list Screen 5 not modified     
 0 \ D#ED  WD#ED                                  13:08JWB04/16/87 
 1   BL CONSTANT CHFL  \ This character will fill unused digit posn
 2 \ Edit double number at current cursor position using default   
 3 \ field with of 12.   Input buffer is at PAD                    
 4 : D#ED   ( adr    -- )                                          
 5         DUP 2@ TUCK DABS <# #S ROT SIGN #>                      
 6         PAD 12 CHFL FILL                                        
 7         PAD SWAP CMOVE                                          
 8         PAD     12 (#ED) ROT 2! ;                               
 9 \ As above but field width is specified on the stack.           
10 : WD#ED  ( adr w   -- )                                         
11         >R                                                      
12         DUP 2@ TUCK DABS <# #S ROT SIGN #>                      
13         PAD R@ CHFL FILL                                        
14         PAD SWAP CMOVE                                          
15         PAD  R>  (#ED) ROT 2! ;                                 

6 list Screen 6 not modified     
 0 \ XYWD#ED  S#ED                                13:08JWB04/16/87 
 1 \ As above but cursor & field width are specified on the stack. 
 2 : XYWD#ED  ( adr x y n   -- )                                   
 3         -ROT AT WD#ED ;                                         
 4                                                                 
 5                                                                 
 6 \ Edit single number a current cursor position using default    
 7 \ field with of 6.   Edit buffer is at PAD                      
 8 : S#ED ( adr   -- )                                             
 9         DUP @ S>D TUCK DABS <# #S ROT SIGN #>                   
10         PAD 6 CHFL FILL                                         
11         PAD SWAP CMOVE                                          
12         PAD     6 (#ED) DROP SWAP ! ;                           
13                                                                 
14                                                                 
15                                                                 

7 list Screen 7 not modified     
 0 \  WS#ED  XYWS#ED                              13:05JWB04/16/87 
 1 \ As above but field width is specified on the stack.           
 2 : WS#ED  ( adr w   -- )                                         
 3         >R                                                      
 4         DUP @ S>D TUCK DABS <# #S ROT SIGN #>                   
 5         PAD R@ CHFL FILL                                        
 6         PAD SWAP CMOVE                                          
 7         PAD    R> (#ED) DROP SWAP ! ;                           
 8                                                                 
 9 \ As above but cursor & field width are specified on the stack. 
10 : XYWS#ED  ( adr x y n   -- )                                   
11         -ROT AT WS#ED ;                                         
12                                                                 
13                                                                 
14                                                                 
15                                                                 

8 list Screen 8 not modified     
 0 \ IN_CONVERT                                   14:18JWB04/16/87 
 1 \ This routine inputs a string and converts to double number.   
 2 : IN_CONVERT  ( adr n cur   cur adr n dn )                      
 3         BEGIN DUP CUR!          \ a n c  Position cursor.       
 4           -ROT 2DUP <LEDIT      \ c a n  Input string.          
 5           OVER 1- SKIP-BLANKS   \ c a n  Move up to non-blank   
 6           ANY-SIGN?             \ c a n a' flg                  
 7           >R 0 0 ROT -1         \ c a n dn a' -1                
 8           BEGIN  DPL !  CONVERT \ c a n dn a"                   
 9             DUP C@  ASCII . =   \ c a n dn a" flg               
10             WHILE 0 REPEAT      \ c a n dn a" 0                 
11             C@ BL <>            \ c a n dn flag                 
12         WHILE 2DROP R> DROP BEEP      \ c a n                   
13               ASCII ? 2 PICK C! ROT   \ a n c                   
14         REPEAT R> ?DNEGATE            \ c a n dn                
15         DPL @ 0< IF DPL OFF THEN ;    \ DPL=0 if .pt not entered

9 list Screen 9 not modified     
 0 \ (#IN)                                        14:19JWB04/16/87 
 1 \ Fetch a double number using field with of n  using adr  for   
 2 \ and input buffer.  Invalid input is marked by ?  and user is  
 3 \ required to repeat until he makes a valid number.             
 4 : (#IN)  ( adr n   dn )                                         
 5         CUR@ -ROT                     \ cur adr n Save cursor   
 6         2DUP 2+ BLANK                 \ cur adr n Blank buffer  
 7         DUP 0 ?DO 95 (CONSOLE) LOOP   \ cur adr n Out underscore
 8         ROT IN_CONVERT                \ cur adr n dn            
 9         >R >R                         \ Save double number.     
10         1+ ROT + CUR!                 \ Restore cursor.         
11         DROP R> R> ;                  \ Recover our number.     
12                                                                 
13                                                                 
14                                                                 
15                                                                 

10 list Screen 10 not modified     
 0 \ D#IN  WD#IN  XYWD#IN                         15:20JWB11/25/85 
 1 \ Input double number a current cursor position using default   
 2 \ field with of 6.   Input buffer is at PAD                     
 3 : D#IN   ( --   dn )                                            
 4         PAD     12 (#IN) ;                                      
 5                                                                 
 6 \ As above but field width is specified on the stack.           
 7 : WD#IN  ( n  dn )                                              
 8         PAD  SWAP  (#IN) ;                                      
 9                                                                 
10 \ As above but cursor position is also specified on the stack.  
11 : XYWD#IN ( x y n  dn )                                         
12         -ROT AT WD#IN    ;                                      
13                                                                 
14                                                                 
15                                                                 

11 list Screen 11 not modified     
 0 \ S#IN  WS#IN  XYS#IN                          15:20JWB11/25/85 
 1 \ Input single number a current cursor position using default   
 2 \ field with of 6.   Input buffer is at PAD                     
 3 : S#IN   ( --   dn )                                            
 4         PAD      6 (#IN) DROP  ;                                
 5                                                                 
 6 \ As above but field width is specified on the stack.           
 7 : WS#IN  ( n  dn )                                              
 8         PAD  SWAP  (#IN) DROP ;                                 
 9                                                                 
10 \ As above but cursor position is also specified on the stack.  
11 : XYS#IN ( x y n  dn )                                          
12         -ROT AT WS#IN    ;                                      
13                                                                 
14                                                                 
15                                                                 

projects/edit.blk.txt · Zuletzt geändert: 2013-06-06 21:27 (Externe Bearbeitung)