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" " keydrop keydrop 4 )##( 1- keydrop )##( 1- keydrop keydrop ; 5 6 Variable top top off 7 8 : full top off ; 9 10 : blankline char" " ; 11 | : lineerase 0 (at blankline ; 12 13 : normal char" " ; : invers char" " ; 14 : underline char" " ; : bright char" " ; 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" " 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