VolksForth/sources/msdos/ansi.vid.src
2017-04-24 00:25:49 +02:00

137 lines
8.7 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.

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