VolksForth/msdos/graphic.prn
2020-06-19 22:32:10 +02:00

1 line
13 KiB
Plaintext
Raw Blame History

\\ Printer Interface cas 11nov05 This File contains the Printer Interface definitions for IBM Graphics 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 IBM Graphic Printer ks cas 10nov05 Onlyforth Vocabulary Printer Printer definitions also Variable pcol pcol off Variable prow prow off Variable prints prints off 2 &10 thru .( Interface for IBM Graphic Printer 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 \ printer controls ks 30 apr 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 30 apr 88 \needs Task \\ | Input: noinput 0 false drop 2drop ; noinput $100 $200 Task spooler keyboard : spool ( from to -- ) isfile@ spooler 3 pass isfile ! pthru stop ;