VolksForth/sources/msdos/ansi.vid.src

137 lines
8.7 KiB
Plaintext
Raw Normal View History

2017-04-23 22:25:49 +00:00
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