Screen 0 not modified     
 0 \ Erweiterte I/O-Funktionen 3.80a                     UH 08Oct87
 1                                                                 
 2 Dieses File enthaelt Definitionen, die eine erweiterte Bild-    
 3 schirmdarstellung ermoeglichen:                                 
 4                                                                 
 5        -  Installation eines Terminals mit Hilfe des Wortes     
 6           "Terminal:"                                           
 7                                                                 
 8        -  Editieren von Eingabezeilen                           
 9                                                                 
10 In der Version 3.80a sind diese Teile aus dem Kern genommen     
11 worden, um diesen einfacher zu gestalten.                       
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 1 not modified     
 0 \ Erweiterte I/O-Funktionen 3.80a  LOAD-Screen        UH 20Nov87
 1                                                                 
 2                                                                 
 3 1 3 +thru  \ Erweiterte Ausgabe                                 
 4                                                                 
 5 4 6 +thru  \ Erweiterte Eingabe                                 
 6                                                                 
 7                                                                 
 8 ' curon Is postlude                                             
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 2 not modified     
 0 \ Erweiterte Ausgabe: Terminal-Defintionen            UH 08OCt87
 1 | Variable terminal                                             
 2                                                                 
 3 : Term: ( off -- off' )   Create  dup c, 2+                     
 4      Does>  c@  terminal @ +  perform ;                         
 5                                                                 
 6 : Terminal:   Create: Does> terminal ! ;                        
 7                                                                 
 8 0  Term: curon     Term: curoff                                 
 9    Term: rvson     Term: rvsoff                                 
10    Term: dark      Term: locate    drop                         
11                                                                 
12 : curleft ( -- )  at? 1- at ;                                   
13 : currite ( -- )  at? 1+ at ;                                   
14                                                                 
15 Terminal: dumb    noop noop noop noop noop 2drop ;      dumb    
Screen 3 not modified     
 0 \ Erweiterte Ausgabe:                                 UH 06Mar88
 1                                                                 
 2 &80 Constant c/row              &24 Constant c/col              
 3                                                                 
 4 | Create 'at 0 , here 0 ,  | Constant 'row   ' 'at | Alias 'col 
 5                                                                 
 6 : (at ( row col -- )   c/row 1- min swap c/col 1- min swap      
 7     2dup 'at 2! locate ;                                        
 8 : (at? ( -- row col )  'at 2@ ;                                 
 9                                                                 
10 : (page ( -- )   0 0 'at 2!  dark ;                             
11                                                                 
12 : (type ( addr len -- )  dup 'col +!                            
13     0 ?DO count (emit LOOP drop ;                               
14                                                                 
15 : (emit ( c -- )   1 'col +! (emit ;                            
Screen 4 not modified     
 0 \ Erweiterte Ausgabe:                                 UH 04Mar88
 1                                                                 
 2 : (cr  ( -- )  'row @ 1+  0  'at 2!  (cr ;                      
 3 : (del ( -- )  'col @ 0> 0=exit  -1 'col +!  (del ;             
 4                                                                 
 5 ' (emit   ' display    2+ !                                     
 6 ' (cr     ' display   4 + !                                     
 7 ' (type   ' display   6 + !                                     
 8 ' (del    ' display   8 + !                                     
 9 ' (page   ' display &10 + !                                     
10 ' (at     ' display &12 + !                                     
11 ' (at?    ' display &14 + !                                     
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 5 not modified     
 0 \ Erweiterte Eingabe                                  UH 08OCt87
 1 | Variable maxchars        | Variable oldspan   oldspan off     
 2                                                                 
 3 | : redisplay ( addr pos -- )                                   
 4      at?  2swap  under  +   span @ rot - type space at ;        
 5 | : del   ( addr pos1 -- )  dup >r   + dup 1+ swap              
 6       span @ r> - 1-  cmove -1 span +! ;                        
 7 | : ins   ( addr pos1 -- )  dup >r   + dup  dup 1+              
 8       span @ r> - cmove>   bl swap c!  1 span +! ;              
 9                                                                 
10 | : (ins  ( a p1 -- a p2 )  2dup ins  2dup redisplay ;          
11 | : (del  ( a p1 -- a p2 )  2dup del  2dup redisplay ;          
12 | : (back ( a p1 -- a p2 )  1-  curleft  (del ;                 
13 | : (recall ( a p1 -- a p2 ) ?dup ?exit                         
14          oldspan @  span !  0  2dup redisplay ;                 
15                                                                 
Screen 6 not modified     
 0 \ Tastenbelegung fuer Zeilen-Editor CP/M              UH 18Mar88
 1 : (decode ( addr pos1 key -- addr pos2 )                        
 2      4  case? IF dup  span @ < 0=exit  currite 1+   exit THEN   
 3    &19  case? IF dup           0=exit  curleft 1-   exit THEN   
 4    &22  case? IF dup  span @ =  ?exit  (ins         exit THEN   
 5    #bs  case? IF dup           0=exit  (back        exit THEN   
 6    #del case? IF dup           0=exit  (back        exit THEN   
 7      7  case? IF span @ 2dup < and 0=exit (del      exit THEN   
 8    $1B  case? IF (recall                            exit THEN   
 9    #cr  case? IF span @  dup  maxchars ! oldspan !              
10                  dup  at?  rot span @ -  - at space exit THEN   
11    dup emit >r  2dup + r> swap c!  1+  dup span @ max span ! ;  
12                                                                 
13 : (expect ( addr len -- )  maxchars !   span off   0            
14     BEGIN span @ maxchars @ u< WHILE key decode REPEAT 2drop ;  
15                                                                 
Screen 7 not modified     
 0 \ Patch                                               UH 08Oct87
 1                                                                 
 2 : (key    ( -- char )                                           
 3     curon  BEGIN  pause (key?  UNTIL curoff getkey ;            
 4                                                                 
 5 ' (key    ' keyboard  2+ !                                      
 6 ' (decode ' keyboard 6 + !                                      
 7 ' (expect ' keyboard 8 + !                                      
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
