%!
%                Macintosh LaserWriter header file.
%
% This is a file of PostScript definitions that can be affixed to the
% front of the PostScript files generated by Macintosh applications in order
% that they can be printed on a LaserWriter that has not been initialized
% with the "LaserPrep" package. This situation will arise if you are
% trying to share a LaserWriter between Macintosh users and non-Macintosh
% users.
%
% Macintosh applications do not normally generate straight PostScript.
% They generate a file in PostScript format, but the contents of the file
% is a series of calls on functions that are not part of the PostScript
% language. This file defines those functions.
%
% This is not the official Apple header file. It is neither endorsed nor
% condemned by Apple. I suspect that it probably started out its life
% as a bootleg copy of a version of the Apple header file. It has been
% slightly modified by me and perhaps heavily modified by various other
% people. I have substantially augmented the comments so that they explain
% what I think the code is doing.
%
%       Brian Reid      [email protected]
%       Stanford        {decwrl,hplabs,bellcore}!glacier!reid
%
% WARNING: There is no guarantee that Apple will stick to this particular
% set of definitions. This header file works with the application software
% that came with my LaserWriter; I make no promises that it will work with
% the software on anybody else's LaserWriter.
%
% To convert this file back into a downloaded file instead of a header
% file, uncomment all of the lines beginning with %-%

%-%0000000                      % Server loop exit password
%-%serverdict begin exitserver
%-%  systemdict /statusdict known
%-%  {statusdict begin 9 0 3 setsccinteractive /waittimeout 300 def end}
%-% if
/md 200 dict def                % define a working dictionary
md begin                        % start using it
/av 13 def                      % define apple version
/mtx matrix currentmatrix def   % save current transformation
/s30 30 string def
/s1 ( ) def
/pys 1 def
/pxs 1 def
/pyt 760 def
/pxt 29.52 def
/por true def
/xl {translate} def
/fp {pnsh 0 ne pnsv 0 ne and} def

% Define QuickDraw operators as an array of procedures.
% They are {frame, paint, erase, invert, fill}
% For some reason "invert" is a no-op.

/vrb [
{fp
{gsave 1 setlinewidth pnsh pnsv scale stroke grestore}
if newpath}
{eofill}
{eofill}
{newpath}
{eofill}
{initclip eoclip newpath}
{}
{}
{}
{}
] def

% convenience function for backwards def
/xdf {exch def} def

% get current halftone screen parameters
currentscreen
       /spf xdf                % spot function
       /rot xdf                % rotation
       /freq xdf               % spatial frequency

% "apply" function to execute appropriate numbered operator from /vrb.
/doop {vrb exch get exec} def

% compute page position from portrait/landscape flag, translation, scale,
%       and resolution.
%  call: P/L-flag xtransl ytransl scale*100 xbits/inch ybits/inch psu
% typical call: F 580 760 100 72 72 psu for life-size screen-resolution
% image.
%
/psu
 {2 index .72 mul exch div /pys xdf    % pixel y scale
 div .72 mul /pxs xdf                  % pixel x scale
/pyt xdf                               % pixel y translation
/pxt xdf                               % pixel x translation
/por xdf                               % portrait flag (T=portrait)
} def

% argument is page y size; use this to determine legal, letter, or note
% and to set up appropriate scale factors and translation/reflection
% for portrait or landscape.

/txpose{
   dup 1680 eq
   userdict /note known
     {{legal}{note}ifelse}
     {pop}
   ifelse
   dup 1212 eq {54 32.4 xl} if
   1321 eq {8.64 -.6 xl} if
   pxs pys scale pxt pyt xl por not
   {270 rotate} if
   1 -1 scale
} def

% Compute oblique shear value for font if flag true
/obl {{0.212557 mul}{pop 0} ifelse} def

