%    Copyright (C) 1994, 1995 Aladdin Enterprises.  All rights reserved.

% pdf_font.ps
% PDF font operations.

/.setlanguagelevel where { pop 2 .setlanguagelevel } if
.currentglobal true .setglobal
/pdfdict where { pop } { /pdfdict 100 dict def } ifelse
GS_PDF_ProcSet begin
pdfdict begin

% We cache the PostScript font in an additional element of the
% font resource dictionary, called PSFont.

% ---------------- Encodings ---------------- %

% Apply a list of differences to an Encoding.
/updateencoding		% <encoding> <differences> updateencoding <enc'>
 { exch dup length array copy
   exch dup 0 get exch dup length 1 sub
   1 exch getinterval
    { dup type /nametype ne
       { exch pop }
       { 3 copy put pop 1 add }
      ifelse
    }
   forall pop
 } bdef

% Get the Encoding for a font.
/getencoding		% <base-encoding> <font-resource> getencoding <enc>
 { /Encoding knownoget
    { dup type /nametype eq
       { exch pop findencoding
       }
       { dup /BaseEncoding knownoget
	  { findencoding 3 -1 roll pop exch
	  }
	 if
	 /Differences knownoget { updateencoding } if
       }
      ifelse
    }
   if
 } bdef

% Insert a modified encoding into a font if needed.
/adjustencoding		% <font-resource> <font> adjustencoding
			%   <font-resource> <font'>
 { 1 index /Encoding known
    { dup /Encoding get 2 index getencoding
      dup 2 index /Encoding get ne
       {	% Insert the new Encoding into the font.
	 exch copyfont
	 dup /Encoding 4 -1 roll put
       }
       { pop
       }
      ifelse
    }
   if
 } bdef

% Insert modified metrics into a font if needed.
/adjustmetrics		% <font-resource> <font> adjustmetrics
			%   <font-resource> <font'>
 { 1 index /Widths known
    { copyfont begin
      /Metrics Encoding length dict
      		% Stack: font-res /Metrics metrics
      2 index /FontDescriptor oget
      /MissingWidth knownoget not { 0 } if exch
      Encoding
       {	% Stack: ... missing-width metrics charname
	 2 copy 4 index put pop
       }
      forall exch pop def
		% Stack: font-res
      dup /FirstChar oget dup 1 3 index /LastChar oget
       {	% Stack: font-res first-char index
	 Encoding 1 index get
	 3 index /Widths oget 2 index 4 index sub get
	 Metrics 3 1 roll put pop
       }
      for pop
      currentdict end
    }
   if
 } bdef

% ---------------- Descriptors ---------------- %

% Partial descriptors for the 14 built-in fonts.
/standardfontdescriptors mark
  /Courier mark /Flags 16#23 .dicttomark
  /Courier-Oblique 1 index
  /Courier-Bold 1 index
  /Courier-BoldOblique 1 index
  /Helvetica mark /Flags 16#20 .dicttomark
  /Helvetica-Oblique 1 index
  /Helvetica-Bold 1 index
  /Helvetica-BoldOblique 1 index
  /Times-Roman mark /Flags 16#22 .dicttomark
  /Times-Bold 1 index
  /Times-Italic mark /Flags 16#62 .dicttomark
  /Times-BoldItalic 1 index
  /Symbol mark /Flags 16#4 .dicttomark
  /ZapfDingbats 1 index
.dicttomark readonly def

% ---------------- Utilities ---------------- %

% Fabricate a font name by adding %'s on the end.
/genfontname		% <name> genfontname <name>
 { dup length string cvs
    { (%) concatstrings
      dup cvn FontDirectory exch known not { cvn exit } if
    }
   loop
 } bdef

% Copy a font if needed.  We can recognize a copied font by
% the absence of FID.
/copyfont		% <font> copyfont <font'>
 { dup /FID known
    { dup length dict copy
      dup /FID undef
      dup /FontName 2 copy get genfontname put
    }
   if
 } bdef

% Define a modified (copied) font if needed.
/defmodfont		% <font> defmodfont <font'>
 { dup /FID known not { dup /FontName get exch definefont } if
 } bdef

% Find a font, and adjust its encoding if necessary.
/pdffindfont		% <font-resource> <fontname> pdffindfont <font>
 { findfont adjustencoding adjustmetrics exch pop defmodfont
 } bdef

% ---------------- Type 1 fonts ---------------- %

/buildType1		% <Type1-font-resource> buildType1 <font>
 { dup /BaseFont get pdffindfont
 } bdef

% The state dictionary for the embedded Type 1 font reading procedure
% has the following keys and values:
%	data - stream (filter)
%	buffer, buffer2 - string
%	leftstr - string containing (non-negative) integer
%	sectionstr - string containing a character 0 .. 2
%	stream - (stream) dictionary
%	proc - procedure of the form {-dict- type1read}
% When the procedure is executing, this dictionary is current.
% leftstr and sectionstr are strings so that we can change their values
% reliably in case the font executes a restore!

% Read an embedded Type 1 font.
/readfontfilter		% <proc> readfontfilter <filter>
 {	% We make this a separate procedure so that we can
	% redefine it when we're writing PostScript.
   0 () /SubFileDecode filter
 } bdef
/readtype1		% <font-resource> <stream-dict> readtype1 <font>
 {		% Read the definition, using a procedure-based filter
		% that turns binary/hex conversion on and off
		% at the right times.
   PDFfile fileposition 3 1 roll
   7 dict begin
     /leftstr (          ) 10 string copy def
       dup /Length1 oget leftstr cvs pop
     /sectionstr <00> 1 string copy def
     /stream 1 index def
     true resolvestream /data exch def
     /buffer 200 string def		% arbitrary
     /buffer2 buffer length 2.1 div cvi 1 sub string def
   currentdict end
   /type1read cvx 2 array astore cvx dup 0 get /proc 2 index put
   readfontfilter
   systemdict begin run end
   PDFfile 3 -1 roll setfileposition
   /FontDescriptor oget /FontName oget findfont
 } bdef

