\\                                                     08may93ep                                                                Fill in right value for #BIG-LINE                                 - length of a line printed in "big mode"                                                                                      Fill in right value for SCRS/PGE,                                 - how many screens may be printed on one page.                  With 12 inch paper this may be up to 8.                                                                                       In "small mode" a line length of 132 is assumed to be valid.                                                                                                                                                                                                                                                                                                                                                                                                    (                                                      17May93ep  ***** Alle Rechte bei Ewald Pfau **************************** )                                                                                                                                   marker noprint                                                                                                                              editor definitions                                2 11 thru                                                                                  forth-wordlist set-current         : SCREEN-PRINT  ( n> >n --) show-start prt-pgs-c show-end ;     : SHADOW-PRINT  ( n> >n --) show-start prt-pgs-s show-end ;                                                                               -1 set-order definitions                                                                                                                                                                                                                              \                                                      21May93ep                                                                                                variable PRT-HDL                : PRT-CLOSE     ( --)                                              prt-hdl @ ?dup if close-file 0 prt-hdl ! throw then ;                                                                        : PTHROW        ( n --)                                            ?dup if >R ['] prt-close catch drop R> throw then ;                                                                          : FNAME         ( -- a n)                                          block-fid @ header-read pthrow >fname count ;                                                                                : KEYSTOP?  ( -- f)     key? if key 27 = else 0 then ;                                                                                                                                                                                                          ( helpers                                              21May93ep)                                                               : U2/       1 rshift ;                                          \ : UMIN      2dup u< if drop else nip  then ;                  \ : UMAX      2dup u< if nip  else drop then ;                                                                                  : $=        create dup c, here over allot swap move align          DOES>    count ;                                                                                                             s" ram2_prtd"   $= 'PRT'                                        s" Screen # "   $= 'SCR#'                                       s" stopped"     $= 'STOPPED'                                    s" ???"         $= '???'                                        s" JanFebMarAprMaiJunJulAugSepOktNovDez" $= MONTHS              s" *** File:"   $= 'fname'                                                                                                      ( values                                               17May93ep)                                                                 96 constant #BIG-LINE                                            8 constant SCRS/PGE                                            64 constant C/L                                               1024 constant B/BLK                                             char . constant '.'                                             variable PRT-DMY                                                variable PRT'D                                                    create DSCRT c/l allot                                                                                                        : >DSCRT    ( a n -- a n)                                          c/l umin >R dscrt R@ move dscrt R> ;                                                                                         : BLK-BOUNDS    ( n n max -- >n n>)                                >R 2dup umin rot rot umax 1+ R@ umin swap R> umin ;          ( output device                                        08may93ep)                                                               : P-TYPE    ( a n --)  prt-hdl @  write-file pthrow ;           : P-EMIT    ( b --)    prt-dmy c! prt-dmy 1 p-type ;                                                                            : P-CHARS   ( n --)    create dup c, ?dup if 0                                         do bl word count evaluate c,                                    loop align then                             DOES>    ( --)      count p-type ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ( output device /epson                                 20May93ep)                                                               2 p-chars P-CR       $d $a                                      1 p-chars P-SPACE    bl                                         1 p-chars P-FFEED    $c                                                                                                          3 p-chars P-INIT   27 82 0                  ( US-char's )       2 p-chars P-RES    27 64                    ( reset     )                                                                       11 p-chars P-BIG                                                  27 71  18      27 50  27 80  27 77  27 52                     ( double nocond. 1/6    pica   elite  italic )                                                                                  9  p-chars P-SML                                                  27 71  27 53     27 80  27 48  15                             ( double no-italic pica   1/8    condensed  )                  ( print screens                                        08may93ep)                                                               : P-SPACES  ( n --)                                                ?dup if 0 do p-space loop then ;                                                                                             : +BIG-TAB  ( n --)                                                #big-line u2/ swap - 0 max p-spaces ;                                                                                        : '.BLK#    ( n -- n)                                              'scr#' tuck p-type  swap 0 <# #s #> tuck p-type + ;                                                                          : .BLK#     ( n n f -- )                                           p-cr p-cr  p-big 2 p-spaces   rot '.blk# swap                                      if    +big-tab '.blk# drop                   p-sml p-cr p-cr    else  2drop then ;                                                                                        ( print screens                                        08may93ep)                                                               : PBLOCK    ( n -- a)   ['] block catch pthrow ;                : PCAPACITY ( -- n)     block-fid @ file-size pthrow                                    b/blk um/mod swap if 1+ then ;                                                                          : PRT-2SCRS ( n n max -- quit-f )                                           over swap u<   >R                                               2dup R@ .blk#  R> b/blk 0                              do       rot rot over pblock i + c/l                                     >dscrt p-type 4 p-spaces  rot dup                          if           over pblock i + c/l                                     -trailing  >dscrt p-type                                   then p-cr keystop?                                              if   unloop             drop 2drop -1 exit                      then c/l          +loop drop 2drop  0 ;                  ( print page                                           21May93ep)                                                               : .P#       ( n --)      0 <# #s #> p-type ;                    : >MONTH    ( n --)      ?dup 0= if '???'                                   else 1- dup dup + + months drop + 3 then ;                                                                          : P-DATE    ( --)        time&date     >R >R >R drop 2drop                  R> .p# '.' p-emit p-space                                       R> >month  p-type p-space  R> .p# ;                                                                                 : P-FNAME   'fname' p-type p-space fname p-type p-space ;       : EJECT     ( --)      p-cr p-big p-space p-fname                           0 +big-tab p-date  p-sml p-ffeed  0 prt'd ! ;                                                                       : FOOTER?   ( --)      2 prt'd +!                                           prt'd @ scrs/pge u< 0= if eject then ;              ( print file                                           08may93ep)                                                               : PRT-PGS-S ( n n max -- f)                                        dup u2/ tuck 2>R blk-bounds                                     2R> 2swap 2dup =          if 2drop                              else do  2dup i dup rot + rot prt-2scrs                            if    unloop                2drop -1 exit                       then  footer?     loop then 2drop  0 ;                                                                                    : PRT-PGS-C ( n n max -- f)                                        dup >R blk-bounds R>                                            rot rot 2dup =             if 2drop                             else do  dup i dup 1+ rot prt-2scrs                                if    unloop                 drop -1 exit                       then  footer? 2   +loop then drop  0 ;                                                                                    ( print file                                           17May93ep)                                                               : PRT-INIT  ( --)                                                  'prt' r/w create-file pthrow prt-hdl ! p-init ;                                                                              : SHOW-END  ( f --)                                                if 'stopped' p-type p-cr then p-res prt-close ;                                                                              : SHOW-START ( n> >n -- n> >n max-n)                               pcapacity  prt-init ;