harvey/sys/lib/ghostscript/gs_ttf.ps

%    Copyright (C) 1996, 2000 Aladdin Enterprises.  All rights reserved.
% 
% This file is part of AFPL Ghostscript.
% 
% AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author or
% distributor accepts any responsibility for the consequences of using it, or
% for whether it serves any particular purpose or works at all, unless he or
% she says so in writing.  Refer to the Aladdin Free Public License (the
% "License") for full details.
% 
% Every copy of AFPL Ghostscript must include a copy of the License, normally
% in a plain ASCII text file named PUBLIC.  The License grants you the right
% to copy, modify and redistribute AFPL Ghostscript, but only under certain
% conditions described in the License.  Among other things, the License
% requires that the copyright notice and this notice be preserved on all
% copies.

% $Id: gs_ttf.ps,v 1.9 2001/07/08 15:24:11 lpd Exp $
% Support code for direct use of TrueType fonts.
% (Not needed for Type 42 fonts.)

% Note that if you want to use this file without including the ttfont.dev
% option when you built Ghostscript, you will need to load the following
% files before this one:
%	lib/gs_mgl_e.ps
%	lib/gs_mro_e.ps
%	lib/gs_wan_e.ps

% Thanks to B. Jackowski and GUST (the Polish TeX Users' Group) for
% the glyf-splitting code.

% ---------------- Font loading machinery ---------------- %

% Augment the FONTPATH machinery so it recognizes TrueType fonts.

/.scanfontheaders where {
  pop /.scanfontheaders [
   .scanfontheaders aload pop (\000\001\000\000*) (true*)
  ] def
} if

% <file> <key> .findfontvalue <value> true
% <file> <key> .findfontvalue false
% Closes the file in either case.
/.findnonttfontvalue /.findfontvalue load def
/.findfontvalue {
  1 index read pop 2 index 1 index unread
  dup 0 eq exch (t) 0 get eq or {
		% If this is a font at all, it's a TrueType font.
    dup /FontType eq {
      pop closefile 42 true
    } {
      dup /FontName eq { pop .findttfontname } { pop closefile false } ifelse
    } ifelse
  } {
		% Not a TrueType font.
    .findnonttfontvalue
  } ifelse
} bind def

% <file> .findttfontname <fname> true
% <file> .findttfontname false
% Closes the file in either case.
/.findttfontname {
  .loadttfonttables
  tabdict /name .knownget {
    dup 8 getu32 f exch setfileposition
    12 getu32 string f exch readstring pop
    6 findname
  } {
    false
  } ifelse
  f closefile end end
} bind def

% Load a font file that might be a TrueType font.

% <file> .loadfontfile -
/.loadnonttfontfile /.loadfontfile load def
/.loadfontfile {
  dup read pop 2 copy unread 0 eq {
		% If this is a font at all, it's a TrueType font.
    .loadttfont pop
  } {
		% Not a TrueType font.
    .loadnonttfontfile
  } ifelse
} bind def

% ---------------- Automatic Type 42 generation ---------------- %

% Load a TrueType font from a file as a Type 42 PostScript font.
% The thing that makes this really messy is the handling of encodings.
% There are 2 interacting tables that affect the encoding:
%       'cmap' provides multiple maps from character codes to glyph indices
%       'post' maps glyph indices to glyph names (if present)
% What we need to get out of this is:
%       Encoding mapping character codes to glyph names
%         (the composition of cmap and post)
%       CharStrings mapping glyph names to glyph indices
%         (the inverse of post)
% If the post table is missing, we have to take a guess based on the cmap
% table.

/.loadttfontdict 50 dict dup begin

/orgXUID AladdinEnterprisesXUID def
/maxstring 32000 def    % half the maximum length of a PostScript string,
			% must be a multiple of 4 (for hmtx / loca / vmtx)

% Define the Macintosh standard mapping from characters to glyph indices.
/MacRomanEncoding dup .findencoding def
/MacGlyphEncoding dup .findencoding def

% Invert the MacRomanEncoding.
/.romanmacdict 300 dict
0 1 MacRomanEncoding length 1 sub {
  MacRomanEncoding 1 index get
		% Stack: dict index charname
  dup /.notdef ne {
    exch 2 index 2 index .knownget {
      dup type /arraytype eq {
	[ exch aload pop counttomark 2 add -1 roll ]
      } {
	exch 2 array astore
      } ifelse
    } if 2 index 3 1 roll put
  } {
    pop pop
  } ifelse
} for def

% Define remapping for misnamed glyphs in TrueType 'post' tables.
% There are probably a lot more than this!
/postremap mark
  /Cdot /Cdotaccent
  /Edot /Edotaccent
  /Eoverdot /Edotaccent
  /Gdot /Gdotaccent
  /Ldot /Ldotaccent
  /Zdot /Zdotaccent
  /cdot /cdotaccent 
  /edot /edotaccent 
  /eoverdot /edotaccent
  /gdot /gdotaccent 
  /ldot /ldotaccent
  /zdot /zdotaccent 
.dicttomark readonly def

% ---- Utilities ---- %

% Define a serial number for creating unique XUIDs for TrueType fonts.
% We used to use the checkSumAdjustment value from the font, but this is
% not reliable, since some fonts don't set it correctly.
% Note that we must do this in a string to make it immune to save/restore.
/xuidstring <80000000> def
/curxuid {		% - curxuid <int>
  0 xuidstring { exch 8 bitshift exch add } forall
} bind def
/nextxuid {		% - nextxuid -
  3 -1 0 {
    xuidstring 1 index 2 copy get dup 255 ne {
      1 add put pop exit
    } if pop 0 put pop
  } for
} bind def

% <string> <index> getu16 <integer>
/getu16 {
  2 copy get 8 bitshift 3 1 roll 1 add get add
} bind def

% <string> <index> gets16 <integer>
/gets16 {
  getu16 16#8000 xor 16#8000 sub
} bind def

% <string> <index> getu32 <integer>
/getu32 {
  2 copy getu16 16 bitshift 3 1 roll 2 add getu16 add
} bind def

% <string> <index> gets32 <integer>
/gets32 {
  2 copy gets16 16 bitshift 3 1 roll 2 add getu16 add
} bind def

% <string> <index> <integer> putu16 -
/putu16 {
  3 copy -8 bitshift put
  exch 1 add exch 16#ff and put
} bind def

% <string> <index> <integer> putu32 -
/putu32 {
  3 copy -16 bitshift putu16
  exch 2 add exch 16#ffff and putu16
} bind def

% <nametable> <nameid> findname <string> true
% <nametable> <nameid> findname false
/findname {
  DEBUG { (findname: ) print dup =only  } if
  false 3 1 roll 0 1 3 index 2 getu16 1 sub {
		% Stack: false table id index
    12 mul 6 add 2 index exch 12 getinterval
    dup 6 getu16 2 index eq {
		% We found the name we want.
      exch pop
		% Stack: false table record
      dup 10 getu16 2 index 4 getu16 add
      1 index 8 getu16 4 -1 roll 3 1 roll getinterval exch
		% Stack: false string record
		% Check for 8- vs. 16-bit characters.
      is2byte { string2to1 } if true null 4 -1 roll exit
    } if pop
  } for pop pop
  DEBUG {
    dup { ( = ) print 1 index == } { ( not found) = } ifelse
  } if
} bind def

% <namerecord> is2byte <bool>
/is2byte {
  dup 0 getu16 {
    { pop true }		% Apple Unicode
    { pop false }		% Macintosh Script manager
    { 1 getu16 1 eq }		% ISO
    { 1 getu16 1 eq }		% Microsoft
  } exch get exec
} bind def

% <string2> string2to1 <string>
/string2to1 {
  dup length 2 idiv string dup
  0 1 3 index length 1 sub {
    3 index 1 index 2 mul 1 add get put dup
  } for pop exch pop
} bind def

% <array> <lt-proc> sort <array>
/sort {
  1 index length 1 sub -1 1 {
    2 index exch 2 copy get 3 copy	% arr proc arr i arr[i] arr i arr[i]
    0 1 3 index 1 sub {
      3 index 1 index get	% arr proc arr i arr[i] arr imax amax j arr[j]
      2 index 1 index 10 index exec {	% ... amax < arr[j]
	4 2 roll
      } if pop pop
    } for			% arr proc arr i arr[i] arr imax amax
    4 -1 roll exch 4 1 roll put put
  } for pop
} def

% Each procedure in this dictionary is called as follows:
%       <encodingtable> proc <glypharray>
/cmapformats mark
  0 {		% Apple standard 1-to-1 mapping.
    6 256 getinterval { } forall 256 packedarray
  } bind
  4 {		% Microsoft/Adobe segmented mapping.
    /etab exch def
    /nseg2 etab 6 getu16 def
    14 /endc etab 2 index nseg2 getinterval def
		% The Apple TrueType documentation omits the 2-byte
		% 'reserved pad' that follows the endCount vector!
    2 add
    nseg2 add /startc etab 2 index nseg2 getinterval def
    nseg2 add /iddelta etab 2 index nseg2 getinterval def
    nseg2 add /idroff etab 2 index nseg2 getinterval def
		% The following hack allows us to properly handle
		% idiosyncratic fonts that start at 0xf000:
    pop
    /firstcode startc 0 getu16 16#ff00 and dup 16#f000 ne { pop 0 } if def
    /putglyph {
      glyphs code 3 -1 roll put /code code 1 add def
    } bind def
		% Do a first pass to compute the size of the glyphs array.
    /numcodes 0 def /glyphs 0 0 2 nseg2 3 sub {
		% Stack: /glyphs numglyphs i2
      /i2 exch def
      /scode startc i2 getu16 def
      /ecode endc i2 getu16 def
      numcodes scode firstcode sub
		% Hack for fonts that have only 0x0000 and 0xf000 ranges
      dup 16#e000 ge { 255 and } if
      exch sub 0 max ecode scode sub 1 add add
      exch 1 index add exch
      numcodes add /numcodes exch def
    } for array def
		% Now fill in the array.
    /numcodes 0 def /code 0 def
    0 2 nseg2 3 sub {
      /i2 exch def
      /scode startc i2 getu16 def
      /ecode endc i2 getu16 def
      numcodes scode firstcode sub
		% Hack for fonts that have only 0x0000 and 0xf000 ranges
      dup 16#e000 ge { 255 and } if
      exch sub 0 max dup { 0 putglyph } repeat
      ecode scode sub 1 add add numcodes add /numcodes exch def
      /delta iddelta i2 gets16 def
      DEBUG {
	(scode=) print scode =only
	( ecode=) print ecode =only
	( delta=) print delta =only
	( droff=) print idroff i2 getu16 =
      } if
      idroff i2 getu16 dup 0 eq {
	pop scode delta add 65535 and 1 ecode delta add 65535 and
	{ putglyph } for
      } {	% The +2 is for the 'reserved pad'.
        /gloff exch 14 nseg2 3 mul add 2 add i2 add add def
        0 1 ecode scode sub {
	  2 mul gloff add etab exch getu16
	  dup 0 ne { delta add 65535 and } if putglyph
	} for
      } ifelse
    } for glyphs /glyphs null def	% for GC
  } bind
  6 {		% Single interval lookup.
    dup 6 getu16 /firstcode exch def dup 8 getu16 /ng exch def
    firstcode ng add array
		% Stack: tab array
		% Fill elements 0 .. firstcode-1 with 0
    0 1 firstcode 1 sub { 2 copy 0 put pop } for
    dup firstcode ng getinterval
		% Stack: tab array subarray
		% Fill elements firstcode .. firstcode+nvalue-1 with glyph values
    0 1 ng 1 sub {
      dup 2 mul 10 add 4 index exch getu16 3 copy put pop pop
    } for pop exch pop
  } bind
.dicttomark readonly def                % cmapformats

% <cmaptab> cmaparray <glypharray>
/cmaparray {
  dup 0 getu16 cmapformats exch .knownget {
    DEBUG {
      (cmap: format ) print 1 index 0 getu16 = flush
    } if exec
  } {
    (Can't handle format ) print 0 getu16 = flush
    0 1 255 { } for 256 packedarray
  } ifelse
  DEBUG {
    (cmap: length=) print dup length = dup ==
  } if
} bind def

% Each procedure in this dictionary is called as follows:
%       posttable <<proc>> glyphencoding
/postformats mark
  16#00010000  {	% 258 standard Macintosh glyphs.
    pop MacGlyphEncoding
  }
  16#00020000  {	% Detailed map, required by Microsoft fonts.
    /postglyphs exch def
      postglyphs 32 getu16 /numglyphs exch def
      /glyphnames numglyphs 2 mul 34 add def
      [ 0 1 numglyphs 1 sub {
	2 mul 34 add postglyphs exch getu16
	dup 258 lt {
	  MacGlyphEncoding exch get
	} {
	  dup 32768 ge {
		% According to the published TrueType spec, such values are
		% "reserved for future use", but at least some PDF files
		% produced by the Adobe PDF library contain entries with a
		% value of 16#ffff.
	    pop /.notdef
	  } {
	    258 sub glyphnames exch {
	      postglyphs 1 index get 1 add add
	    } repeat
	    1 add postglyphs exch 2 copy 1 sub get getinterval cvn
		% At least some of Microsoft's TrueType fonts use incorrect
		% (Adobe-incompatible) names for some glyphs.
		% Correct for this here.
	    postremap 1 index .knownget { exch pop } if
	  } ifelse
	} ifelse
      } for ]
  } bind
  16#00030000  {	% No map.
    pop [ ]
  } bind
