Screen 0 not modified     
 0                                                      cas 10nov05
 1 Video display interface for an ANSI.SYS interface.              
 2 It should work on any MS-DOS computer. Since ANSI.SYS does      
 3 not have a delete line function, split screen can not           
 4 be implemented as usual. Instead, the cursor "rotates"          
 5 ie. when a CR is performed on the bottom line, the cursor       
 6 moves up to the top line in the current window.                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 1 not modified     
 0 \ ansi cursor control                                cas 10nov05
 1   Onlyforth                                                     
 2                                                                 
 3 | : (char"    "lit count bounds DO I c@ charout LOOP ;          
 4 | : char"     compile (char" ," align ; immediate restrict      
 5                                                                 
 6 | Ascii 0 Constant #0                                           
 7                                                                 
 8 | : (#S)  ( u -- )  &10 /mod  #0 + charout   #0 + charout ;     
 9                                                                 
10   : (at  ( row col -- )     char" ["                           
11      swap 1+ (#S) char" ;" 1+ (#S) char" H" ;                   
12                                                                 
13 | : )##(  ( -- u )   (key #0 - &10 *   (key #0 -  + ;           
14                                                                 
15   1 4 +thru   .( ANSI display interface active) cr              
Screen 2 not modified     
 0 \ Ansi Standard display output                       cas 10nov05
 1 | : keydrop    (key drop ;                                      
 2                                                                 
 3   : (at?    char" [6n"    keydrop   keydrop                    
 4      )##( 1-  keydrop  )##( 1-  keydrop keydrop ;               
 5                                                                 
 6   Variable top   top off                                        
 7                                                                 
 8   : full         top off ;                                      
 9                                                                 
10   : blankline    char" [K" ;                                   
11 | : lineerase    0 (at blankline ;                              
12                                                                 
13   : normal     char" [0m" ;  : invers     char" [7m" ;        
14   : underline  char" [4m" ;  : bright     char" [1m" ;        
15                                                                 
Screen 3 not modified     
 0 \ Ansi Standard display output                       cas 10nov05
 1                                                                 
 2   ' 2drop Alias curshape                                        
 3   ' drop  Alias setpage                                         
 4   ' (at?  Alias curat?                                          
 5                                                                 
 6   : (type  ( addr len -- )   pad place                          
 7      pad count bounds ?DO  I c@ (emit  LOOP ;                   
 8                                                                 
 9   : (cr   top @ 0=  adr .status @ ['] noop = and                
10      IF  (cr exit  THEN   row c/col 2- u<                       
11      IF  row 1+  ELSE  top @  THEN  lineerase ;                 
12                                                                 
13   : (page   top @ 0= IF  char" [2J" exit  THEN                 
14      top @ c/col 2- DO  I lineerase  -1 +LOOP ;                 
15                                                                 
Screen 4 not modified     
 0 \ statusline                                         cas 10nov05
 1                                                                 
 2   ' (cr   ' display   4 + !  ' (type ' display   6 + !          
 3   ' (page ' display &10 + !                                     
 4   ' (at   ' display &12 + !  ' (at?  ' display &14 + !          
 5                                                                 
 6                                                                 
 7   : .sp      ( n -- )  ."  s" depth   swap 1+ - 2 .r ;          
 8   : .base    base @  decimal dup 2 .r   base ! ;                
 9   : (.drv    ( n -- )   Ascii A + emit ." : " ;                 
10   : .dr      ."   " drv (.drv ;                                 
11   : .scr     blk @ IF  ."   Blk" blk  ELSE  ."   Scr" scr  THEN 
12              @ 5 .r ;                                           
13   : .space   ."   Dic" s0 @ here $100 + - 6 u.r ;               
14                                                                 
15                                                                 
Screen 5 not modified     
 0 \ statusline                                         cas 10nov05
 1                                                                 
 2 | : fstat  ( n -- )   invers .base .sp                          
 3      .space .scr .dr file? 2 spaces order normal ;              
 4                                                                 
 5   : .stat    output @  (at?   display  c/col 1- 0 (at           
 6      3 fstat blankline   (at  output ! ;                        
 7                                                                 
 8   : +stat   ['] .stat Is .status  .status ;                     
 9                                                                 
10   : -stat   [']  noop Is .status ;                              
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 6 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 7 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
