VolksForth/8086/msdos/ansi.vid

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