.dicttomark readonly def                % postformats

% Each procedure in this dictionary is called as follows:
%	<file> <length> -proc- <string|array_of_strings>
% Note that each table must have an even length, because of a strange
% Adobe requirement that each sfnts entry have even length.
/readtables mark
	% Ordinary tables
  (cmap) { .readtable }
  (head) 1 index
  (hhea) 1 index
  (maxp) 1 index
  (name) 1 index
  (OS/2) 1 index
  (post) 1 index
  (vhea) 1 index
	% Big tables
  (glyf) { .readbigtable }
  (loca) 1 index
  (hmtx) 1 index
  (vmtx) 1 index
	% Tables only needed for embedding in PDF files
  (cvt ) { .readtable }
  (fpgm) 1 index
  (prep) 1 index
.dicttomark
% Normally there would be a 'readonly' here, but the ttf2pf utility wants
% to include the 'kern' table as well, so we leave the readtables dictionary
% writable.
def                % readtables

% Read a table as a single string.
% <file> <length> .readtable <string>
/.readtable {
  dup dup 1 and add string
		% Stack: f len str
  dup 0 4 -1 roll getinterval
		% Stack: f str str1
	% Because of the absurd PostScript specification that gives an
	% error for reading into an empty string, we have to check for
	% this explicitly here.
  3 -1 roll exch
  dup () ne { readstring } if pop pop
} bind def

