VolksForth/8086/msdos/epson.prn
2021-04-11 13:43:39 +02:00

1 line
13 KiB
Plaintext
Raw Blame History

\\ 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 ;