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