% Read a big table (one that may exceed 64K).
% <file> <length> .readbigtable <string[s]>
/.readbigtable {
  dup 65400 lt {
    .readtable
  } {
    currentuserparams /VMReclaim get -2 vmreclaim
    [ 4 2 roll {
		% Stack: mark ... f left
      dup maxstring le { exit } if
      1 index maxstring string readstring pop 3 1 roll maxstring sub
    } loop .readtable ]
    exch vmreclaim
  } ifelse
} bind def

end readonly def                % .loadttfontdict

% <tab> .printtab -
/.printtab {
  dup 0 4 getinterval print ( ) print
  dup 8 getu32 =only ( ) print
  12 getu32 =
} bind def

% <file> .loadttfonttables -
% Pushes .loadttfontdict & scratch dict on d-stack.
% Defines f, offsets, tables, tabdict, tabs.
/.loadttfonttables {
  .loadttfontdict begin
  40 dict begin
  /f exch def
  /offsets f 12 string readstring pop def
  /tables f offsets 4 getu16 16 mul string readstring pop def
  /tabdict tables length 16 idiv dict def
	% tabs = tables we want to keep, sorted by file position.
  /tabs [ 0 16 tables length 1 sub {
    tables exch 16 getinterval
    DEBUG { dup .printtab } if
    dup 0 4 getinterval readtables 1 index known {
      tabdict exch 2 index put
    } {
      pop pop
    } ifelse
  } for ] {
    exch 8 getu32 exch 8 getu32 lt
  } sort def
	% In certain malformed TrueType fonts, tables overlap.
	% Truncate tables if necessary.
  0 1 tabs length 2 sub {
    dup tabs exch get exch 1 add tabs exch get
    1 index 8 getu32 2 index 12 getu32 add
    1 index 8 getu32 gt {
      (**** Warning: ) print 1 index 0 4 getinterval print
      ( overlaps ) print dup 0 4 getinterval print
      (, truncating.) = flush
      dup 8 getu32 2 index 8 getu32 sub
      2 index 12 3 -1 roll putu32
    } if pop pop
  } for
} bind def

