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 ;