VolksForth/sources/cpm/XINOUT.FB.src

137 lines
8.7 KiB
Plaintext
Raw Normal View History

2020-06-20 16:59:14 +00:00
Screen 0 not modified
0 \ Erweiterte I/O-Funktionen 3.80a UH 08Oct87
1
2 Dieses File enthaelt Definitionen, die eine erweiterte Bild-
3 schirmdarstellung ermoeglichen:
4
5 - Installation eines Terminals mit Hilfe des Wortes
6 "Terminal:"
7
8 - Editieren von Eingabezeilen
9
10 In der Version 3.80a sind diese Teile aus dem Kern genommen
11 worden, um diesen einfacher zu gestalten.
12
13
14
15
Screen 1 not modified
0 \ Erweiterte I/O-Funktionen 3.80a LOAD-Screen UH 20Nov87
1
2
3 1 3 +thru \ Erweiterte Ausgabe
4
5 4 6 +thru \ Erweiterte Eingabe
6
7
8 ' curon Is postlude
9
10
11
12
13
14
15
Screen 2 not modified
0 \ Erweiterte Ausgabe: Terminal-Defintionen UH 08OCt87
1 | Variable terminal
2
3 : Term: ( off -- off' ) Create dup c, 2+
4 Does> c@ terminal @ + perform ;
5
6 : Terminal: Create: Does> terminal ! ;
7
8 0 Term: curon Term: curoff
9 Term: rvson Term: rvsoff
10 Term: dark Term: locate drop
11
12 : curleft ( -- ) at? 1- at ;
13 : currite ( -- ) at? 1+ at ;
14
15 Terminal: dumb noop noop noop noop noop 2drop ; dumb
Screen 3 not modified
0 \ Erweiterte Ausgabe: UH 06Mar88
1
2 &80 Constant c/row &24 Constant c/col
3
4 | Create 'at 0 , here 0 , | Constant 'row ' 'at | Alias 'col
5
6 : (at ( row col -- ) c/row 1- min swap c/col 1- min swap
7 2dup 'at 2! locate ;
8 : (at? ( -- row col ) 'at 2@ ;
9
10 : (page ( -- ) 0 0 'at 2! dark ;
11
12 : (type ( addr len -- ) dup 'col +!
13 0 ?DO count (emit LOOP drop ;
14
15 : (emit ( c -- ) 1 'col +! (emit ;
Screen 4 not modified
0 \ Erweiterte Ausgabe: UH 04Mar88
1
2 : (cr ( -- ) 'row @ 1+ 0 'at 2! (cr ;
3 : (del ( -- ) 'col @ 0> 0=exit -1 'col +! (del ;
4
5 ' (emit ' display 2+ !
6 ' (cr ' display 4 + !
7 ' (type ' display 6 + !
8 ' (del ' display 8 + !
9 ' (page ' display &10 + !
10 ' (at ' display &12 + !
11 ' (at? ' display &14 + !
12
13
14
15
Screen 5 not modified
0 \ Erweiterte Eingabe UH 08OCt87
1 | Variable maxchars | Variable oldspan oldspan off
2
3 | : redisplay ( addr pos -- )
4 at? 2swap under + span @ rot - type space at ;
5 | : del ( addr pos1 -- ) dup >r + dup 1+ swap
6 span @ r> - 1- cmove -1 span +! ;
7 | : ins ( addr pos1 -- ) dup >r + dup dup 1+
8 span @ r> - cmove> bl swap c! 1 span +! ;
9
10 | : (ins ( a p1 -- a p2 ) 2dup ins 2dup redisplay ;
11 | : (del ( a p1 -- a p2 ) 2dup del 2dup redisplay ;
12 | : (back ( a p1 -- a p2 ) 1- curleft (del ;
13 | : (recall ( a p1 -- a p2 ) ?dup ?exit
14 oldspan @ span ! 0 2dup redisplay ;
15
Screen 6 not modified
0 \ Tastenbelegung fuer Zeilen-Editor CP/M UH 18Mar88
1 : (decode ( addr pos1 key -- addr pos2 )
2 4 case? IF dup span @ < 0=exit currite 1+ exit THEN
3 &19 case? IF dup 0=exit curleft 1- exit THEN
4 &22 case? IF dup span @ = ?exit (ins exit THEN
5 #bs case? IF dup 0=exit (back exit THEN
6 #del case? IF dup 0=exit (back exit THEN
7 7 case? IF span @ 2dup < and 0=exit (del exit THEN
8 $1B case? IF (recall exit THEN
9 #cr case? IF span @ dup maxchars ! oldspan !
10 dup at? rot span @ - - at space exit THEN
11 dup emit >r 2dup + r> swap c! 1+ dup span @ max span ! ;
12
13 : (expect ( addr len -- ) maxchars ! span off 0
14 BEGIN span @ maxchars @ u< WHILE key decode REPEAT 2drop ;
15
Screen 7 not modified
0 \ Patch UH 08Oct87
1
2 : (key ( -- char )
3 curon BEGIN pause (key? UNTIL curoff getkey ;
4
5 ' (key ' keyboard 2+ !
6 ' (decode ' keyboard 6 + !
7 ' (expect ' keyboard 8 + !
8
9
10
11
12
13
14
15