% - .readttdata -
% Read data.  Updates offsets, tabs; stores data in tabdict.
/.readttdata {
  /fpos offsets length tables length add def
  /sfpos offsets length tabs length 16 mul add def
  offsets 4 tabs length putu16
  tabs {
    dup 0 4 getinterval /tname exch def
    dup 8 getu32 /tpos exch def
    dup 12 getu32 /tlen exch def
    8 sfpos putu32
	% Skip data between the end of the previous table and
	% the beginning of this one, if any.
    tpos fpos gt {
      f tpos fpos sub () /SubFileDecode filter dup flushfile closefile
      /fpos tpos def
    } if
    f tlen readtables tname get exec
    tabdict tname 3 -1 roll put
    /fpos fpos tlen add def
	% Round up the table length to an even value.
    /sfpos sfpos tlen dup 1 and add add def
  } forall
} bind def

% Find the string in a list of strings that includes a given index.
% <strings> <index> .findseg <string> <index'>
/.findseg {
  exch {
    dup length 2 index gt { exch exit } if
    length sub
  } forall
} bind def

% - .makesfnts -
% Defines checksum, getloca, head, locatable, numloca, post, sfnts, upem
/.makesfnts {
  .readttdata
  /head tabdict /head get def
  /locatable tabdict /loca get def
  /post tabdict /post .knownget not { null } if def
  /numloca
    locatable dup type /stringtype eq
     { length }
     { 0 exch { length add } forall }
    ifelse	% no def yet
  locatable type /stringtype eq {
    /.indexloca {} def
  } {
    /.indexloca /.findseg load def
  } ifelse
  head 50 getu16 0 ne {
    /getloca {
      2 bitshift locatable exch .indexloca getu32
    } def
    4 idiv 1 sub
  } {
    /getloca {
      dup add locatable exch .indexloca getu16 dup add
    } def
    2 idiv 1 sub
  } ifelse def		% numloca
	% If necessary, re-partition the glyfs.
  tabdict /glyf get dup type /stringtype ne {
    .dividesfnts tabdict /glyf 3 -1 roll put
  } {
    pop
  } ifelse
  /sfnts [
    offsets tabs { concatstrings } forall
    tabs {
      0 4 getinterval tabdict exch get
      dup type /stringtype ne { aload pop } if
    } forall
  ] def
} bind def

