100 dict dup begin

%
% File: org/freehep/graphicsio.ps/PSProlog.txt
% Author: Charles Loomis
%

% Redefinitions which save some space in the output file.  These are also
% the same as the PDF operators.
/q {gsave} def
/Q {grestore} def

/n {newpath} def
/m {moveto} def
/l {lineto} def
/c {curveto} def
/h {closepath} def

/re {4 -2 roll moveto
     dup 0 exch rlineto exch 0 rlineto
     neg 0 exch rlineto closepath} def

/f {fill} def
/f* {eofill} def
/F {gsave vg&FC fill grestore} def
/F* {gsave vg&FC eofill grestore} def

/s {closepath stroke} def
/S {stroke} def

/b {closepath gsave vg&FC fill grestore
    gsave stroke grestore newpath} def
/B {gsave vg&FC fill grestore gsave stroke grestore newpath} def
/b* {closepath gsave vg&FC eofill grestore
    gsave stroke grestore newpath} def
/B* {gsave vg&FC eofill grestore gsave stroke grestore newpath} def

/g {1 array astore /vg&fcolor exch def} def
/G {setgray} def
/k {4 array astore /vg&fcolor exch def} def
/K {setcmykcolor} def
/rg {3 array astore /vg&fcolor exch def} def
/RG {setrgbcolor} def

% Initialize the fill color.
0 0 0 rg

/vg&FC {mark vg&fcolor aload pop
        counttomark 1 eq {G} if
        counttomark 3 eq {RG} if
        counttomark 4 eq {K} if
        cleartomark } def

/vg&DFC {/vg&fcolor exch def} def

/vg&C {mark exch aload pop
       counttomark 1 eq {G} if
       counttomark 3 eq {RG} if
       counttomark 4 eq {K} if
       cleartomark } def

/w {setlinewidth} def
/j {setlinejoin} def
/J {setlinecap} def
/M {setmiterlimit} def
/d {setdash} def
/i {setflat} def

/W {clip} def
/W* {eoclip} def

% Setup the default graphics state.
% (black; 1 pt. linewidth; miter join; butt-ends; solid)
/defaultGraphicsState {0 g 1 w 0 j 0 J [] 0 d} def

