VolksForth/msdos/graphic.prn

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