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