mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-07-25 09:29:00 +00:00
137 lines
8.4 KiB
Forth
137 lines
8.4 KiB
Forth
|
\ *** Block No. 0 Hexblock 0
|
|||
|
|
cas 10nov05
|
|||
|
|
Video 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.
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 1 Hexblock 1
|
|||
|
|
\ 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
|
|||
|
|
\ *** Block No. 2 Hexblock 2
|
|||
|
|
\ Ansi Standard display output cas 10nov05
|
|||
|
|
| : keydrop (key drop ;
|
|||
|
|
|
|||
|
|
: (at? char" [6n" keydrop keydrop
|
|||
|
|
)##( 1- keydrop )##( 1- keydrop keydrop ;
|
|||
|
|
|
|||
|
|
Variable top top off
|
|||
|
|
|
|||
|
|
: full top off ;
|
|||
|
|
|
|||
|
|
: blankline char" [K" ;
|
|||
|
|
| : lineerase 0 (at blankline ;
|
|||
|
|
|
|||
|
|
: normal char" [0m" ; : invers char" [7m" ;
|
|||
|
|
: underline char" [4m" ; : bright char" [1m" ;
|
|||
|
|
|
|||
|
|
\ *** Block No. 3 Hexblock 3
|
|||
|
|
\ 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" [2J" exit THEN
|
|||
|
|
top @ c/col 2- DO I lineerase -1 +LOOP ;
|
|||
|
|
|
|||
|
|
\ *** Block No. 4 Hexblock 4
|
|||
|
|
\ 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 ;
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 5 Hexblock 5
|
|||
|
|
\ 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 ;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 6 Hexblock 6
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
\ *** Block No. 7 Hexblock 7
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|