\\ *** Output Driver *** 01apr92py Der Output kann mit +OUT verdoppelt werden und mit +BUFFER gepuffert. EOT beendet die Verdopplung bzw. die Pufferung. Beim gepufferten Output wird EOT weitergeleitet, beim verdop- pelten Output wird nur an den zugefgten Teil EOT gesendet. Alternativ dazu kann mit -BUFFER die Pufferung wieder aufge- hoben werden. Bei der Verdoppelung des Outputs wird an +OUT ein ausfhrbaresWort bergeben, das den Output umschaltet, also ' PRINTIT +OUT h„ngt den Drucker, der von PRINTIT angeworfen wird, in den Output ein. \ Loadscreen 28jun95py \needs 0. : 0. 0 dup ; macro Onlyforth Memory also Module Out 1 capacity 2- +thru [IFDEF] print : printit print +buffer ; : protokoll cr ['] printit +out ; export Out Null +Out +Buffer -Buffer printit protokoll ; [ELSE] export Out Null +Out +Buffer -Buffer ; [THEN] Module; Onlyforth \ Null 2.Out 02dec93py Output: Null drop true noop 2drop noop noop 2drop 0. PCform noop noop noop noop noop noop noop noop [ User 2.Out 2.Out off \ "Second Out" | : 2Out: | Create dup c, cell+ DOES> c@ output @ >r 2.Out @ dup >r sp@ >r 2over 2over @ 8+ 2@ 2.Out ! dup output ! + perform r> sp! @ 2@ 2.Out ! dup output ! + perform r> 2.Out ! r> output ! ; 0 2Out: 2emit cell+ 2Out: 2cr 2Out: 2type 2Out: 2del 2Out: 2page 2Out: 2at 2Out: 2at? 2Out: 2form cell+ cell+ 2Out: 2flush 2Out: 2curon 2Out: 2curoff 2Out: 2curleft 2Out: 2currite 2Out: 2clrline drop \ Duplicate +Out -Out 02dec93py | : 2emit? output @ >r 2.Out @ dup >r dup @ 8+ 2@ 2.Out ! output ! emit? >r @ 2@ 2.Out ! output ! emit? r> and r> 2.Out ! r> output ! ; | : 2eot ( -- ) 2.Out @ dup >r @ 8+ 2@ 2.Out ! output ! eot r@ @ 2@ 2.Out ! output ! r> DisposHandle ; Output: Duplicate 2emit 2emit? 2cr 2type 2del 2page 2at 2at? 2form noop 2eot 2flush 2curon 2curoff 2curleft 2currite 2clrline [ : +Out ( output -- ) 4 cells NewHandle >r output @ 2.Out @ r@ @ 2! execute output @ 2.Out @ r@ @ 8+ 2! r> 2.Out ! Duplicate ; \ buffering 02dec93py | : 1Out: | Create dup c, cell+ DOES> c@ output @ >r 2.Out @ dup >r @ 2@ 2.Out ! dup output ! + perform r> 2.Out ! r> output ! ; 0 cell+ 1Out: 1emit? 1Out: 1cr 1Out: 1type cell+ 1Out: 1page cell+ 1Out: 1at? 1Out: 1form 3 cells + 1Out: 1curon 1Out: 1curoff drop \ buffered 25aug08py| : buf@ 2.Out @ @ 8+ ; | : bclrline ( -- ) 0 buf@ c! buf@ 1+ count bl fill ; | : bflush 2.Out @ HLock buf@ count swap 1+ swap 1type 2.Out @ HUnLock bclrline ; | : bcr bflush 1cr ; | : blen@ ( total len -- ) buf@ dup c@ >r 1+ c@ r> ; | : bflush? blen@ = IF bflush THEN ; | : bcurrite buf@ c@ 1+ buf@ c! bflush? ; | : bemit ( char -- ) buf@ count + 1+ c! bcurrite ; | : btype ( addr count -- ) BEGIN dup blen@ - < 0= WHILE over blen@ - >r buf@ dup c@ + 2+ r@ move buf@ c@ r@ + buf@ c! bflush r> /string REPEAT >r buf@ dup c@ + 2+ r@ move buf@ c@ r> + buf@ c! ; | : bat ( row col -- ) buf@ 1+ c@ 1- min 0 max buf@ c! drop ; | : bat? ( -- row col ) 1at? drop buf@ c@ ; \ buffered 20aug08py| : bpage bclrline 1page ; | : bemit? blen@ - 1 = IF 1emit? ELSE true THEN ; | : bcurleft buf@ c@ dup 0= IF drop exit THEN 1- buf@ c! ; | : bdel bcurleft bl buf@ dup c@ + 2+ c! ; : -buffer bcr 2.Out @ dup @ 2@ 2.Out ! output ! DisposHandle ; | : beot ( -- ) -buffer eot ; Output: buffered bemit bemit? bcr btype bdel bpage bat bat? 1form noop beot noop 1curon 1curoff bcurleft bcurrite bclrline [ : +buffer ( -- ) col IF row 0 at THEN cols &10 + NewHandle >r output @ 2.Out @ r@ @ 2! r> 2.Out ! cols buf@ 1+ c! bclrline 0 buf@ c! buffered ;