% <glyfs> .dividesfnts <glyfs'>
/.dividesfnts {
  /glyfs exch def
  /len1 0 glyfs { length add } forall def
		% Determine where to split the glyfs by scanning loca.
		% The very last entry in loca may be bogus.
		% Note that some loca entries may be odd, but we can only
		% split at even positions.
		%
		% Construct splitarray, the array of final lengths of
		% the sfnts entries covering the glyfs (i.e., all but
		% the first and last sfnts entries).
    /prevsplit 0 def
    /prevboundary 0 def
    /splitarray [
      0 1 numloca 1 sub {
	getloca dup prevsplit maxstring add gt {
	  prevboundary prevsplit sub exch
	  /prevsplit prevboundary def
	} if
	dup 1 and 0 eq { /prevboundary exch def } { pop } ifelse
      } for
      len1 prevsplit sub
    ] def
    currentuserparams /VMReclaim get -2 vmreclaim
    [
		% Re-split the sfnts glyfs strings according to splitarray.
		% We do this by iterating over the final segments defined
		% by splitarray, and constructing them from pieces of the
		% current glyfs strings.  We recycle the current strings
		% when possible, to avoid stressing the allocator.
      /sfnt_idx 0 def
      /strpos 0 def
      /avail () def
      splitarray {
	/seglen exch def
	/segpos 0 def
	avail length seglen ge
	  { avail 0 seglen getinterval /avail () def } { seglen string }
	ifelse
	{
	  /str glyfs sfnt_idx get def
	  /strlen str length def
	  /strleft strlen strpos sub def
	  seglen segpos sub strleft lt { exit } if
		% Copy the (rest of the) string into the new segment.
		% We know strleft <= segleft.
	  dup segpos str strpos strleft getinterval putinterval
	  /segpos segpos strleft add def
	  /avail str def
	  /sfnt_idx sfnt_idx 1 add def
	  /strpos 0 def
	  segpos seglen eq { exit } if
	} loop
		% Fill up the segment with an initial piece of the next
		% existing glyfs string.  We know strleft > segleft.
	/segleft seglen segpos sub def
	dup segpos str strpos segleft getinterval putinterval
	/strpos strpos segleft add def
      } forall
    ]
    exch vmreclaim
} bind def

