VolksForth/sources/msdos/multi.fth

307 lines
19 KiB
Forth
Raw Normal View History

\ *** Block No. 0 Hexblock 0
This display interface uses BIOS call $10 functions for a fast
display interface. A couple of state variables is contained
in a vector that is task specific such that different tasks
may use different windows. For simplicity windows always
span the whole width of the screen. They can be defined by
top and bottom line. This mechanism is used for a convenient
status display line on the bottom of the screen.
\ *** Block No. 1 Hexblock 1
\ Multitsking display interface loadscreen ks cas 10nov05
Onlyforth \needs Assembler 2 loadfrom asm.scr
User area area off \ points at active window
Variable status \ to switch status on/off
| Variable cursor \ points at area with active cursor
1 8 +thru .( Multitasking display driver loaded ) cr
\ *** Block No. 2 Hexblock 2
\ Multitsking display interface ks 6 sep 86
: Area: Create 0 , 0 , 7 c, Does> area ! ;
\ | col | row | top | bot | att |
Area: terminal terminal area @ cursor !
: (area Create dup c, 1+ Does> c@ area @ + ;
0 | (area ccol | (area crow | (area ctop
| (area cbot (area catt drop
: window ( topline botline -- ) cbot c! ctop c! ;
: full 0 c/col 2- window ; full
\ *** Block No. 3 Hexblock 3
\ Multitask (type (emit ks 20 dez 87
Code (type ( addr len -- ) W pop I push R push
u' area U D) I mov U push D U mov
$F # A+ mov $10 int u' catt I D) R- mov
3 # A+ mov $10 int C push D push $E0E # C mov
1 # A+ mov $10 int I ) D mov 1 # C mov
U inc [[ U dec 0= not ?[[ 2 # A+ mov $10 int
D- inc ' c/row >body #) D- cmp 0= not
?[[ W ) A- mov W inc 9 # A+ mov $10 int ]]? ]?
D I ) mov D pop cursor #) I cmp 0= ?[ I ) D mov ]?
2 # A+ mov $10 int C pop 1 # A+ mov $10 int U pop
R pop I pop D pop ' pause #) jmp end-code
: (emit ( char -- ) sp@ 1 (type drop ;
\ *** Block No. 4 Hexblock 4
\ Multitask (at (at? ks 04 aug 87
Code (at ( row col -- ) A pop A- D+ mov
u' area U D) W mov D W ) mov cursor #) W cmp 0=
?[ R push U push $F # A+ mov $10 int
2 # A+ mov $10 int U pop R pop
]? D pop Next end-code
Code (at? ( -- row col )
D push u' area U D) W mov W ) D mov
D+ A- mov 0 # A+ mov A+ D+ mov A push Next
end-code
Code curat? ( -- row col ) D push R push
$F # A+ mov $10 int 3 # A+ mov $10 int
R pop 0 # A mov D+ A- xchg A push Next
end-code
\ *** Block No. 5 Hexblock 5
\ cur! curshape setpage ks 28 jun 87
: cur! \ set cursor into current task's window
area @ cursor ! (at? (at ; cur!
Code curshape ( top bot -- ) D C mov D pop
D- C+ mov 1 # A+ mov $10 int D pop Next
end-code
Code setpage ( n -- )
$503 # A mov D- A- and $10 int D pop Next
end-code
\ *** Block No. 6 Hexblock 6
\ Multitask normal invers blankline ks 01 nov 88
: normal 7 catt c! ; : invers $70 catt c! ;
: underline 1 catt c! ; : bright $F catt c! ;
Code blankline D push R push U push $F # A+ mov
$10 int u' area U D) W mov u' catt W D) R- mov
3 # A+ mov $10 int C push D push
$E0E # C mov 1 # A+ mov $10 int W ) D mov
2 # A+ mov $10 int ' c/row >body #) C mov
D- C- sub bl # A- mov 9 # A+ mov
C- C- or 0= not ?[ $10 int ]?
D pop 2 # A+ mov $10 int \ set cursor back
C pop 1 # A+ mov $10 int \ cursor visible again
U pop R pop D pop ' pause #) jmp end-code
| : lineerase ( line# -- ) 0 (at blankline ;
\ *** Block No. 7 Hexblock 7
\ Multitask (del scroll (cr (page ks 04 okt 87
: (del (at? ?dup
IF 1- 2dup (at bl (emit (at exit THEN drop ;
Code scroll D push R push U push
u' area U D) W mov u' catt W D) R+ mov
u' ctop W D) D mov D- C+ mov 0 # C- mov
' c/row >body #) D- mov D- dec $601 # A mov
$10 int U pop R pop D pop Next
end-code
: (cr (at? drop 1+ dup cbot c@ u>
IF scroll drop cbot c@ THEN lineerase ;
: (page ctop c@ cbot c@ DO I lineerase -1 +LOOP ;
\ *** Block No. 8 Hexblock 8
\ Multitask status display ks 10 okt 87
' (emit ' display 2 + ! ' (cr ' display 4 + !
' (type ' display 6 + ! ' (del ' display 8 + !
' (page ' display &10 + !
' (at ' display &12 + ! ' (at? ' display &14 + !
: .base base @ decimal dup 2 .r base ! ;
: .sp ( n -- ) ." s" depth swap 1+ - 2 .r ;
: (.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. 9 Hexblock 9
\ statuszeile ks ks 04 aug 87
| : fstat ( n -- ) .base .sp
.space .scr .dr file? 2 spaces order ;
| Area: statusline
statusline c/col 1- dup window page invers terminal
: (.status output @ display area @ statusline
status @ IF (at? drop 0 (at 2 fstat blankline
ELSE normal page invers
THEN area ! output ! ;
' (.status Is .status
: bye status off .status bye ;
\ *** Block No. 10 Hexblock A
\ *** Block No. 11 Hexblock B
\ *** Block No. 12 Hexblock C
\ *** Block No. 13 Hexblock D
\ *** Block No. 14 Hexblock E
\ *** Block No. 15 Hexblock F
\ *** Block No. 16 Hexblock 10
\ *** Block No. 17 Hexblock 11