path: root/Build/source/texk/dvipsk/tex.lpro

% tex.lpro - public domain.
% 
% The following defines procedures assumed and used by program "dvips"
% and must be downloaded or sent as a header file for all TeX jobs.
% Originated by Neal Holtz, Carleton University, Ottawa, Canada
%      <holtz@cascade.carleton.cdn>
%      June, 1985
%
%   Hacked by tgr, July 1987, stripped down to bare essentials,
%   plus a few new commands for speed.
%
%   Hacked by don, December 1989, to give characters top down and to
%   remove other small nuisances; merged with tgr's compression scheme
%
% To convert this file into a downloaded file instead of a header
% file, uncomment all of the lines beginning with %-%
%
%   To observe available VM, uncomment the following.
%   (The first ten lines define a general 'printnumber' routine.)
%
% /VirginMtrx 6 array currentmatrix def
% /dummystring 20 string def
% /numberpos 36 def
% /printnumber { gsave VirginMtrx setmatrix
%   /Helvetica findfont 10 scalefont setfont
%   36 numberpos moveto
%   /numberpos numberpos 12 add def
%   dummystring cvs show
%   grestore
%   } bind def
% /showVM { vmstatus exch sub exch pop printnumber } def
% /eop-aux { showVM } def
%
%-%0000000 			% Server loop exit password
%-%serverdict begin exitserver
%-%  systemdict /statusdict known
%-%  {statusdict begin 9 0 3 setsccinteractive /waittimeout 300 def end}
%-% if

/TeXDict 300 dict def   % define a working dictionary
TeXDict begin           % start using it.
/N {def} def
/B {bind def} N
/S {exch} N
/X { S N } B
/A {dup} B
/TR {translate} N

% The output of dvips assumes pixel units, Resolution/inch, with
% increasing y coordinates corresponding to moving DOWNWARD.
% The PostScript default is big point units (bp), 72/inch, with
% increasing y coordinates corresponding to moving UP; the
% following routines handle conversion to dvips conventions. 

% Let the PostScript origin be (xps,yps) in dvips coordinates.

/isls false N
/vsize 11 72 mul N
/hsize 8.5 72 mul N
/landplus90 { false } def % make this true to flip landscape

/@rigin                 % -xps -yps @rigin -   establishes dvips conventions
  { isls { [ 0 landplus90 { 1 -1 } { -1 1 } ifelse 0 0 0 ] concat } if
    72 Resolution div 72 VResolution div neg scale
    isls { landplus90 { VResolution 72 div vsize mul 0 exch }
                      { Resolution -72 div hsize mul 0 } ifelse TR } if
    Resolution VResolution vsize -72 div 1 add mul TR
% As bad as setmatrix is, it is better than misalignment.
    [ matrix currentmatrix
       { A A round sub abs 0.00001 lt {round} if } forall
       round exch round exch
    ] setmatrix } N

/@landscape { /isls true N } B

/@manualfeed
   { statusdict /manualfeed true put
   } B

        % n @copies -   set number of copies
/@copies
   { /#copies X
   } B

% Bitmap fonts are called Fa, Fb, ..., Fz, F0, F1 . . . Ga . . .
% The calling sequence for downloading font foo is
%           /foo df charde1 ... chardefn E 
% where each chardef is
%           <hexstring> wd ht xoff yoff dx charno D 
%  or       <hexstring> wd ht xoff yoff dx I
%  or       <hexstring> charno D
%  or       <hexstring> I

/FMat [1 0 0 -1 0 0] N
/FBB [0 0 0 0] N