% Execute the appropriate reading procedure.
/type1read		% <dict> type1read <string>
 { begin leftstr cvi
    { type1read1 type1read2 type1read3 } sectionstr 0 get get exec
   (          ) leftstr copy cvs pop end
 } bdef

% Read the next block of data into the buffer.
/type1readdata		% <left> <buffer> type1readdata <substring> <left'>
 { 0 2 index 2 index length min getinterval
   data exch readstring pop
   dup length 3 -1 roll exch sub
   DEBUG
    { dup =only ( read ) print
      1 index length =only (: ) print
      1 index == flush
    } if
 } bdef

% Read the next block of the initial text portion.
/type1read1		% <left> type1read1 <string> <left'>
 { DEBUG { (read1 ) print } if
   dup 0 eq
    { pop sectionstr 0 1 put
      stream /Length2 oget type1read2
    }
    { buffer type1readdata
    }
   ifelse
 } bdef

% Read the next block of the encrypted portion.
/type1trailer
(0000000000000000000000000000000000000000000000000000000000000000\n\
0000000000000000000000000000000000000000000000000000000000000000\n\
0000000000000000000000000000000000000000000000000000000000000000\n\
0000000000000000000000000000000000000000000000000000000000000000\n\
0000000000000000000000000000000000000000000000000000000000000000\n\
0000000000000000000000000000000000000000000000000000000000000000\n\
0000000000000000000000000000000000000000000000000000000000000000\n\
0000000000000000000000000000000000000000000000000000000000000000\n\
cleartomark\n)
readonly def
/type1read2
 { DEBUG { (read2 ) print } if
   dup 0 eq
    { pop sectionstr 0 2 put
      stream /Length3 oget
      dup 0 eq { type1trailer exch } { type1read3 } ifelse
    }
    { buffer2 type1readdata exch
      buffer /ASCIIHexEncode filter dup 3 -1 roll writestring closefile
      buffer (>) search pop exch pop exch pop exch
    }
   ifelse
 } bdef

% Read the next block of the final text portion.
% When finished, this procedure returns an empty string.
/type1read3
 { DEBUG { (read3 ) print } if
   buffer type1readdata
 } bdef

% ---------------- Type 3 fonts ---------------- %

/.notdefEncoding 256 { /.notdef } repeat 256 packedarray def

/buildType3		% <Type3-font-resource> buildType3 <font>
  { 8 dict begin
    /FontType 3 def
    /FontBBox 1 index /FontBBox get cvx def
    /FontMatrix 1 index /FontMatrix oget def
    /CharProcs 1 index /CharProcs oget def
    /FontName 1 index /Name get genfontname def
    /Encoding .notdefEncoding 2 index getencoding def
    /BuildGlyph
     { exch /CharProcs get exch oget
       PDFfile fileposition exch
       false resolvestream
		% Don't let setgcolor set the color inside the BuildGlyph
		% procedure, because this causes an /undefined error
       pdfgsave null /FillColor gput null /StrokeColor gput
       pdfopdict pdfrun
       pdfgrestore
       PDFfile exch setfileposition
     } bdef
    FontName currentdict end definefont exch pop
  } bdef

% ---------------- TrueType fonts ---------------- %

/TTfonts mark
  /Arial /Helvetica
  /Arial,Italic /Helvetica-Oblique
  /Arial,Bold /Helvetica-Bold
  /Arial,BoldItalic /Helvetica-BoldOblique
  /TimesNewRoman /Times-Roman
  /TimesNewRoman,Italic /Times-Italic
  /TimesNewRoman,Bold /Times-Bold
  /TimesNewRoman,BoldItalic /Times-BoldItalic
.dicttomark readonly def

/buildTrueType		% <TrueType-font-resource> buildTrueType <font>
 { dup /BaseFont get
   dup TTfonts exch .knownget { exch pop } if pdffindfont
 } bdef

% ---------------- Font lookup ---------------- %

/fonttypeprocs mark		% <font-resource> -proc- <font>
  /Type1 /buildType1 cvx
  /MMType1 1 index
  /Type3 /buildType3 cvx
  /TrueType /buildTrueType cvx
.dicttomark readonly def

/resourcefont			% <font-resource> resourcefont <font>
 { dup /PSFont .knownget
    { /FID .knownget
       { type /fonttype eq }
       { false }
      ifelse
    }
    { false
    }
   ifelse
    { /PSFont get
    }
    { dup dup /FontDescriptor knownoget
       { /FontFile knownoget }
       { false }
      ifelse
       { 1 index 3 1 roll readtype1 adjustencoding adjustmetrics exch pop defmodfont }
       { dup /Subtype get fonttypeprocs exch get exec }
      ifelse
      2 copy /PSFont exch put
      exch pop
    }
   ifelse
 } bdef

drawopdict begin
  /d0 /setcharwidth load def
  /d1 /setcachedevice load def
  /Tf
   { exch
     Page /Resources oget /Font oget exch oget
     resourcefont
false
{		%**************** PATCH for #exec ****************
		/FontName get (xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx) cvs
		 { dup dup length 1 sub 1 getinterval (%) ne { exit } if
		   0 1 index length 1 sub getinterval
		 }
		loop cvn exch Tf currentfont
		%**************** END PATCH ****************
}{
     exch scalefont dup setfont
}ifelse
     /TextFont gput
   } bdef
end

end			% pdfdict
end			% GS_PDF_ProcSet
.setglobal