% Emulation of the rectangle operators for PostScript implementations
% which do not implement all Level 2 features.  This is an INCOMPLETE
% emulation; only the "x y width height rect..." form is emulated.
/*rf {gsave newpath re fill grestore} def
/*rs {gsave newpath re stroke grestore} def
/*rc {newpath re clip} def
/rf  /rectfill where {pop /rectfill}{/*rf} ifelse load def
/rs  /rectstroke where {pop /rectstroke}{/*rs} ifelse load def
/rc  /rectclip where {pop /rectclip}{/*rc} ifelse load def

% Emulation of the selectfont operator.  This includes a 20% increase in
% the fontsize which is necessary to get sizes similar to the Java fonts.
/*sf {exch findfont exch
      dup type /arraytype eq {makefont}{scalefont} ifelse setfont} bind def
/sf /selectfont where {pop {1.2 mul selectfont}}{{1.2 mul *sf}} ifelse def

% Special version of stroke which allows the dash pattern to continue
% across path segments.  (This may be needed for PostScript although
% modern printers seem to do this correctly.)
/vg&stroke {
  currentdash pop length 0 eq
  {stroke}
  {
    currentdash /vg&doffset exch def pop
    flattenpath
    {m vg&resetdash}
    {2 copy
     currentpoint
     3 -1 roll sub dup mul
     3 1 roll sub dup mul
     add sqrt
     3 1 roll l
     currentdash 3 -1 roll add setdash}
     {}
     {h vg&resetdash}
     pathforall
     stroke
     vg&resetdash
  } ifelse
} def
/vg&resetdash {currentdash pop vg&doffset setdash} def

% Initialize variables for safety.
/delta 0 def
/xv 0 def  /yv 0 def  /width 0 def  /height 0 def

% Initialize to portrait INTERNATIONAL (Letter-height, A4-width) page.
/pw 595 def  /ph 791  def  /po true def /ftp false def

% Initialize margins to 20 points.
/ml 20 def  /mr 20 def  /mt 20 def  /mb 20 def

% Temporary matrices.
/smatrix 0 def  /nmatrix 0 def

% set page size (usage: <page width><page height> setpagesize)
/setpagesize {/ph exch def /pw exch def} def

% set page orientation (usage: portrait or landscape)
/portrait {/po true def} def
/landscape {/po false def} def

% force natural size for image (usage: naturalsize)
/naturalsize {/ftp false def} def

% resize image to fill page (usage: fittopage)
/fittopage {/ftp true def} def

% set margins of the page (usage: <left><bottom><top><right> setmargins)
/setmargins {/mr exch def /mt exch def /mb exch def /ml exch def} def

% set the graphic's size (usage: <width><height> setsize)
/setsize {/gh exch def /gw exch def} def

% set the graphic's origin (usage: <x0><y0> setorigin)
/setorigin {/gy exch def /gx exch def} def

% calculate image center
/imagecenter {pw ml sub mr sub 2 div ml add
              ph mt sub mb sub 2 div mb add} def

% calculate the necessary scaling
/imagescale {po {gw}{gh} ifelse pw ml sub mr sub div
             po {gh}{gw} ifelse ph mt sub mb sub div
             2 copy lt {exch} if pop
             ftp not {1 2 copy lt {exch} if pop} if
             1 exch div /sfactor exch def
             /gw gw sfactor mul def /gh gh sfactor mul def} def

% calculate image origin
/imageorigin {pw ml sub mr sub 2 div ml add
              po {gw}{gh} ifelse 2 div sub
              ph mt sub mb sub 2 div mb add
              po {gh}{gw} ifelse 2 div po {add}{sub} ifelse} def

% calculate the clipping origin
/cliporigin  {pw ml sub mr sub 2 div ml add
              po {gw}{gh} ifelse 2 div sub floor
              ph mt sub mb sub 2 div mb add
              po {gh}{gw} ifelse 2 div sub floor} def

% Set the clipping region to the bounding box.
/cliptobounds {cliporigin po {gw}{gh} ifelse 1 add
                          po {gh}{gw} ifelse 1 add rc} def

% set the base transformation matrix (usage: setbasematrix)
/setbasematrix {imageorigin translate
                po {0}{90} ifelse rotate
                sfactor sfactor neg scale
                /defaultmatrix matrix currentmatrix def} def

% The lower-right bias in drawing 1 pt. wide lines.
/bias  {q 0.5 0.5 translate} def
/unbias {Q} def

% Draw a line. (x0 y0 x1 y1 line)
/L {bias n m l S unbias} def

% Polyline primitive.
/polyline  {n m 1 exch 1 exch
           {pop currentfile token pop currentfile token pop l} for
           } def

% Draw a polyline (n x0 y0 OPL x1 y1 x2 y2 ... ... xn yn)
/OPL {bias polyline S unbias} def

% Draw a closed polyline (n x0 y0 CPL x1 y1 x2 y2 ... ... xn yn)
/CPL {bias polyline s unbias} def

% Draw a filled polyline (n x0 y0 FPL x1 y1 x2 y2 ... ... xn yn)
/FPL {polyline h f*} def

% Draw an oval. (x y w h OVL)
/OVL {matrix currentmatrix /smatrix exch def
      /height exch def /width exch def
      /yv exch def /xv exch def
      width 2 div xv add height 2 div yv add translate
      width currentlinewidth sub 2 div
      height currentlinewidth sub 2 div neg
      scale n 0 0 1 5 -2 roll arc
      smatrix setmatrix S} def

% Draw a filled oval. (x y w h FOVL)
/FOVL {matrix currentmatrix /smatrix exch def
      /height exch def /width exch def
      /yv exch def /xv exch def
      width 2 div xv add height 2 div yv add translate
      width 2 div
      height 2 div neg
      scale n 0 0 m 0 0 1 5 -2 roll arc
      h smatrix setmatrix f} def

% Draw a rounded rectangle. (x y w h arcwidth archeight RREC)
/RREC {matrix currentmatrix /smatrix exch def
      2 div /ah exch def
      2 div /aw exch def
      /height exch def /width exch def
      /yv exch def /xv exch def
      aw ah scale matrix
      currentmatrix /nmatrix exch def
      smatrix setmatrix
      n xv width add aw sub yv m
      nmatrix setmatrix
      currentpoint exch 1 add exch
      currentpoint 1 add exch 1 add exch
      1 arct smatrix setmatrix
      xv width add yv height add ah sub l
      nmatrix setmatrix
      currentpoint 1 add
      currentpoint exch 1 sub exch 1 add
      1 arct smatrix setmatrix
      xv aw add yv height add l
      nmatrix setmatrix
      currentpoint exch 1 sub exch
      currentpoint exch 1 sub exch 1 sub
      1 arct smatrix setmatrix
      xv yv ah add l
      nmatrix setmatrix
      currentpoint 1 sub
      currentpoint exch 1 add exch 1 sub
      1 arct smatrix setmatrix
      s} def

% Draw a filled rounded rectangle. (x y w h arcwidth archeight FRREC)
/FRREC{matrix currentmatrix /smatrix exch def
      2 div /ah exch def
      2 div /aw exch def
      /height exch def /width exch def
      /yv exch def /xv exch def
      aw ah scale matrix
      currentmatrix /nmatrix exch def
      smatrix setmatrix
      n xv width add aw sub yv m
      nmatrix setmatrix
      currentpoint exch 1 add exch
      currentpoint 1 add exch 1 add exch
      1 arct smatrix setmatrix
      xv width add yv height add ah sub l
      nmatrix setmatrix
      currentpoint 1 add
      currentpoint exch 1 sub exch 1 add
      1 arct smatrix setmatrix
      xv aw add yv height add l
      nmatrix setmatrix
      currentpoint exch 1 sub exch
      currentpoint exch 1 sub exch 1 sub
      1 arct smatrix setmatrix
      xv yv ah add l
      nmatrix setmatrix
      currentpoint 1 sub
      currentpoint exch 1 add exch 1 sub
      1 arct smatrix setmatrix
      h f} def

% Draw a string.  (string x y STR)
/STR {q m 1 -1 scale recshow Q} def

% Define basic plot symbols.
/xys   {/siz exch def /yv exch def /xv exch def} def
/hline {xys n xv siz 2. div sub yv m siz 0 rlineto S} def
/vline {xys n xv yv siz 2. div sub m 0 siz rlineto S} def
/plus  {xys n xv yv siz 2. div sub m 0 siz rlineto
                    xv siz 2. div sub yv m siz 0 rlineto S} def
/dot   {n 2. div 0 360 arc s} def
/fdot  {n 2. div 0 360 arc h f} def
/box   {xys n xv siz 2 sqrt div 2 div sub yv siz 2 sqrt div 2 div sub
                    siz 2 sqrt div dup rs} def
/fbox  {xys n xv siz 2 sqrt div 2 div sub yv siz 2 sqrt div 2 div sub
                       siz 2 sqrt div dup rf} def
/tridn{xys n xv yv siz 3 sqrt div add m
                       siz 2. div neg 3 sqrt 2. div siz mul neg rlineto
                       siz 0 rlineto s} def
/ftridn{xys n xv yv siz 3 sqrt div add m
                       siz 2. div neg 3 sqrt 2. div siz mul neg rlineto
                       siz 0 rlineto h f} def

% Symbols defined in terms of the others.
/star     {3 copy cross plus} def
/cross    {xys q xv yv translate 45 rotate 0 0 siz plus Q} def
/diamond  {xys q xv yv translate 45 rotate 0 0 siz box Q} def
/fdiamond {xys q xv yv translate 45 rotate 0 0 siz fbox Q} def
/triup    {xys q xv yv translate 180 rotate 0 0 siz tridn Q} def
/ftriup   {xys q xv yv translate 180 rotate 0 0 siz ftridn Q} def

% Define the composite fonts used to print Unicode strings.
% Undefine particular values in an encoding array.
/vg&undef { {exch dup 3 -1 roll /.notdef put} forall } def
/vg&redef { {3 -1 roll dup 4 2 roll put} forall } def

% usage: key encoding basefontname vg&newbasefont font
/vg&newbasefont {
findfont dup length dict copy
  begin
    currentdict /FID undef
    /Encoding exch def
    dup /FontName exch def
    currentdict
  end
definefont
} def

% usage: key encoding basefontname vg&newskewedbasefont font
/vg&newskewedbasefont {
findfont dup length dict copy
  begin
    currentdict /FID undef
    /Encoding exch def
    dup /FontName exch def
    exch FontMatrix exch matrix concatmatrix /FontMatrix exch def
    currentdict
  end
definefont
} def

% usage: basekey suffix vg&nconcat name
/vg&nconcat {
  2 {dup length string cvs exch} repeat
  dup length 3 -1 roll dup length 3 -1 roll add string
  dup 0 4 -1 roll dup length 5 1 roll putinterval
  dup 4 -2 roll exch putinterval cvn
} def

%usage: fontname vg&skewmatrix matrix
/vg&skewmatrix {
findfont dup /FontInfo known
  {
    /FontInfo get dup /ItalicAngle known
    {
      [ 1 0 4 -1 roll /ItalicAngle get neg dup sin exch cos div 1 0 0 ]
    }
    {pop matrix} ifelse
  }
  {pop matrix} ifelse
} def

% usage: newfontname basefontname vg&newcompositefont --
/vg&newcompositefont {
/vg&fstyle exch def
/vg&bfont exch def
/vg&fname exch def
<<
/FontStyleBits vg&fstyle
/FontType 0
/FontMatrix matrix
/FontName vg&fname
/FMapType 2
/Encoding [ 0 1 255 {pop 6} for ]
          dup 16#00 0 put % Latin
          dup 16#03 1 put % Greek
          dup 16#20 2 put % Punctuation
          dup 16#21 3 put % Arrows
          dup 16#22 4 put % MathOps
          dup 16#27 5 put % Dingbats

/FDepVector [
vg&bfont /-UC-Latin vg&nconcat UCLatinEncoding
vg&bfont vg&newbasefont

vg&bfont vg&skewmatrix
vg&bfont /-UC-Greek vg&nconcat UCGreekEncoding
/Symbol vg&newskewedbasefont

vg&bfont /-UC-Punctuation vg&nconcat UCPunctuationEncoding
vg&bfont vg&newbasefont

/Arrows-UC findfont
/MathOps-UC findfont
/Dingbats-UC findfont
/Undefined-UC findfont ]
>>
vg&fname exch definefont pop
} def

% Null encoding vector (all elements set to .notdef)
/NullEncoding [ 256 {/.notdef} repeat ] def

% Unicode Latin encoding (unicode codes \u0000-\u00ff)
/UCLatinEncoding
  ISOLatin1Encoding dup length array copy
  dup 16#60 /grave put
  [ 16#90 16#91 16#92 16#93 16#94 16#95 16#96
    16#97 16#98 16#9a 16#9b 16#9d 16#9e 16#9f
  ] vg&undef
  def

% Unicode Greek encoding (unicode codes \u0370-\u03ff)
/UCGreekEncoding
  NullEncoding dup length array copy
  << 16#91 /Alpha    16#92 /Beta      16#93 /Gamma    16#94 /Delta
     16#95 /Epsilon  16#96 /Zeta      16#97 /Eta      16#98 /Theta
     16#99 /Iota     16#9a /Kappa     16#9b /Lambda   16#9c /Mu
     16#9d /Nu       16#9e /Xi        16#9f /Omicron  16#a0 /Pi
     16#a1 /Rho      16#a3 /Sigma     16#a4 /Tau      16#a5 /Upsilon
     16#a6 /Phi      16#a7 /Chi       16#a8 /Psi      16#a9 /Omega
     16#b1 /alpha    16#b2 /beta      16#b3 /gamma    16#b4 /delta
     16#b5 /epsilon  16#b6 /zeta      16#b7 /eta      16#b8 /theta
     16#b9 /iota     16#ba /kappa     16#bb /lambda   16#bc /mu
     16#bd /nu       16#be /xi        16#bf /omicron  16#c0 /pi
     16#c1 /rho      16#c2 /sigma1    16#c3 /sigma    16#c4 /tau
     16#c5 /upsilon  16#c6 /phi1      16#c7 /chi      16#c8 /psi
     16#c9 /omega    16#7e /semicolon 16#87 /dotmath  16#d1 /theta1
     16#d2 /Upsilon1 16#d5 /phi       16#d6 /omega1
  >> vg&redef
  def

% Unicode punctuation encoding (unicode codes \u2000-\u206f)
/UCPunctuationEncoding
  NullEncoding dup length array copy
  << 16#10 /hyphen          16#11 /hyphen              16#12 /endash
     16#13 /emdash          16#18 /quoteleft           16#19 /quoteright
     16#1a /quotesinglbase  16#1b /quotesingle         16#1c /quotedblleft
     16#1d /quotedblright   16#1e /quotedblbase        16#1f /quotedbl
     16#20 /dagger          16#21 /daggerdbl           16#22 /bullet
     16#24 /period          16#26 /ellipsis            16#27 /periodcentered
     16#30 /perthousand     16#44 /fraction
     16#70 /zerosuperior    16#74 /foursuperior        16#75 /fivesuperior
     16#76 /sixsuperior     16#77 /sevensuperior       16#78 /eightsuperior
     16#79 /ninesuperior    16#7b /hyphensuperior      16#7d /parenleftsuperior
     16#7e /parenrightsuperior
     16#80 /zeroinferior    16#84 /fourinferior        16#85 /fiveinferior
     16#81 /oneinferior     16#82 /twoinferior         16#83 /threeinferior
     16#86 /sixinferior     16#87 /seveninferior       16#88 /eightinferior
     16#89 /nineinferior    16#8b /hypheninferior      16#8d /parenleftinferior
     16#8e /parenrightinferior
  >> vg&redef
  def

% Unicode mathematical operators encoding (unicode codes \u2200-\u22ff)
/UCMathOpsEncoding
  NullEncoding dup length array copy
  << 16#00 /universal       16#02 /partialdiff         16#03 /existential
     16#05 /emptyset        16#06 /Delta               16#07 /gradient
     16#08 /element         16#09 /notelement          16#0b /suchthat
     16#0f /product         16#11 /summation           16#12 /minus
     16#15 /fraction        16#17 /asteriskmath        16#19 /bullet
     16#1a /radical         16#1d /proportional        16#1e /infinity
     16#20 /angle           16#23 /bar                 16#27 /logicaland
     16#28 /logicalor       16#29 /intersection        16#2a /union
     16#2b /integral        16#34 /therefore           16#36 /colon
     16#3c /similar         16#45 /congruent           16#48 /approxequal
     16#60 /notequal        16#61 /equivalence         16#64 /lessequal
     16#65 /greaterequal    16#82 /propersubset        16#83 /propersuperset
     16#86 /reflexsubset    16#87 /reflexsuperset      16#95 /circleplus
     16#97 /circlemultiply  16#a5 /perpendicular       16#03 /existential
     16#c0 /logicaland      16#c1 /logicalor           16#c2 /intersection
     16#c3 /union           16#c4 /diamond             16#c5 /dotmath
  >> vg&redef
  def

% Unicode arrows encoding (unicode codes \u2190-\u21ff)
% Also includes those "Letterlike" unicode characters
% which are available in the symbol font. (unicode codes \u2100-\u214f)
/UCArrowsEncoding
  NullEncoding dup length array copy
  << 16#11 /Ifraktur        16#1c /Rfraktur            16#22 /trademarkserif
     16#35 /aleph
     16#90 /arrowleft       16#91 /arrowup             16#92 /arrowright
     16#93 /arrowdown       16#94 /arrowboth           16#d0 /arrowdblleft
     16#d1 /arrowdblup      16#d2 /arrowdblright       16#d3 /arrowdbldown
     16#d4 /arrowdblboth
  >> vg&redef
  def

/ZapfDingbats findfont /Encoding get
dup length array copy /UCDingbatsEncoding exch def
16#20 1 16#7f {
  dup 16#20 sub exch
  UCDingbatsEncoding exch get
  UCDingbatsEncoding 3 1 roll put
} for
16#a0 1 16#ff {
  dup 16#40 sub exch
  UCDingbatsEncoding exch get
  UCDingbatsEncoding 3 1 roll put
} for
UCDingbatsEncoding [ 16#c0 1 16#ff {} for ] vg&undef
[ 16#00  16#05 16#0a 16#0b  16#28 16#4c 16#4e  16#53 16#54 16#55  16#57 16#5f
  16#60  16#68 16#69 16#6a  16#6b 16#6c 16#6d  16#6e 16#6f 16#70  16#71 16#72
  16#73  16#74 16#75 16#95  16#96 16#97 16#b0  16#bf
] vg&undef pop

% Define the base fonts which don't change.
/Undefined-UC NullEncoding       /Helvetica    vg&newbasefont pop
/MathOps-UC   UCMathOpsEncoding  /Symbol       vg&newbasefont pop
/Arrows-UC    UCArrowsEncoding   /Symbol       vg&newbasefont pop
/Dingbats-UC  UCDingbatsEncoding /ZapfDingbats vg&newbasefont pop

% Make the SansSerif composite fonts.
/SansSerif /Helvetica 16#00 vg&newcompositefont
/SansSerif-Bold /Helvetica-Bold 16#01 vg&newcompositefont
/SansSerif-Italic /Helvetica-Oblique 16#02 vg&newcompositefont
/SansSerif-BoldItalic /Helvetica-BoldOblique 16#03 vg&newcompositefont

% Make the Serif composite fonts.
/Serif /Times-Roman 16#00 vg&newcompositefont
/Serif-Bold /Times-Bold 16#01 vg&newcompositefont
/Serif-Italic /Times-Italic 16#02 vg&newcompositefont
/Serif-BoldItalic /Times-BoldItalic 16#03 vg&newcompositefont

% Make the Monospaced composite fonts.
/Monospaced /Courier 16#00 vg&newcompositefont
/Monospaced-Bold /Courier-Bold 16#01 vg&newcompositefont
/Monospaced-Italic /Courier-Oblique 16#02 vg&newcompositefont
/Monospaced-BoldItalic /Courier-BoldOblique 16#03 vg&newcompositefont

% Make the Dialog composite fonts.
/Dialog /Helvetica 16#00 vg&newcompositefont
/Dialog-Bold /Helvetica-Bold 16#01 vg&newcompositefont
/Dialog-Italic /Helvetica-Oblique 16#02 vg&newcompositefont
/Dialog-BoldItalic /Helvetica-BoldOblique 16#03 vg&newcompositefont

% Make the DialogInput composite fonts.
/DialogInput /Helvetica 16#00 vg&newcompositefont
/DialogInput-Bold /Helvetica-Bold 16#01 vg&newcompositefont
/DialogInput-Italic /Helvetica-Oblique 16#02 vg&newcompositefont
/DialogInput-BoldItalic /Helvetica-BoldOblique 16#03 vg&newcompositefont

% Make the Typewriter composite fonts (JDK 1.1 only).
/Typewriter /Courier 16#00 vg&newcompositefont
/Typewriter-Bold /Courier-Bold 16#01 vg&newcompositefont
/Typewriter-Italic /Courier-Oblique 16#02 vg&newcompositefont
/Typewriter-BoldItalic /Courier-BoldOblique 16#03 vg&newcompositefont


/cfontH {
 dup /fontsize exch def /SansSerif exch sf
 /vg&fontstyles [{cfontH} {cfontHB} {cfontHI} {cfontHBI}] def
} def
/cfontHB {
  dup /fontsize exch def /SansSerif-Bold exch sf
 /vg&fontstyles [{cfontH} {cfontHB} {cfontHI} {cfontHBI}] def
} def
/cfontHI {
 dup /fontsize exch def /SansSerif-Italic exch sf
 /vg&fontstyles [{cfontH} {cfontHB} {cfontHI} {cfontHBI}] def
} def
/cfontHBI {
 dup /fontsize exch def /SansSerif-BoldItalic exch sf
 /vg&fontstyles [{cfontH} {cfontHB} {cfontHI} {cfontHBI}] def
} def

/cfontT {
 dup /fontsize exch def /Serif exch sf
 /vg&fontstyles [{cfontT} {cfontTB} {cfontTI} {cfontTBI}] def
} def
/cfontTB {
 dup /fontsize exch def /Serif-Bold exch sf
 /vg&fontstyles [{cfontT} {cfontTB} {cfontTI} {cfontTBI}] def
} def
/cfontTI {
 dup /fontsize exch def /Serif-Italic exch sf
 /vg&fontstyles [{cfontT} {cfontTB} {cfontTI} {cfontTBI}] def
} def
/cfontTBI {
 dup /fontsize exch def /Serif-BoldItalic exch sf
 /vg&fontstyles [{cfontT} {cfontTB} {cfontTI} {cfontTBI}] def
} def

/cfontC {
 dup /fontsize exch def /Typewriter exch sf
 /vg&fontstyles [{cfontC} {cfontCB} {cfontCI} {cfontCBI}] def
} def
/cfontCB {
 dup /fontsize exch def /Typewriter-Bold exch sf
 /vg&fontstyles [{cfontC} {cfontCB} {cfontCI} {cfontCBI}] def
} def
/cfontCI {
 dup /fontsize exch def /Typewriter-Italic exch sf
 /vg&fontstyles [{cfontC} {cfontCB} {cfontCI} {cfontCBI}] def
} def
/cfontCBI {
 dup /fontsize exch def /Typewriter-BoldItalic exch sf
 /vg&fontstyles [{cfontC} {cfontCB} {cfontCI} {cfontCBI}] def
} def

% Darken or lighten the current color.
/darken {0.7 exch exp 3 copy
         q 4 -1 roll vg&C
         currentrgbcolor 3 {4 -2 roll mul} repeat
         3 array astore Q} def

/displayColorMap
<< /Cr   [1.00 0.00 0.00]       /Cg     [0.00 1.00 0.00]
   /Cb   [0.00 0.00 1.00]       /Cc     [1.00 0.00 0.00 0.00]
   /Cm   [0.00 1.00 0.00 0.00]  /Cy     [0.00 0.00 1.00 0.00]
   /Co   [1.00 0.78 0.00]       /Cp     [1.00 0.67 0.67]
   /Cw   [1   ]                 /Cgrl   [0.75]
   /Cgr  [0.50]                 /Cgrd   [0.25]
   /Ck   [0   ]
   /CGr  [1.00 0.00 0.00]       /CGg    [0.00 1.00 0.00]
   /CGb  [0.00 0.00 1.00]       /CGc    [1.00 0.00 0.00 0.00]
   /CGm  [0.00 1.00 0.00 0.00]  /CGy    [0.00 0.00 1.00 0.00]
   /CGo  [1.00 0.78 0.00]       /CGp    [1.00 0.67 0.67]
   /CGw  [1   ]                 /CGgrl  [0.75]
   /CGgr [0.50]                 /CGgrd  [0.25]
   /CGk  [0   ]
   /CIr  [1.00 0.00 0.00]       /CIg    [0.00 1.00 0.00]
   /CIb  [0.00 0.00 1.00]       /CIc    [1.00 0.00 0.00 0.00]
   /CIm  [0.00 1.00 0.00 0.00]  /CIy    [0.00 0.00 1.00 0.00]
   /CIo  [1.00 0.78 0.00]       /CIp    [1.00 0.67 0.67]
   /CIw  [1   ]                 /CIgrl  [0.75]
   /CIgr [0.50]                 /CIgrd  [0.25]
   /CIk  [0   ]
>> def

/printColorMap
<< /Cr   [1.00 0.33 0.33]       /Cg     [0.33 1.00 0.33]
   /Cb   [0.33 0.33 1.00]       /Cc     [1.00 0.00 0.00 0.00]
   /Cm   [0.00 1.00 0.00 0.00]  /Cy     [0.00 0.00 1.00 0.00]
   /Co   [1.00 0.78 0.00]       /Cp     [1.00 0.67 0.67]
   /Cw   [1   ]                 /Cgrl   [0.75]
   /Cgr  [0.50]                 /Cgrd   [0.25]
   /Ck   [0   ]
   /CGr  [1.00 0.33 0.33]       /CGg    [0.33 1.00 0.33]
   /CGb  [0.33 0.33 1.00]       /CGc    [1.00 0.00 0.00 0.00]
   /CGm  [0.00 1.00 0.00 0.00]  /CGy    [0.00 0.00 1.00 0.00]
   /CGo  [1.00 0.78 0.00]       /CGp    [1.00 0.67 0.67]
   /CGw  [1   ]                 /CGgrl  [0.75]
   /CGgr [0.50]                 /CGgrd  [0.25]
   /CGk  [0   ]
   /CIr  [1.00 0.33 0.33]       /CIg    [0.33 1.00 0.33]
   /CIb  [0.33 0.33 1.00]       /CIc    [1.00 0.00 0.00 0.00]
   /CIm  [0.00 1.00 0.00 0.00]  /CIy    [0.00 0.00 1.00 0.00]
   /CIo  [1.00 0.78 0.00]       /CIp    [1.00 0.67 0.67]
   /CIw  [1   ]                 /CIgrl  [0.75]
   /CIgr [0.50]                 /CIgrd  [0.25]
   /CIk  [0   ]
>> def

/grayColorMap
<< /Cr   [0   ]                 /Cg     [0   ]
   /Cb   [0   ]                 /Cc     [0   ]
   /Cm   [0   ]                 /Cy     [0   ]
   /Co   [0   ]                 /Cp     [0   ]
   /Cw   [0   ]                 /Cgrl   [0   ]
   /Cgr  [0   ]                 /Cgrd   [0   ]
   /Ck   [0   ]
   /CGr  [0.75]                 /CGg    [1   ]
   /CGb  [0.50]                 /CGc    [0.75]
   /CGm  [0.50]                 /CGy    [1   ]
   /CGo  [0.75]                 /CGp    [1   ]
   /CGw  [0   ]                 /CGgrl  [0.25]
   /CGgr [0.50]                 /CGgrd  [0.75]
   /CGk  [1   ]
   /CIr  [1   ]                 /CIg    [1   ]
   /CIb  [1   ]                 /CIc    [1   ]
   /CIm  [1   ]                 /CIy    [1   ]
   /CIo  [1   ]                 /CIp    [1   ]
   /CIw  [1   ]                 /CIgrl  [1   ]
   /CIgr [1   ]                 /CIgrd  [1   ]
   /CIk  [1   ]
>> def

/bwColorMap
<< /Cr   [0   ]                 /Cg     [0   ]
   /Cb   [0   ]                 /Cc     [0   ]
   /Cm   [0   ]                 /Cy     [0   ]
   /Co   [0   ]                 /Cp     [0   ]
   /Cw   [0   ]                 /Cgrl   [0   ]
   /Cgr  [0   ]                 /Cgrd   [0   ]
   /Ck   [0   ]
   /CGr  [1   ]                 /CGg    [1   ]
   /CGb  [1   ]                 /CGc    [1   ]
   /CGm  [1   ]                 /CGy    [1   ]
   /CGo  [1   ]                 /CGp    [1   ]
   /CGw  [0   ]                 /CGgrl  [1   ]
   /CGgr [1   ]                 /CGgrd  [1   ]
   /CGk  [1   ]
   /CIr  [1   ]                 /CIg    [1   ]
   /CIb  [1   ]                 /CIc    [1   ]
   /CIm  [1   ]                 /CIy    [1   ]
   /CIo  [1   ]                 /CIp    [1   ]
   /CIw  [1   ]                 /CIgrl  [1   ]
   /CIgr [1   ]                 /CIgrd  [1   ]
   /CIk  [1   ]
>> def

%
% The following routines handle the alignment of and printing of
% tagged strings.
%

% Predefine the bounding box values.
/bbllx 0 def /bblly 0 def /bburx 0 def /bbury 0 def

% This routine pops the first unicode character off of a string and returns
% the remainder of the string, the character code of first character,
% and a "true" if the string was non-zero length.
% <string>      popfirst <remaining string> <true>
% <null string> popfirst <false>
/popfirst {
  dup length 1 gt
    {dup 0 get /vg&fbyte exch def
     dup 1 get /vg&cbyte exch def
     dup length 2 sub 2 exch getinterval true}
    {pop false} ifelse
} def

% This routine shows a single unicode character given the font and
% character codes.
% <font code> <char code> unicharshow --
/unicharshow {
  2 string
  dup 0 5 -1 roll put
  dup 1 4 -1 roll put
  internalshow
} def

% This is an internal routine to alternate between determining the
% bounding box for stringsize and showing the string for recshow.
% <string> internalshow --
/internalshow {show} def

% This is an internal routine to alternate between determining the
% bounding box for stringsize and stroking various ornaments.
% <string> internalstroke --
/internalstroke {S} def

% Sets up internalshow to use the null device to determine string size.
% -- nullinternalshow --
/nullinternalshow {/internalshow {false charpath flattenpath
                                  pathbbox updatebbox} def} def

% Sets up internalstroke to use the null device to determine string size.
% -- nullinternalstroke --
/nullinternalstroke {
 /internalstroke {flattenpath pathbbox updatebbox} def} def

% This routine tests to see if the character code matches the first
% character of a string.
% <char code> <string> testchar <char code> <true or false>
/testchar {exch dup 3 -1 roll 0 get eq} def

% Raise the text baseline for superscripts.
% -- raise --
/raise {
  0 fontsize 2 div rmoveto
  /fontsize fontsize 2 mul 3 div def
  currentfont /FontName get fontsize sf
} def

% Un-raise the text baseline for superscripts.
% -- unraise --
/unraise {
  /fontsize fontsize 1.5 mul def
  0 fontsize 2 div neg rmoveto
} def

% Lower the text baseline for subscripts.
% -- lower --
/lower {
  0 fontsize 3 div neg rmoveto
  /fontsize fontsize 2 mul 3 div def
  currentfont /FontName get fontsize sf
} def

% Un-lower the text baseline for subscripts.
% -- unlower --
/unlower {
  /fontsize fontsize 1.5 mul def
  0 fontsize 3 div rmoveto
} def

% Compare the top two elements on the stack and leave only the
% larger one.
/maxval {2 copy gt {pop} {exch pop} ifelse} def

% Tokenize a string.  Do not use the usual PostScript token because
% parentheses will not be interpreted correctly because of rescanning
% of the string.
/vg&token {/vg&string exch def /vg&index -1 def /vg&level 0 def
0 2 vg&string length 2 sub {
  dup dup 1 add exch vg&string exch get 8 bitshift vg&string 3 -1 roll get or
  dup 16#f0fe eq {pop 1}{16#f0ff eq {-1}{0} ifelse} ifelse
  /vg&level exch vg&level add def
  vg&level 0 eq {/vg&index exch def exit} if pop
} for
vg&index 0 ge {
  vg&string vg&index 2 add dup vg&string length exch sub getinterval
  vg&index 2 gt {vg&string 2 vg&index 2 sub getinterval}{()} ifelse
  true}
{false} ifelse
} bind def

% Recursively show an unicode string.
% <string> recshow --
/recshow {
  popfirst
  {
    % Test to see if this is a string attribute.
    vg&fbyte 16#f0 and 16#e0 eq
    {
      q

      % Font style.
      currentfont dup /FontStyleBits known {/FontStyleBits get}{pop 0} ifelse
      vg&cbyte or vg&fontstyles exch get fontsize exch exec

      vg&token pop recshow currentpoint Q m recshow
    }
    {
      vg&fbyte 16#F8 and 16#F0 eq {

        % Superscript and/or subscript.
        vg&cbyte 16#00 eq {
          vg&token pop exch vg&token pop 3 -1 roll
          q raise recshow unraise currentpoint pop Q exch
          q lower recshow unlower currentpoint pop Q
          maxval currentpoint exch pop m recshow } if

        % Strikeout.
        vg&cbyte 16#01 eq {
          vg&token pop currentpoint 3 -1 roll recshow
          q 0 J vg&underline vg&uthick w
          currentpoint 4 -2 roll fontsize 3 div add moveto
          fontsize 3 div add lineto internalstroke Q
          recshow} if

        % Underline.
        vg&cbyte 16#02 eq {
          vg&token pop currentpoint 3 -1 roll recshow
          q 0 J vg&underline vg&uthick w
          currentpoint 4 -2 roll vg&uoffset add moveto
          vg&uoffset add lineto internalstroke Q
          recshow} if

        % Dashed underline.
        vg&cbyte 16#03 eq {
          vg&token pop currentpoint 3 -1 roll recshow
          q 0 J [ vg&uthick 5 mul vg&uthick 2 mul] 0 d
          vg&underline vg&uthick w
          currentpoint 4 -2 roll vg&uoffset add moveto
          vg&uoffset add lineto internalstroke Q
          recshow} if

        % Dotted underline.
        vg&cbyte 16#04 eq {
          vg&token pop currentpoint 3 -1 roll recshow
          q 1 J [ 0 vg&uthick 3 mul] 0 d
          vg&underline vg&uthick w
          currentpoint 4 -2 roll vg&uoffset add moveto
          vg&uoffset add lineto internalstroke Q
          recshow} if

        % Thick underline.
        vg&cbyte 16#05 eq {
          vg&token pop currentpoint 3 -1 roll recshow
          q 0 J vg&underline vg&uthick 2 mul w
          currentpoint 4 -2 roll vg&uoffset vg&uthick 2 div sub add moveto
          vg&uoffset vg&uthick 2 div sub add lineto internalstroke Q
          recshow} if

        % Gray thick underline.
        vg&cbyte 16#06 eq {
          vg&token pop currentpoint 3 -1 roll recshow
          q 0 J vg&underline vg&uthick 2 mul w 0.5 setgray
          currentpoint 4 -2 roll vg&uoffset vg&uthick 2 div sub add moveto
          vg&uoffset vg&uthick 2 div sub add lineto internalstroke Q
          recshow} if

        % Overbar.
        vg&cbyte 16#07 eq {
          vg&token pop dup stringsize relative 4 1 roll pop pop exch
          3 -1 roll recshow
          q 0 J vg&underline vg&uthick w
          vg&uoffset neg add dup currentpoint pop exch m l internalstroke Q
          recshow} if
      }
      {
        vg&fbyte vg&cbyte unicharshow recshow
      } ifelse
    } ifelse
  } if
} def

% Get the underline position and thickness from the current font.
/vg&underline {

currentfont dup /FontType get 0 eq {/FDepVector get 0 get} if
dup dup /FontInfo known {
  /FontInfo get dup
  dup /UnderlinePosition known {
    /UnderlinePosition get /vg&uoffset exch def
  }
  {
    pop /vg&uoffset 0 def
  } ifelse
  dup /UnderlineThickness known {
    /UnderlineThickness get /vg&uthick exch def
  }
  {
    pop /vg&uthick 0 def
  } ifelse
}
{
  pop /vg&uoffset 0 def /vg&uthick 0 def
} ifelse
/FontMatrix get
currentfont dup /FontType get 0 eq
{/FontMatrix get matrix concatmatrix}{pop} ifelse
dup 0 vg&uoffset 3 -1 roll transform /vg&uoffset exch def pop
0 vg&uthick 3 -1 roll transform /vg&uthick exch def pop
} def

% Make a frame with the coordinates on the stack.
% <llx> <lly> <urx> <ury> frame --
/frame {4 copy m 3 1 roll exch l 4 -2 roll l l h} def

% Resets the accumulated bounding box to a degenerate box at the
% current point.
% -- resetbbox --
/resetbbox {
  currentpoint 2 copy
  /bbury exch def
  /bburx exch def
  /bblly exch def
  /bbllx exch def
} def

% Update the accumulated bounding box.
% <llx'> <lly'> <urx'> <ury'> updatebbox --
/updatebbox {
  dup bbury gt {/bbury exch def} {pop} ifelse
  dup bburx gt {/bburx exch def} {pop} ifelse
  dup bblly lt {/bblly exch def} {pop} ifelse
  dup bbllx lt {/bbllx exch def} {pop} ifelse
} def

% Set the bounding box to the values on the stack.
% <llx'> <lly'> <urx'> <ury'> updatebbox --
/restorebbox {
  /bbury exch def /bburx exch def /bblly exch def /bbllx exch def
} def

% Push the accumulated bounding box onto the stack.
% -- pushbbox <llx> <lly> <urx> <ury>
/pushbbox {bbllx bblly bburx bbury} def

% Make the relative bounding box relative to the currentpoint.
% <llx'> <lly'> <urx'> <ury'> inflate <llx> <lly> <urx> <ury>
/inflate {
  2 {fontsize 0.2 mul add 4 1 roll} repeat
  2 {fontsize 0.2 mul sub 4 1 roll} repeat
} def

% Make the relative bounding box relative to the currentpoint.
% <llx'> <lly'> <urx'> <ury'> relative <llx> <lly> <urx> <ury>
/relative {
  currentpoint 3 -1 roll add 3 1 roll add exch 4 2 roll
  currentpoint 3 -1 roll add 3 1 roll add exch 4 2 roll
} def

% Returns the size of a string appropriate for recshow.
% <string> stringsize <llx> <lly> <urx> <ury>
/stringsize {
  pushbbox /internalshow load /internalstroke load 7 -1 roll
  q
  nulldevice 0 0 m
  nullinternalshow nullinternalstroke
  resetbbox
  recshow
  /internalstroke exch def /internalshow exch def
  pushbbox 8 -4 roll restorebbox
  Q
} def

% Calculate values for string positioning.
/calcval {4 copy
  3 -1 roll sub /widy exch def sub neg /widx exch def
  pop pop /dy exch def /dx exch def} def

% Utilities to position a string.
% First letter (U=upper, C=center, B=baseline, L=lower)
% Second letter (L=left, C=center, R=right)
/align [
{calcval dx neg widy dy add neg rmoveto} % UL
{calcval dx neg widy 2 div dy add neg rmoveto} % CL
{calcval dx neg 0 rmoveto} % BL
{calcval dx neg dy neg rmoveto} % LL
{calcval widx dx add neg widy dy add neg rmoveto} % UR
{calcval widx dx add neg widy 2 div dy add neg rmoveto} % CR
{calcval widx dx add neg 0 rmoveto} % BR
{calcval widx dx add neg dy neg rmoveto} % LR
{calcval widx 2 div dx add neg widy dy add neg rmoveto} % UC
{calcval widx 2 div dx add neg widy 2 div dy add neg rmoveto} % CC
{calcval widx 2 div dx add neg 0 rmoveto} % BC
{calcval widx 2 div dx add neg dy neg rmoveto} % LC
] def

/vg&str {m q 1 -1 scale dup stringsize 4 copy align 11 -1 roll get exec
         q inflate relative frame exch exec Q recshow Q} def

end /procDict exch def