% - .getpost -
% Uses post, defines glyphencoding
/.getpost {
  /glyphencoding post null eq {
    DEBUG { (post missing) = flush } if [ ]
  } {
    postformats post 0 getu32 .knownget {
      DEBUG {
	(post: format ) print
	post 0 getu16 =only (,) print post 2 getu16 = flush
      } if
      post exch exec
    } {
      DEBUG { (post: unknown format ) print post 0 getu32 = flush } if [ ]
    } ifelse
  } ifelse def
} bind def

% - .ttkeys <key> <value> ...
/.ttkeys {
  count /ttkeycount exch def
  /upem head 18 getu16 def
  /FontMatrix matrix
  /FontBBox [ 36 2 42 { head exch gets16 upem div } for ]
  nextxuid
  tabdict /name .knownget {
		% Find the names from the 'name' table.
    /names exch def
    /FontName names 6 findname not { curxuid 16 8 string cvrs } if
      /fontname 1 index def
    /FontInfo mark
      names 0 findname { /Notice exch } if
      names 1 findname { /FamilyName exch } if
      names 4 findname { /FullName exch } if
      names 5 findname { /Version exch } if
  } {
		% No name table, fabricate a FontName.
    /FontName curxuid 16 8 string cvrs
      /fontname 1 index def
    /FontInfo mark
  } ifelse
		% Stack: ... /FontInfo mark key1 value1 ...
  post null ne {
    /ItalicAngle post 4 gets32 65536.0 div
    /isFixedPitch post 12 getu32 0 ne
    /UnderlinePosition post 8 gets16 upem div
    /UnderlineThickness post 10 gets16 upem div
  } if
  counttomark 0 ne { .dicttomark } { pop pop } ifelse
  /XUID [orgXUID 42 curxuid]
  DEBUG {
    tabs { .printtab } forall
    [ sfnts { length } forall ] ==
    count ttkeycount sub array astore dup { == } forall aload pop
  } if
  /sfnts sfnts
} bind def

% ---------------- Standard TrueType font loading ---------------- %

