%!
% a start (Ha!) at a TeX mode for PostScript
% Caution:  the following violates almost all codes of good programming practice

(TeX job [preamble version 1.00/02]\n) print flush

                        % units are in "dots" (300/inch)
/Resolution 300 def
/Page-X-Offset 250 def  % pages are shifted right this much for TeX
/Page-Y-Offset 275 def  % pages are shifted down this much for TeX
/Inch  {Resolution mul} def  % converts inches to internal units

/PageCounter statusdict begin pagecount end def  % so we can report # pages printed

/@newfont       % id @newfont -         -- initialize a new font dictionary
  { /newname exch def
    pop
    newname 7 dict def          % allocate new font dictionary
    newname load begin
        /FontType 3 def
        /FontMatrix [1 0 0 1 0 0] def
        /FontBBox [0 0 1 1] def
        /BitMaps 128 array def
        /BuildChar {CharBuilder} def
        /Encoding 128 array def
        0 1 127 {Encoding exch /.undef put} for
        end
    newname newname load definefont pop
  } def


% the following is the only character builder we need.  it looks up the
% char data in the BitMaps array, and paints the character if possible.
% char data  -- a bitmap descriptor -- is an array of length 6, of
%          which the various slots are:

/ch-image {ch-data 0 get} def   % the hex string image
/ch-width {ch-data 1 get} def   % the number of pixels across
/ch-height {ch-data 2 get} def  % the number of pixels tall
/ch-xoff  {ch-data 3 get} def   % number of pixels below origin
/ch-yoff  {ch-data 4 get} def   % number of pixels to left of origin
/ch-tfmw  {ch-data 5 get} def   % spacing to next character

/CharBuilder    % fontdict ch Charbuilder -     -- image one character
  { /ch-code exch def           % save the char code
    /font-dict exch def         % and the font dict.
    /ch-data font-dict /BitMaps get ch-code get def     % get the bitmap descriptor for char
    ch-data null eq not
      { ch-tfmw   0   ch-xoff neg   ch-yoff neg   ch-width ch-xoff sub   ch-height ch-yoff sub
            setcachedevice
        ch-width ch-height true [1 0  0 1  ch-xoff ch-yoff]
            {ch-image} imagemask
      }
    if
  } def


/@sf            % fontdict @sf -        -- make that the current font
  { setfont
  } def

                % in the following, the font-cacheing mechanism requires that
                % a name unique in the particular font be generated

/@dc            % char-data ch @dc -    -- define a new character bitmap in current font
  { /ch-code exch def
    /ch-data exch def
    currentfont /BitMaps get ch-code ch-data put
    currentfont /Encoding get ch-code
       dup (   ) cvs cvn   % generate a unique name simply from the character code
       put
  } def

/@bop0           % n @bop0 -              -- begin the char def section of a new page
  { (Page ) print == flush
  } def

/@bop1           % n @bop1 -              -- begin a brand new page
  { pop
    erasepage initgraphics
%                translations are a haque to get correct margins (1" default for TeX)
    [1.0 0.0 0.0 -1.0 Page-X-Offset 11 Inch Page-Y-Offset add]  setmatrix
    /SaveImage save def
  } def

/@eop           % - @eop -              -- end a page
  { showpage
    SaveImage restore
%%    vmstatus exch sub == pop          % print a few statistics (mem remaining)
  } def

/@end           % - @end -              -- done the whole shebang
  { (Done! ) print
    statusdict begin pagecount end PageCounter sub
    dup /PageCounter exch def
    (      ) cvs print
    ( pages printed.\n) print flush
    erasepage initgraphics
    count 0 gt             % print stats if stack not empty
      { PageCounter 3 ge   % and if there were a significant number of pages
          { /Times-Bold findfont 16 scalefont setfont
            newpath 200 500 moveto
            count
              { gsave
                  (                                                           ) cvs show
                grestore
                0 -30 rmoveto
              }
            repeat
            0 -20 rmoveto
            PageCounter (      ) cvs show
            ( pages printed.) show
            0.3 setgray
            newpath 0 792 moveto
            0 -24 rlineto 692 0 rlineto 0 24 rlineto closepath fill
            newpath 0 0 moveto
            692 0 rlineto 0 24 rlineto -692 0 rlineto closepath fill
            showpage
          }
        if
      }
    if
  } def

/p              % x y p -               -- move to position
  { moveto
  } def

/r              % x r -                 -- move right
  { 0 rmoveto
  } def

/s              % string s -            -- show the string
  { show
  } def

/c              % ch c -                -- show the character (code given)
  { c-string exch 0 exch put
    c-string show
  } def

/c-string ( ) def

/ru             % dx dy ru -   -- set a rule (rectangle)
  { /dy exch def
    /dx exch def
    /x currentpoint /y exch def def   % remember current point
    newpath x y moveto
    dx 0 rlineto
    0 dy rlineto
    dx neg 0 rlineto
    closepath fill
    x y moveto
  } def

% this will be invoked as the result of a \special command (for the
% inclusion of PostScript graphics).  The basic idea is to change all
% scaling and graphics back to defaults, but to shift the origin
% to the current position on the page.  Due to TeXnical difficulties,
% we only set the y-origin.  The x-origin is set at the left edge of
% the page.

/@beginspecial          % - @beginspecial -     -- enter special mode
  { /SpecialSave save def gsave
    currentpoint initgraphics
       exch pop Page-Y-Offset sub         % remember, page is offset vertically
       72 1 Inch div mul                  % convert this dimension to points
       0 exch translate
  } def

/@endspecial            % - @endspecial -       -- leave specail mode
  { grestore SpecialSave restore
  } def