/nn 0 N /IEn 0 N /ctr 0 N
/df-tail       % id numcc maxcc df-tail -- initialize a new font dictionary
  {
%   dmystr 2 fontname cvx (@@@@) cvs putinterval  % put name in template
    /nn 8 dict N              % allocate new font dictionary
    nn begin
        /FontType 3 N
	/FontMatrix fntrx N
	/FontBBox FBB N
        string /base X
        array /BitMaps X
        /BuildChar {CharBuilder} N
        /Encoding IEn N
        end
    A { /foo setfont }          %  dummy macro to be filled in
       2 array copy cvx N         %  have to allocate a new one
    load                          %  now we change it
%      0 dmystr 6 string copy       %  get a copy of the font name
       0 nn put
%      cvn cvx put                  %  and stick it in the dummy macro
    /ctr 0 N                      %  go, count, and etc.
    [                               %  start next char definition
  } B
/sf 0 N
/df {
   /sf 1 N
   /fntrx FMat N
   df-tail
} B
/dfs { div /sf X
   /fntrx [ sf 0 0 sf neg 0 0 ] N
   df-tail
} B

/E { pop nn A definefont setfont } B

% 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:

/Cw {Cd A length 5 sub get} B % the number of pixels across
/Ch {Cd A length 4 sub get} B % the number of pixels tall
/Cx {128 Cd A length 3 sub get sub} B % num pixels right of origin
/Cy {Cd A length 2 sub get 127 sub} B % number of pixels below origin
/Cdx {Cd A length 1 sub get} B     % number of pixels to next character
/Ci {Cd A type /stringtype ne
      { ctr get /ctr ctr 1 add N } if
   } B                        % the hex string image, or array of same
% begin code for uncompressed fonts only
/CharBuilder    % fontdict ch Charbuilder -     -- image one character
     {save 3 1 roll S A /base get 2 index get S /BitMaps get S get
      /Cd X pop
      /ctr 0 N
      Cdx 0 Cx Cy Ch sub
      Cx Cw add Cy
      setcachedevice
      Cw Ch true
      [1 0 0 -1 -.1 Cx sub Cy .1 sub]
      {Ci} imagemask
      restore
  } B
% end code for uncompressed fonts only
% % here's the alternate code for unpacking compressed fonts
% /id 0 N /rw 0 N /rc 0 N /gp 0 N /cp 0 N /G 0 N
% /CharBuilder    % fontdict ch Charbuilder -     -- image one character
%     {save 3 1 roll S A /base get 2 index get S /BitMaps get S get
%      /Cd X pop
%      /ctr 0 N
%      Cdx 0 Cx Cy Ch sub
%      Cx Cw add Cy
%      setcachedevice
%      Cw Ch true
%      [1 0 0 -1 -.1 Cx sub Cy .1 sub]
%      /id Ci N                          % image data
%      /rw Cw 7 add 8 idiv string N      % row, initially zero
%      /rc 0 N                                 % repeat count
%      /gp 0 N                                 % image data pointer
%      /cp 0 N                                 % column pointer
%      { rc 0 ne { rc 1 sub /rc X rw } { G } ifelse } imagemask
%    restore
% } B
% /G { { id gp get /gp gp 1 add N
%   A 18 mod S 18 idiv pl S get exec } loop } B
% /adv { cp add /cp X } B
% /chg { rw cp id gp 4 index getinterval putinterval
%         A gp add /gp X adv } B
% /nd { /cp 0 N rw exit } B
% /lsh { rw cp 2 copy get A 0 eq { pop 1 } { A 255 eq { pop 254 }
%     { A A add 255 and S 1 and or } ifelse } ifelse put 1 adv } B
% /rsh { rw cp 2 copy get A 0 eq { pop 128 } { A 255 eq { pop 127 }
%     { A 2 idiv S 128 and or } ifelse } ifelse put 1 adv } B
% /clr { rw cp 2 index string putinterval adv } B
% /set { rw cp fillstr 0 4 index getinterval putinterval adv } B
% /fillstr 18 string 0 1 17 { 2 copy 255 put pop } for N
% /pl [
%    { adv 1 chg }
%    { adv 1 chg nd }
%    { 1 add chg }
%    { 1 add chg nd }
%    { adv lsh }
%    { adv lsh nd }
%    { adv rsh }
%    { adv rsh nd }
%    { 1 add adv }
%    { /rc X nd }
%    { 1 add set }
%    { 1 add clr }
%    { adv 2 chg }
%    { adv 2 chg nd }
%    { pop nd } ] A { bind pop } forall N
% % end of code for unpacking compressed fonts

/D             % char-data ch D -    -- define character bitmap in current font
  { /cc X
    A type /stringtype ne {]} if
    nn /base get cc ctr put
    nn /BitMaps get S ctr S
    sf 1 ne {
       A A length 1 sub A 2 index S get sf div put
    } if
    put
    /ctr ctr 1 add N
  } B