% - .pickcmap -
% Defines cmapsub, cmaptab
/.pickcmap {
  tabdict /cmap get
		% The Apple cmap format is no help in determining the encoding.
		% Look for a Microsoft table.  If we can't find one,
		% just use the first table, whatever it is.
  dup 4 8 getinterval exch             % the default
  0 1 2 index 2 getu16 1 sub {
    8 mul 4 add 1 index exch 8 getinterval
    DEBUG {
      (cmap: platform ) print dup 0 getu16 =only
      ( encoding ) print dup 2 getu16 = flush
    } if
    dup 0 getu16 3 eq { exch 3 -1 roll pop exit } if pop
  } for
		% Stack: subentry table
  /cmapsub 2 index def
  exch 4 getu32 1 index length 1 index sub getinterval
  /cmaptab exch def
} bind def

% <glyph> .nname <_name>
/.nname {
  =string cvs (_) exch concatstrings cvn
} bind def

% - .charkeys /CharStrings <charstrings> /Encoding <encoding>
% Resets glyphencoding
/.charkeys {
  DEBUG {
    (glyphencoding: length=) print glyphencoding dup length = === flush
  } if
		% Hack: if there is no usable post table but the cmap uses
		% the Microsoft Unicode encoding, use ISOLatin1Encoding.
  glyphencoding length 0 eq cmapsub 0 4 getinterval <00030001> eq and {
    /glyphencoding ISOLatin1Encoding dup length array copy def
  } if
		% If necessary, fabricate additional glyphencoding entries
		% to cover all of loca, or truncate glyphencoding.
  glyphencoding length numloca lt {
    /glyphencoding [ glyphencoding aload pop
    counttomark 1 numloca 1 sub { .nname } for ] def
  } {
    /glyphencoding glyphencoding 0 numloca getinterval def
  } ifelse
		% Some badly designed Chinese fonts have a post table
		% in which all glyphs other than 0 are named .null.
		% Use CharStrings to keep track of the reverse map from
		% names to glyphs, and don't let any name be used for
		% more than one glyph.
  /CharStrings glyphencoding dup length 1 add dict	% +1 for .notdef
    0 1 3 index length 1 sub {
		% Stack: glyphencoding dict index
      2 index 1 index get 2 index 1 index known {
		% The same name maps to more than one glyph.
		% Change the name.
	pop dup .nname 3 index 2 index 2 index put
      } if
      2 index exch 3 -1 roll put
    } for exch pop
		% If there is no .notdef entry, map it to glyph 0.
  dup /.notdef known not { dup /.notdef 0 put } if
  readonly
  /Encoding
    [ cmaptab cmaparray dup length 256 gt { 0 256 getinterval } if
    { glyphencoding exch get } forall
    counttomark 256 exch sub { /.notdef } repeat ]
  DEBUG { (Encoding: ) print dup === flush } if
} bind def

% -mark- <key> <value> ... .definettfont <font>
/.definettfont {
  /FontType 42
  /PaintType 0
  DEBUG {
    (numloca=) print numloca =
  } if
  .dicttomark
  end end dup /FontName get exch definefont
} bind def

% <file> .loadttfont <type42font>
/.loadttfont {
  .loadttfonttables
  .makesfnts
  .getpost
  .pickcmap
  mark
  .charkeys
  .ttkeys
  .definettfont
} bind def

% ---------------- CIDFontType 2 font loading ---------------- %

% Create a string with N CIDs from the top of the stack.
% <cid1> ... <cidN> <N> .makecidmap <string>
/.makecidmap {
  dup 2 mul string dup 3 -1 roll 1 sub 2 mul -2 0 {
		% Stack: cids str str i2
    2 copy 5 index -8 bitshift put
    1 add 4 -1 roll 16#ff and put dup
  } for pop
} bind def

