mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-11-18 10:09:33 +00:00
1 line
13 KiB
Plaintext
1 line
13 KiB
Plaintext
\\ Printer Interface cas 11nov05 This File contains the Printer Interface definitions for NEC 8023 Printer. The definitions can be used to print Forth Sourcecode in a consice way 6 Screens per page. When using the Multitask-Extension it is possible to print and continue working with Forth. This Printerinterface is based on Ideas from D. Weineck and was portet to volksFORTH by U. Hoffmann and K.Schleisiek. \ Printer Interface NEC 8023 Printer cas 10nov05 Onlyforth Vocabulary Printer Printer definitions also Variable pcol pcol off Variable prow prow off Variable prints prints off 2 &10 thru .( Printer Interface for NEC 8023 loaded ) cr \ &11 load .( Spooler loaded ) cr : plist ( scr -- ) prints lock output push print 10cpi cr list cr 5 lf's prints unlock ; Onlyforth \ Printer controls ks 23 m<>r 88 | : ctrl: ( char -- ) Create c, Does> c@ lst! ; 8 ctrl: ~bs $D ctrl: ~cr $A ctrl: ~lf $C ctrl: ~ff $1B | ctrl: ESC $12 ctrl: 10cpi $F ctrl: 17cpi \ printer controls ks 24 m<>r 88 | : #esc: ( cn..c1 n -- ) Create dup c, 0 DO c, LOOP Does> ESC count bounds DO I c@ lst! LOOP ; $3A 1 #esc: 12cpi $47 $25 2 #esc: cursive $48 $25 2 #esc: -cursive $50 $25 2 #esc: prop $51 $25 2 #esc: -prop $33 $49 2 #esc: nlq $31 $49 2 #esc: standard $30 $23 2 #esc: fast $31 $57 2 #esc: wide $30 $57 2 #esc: -wide $47 1 #esc: dark $48 1 #esc: -dark $32 1 #esc: 6/" $30 1 #esc: 8/" $31 $2D 2 #esc: +under $30 $2D 2 #esc: -under \ ks 24 m<>r 88 : <rand ( +n -- ) ESC $58 lst! lst! &300 lst! ; : lf's ( +n -- ) 0 DO ~lf LOOP ; : normal standard 12cpi ~cr ; \ Printer output functions ks 07 jan 88 : pemit ( char -- ) 1 pcol +! dup BL u< IF $40 or +under lst! -under exit THEN lst! ; : pcr ~cr ~lf 1 prow +! pcol off ; : pdel ~bs pcol @ 1- 0 max pcol ! ; : ppage ~ff prow off pcol off ; : pat ( row col -- ) dup pcol @ - dup 0< swap abs 0 DO BL over IF drop 8 THEN lst! LOOP drop pcol ! prow ! ; : pat? ( -- row col ) prow @ pcol @ ; \ Printer output ks 24 m<>r 88 : +emit dup (emit pemit ; : +cr (cr pcr ; : +del (del pdel ; : +page (page ppage ; : +at 2dup (at pat ; | Output: >printer pemit pcr tipp pdel ppage pat pat? ; | Output: +printer +emit +cr tipp +del +page +at (at? ; Forth definitions : print >printer normal ; : +print +printer normal ; \ Variables and Setup ks cas 10nov05 Printer definitions $00 | Constant logo | Variable pageno | Create scr#s &14 allot \ enough room for 6 screens | : header ( -- ) normal 4 spaces dark ." Page " pageno @ 2 .r &13 spaces ." volksFORTH83 " 5 spaces file? -dark 1 pageno +! ~lf ; \ Print 2 screens across on a page ks 03 apr 88 | : pr ( scr# -- ) dup capacity 1- u> IF drop logo THEN 1 scr#s +! scr#s dup @ 2* + ! ; | : 2pr ( scr#1 scr#2 line# -- ) cr 17cpi dup 2 .r space c/l * >r pad $101 bl fill swap block r@ + pad c/l cmove block r> + pad c/l + 1+ c/l cmove pad $101 -trailing type ; | : 2scr ( scr#1 scr#2 -- ) cr cr normal &17 spaces wide dark over 4 .r &18 spaces dup 4 .r -wide -dark cr l/s 0 DO 2dup I 2pr LOOP 2drop ; | : pr-start ( --) scr#s off 1 pageno ! ; \ Printer 6 screens on a page ks 03 apr 88 | : pagepr header scr#s off scr#s 2+ 3 0 DO dup @ over 6 + @ 2scr 2+ LOOP drop page ; | : shadowpr header scr#s off scr#s 2+ 3 0 DO dup @ over 2+ @ 2scr 4 + LOOP drop page ; | : pr-flush ( -- f ) \ any screens left over? scr#s @ dup 0=exit 0<> BEGIN scr#s @ 5 < WHILE -1 pr REPEAT logo pr ; | Variable shadow | : full? ( -- f ) scr#s @ 6 = ; \ Printer 6 screens on a page ks 09 mai 88 Forth definitions : pthru ( first last -- ) [ Printer ] prints lock output push print pr-start 1+ swap ?DO I pr full? IF pagepr THEN LOOP pr-flush IF pagepr THEN prints unlock ; : document ( first last -- ) [ Printer ] isfile@ IF capacity 2/ shadow ! THEN prints lock output push print pr-start 1+ swap ?DO I pr I shadow @ + pr full? IF shadowpr THEN LOOP pr-flush IF shadowpr THEN prints unlock ; : listing 0 capacity 2/ 1- document ; \ Printerspool ks 03 apr 88 \needs Task \\ | Input: noinput 0 false drop 2drop ; $100 $200 noinput Task spooler keyboard : spool ( from to -- ) isfile@ spooler 3 pass isfile ! pthru stop ; |