/I            % a faster D for when the next char follows immediately
  { cc 1 add D } B

/bop           % %t %d bop -  -- begin a brand new page, %t=pageno %d=seqno
  {
    userdict /bop-hook known { bop-hook } if
    /SI save N
    @rigin
%
%   Now we check the resolution.  If it's correct, we use RV as V,
%   otherwise we use QV.
%
    0 0 moveto
    /V matrix currentmatrix
    A 1 get A mul exch 0 get A mul add .99 lt
    {/QV} {/RV} ifelse load def
    pop pop
  } N

/eop           % - eop -              -- end a page
  { % eop-aux  % -- to observe VM usage
    SI restore
    userdict /eop-hook known { eop-hook } if
    showpage
  } N

/@start         % hsz vsz mag dpi vdpi name @start -   -- start everything
  {
    userdict /start-hook known { start-hook } if
    pop % the job name string is used only by start-hook
    /VResolution X
    /Resolution X
    1000 div /DVImag X
    /IEn 256 array N
    2 string 0 1 255 { IEn S A 360 add 36 4 index cvrs cvn put } for pop
    65781.76 div /vsize X
    65781.76 div /hsize X
  } N

/dir 0 def
/dyy {/dir 0 def
} B
/dyt {/dir 1 def
} B
/dty {/dir 2 def
} B
/dtt {/dir 3 def
} B

%/p {show} N        %  the main character setting routine
/p {dir 2 eq
   {-90 rotate show 90 rotate}
   {dir 3 eq {-90 rotate show 90 rotate}
   {show} ifelse} ifelse
} N

/RMat [ 1 0 0 -1 0 0 ] N % things we need for rules
/BDot 260 string N
/Rx 0 N /Ry 0 N
%
%   What we need to do to get things to work here is tragic.
%
/V {} B /RV
/v {                   % can't use ...fill; it makes rules too big
   /Ry X /Rx X
   V
} B
%
%   Which do we use?  The first if we are talking to Display
%   PostScript, the latter otherwise.
%
statusdict begin /product where
   { pop false [(Display) (NeXT) (LaserWriter 16/600)] {
      A length product length le {
            A length product exch 0 exch getinterval eq
            { pop true exit } if
         } { pop } ifelse
      } forall }
   { false } ifelse end
{ {
   gsave
      TR -.1 .1 TR 1 1 scale Rx Ry
      false RMat { BDot } imagemask
   grestore
} }
{ {
   gsave
      TR -.1 .1 TR Rx Ry scale 1 1
      false RMat { BDot } imagemask
   grestore
} } ifelse B
%
%   We use this if the resolution doesn't match.
%
/QV {
   gsave
      newpath transform round exch round exch itransform moveto
      Rx 0 rlineto 0 Ry neg rlineto
      Rx neg 0 rlineto fill
   grestore
} B
%
/a { moveto } B    % absolute positioning
/delta 0 N         % we need a variable to hold space moves
%
%   The next ten macros allow us to make horizontal motions that
%   are within 4 of the previous horizontal motion with a single
%   character.  These are typically used for spaces.
%
/tail { A /delta X 0 rmoveto } B
/M { S p delta add tail } B
/b { S p tail } B      % show and tail!
/c { -4 M } B
/d { -3 M } B
/e { -2 M } B
/f { -1 M } B
/g { 0 M } B
/h { 1 M } B
/i { 2 M } B
/j { 3 M } B
/k { 4 M } B
%
%   These next allow us to make small motions (-4..4) cheaply.
%   Typically used for kerns.
%
/w { 0 rmoveto } B
/l { p -4 w } B
/m { p -3 w } B
/n { p -2 w } B
/o { p -1 w } B
/q { p 1 w } B
/r { p 2 w } B
/s { p 3 w } B
/t { p 4 w } B
%
%  x is good for small vertical positioning.
%  And y is good for a print followed by a move.
%
/x { 0 S rmoveto } B
/y { 3 2 roll p a } B
%
%   The bos and eos commands bracket sections of downloaded characters.
%
/bos { /SS save N } B
/eos { SS restore } B

end  % revert to previous dictionary