% -mark- <key> <value> ... .definettcidfont <font>
/.definettcidfont {
  /CIDFontName fontname
  /CIDFontType 2
  /CIDSystemInfo mark
    /Registry (Adobe)
    /Ordering (Japan1)		% adhoc
    /Supplement 0
  .dicttomark
  /CharStrings mark /.notdef 0 .dicttomark
		% The cmap isn't of any use even if it is present.
		% Just construct an identity CIDMap covering all the glyphs.
  mark 0 1 numloca 1 sub { } for
  counttomark /cidcount exch def
  cidcount maxstring le {
		% Use a single string.
    cidcount .makecidmap exch pop
  } {
		% We must use 2 strings.
    maxstring .makecidmap counttomark 1 add 1 roll
    counttomark .makecidmap exch pop exch 2 array astore
  } ifelse
  /CIDMap exch
  /CIDCount cidcount
  /GDBytes 2
  .dicttomark
  end end dup /CIDFontName get exch /CIDFont defineresource
} bind def

% <file> .loadttcidfont <cidtype2font>
/.loadttcidfont {
  .loadttfonttables
  .makesfnts
	% CIDFontType2 fonts don't have a cmap: they are indexed by CID.
  mark
  .ttkeys
  .definettcidfont
} bind def

% ---------------- PDF TrueType font loading ---------------- %

% Strictly speaking, this code should be loaded only if we have a PDF
% interpreter, but it's so closely tied to the rest of the code in this
% file that we always include it.

% <plat+enc> .findcmap <subtable> true
% <plat+enc> .findcmap false
/.findcmap {
  false exch tabdict /cmap get
		% Some fonts have multiple cmaps with the same platform and
		% encoding.  Use the first one we find.
  0 1 2 index 2 getu16 1 sub {
		% Stack: false plat+enc cmap index
    8 mul 4 add 1 index exch 8 getinterval 
    dup 0 4 getinterval 3 index eq {
      4 getu32 1 index exch 1 index length 1 index sub getinterval
      4 -1 roll not 4 2 roll exit
    } if pop
  } for
		% Stack: false plat+enc cmap || subtable true plat+enc cmap
  pop pop
} bind def

% <subcmap> <chartoglyphmap> .pdfmapchars
%   /CharStrings <charstrings> /Encoding <encoding>
% Uses encoding
/.pdfmapchars {
  exch cmaparray /cmapencoding exch def
	% Invert glyphencoding (post).
  /inversepost glyphencoding length dict def
  0 1 glyphencoding length 1 sub {
    glyphencoding 1 index get exch inversepost 3 1 roll put
  } for
  /CharStrings mark 3 -1 roll {
    dup type /arraytype eq {
      exch /ch exch def { ch exch .pdfaddchar } forall
    } {
      .pdfaddchar
    } ifelse
  } forall
	% Add a .notdef => 0 entry if needed.  Per Adobe's spec,
	% .dicttomark (>>) adds pairs in top-to-bottom order.
  /.notdef 0
  .dicttomark
  /Encoding encoding
} bind def
% <charname> <charcode> .pdfaddchar <charname> <glyph#>
% <charname> <charcode> .pdfaddchar -
/.pdfaddchar {
  dup cmapencoding length lt {
    cmapencoding exch get dup 0 eq {
      pop .pdfaddpost
    } if
  } {
    pop .pdfaddpost
  } ifelse
} bind def
% <charname> .pdfaddpost <charname> <glyph#>
% <charname> .pdfaddpost -
/.pdfaddpost {
  inversepost 1 index .knownget not { pop } if
} bind def

% - .pdfcharkeys /CharStrings <charstrings> /Encoding <encoding>
/.pdfcharkeys {
	% The following algorithms are per the PDF Reference, Second Edition
	% (PDF 1.3 reference manual).
  encoding null eq {
    .charkeys		% use default algorithm
  } {
    <00030001> .findcmap {
      AdobeGlyphList .pdfmapchars
    } {
      <00010000> .findcmap {
	.romanmacdict .pdfmapchars
      } {
	.charkeys	% use default algorithm
      } ifelse
    } ifelse
  } ifelse
} bind def

% <file> <encoding|null> .loadpdfttfont <type42font>
/.loadpdfttfont {
  exch .loadttfonttables
  /encoding exch def
  .makesfnts
  .getpost
  .pickcmap
  mark
  .pdfcharkeys
  .ttkeys
  .definettfont
} bind def