VolksForth/msdos/ansi.vid
2020-06-19 22:32:10 +02:00

1 line
8.0 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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 ;