\\ Printer Interface cas 10nov05 This File contains the Printer Interface definitions for EPSON LQ500 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 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 EPSON LQ500 loaded. ) cr \ 11 load .( Spooler loaded ) cr : plist ( scr -- ) prints lock output push print 10cpi cr list cr 5 lfs prints unlock ; Onlyforth \ Printer controls ks 2UH 14sep88 | : ctrl: ( char -- ) Create c, Does> c@ lst! ; 8 ctrl: ~bs $D ctrl: ~cr $A ctrl: ~lf $C ctrl: ~ff $1B | ctrl: ESC $F | ctrl: +17cpi $12 | ctrl: -17cpi \ printer controls UH 14sep88 | : #esc: ( cn..c1 n -- ) Create dup c, 0 DO c, LOOP Does> ESC count bounds DO I c@ lst! LOOP ; $4D 1 | #esc: (12cpi $67 1 | #esc: (15cpi $50 1 | #esc: (10cpi 1 $70 2 #esc: prop 0 $70 2 #esc: -prop : 12cpi -prop (12cpi -17cpi ; : 15cpi -prop (15cpi -17cpi ; : 10cpi -prop (10cpi -17cpi ; : 17cpi -prop (10cpi +17cpi ; \ printer controls ks 3UH 14sep88 $34 1 #esc: cursive $35 1 #esc: -cursive 1 $78 2 #esc: nlq 0 $78 2 #esc: standard ' standard Alias fast ' standard Alias draft $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 : <rand ( +n -- ) ESC $6C lst! lst! ; : lfs ( +n -- ) 0 DO ~lf LOOP ; : normal 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 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 ;