%  set font from dictionary: make a font, set it to current, leave on stack
%  call: "found-font size oblique-flag dictionary sfd"
/sfd {
  [ps 0 ps 6 -1 roll obl ps neg 0 0] makefont
  dup setfont
} def
/fnt {findfont sfd} def

% bit test-- "number mask-word bt" returns boolean and unchanged number
% thus, "4095 512 bt" returns "true 4095" -- the argument is a mask
% and not a bit number.

/bt {1 index and 0 ne exch} def

% load style array with unpacked true/false flags from style word
% flags are Bold, Italic, Underline, Outline, Shadow (I don't know
% what the 6th one is supposed to be).
/sa 6 array def
/fs {
   1 bt     2 bt    4 bt    8 bt   16 bt
  sa astore pop
} def

/matrix1 matrix def
/matrix2 matrix def
/gf{
 currentfont
} def

% set translation center from 2 double-precision integers giving x,y
/tc{
  32768 div add                % compute y location
  3 1 roll
  32768 div add                % compute x location
  2t astore pop                % save 'em
} def

/3a [0 0 0] def
/2t 2 array def

% store transformation params: "justify flip rotation tp"
% (left/center/right/full, none/yflip,xflip, degrees)
/tp{
  3a astore pop
} def
/ee {} def

% move PostScript current position to QuickDraw current position,
% and get scaling and rotation right (this is in preparation for
% outputting text
/tt {
  gsave
    currentpoint 2 copy
    2t aload pop qa 2 copy xl
    3a aload pop exch dup 0 eq
    {pop}
    {1 eq {-1 1}
          {1 -1}ifelse scale}
    ifelse
    rotate
    pop neg exch neg exch xl
    moveto
} def

/te {                           % text-end: undo effects of prior "tt"
  currentpoint currentfont
  grestore setfont moveto      % but leave font and currentpoint set
} def

/tb {
  /tg currentgray def
  3 -1 roll 3 eq
  {1 setgray} if
  /ml 0 def /al 0 def
} def

/am {
  ml add /ml xdf
} def

/aa {
  [currentgray /setgray cvx] cvx
  exch dup wi pop dup al add /al xdf exch
} def

% scale by rational value (quotient) in x and y. Set "scaleflag" to
% record that we have done this.

/th {
  3 -1 roll div
  3 1 roll exch div
% not sure of "transform" in next line (BKR)
  2 copy matrix1 transform scale
  pop scale
  /scaleflag true def
} def

% undo a "th" scaling and return to default coordinate system
/tu {
  1 1 matrix1 itransform scale
  /scaleflag false def
} def

/ts {
  1 1 matrix1 transform scale
  /scaleflag true def
} def

% record point size (of fonts)
/fz{/ps xdf} def

% execute a procedure but leave it on the stack
/fx{dup exec} def

/st{show pop pop} def

% text munger. This does the dirty work for the edit string procedure
% (following) by iterating over a polymorphic array and doing the right
% thing with what it finds there.
/tm {
     {dup type dup /integertype eq exch /realtype eq or
        {dup ml mul}
        {dup type /stringtype eq
           {rs}
           {dup type /dicttype eq
              {setfont}
              {dup type /arraytype eq
                 {exec}
                 {pop}
                 ifelse
              } ifelse
           } ifelse
        } ifelse
     } forall
  } def

% edit string. Takes a font, a text mode, a justification mode, and an
% array of text and font changes for that text, and does it.
/es {
  3 -1 roll dup sa 5 get dup type /nulltype eq
  {pop4 pop}
  {sa 1 get
     {/ml ml .2 ps mul sub def} if
     ne {fs}
        {pop}
     ifelse exch
     dup 1 eq                  % justification mode 1 is left-justify
     {pop
        al ml gt
        {/tv {ll} /ml ml al dup 0 ne
           {div}{pop} ifelse
        def}
        {/tv {st} /ml 1 def}
        ifelse def tm
     }
     {dup 3 eq                 % justification mode 3 is right-justify
     {pop
     al ml gt
     {/tv {ll} /ml ml al dup 0 ne
       {div}{pop} ifelse
       def}
     {ml al sub 0 rmoveto
       /tv {st} /ml 1 def}
     ifelse def
        tm}
     {2 eq                     % justification mode 3 is centered
     {al ml gt
        { /tv {ll} /ml ml al dup
          0 ne
          {div}{pop}
          ifelse def}
        {ml al sub 2 div 0 rmoveto
          /tv {st} /ml 1 def}
          ifelse def
        tm}
     {                         % otherwise it is just "justified"
       /tv {ll} def
       /ml ml al dup 0 ne
         {div}{pop}
         ifelse def
        tm}
      ifelse}
    ifelse}
  ifelse}
  ifelse
  tg setgray
}def

/pop4 {pop pop pop pop} def
% --------------------------------------------------------------------
%                        QuickDraw Procedures
%
% moveto. If a scale factor is in effect, then honor it.
/gm {
 scaleflag {matrix1 itransform} if
 moveto
} def

%local y move
% call: "x y localy ly"
/ly {
  exch pop
  currentpoint exch pop
  sub 0 exch rmoveto
} def

% print n copies of page  (ensures full speed for multiple copies)
/page {
  1 add /#copies xdf showpage
} def

/sk {
  systemdict /statusdict known
} def

% set job name
/jn {
  sk {statusdict /jobname 3 -1 roll put}
     {pop}
  ifelse
} def

% set pen size: h v pen
/pen {
  /pnsv xdf
  /pnsh xdf
  pnsh setlinewidth
} def

% draw line
% (uses current pen location, pen size and graylevel)
% This emulates the ugly QuickDraw pen on the LaserWriter but
% preserves the same endpoint and linewidth anomalies that some applications
% rely on. (Bletch).
/dlin {
  currentpoint newpath moveto
  lineto currentpoint stroke
  grestore moveto
} def

/lin {
  currentpoint /pnlv xdf /pnlh xdf
  gsave newpath /@y xdf /@x xdf fp
  {pnlh @x lt
     {pnlv @y ge
        {pnlh pnlv moveto @x @y lineto
         pnsh 0 rlineto
         0 pnsv rlineto
         pnlh pnsh add pnlv pnsv add lineto
         pnsh neg 0 rlineto}
        {pnlh pnlv moveto
         pnsh 0 rlineto
         @x pnsh add @y lineto
         0 pnsv rlineto
         pnsh neg 0 rlineto
         pnlh pnlv pnsv add lineto}
        ifelse}
     {pnlv @y gt
        {@x @y moveto pnsh 0 rlineto
         pnlh pnsh add pnlv lineto
         0 pnsv rlineto
         pnsh neg 0 rlineto
         @x @y pnsv add lineto}
        {pnlh pnlv moveto pnsh 0 rlineto
         0 pnsv rlineto
         @x pnsh add @y pnsv add lineto
         pnsh neg 0 rlineto
         0 pnsv neg rlineto}
        ifelse}
     ifelse
     closepath fill}
  if @x @y grestore moveto
} def

/dl {
  gsave
  0 setlinewidth 0 setgray
} def

% Arc: top left bottom right startangle stopangle verb flag
% flag true means to exclude the center of curvature in the arc
/barc {
  /@f xdf   /@op xdf   /@e xdf   /@s xdf
  /@r xdf   /@b xdf    /@l xdf   /@t xdf
  gsave
  @r @l add 2 div @b @t add 2 div xl 0 0 moveto
  @r @l sub @b @t sub mtx currentmatrix pop scale
  @f {newpath} if
  0 0 0.5 @s @e arc
  mtx setmatrix @op doop
  grestore
} def
/doarc {dup 0 eq barc} def

% oval:  top left bottom right verb
/doval {0 exch 360 exch true barc} def

% rectangle:  top left bottom right verb
/dorect {
  /@op xdf currentpoint 6 2 roll
  newpath 4 copy
  4 2 roll exch moveto
  6 -1 roll lineto
  lineto lineto closepath
  @op doop moveto
} def

/mup {dup pnsh 2 div le exch pnsv 2 div le or} def

% roundrect:  top left bottom right ovalwidth ovalheight operation
% Warning: ovalwidth is assumed equal to ovalheight.
/dorrect {
  /@op xdf     2. div /@h xdf     2. div /@w xdf
  /@r xdf      /@b xdf            /@l xdf /@t xdf
  @t @b eq @l @r eq @w mup or or
  {@t @l @b @r @op dorect}
  {@r @l sub 2. div dup @w lt
     {/@w xdf}{pop}
     ifelse
     @b @t sub 2. div dup @w lt
     {/@w xdf}{pop}
     ifelse
     @op 0 eq
     {/@w @w pnsh 2 div sub def}
     if                   %this helps solve overlap gap for wide line widths
     currentpoint
     newpath
     @r @l add 2. div @t moveto
     @r @t @r @b @w arcto pop4
     @r @b @l @b @w arcto pop4
     @l @b @l @t @w arcto pop4
     @l @t @r @t @w arcto pop4
     closepath @op doop
     moveto
  }ifelse
} def

% Polygon utility procedures
/pr {
  gsave newpath /pl
     {moveto
      /pl {lineto} def
     }def
} def

/pl {lineto} def

/ep {
  dup 0 eq
   {
    {moveto}{lin}{}{}
    pathforall %nothing but movetos and linetos should be called
    pop grestore
   }
   {
    doop grestore
   }
   ifelse
} def

/bs 8 string def
/bd {/bs xdf} def



% These following procedures are used in defining QuickDraw patterns.
% (Pattern definition goes into halftone screen of PostScript)

% procedure to find black bits in QuickDraw pattern (pattern in hex string bs)
/bit {bs exch get exch 7 sub bitshift 1 and} def
/bix {1 add 4 mul cvi} def
/pp{exch bix exch bix bit}def
/grlevel {64. div setgray} def


% procedure to set a pattern: ratio hexstring
% ratio is the total number of white bits in the QuickDraw pattern represented in hexstring

/setpat {
  /bs xdf
  9.375 0 {pp} setscreen
  grlevel
} def

/setgry {
  freq rot {spf} setscreen
  grlevel
} def

% standard copybits routine:
% arguments: xscale yscale xloc yloc rowbytes xwidth ywidth fsmooth bitmode
% This procedure is the basis for all QuickDraw bit operations.
% xscale and yscale tell how much to scale the bit image in 72nds of an inch
% xloc and yloc are the location of the top left corner of the bitmap
% rowbytes is the total number of bytes in each scanline of hex data in the
% image.
%    Note that rowbytes must be even.
% xwidth and ywidth are the actual number of bits in the x and y coordinates
% of the image. fsmooth is a flag to tell whether or not to use bit
% smoothing.  Bit smoothing is a
% proprietary algorithm that provides smoothing of the data around a 5 by 5
% local area of each data pixel.
% bitmode can be any of the QuickDraw source transfer modes excluding srcXor
% and notSrcXor.
%    Note that this is the only QuickDraw procedure that can implement
% more than the simple srcCopy transfer mode.

/x4 {2 bitshift} def
/d4 {-2 bitshift} def
/xf {.96 mul exch 2 sub .96 mul exch} def
/dobits
{
  /bmode xdf
  save 9 1 roll
% 2 sub fixes dxsrc offset number required for bitsmoothing, but applies
% to both

%Bit Smooth mode
  {
  x4 /@dy xdf 2 sub x4 /@dx xdf /@idx xdf
  .96 mul exch 3 index 2 sub @dx div 7.68 mul dup 6 1 roll sub exch xl 0 0 moveto xf
  0 4 -1 roll 2 index 4 index 1.759 add 10 dorect clip newpath 0 0 moveto scale
  bmode 0 eq bmode 4 eq or{1 setgray 1 @dy div 1 @dx div 1 1 2 dorect}if
  bmode 3 eq bmode 7 eq or{1}{0}ifelse setgray
  @idx 5 bitshift @dy bmode 0 eq bmode 1 eq bmode 3 eq or or [@dx 0 0 @dy 0 0]
    {(%stdin)(r) file @dy d4 4 add @idx mul string readhexstring pop
    dup length @idx x4 sub 4 bitshift string
    dup 3 1 roll @dx 8 add d4 smooth} imagemask
  }
%Non Bit Smooth mode
  {
  /@dy xdf 2 sub /@dx xdf /@idx xdf
  /@xs @idx string def
  /@f (%stdin)(r) file def
  /@p{@f @xs readhexstring pop}def
  .96 mul xl 0 0 moveto xf scale
  0 0 1 1 10 dorect clip newpath 0 0 moveto
  bmode 0 eq bmode 4 eq or{1 setgray .25 @dy div .25 @dx div 1 1 2 dorect}if
  bmode 3 eq bmode 7 eq or{1}{0}ifelse setgray
  @p @p
  @idx 3 bitshift @dy bmode 0 eq bmode 1 eq bmode 3 eq or or [@dx 0 0 @dy 0 0]
  {@p} imagemask
  @p @p pop4
  }ifelse
restore
} def


% Making Mac compatible Fonts


/mfont 14 dict def
/wd 14 dict def
/mdef {mfont wcheck not{/mfont 14 dict def}if mfont begin xdf end} def
/dc {transform round .5 sub exch round .5 sub exch itransform} def


% Copy a font dictionary: fontdictionary
% copies a font dictionary into tmp so it may be used to define a new font

% tmp must be set before cf is called
/cf{{1 index /FID ne {tmp 3 1 roll put}{pop pop}ifelse}forall}def


% Procedures used in defining a bit map font

/mv{tmp /Encoding macvec put}def
/bf{
mfont begin
/FontType 3 def
/FontMatrix [1 0 0 1 0 0] def
/FontBBox [0 0 1 1] def
/Encoding macvec def
/BuildChar
 {
 wd begin
   /cr xdf
   /fd xdf
   fd /low get cr get 2 get -1 ne
   {
   fd begin
     low cr get aload pop
     sd
     low cr 1 add get 0 get
     sh
     sw
   end
   /sw xdf
   /sh xdf
   sw div /clocn xdf
   dup 0 ne {0 exch sh div neg dc xl}{pop}ifelse
   exch sw div /coff xdf
   exch sw div /cloc xdf
   /bitw clocn cloc sub def
   sw sh div 1 scale
   sw div 0 coff 0 bitw coff add 1 setcachedevice
   coff cloc sub 0 dc xl
   cloc .5 sw div add 0 dc newpath
moveto
   bitw 0 ne
     {0 1 rlineto bitw .5 sw div sub 0 rlineto 0 -1 rlineto
       closepath clip
     sw sh false [sw 0 0 sh neg 0 sh]{fd /hm get}imagemask}if
   } if
 end
 } def
end
mfont definefont pop
} def


% stringwidth procedure which does not allow a show to occur: (string)

/wi{save exch /show{pop}def
stringwidth 3 -1 roll restore}def

/aps {0 get 124 eq}def
/apn {s30 cvs aps} def


%set style in a PostScript name: AppleFontName
% e.g.
% /|----name sos /|---Oname
% /|----name sis /|-I--name

/xc{s30 cvs dup}def
/xp{put cvn}def
/scs{xc 3 67 put dup 0 95 xp}def
/sos{xc 3 79 xp}def
/sbs{xc 1 66 xp}def
/sis{xc 2 73 xp}def
/sob{xc 2 79 xp}def
/sss{xc 4 83 xp}def

/dd{exch 1 index add 3 1 roll add exch} def
/smc{moveto dup show} def
/kwn{dup FontDirectory exch known{findfont exch pop}}def
/fb{/ps ps 1 add def}def
/mb
{dup sbs kwn
  {
  exch{pop}{bbc}{} mm
  }ifelse
sfd
}def
/mo
{dup sos kwn
  {
  exch{pop}{boc}{} mm
  }ifelse
sfd
}def
/ms
{dup sss kwn
  {
  exch{pop}{bsc}{} mm
  }ifelse
sfd
}def

/ao
{dup sos kwn
  {
  exch dup ac pop
  {scs findfont /df2 xdf}{aoc}{} mm
  }ifelse
sfd
}def

/as
{dup sss kwn
  {
  exch dup ac pop
  {scs findfont /df2 xdf}{asc}{} mm
  }ifelse
sfd
}def

/ac
  {
  dup scs kwn
     {exch /ofd exch findfont def
     /tmp ofd maxlength 1 add dict def
     ofd cf mv
     tmp /PaintType 1 put
     tmp definefont}ifelse
  }def

/mm{
/mfont 10 dict def
mfont begin
/FontMatrix [1 0 0 1 0 0] def
/FontType 3 def
/Encoding macvec def
/df 4 index findfont def
/FontBBox [0 0 1 1] def
/xda xdf
/mbc xdf
/BuildChar { wd begin
 /cr xdf
 /fd xdf
 /cs s1 dup 0 cr put def
 fd /mbc get exec
 end
} def
exec
end
mfont definefont} def
/bbc
{
 /da .03 def
 fd /df get setfont
 gsave
   cs wi exch da add exchd
 grestore
 setcharwidth
 cs 0 0 smc
   da 0 smc
   da da smc
    0 da moveto show
} def

/boc
{
 /da 1 ps div def
 fd /df get setfont
 gsave
   cs wi
   exch da add exch
 grestore
 setcharwidth
 cs 0 0 smc
   da 0 smc
   da da smc
    0 da smc
 1 setgray
    da 2. div dup moveto show
} def

/bsc
{
 /da 1 ps div def
 /ds .05 def %da dup .03 lt {pop .03}if def
 /da2 da 2. div def
 fd /df get setfont
 gsave
   cs wi
   exch ds add da2 add exch
 grestore
 setcharwidth
 cs ds da2 add .01 add 0 smc
     0 ds da2 sub xl
     0  0 smc
    da  0 smc
    da da smc
     0 da smc
 1 setgray
     da 2. div dup moveto show
} def
/aoc
{
 fd /df get setfont
 gsave
   cs wi
 grestore
 setcharwidth
 1 setgray
 cs 0 0 smc
 fd /df2 get setfont
 0 setgray
 0 0 moveto show
}def
/asc
{
 /da .05 def
 fd /df get setfont
 gsave
   cs wi
   exch da add exch
 grestore
 setcharwidth
 cs da .01 add 0 smc
     0 da xl
 1 setgray
     0 0 smc
 0 setgray
 fd /df2 get setfont
     0 0 moveto show
}def

/T true def
/F false def


% More Polygon stuff used in polygon comment

/6a 6 array def
/2a 2 array def
/5a 5 array def
%subtract points, first from second (reverse order):  pt0 pt1 qs newpt
/qs{3 -1 roll sub exch 3 -1 roll sub exch}def
/qa{3 -1 roll add exch 3 -1 roll add exch}def
%multiply point: pt factor qm newpt
/qm{3 -1 roll 1 index mul 3 1 roll mul}def
/qn{6a exch get mul}def
/qA .166667 def /qB .833333 def /qC .5 def
/qx{
  6a astore pop
  qA 0 qn qB 2 qn add  qA 1 qn qB 3 qn add
  qB 2 qn qA 4 qn add  qB 3 qn qA 5 qn add
  qC 2 qn qC 4 qn add  qC 3 qn qC 5 qn add
}def
/qp{6 copy 12 -2 roll pop pop}def
/qc{qp qx curveto}def
/qi{{4 copy 2a astore aload pop qa .5 qm newpath moveto}{2 copy 6 -2 roll 2 qm qs 4 2 roll}ifelse}def
/qq{{qc 2a aload pop qx curveto}{4 copy qs qa qx curveto}ifelse}def

%start polygon comment
/pt{gsave currentpoint newpath moveto}def

%fill smoothed poly
/qf{gsave eofill grestore}def
/tr{currentgray currentscreen bs 5a astore pop /fillflag 1 def}def
/bc{/fillflag 0 def}def

%polyverb ec
/ec{currentpoint 3 -1 roll
  1 and 0 ne
  {currentgray currentscreen bs 5a aload pop bd setscreen setgray 0 doop bd setscreen setgray}
  {newpath}ifelse
  moveto
}def

/bp {
  currentpoint newpath 2 copy moveto
  currentgray currentscreen bs 5a astore pop
} def

/eu{
  fillflag 0 ne
  {
  gsave currentgray currentscreen bs
  5a aload pop bd setscreen setgray
  4 ep
  bd setscreen setgray
  }if
  fp{0 ep}{grestore newpath}ifelse
}def


% Line Layout stuff used by string merging algorithm

% counts spaces in string:   (...) sm (...) n
% returns string and number of spaces in string

/sm
{
dup 0 exch
{32 eq{1 add}if}forall
}
def


% layout a string to length specified by desiredlength:  printerlength desiredlength (...) ll
% printerlength is length of string in printer space

/ll
{
3 1 roll exch dup .0001 lt 1 index -.0001 gt and
{pop pop pop}
{sub dup 0 eq
  {
  pop show
  }
  {
  1 index sm dup 0 eq 3 index 0 le or
     {
     pop length div
     0 3 -1 roll ashow
     }
     {
% This piece does 10 percent stretching in characters and 90 percent in spaces
     10 mul exch length add div
     dup 10 mul 0 32 4 -1 roll 0 6 -1 roll awidthshow
% This piece does straight stretching in spaces only
%      exch pop div
%      0 32 4 -1 roll widthshow
     }ifelse
  }ifelse
}ifelse
}def


%set font to symbol and show the string: (...) ss

/ss
{  /pft currentfont def sa aload pop pop /|----2Symbol 4 1 roll
  {pop{as}}
  {{{ao}}{{fnt}}ifelse}ifelse
  exch pop exec exch pop
}def
/pf{pft dup setfont}def


% regular show does underline if ulf is true:
% arguments: printerlength desiredlength string rs

/rs
{
  sa 2 get
  {
  gsave
  1 index 0
  currentfont
  dup /FontInfo known
     {
     /FontInfo get
     dup /UnderlinePosition known
        {
        dup /UnderlinePosition get 1000 div ps mul
        }
        {
        ps 10 div neg  %15 makes line closer to text
        }ifelse
     exch
     dup /UnderlineThickness known
        {
        /UnderlineThickness get 1000 div ps mul
        }
        {
        pop
        ps 15 div  %20 makes slightly narrower line
        }ifelse
     }
     {
     pop
     ps 10 div neg   %15 makes line closer to text
     ps 15 div       %20 makes slightly narrower line
     }ifelse
  setlinewidth
  0 setgray
  currentpoint 3 -1 roll sub moveto
  sa 4 get{gsave currentlinewidth 2. div dup rmoveto currentpoint xl 2 copy rlineto
  stroke grestore}if
  sa 3 get sa 4 get or 3 1 roll 2 index{gsave 1 setgray 2 copy rlineto stroke grestore}if
  rlineto{strokepath 0 setlinewidth}if stroke
  grestore
  }if
  tv
}
def


%  More Font building stuff, specifically the Apple Encoding Vector

% Font encoding vector for PostScript fonts to match Mac
/macvec 256 array def
macvec 0
/Times-Roman findfont /Encoding get
0 128 getinterval putinterval macvec 39 /quotesingle put
/dotlessi /grave /circumflex /tilde /cedilla /registerserif
/copyrightserif /trademarkserif
macvec 0 8 getinterval astore pop
/Adieresis /Aring /Ccedilla /Eacute /Ntilde /Odieresis /Udieresis /aacute
/agrave /acircumflex /adieresis /atilde /aring /ccedilla /eacute /egrave
/ecircumflex /edieresis /iacute /igrave /icircumflex /idieresis /ntilde
/oacute  /ograve /ocircumflex /odieresis /otilde /uacute /ugrave
/ucircumflex /udieresis
/dagger /ring /cent /sterling /section /bullet /paragraph /germandbls
/registersans /copyrightsans /trademarksans /acute /dieresis /notequal
/AE /Oslash
/infinity /plusminus /lessequal /greaterequal /yen /mu /partialdiff
/summation
/product /pi /integral /ordfeminine /ordmasculine /Omega /ae /oslash
/questiondown /exclamdown /logicalnot /radical /florin /approxequal /Delta
/guillemotleft  /guillemotright /ellipsis /space /Agrave /Atilde /Otilde
/OE /oe /endash /emdash /quotedblleft /quotedblright /quoteleft
/quoteright /divide /lozenge /ydieresis /Ydieresis /fraction /currency
/guilsinglleft /guilsinglright /fi /fl /daggerdbl /periodcentered
/quotesinglbase /quotedblbase /perthousand /Acircumflex /Ecircumflex /Aacute
/Edieresis /Egrave /Iacute /Icircumflex /Idieresis /Igrave /Oacute
/Ocircumflex /apple /Ograve /Uacute /Ucircumflex /Ugrave /dotlessi
/asciicircum /asciitilde /macron /breve /dotaccent /ring /cedilla
/hungarumlaut /ogonek /caron
macvec 128 128 getinterval astore pop

% now redefine all fonts using the MAC Encoding (except in Symbol) to make
% them be Apple compatible.

FontDirectory
{exch dup s30 cvs /@s xdf @s aps
  {pop pop}
  {exch dup length dict /tmp xdf
     cf
     /Symbol ne {mv} if
     /@i false def /@o false def /@b false def
     mark @s (Italic) search {/@i true def} if (Oblique) search {/@o true def} if
     (Bold) search {/@b true def} if (Roman) search pop (-) search pop /@s xdf cleartomark
     @s cvn dup /Symbol eq{pop 50}{/Courier eq{51}{49}ifelse}ifelse
     s30 0 @s length 6 add getinterval dup 6 @s putinterval dup 0 (|-----) putinterval
     @b {dup 1 66 put} if @i @o or {dup 2 73 put} if % @o {dup 2 79 put} if
     dup 5 4 -1 roll put
     cvn tmp definefont pop
  }ifelse
}forall


%Make any other special fonts here, i.e. Seattle

/_--C-2Symbol /Symbol findfont /tmp 1 index maxlength 1 add dict def cf tmp /PaintType 1 put tmp definefont
/|----4Seattle /Helvetica findfont dup length 1 add dict /tmp xdf cf mv
/mxv [/zero /one /two /three /four /five /six /seven /eight /nine /comma /period /dollar /numbersign
/percent /plus /hyphen /E /parenleft /parenright /space] def
tmp /Metrics 21 dict dup begin mxv{600 def}forall end put
tmp begin /FontBBox FontBBox [0 0 0 0] astore def end
tmp definefont pop


% open document, open page and close page procedures
% close document doesn't do anything currently

% txpose takes the vertical page size as a parameter
/od{txpose 10 fz 0 fs F /|----3Courier fnt pop}def
/op{/scaleflag false def /pm save def}def
/cp{pm restore}def

end