home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / GhostScript / !GhostScr / 6_01 / lib / gs_ttf.ps < prev    next >
Text File  |  2000-03-16  |  23KB  |  767 lines
  1. %    Copyright (C) 1996, 2000 Aladdin Enterprises.  All rights reserved.
  2. %
  3. % This file is part of Aladdin Ghostscript.
  4. %
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. %
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % $Id: gs_ttf.ps,v 1.3 2000/03/16 07:38:07 lpd Exp $
  19. % Support code for direct use of TrueType fonts.
  20. % (Not needed for Type 42 fonts.)
  21.  
  22. % Note that if you want to use this file without including the ttfont.dev
  23. % option when you built Ghostscript, you will need to load the following
  24. % files before this one:
  25. %    lib/gs_mgl_e.ps
  26. %    lib/gs_mro_e.ps
  27. %    lib/gs_wan_e.ps
  28.  
  29. % Thanks to B. Jackowski and GUST (the Polish TeX Users' Group) for
  30. % the glyf-splitting code.
  31.  
  32. % ---------------- Font loading machinery ---------------- %
  33.  
  34. % Augment the FONTPATH machinery so it recognizes TrueType fonts.
  35.  
  36. /.scanfontheaders where {
  37.   pop /.scanfontheaders [
  38.    .scanfontheaders aload pop (\000\001\000\000*) (true*)
  39.   ] def
  40. } if
  41.  
  42. % <file> <key> .findfontvalue <value> true
  43. % <file> <key> .findfontvalue false
  44. % Closes the file in either case.
  45. /.findnonttfontvalue /.findfontvalue load def
  46. /.findfontvalue {
  47.   1 index read pop 2 index 1 index unread
  48.   dup 0 eq exch (t) 0 get eq or {
  49.         % If this is a font at all, it's a TrueType font.
  50.     dup /FontType eq {
  51.       pop closefile 42 true
  52.     } {
  53.       dup /FontName eq { pop .findttfontname } { pop closefile false } ifelse
  54.     } ifelse
  55.   } {
  56.         % Not a TrueType font.
  57.     .findnonttfontvalue
  58.   } ifelse
  59. } bind def
  60.  
  61. % <file> .findttfontname <fname> true
  62. % <file> .findttfontname false
  63. % Closes the file in either case.
  64. /.findttfontname {
  65.   .loadttfonttables
  66.   tabdict /name .knownget {
  67.     dup 8 getu32 f exch setfileposition
  68.     12 getu32 string f exch readstring pop
  69.     6 findname
  70.   } {
  71.     false
  72.   } ifelse
  73.   f closefile end end
  74. } bind def
  75.  
  76. % Load a font file that might be a TrueType font.
  77.  
  78. % <file> .loadfontfile -
  79. /.loadnonttfontfile /.loadfontfile load def
  80. /.loadfontfile {
  81.   dup read pop 2 copy unread 0 eq {
  82.         % If this is a font at all, it's a TrueType font.
  83.     .loadttfont pop
  84.   } {
  85.         % Not a TrueType font.
  86.     .loadnonttfontfile
  87.   } ifelse
  88. } bind def
  89.  
  90. % ---------------- Automatic Type 42 generation ---------------- %
  91.  
  92. % Load a TrueType font from a file as a Type 42 PostScript font.
  93. % The thing that makes this really messy is the handling of encodings.
  94. % There are 2 interacting tables that affect the encoding:
  95. %       'cmap' provides multiple maps from character codes to glyph indices
  96. %       'post' maps glyph indices to glyph names (if present)
  97. % What we need to get out of this is:
  98. %       Encoding mapping character codes to glyph names
  99. %         (the composition of cmap and post)
  100. %       CharStrings mapping glyph names to glyph indices
  101. %         (the inverse of post)
  102. % If the post table is missing, we have to take a guess based on the cmap
  103. % table.
  104.  
  105. /.loadttfontdict 50 dict dup begin
  106.  
  107. /orgXUID AladdinEnterprisesXUID def
  108. /maxstring 32000 def    % half the maximum length of a PostScript string,
  109.             % must be a multiple of 4 (for hmtx / loca / vmtx)
  110.  
  111. % Define the Macintosh standard mapping from characters to glyph indices.
  112. /MacRomanEncoding dup .findencoding def
  113. /MacGlyphEncoding dup .findencoding def
  114.  
  115. % ---- Utilities ---- %
  116.  
  117. % Define a serial number for creating unique XUIDs for TrueType fonts.
  118. % We used to use the checkSumAdjustment value from the font, but this is
  119. % not reliable, since some fonts don't set it correctly.
  120. % Note that we must do this in a string to make it immune to save/restore.
  121. /xuidstring <80000000> def
  122. /curxuid {        % - curxuid <int>
  123.   0 xuidstring { exch 8 bitshift exch add } forall
  124. } bind def
  125. /nextxuid {        % - nextxuid -
  126.   3 -1 0 {
  127.     xuidstring 1 index 2 copy get dup 255 ne {
  128.       1 add put pop exit
  129.     } if pop 0 put pop
  130.   } for
  131. } bind def
  132.  
  133. % <string> <index> getu16 <integer>
  134. /getu16 {
  135.   2 copy get 8 bitshift 3 1 roll 1 add get add
  136. } bind def
  137.  
  138. % <string> <index> gets16 <integer>
  139. /gets16 {
  140.   getu16 16#8000 xor 16#8000 sub
  141. } bind def
  142.  
  143. % <string> <index> getu32 <integer>
  144. /getu32 {
  145.   2 copy getu16 16 bitshift 3 1 roll 2 add getu16 add
  146. } bind def
  147.  
  148. % <string> <index> gets32 <integer>
  149. /gets32 {
  150.   2 copy gets16 16 bitshift 3 1 roll 2 add getu16 add
  151. } bind def
  152.  
  153. % <string> <index> <integer> putu16 -
  154. /putu16 {
  155.   3 copy -8 bitshift put
  156.   exch 1 add exch 16#ff and put
  157. } bind def
  158.  
  159. % <string> <index> <integer> putu32 -
  160. /putu32 {
  161.   3 copy -16 bitshift putu16
  162.   exch 2 add exch 16#ffff and putu16
  163. } bind def
  164.  
  165. % <nametable> <nameid> findname <string> true
  166. % <nametable> <nameid> findname false
  167. /findname {
  168.   false 3 1 roll 0 1 3 index 2 getu16 1 sub {
  169.         % Stack: false table id index
  170.     12 mul 6 add 2 index exch 12 getinterval
  171.     dup 6 getu16 2 index eq {
  172.         % We found the name we want.
  173.       exch pop
  174.         % Stack: false table record
  175.       dup 10 getu16 2 index 4 getu16 add
  176.       1 index 8 getu16 4 -1 roll 3 1 roll getinterval exch
  177.         % Stack: false string record
  178.         % Check for 8- vs. 16-bit characters.
  179.       is2byte { string2to1 } if true null 4 -1 roll exit
  180.     } if pop
  181.   } for pop pop
  182. } bind def
  183.  
  184. % <namerecord> is2byte <bool>
  185. /is2byte {
  186.   dup 0 getu16 {
  187.     { pop true }        % Apple Unicode
  188.     { pop false }        % Macintosh Script manager
  189.     { 1 getu16 1 eq }        % ISO
  190.     { 1 getu16 1 eq }        % Microsoft
  191.   } exch get exec
  192. } bind def
  193.  
  194. % <string2> string2to1 <string>
  195. /string2to1 {
  196.   dup length 2 idiv string dup
  197.   0 1 3 index length 1 sub {
  198.     3 index 1 index 2 mul 1 add get put dup
  199.   } for pop exch pop
  200. } bind def
  201.  
  202. % <array> <lt-proc> sort <array>
  203. /sort {
  204.   1 index length 1 sub -1 1 {
  205.     2 index exch 2 copy get 3 copy    % arr proc arr i arr[i] arr i arr[i]
  206.     0 1 3 index 1 sub {
  207.       3 index 1 index get    % arr proc arr i arr[i] arr imax amax j arr[j]
  208.       2 index 1 index 10 index exec {    % ... amax < arr[j]
  209.     4 2 roll
  210.       } if pop pop
  211.     } for            % arr proc arr i arr[i] arr imax amax
  212.     4 -1 roll exch 4 1 roll put put
  213.   } for pop
  214. } def
  215.  
  216. % Each procedure in this dictionary is called as follows:
  217. %       <encodingtable> proc <glypharray>
  218. /cmapformats mark
  219.   0 {        % Apple standard 1-to-1 mapping.
  220.     6 256 getinterval { } forall 256 packedarray
  221.   } bind
  222.   4 {        % Microsoft/Adobe segmented mapping.
  223.     /etab exch def
  224.     /nseg2 etab 6 getu16 def
  225.     14 /endc etab 2 index nseg2 getinterval def
  226.         % The Apple TrueType documentation omits the 2-byte
  227.         % 'reserved pad' that follows the endCount vector!
  228.     2 add
  229.     nseg2 add /startc etab 2 index nseg2 getinterval def
  230.     nseg2 add /iddelta etab 2 index nseg2 getinterval def
  231.     nseg2 add /idroff etab 2 index nseg2 getinterval def
  232.         % The following hack allows us to properly handle
  233.         % idiosyncratic fonts that start at 0xf000:
  234.     pop
  235.     /firstcode startc 0 getu16 16#ff00 and dup 16#f000 ne { pop 0 } if def
  236.     /putglyph {
  237.       glyphs code 3 -1 roll put /code code 1 add def
  238.     } bind def
  239.         % Do a first pass to compute the size of the glyphs array.
  240.     /numcodes 0 def /glyphs 0 0 2 nseg2 3 sub {
  241.         % Stack: /glyphs numglyphs i2
  242.       /i2 exch def
  243.       /scode startc i2 getu16 def
  244.       /ecode endc i2 getu16 def
  245.       numcodes scode firstcode sub
  246.         % Hack for fonts that have only 0x0000 and 0xf000 ranges
  247.       dup 16#e000 ge { 255 and } if
  248.       exch sub 0 max ecode scode sub 1 add add
  249.       exch 1 index add exch
  250.       numcodes add /numcodes exch def
  251.     } for array def
  252.         % Now fill in the array.
  253.     /numcodes 0 def /code 0 def
  254.     0 2 nseg2 3 sub {
  255.       /i2 exch def
  256.       /scode startc i2 getu16 def
  257.       /ecode endc i2 getu16 def
  258.       numcodes scode firstcode sub
  259.         % Hack for fonts that have only 0x0000 and 0xf000 ranges
  260.       dup 16#e000 ge { 255 and } if
  261.       exch sub 0 max dup { 0 putglyph } repeat
  262.       ecode scode sub 1 add add numcodes add /numcodes exch def
  263.       /delta iddelta i2 gets16 def
  264.       DEBUG {
  265.     (scode=) print scode =only
  266.     ( ecode=) print ecode =only
  267.     ( delta=) print delta =only
  268.     ( droff=) print idroff i2 getu16 =
  269.       } if
  270.       idroff i2 getu16 dup 0 eq {
  271.     pop scode delta add 65535 and 1 ecode delta add 65535 and
  272.     { putglyph } for
  273.       } {    % The +2 is for the 'reserved pad'.
  274.         /gloff exch 14 nseg2 3 mul add 2 add i2 add add def
  275.         0 1 ecode scode sub {
  276.       2 mul gloff add etab exch getu16
  277.       dup 0 ne { delta add 65535 and } if putglyph
  278.     } for
  279.       } ifelse
  280.     } for glyphs /glyphs null def    % for GC
  281.   } bind
  282.   6 {        % Single interval lookup.
  283.     dup 6 getu16 /firstcode exch def dup 8 getu16 /ng exch def
  284.     firstcode ng add array
  285.         % Stack: tab array
  286.         % Fill elements 0 .. firstcode-1 with 0
  287.     0 1 firstcode 1 sub { 2 copy 0 put pop } for
  288.     dup firstcode ng getinterval
  289.         % Stack: tab array subarray
  290.         % Fill elements firstcode .. firstcode+nvalue-1 with glyph values
  291.     0 1 ng 1 sub {
  292.       dup 2 mul 10 add 3 index exch getu16 3 copy put pop pop
  293.     } for pop exch pop
  294.   } bind
  295. .dicttomark readonly def                % cmapformats
  296.  
  297. % <cmaptab> cmaparray <glypharray>
  298. /cmaparray {
  299.   dup 0 getu16 cmapformats exch .knownget {
  300.     DEBUG {
  301.       (cmap: format ) print 1 index 0 getu16 = flush
  302.     } if exec
  303.   } {
  304.     (Can't handle format ) print 0 getu16 = flush
  305.     0 1 255 { } for 256 packedarray
  306.   } ifelse
  307.   DEBUG {
  308.     (cmap: length=) print dup length = dup ==
  309.   } if
  310. } bind def
  311.  
  312. % Each procedure in this dictionary is called as follows:
  313. %       posttable <<proc>> glyphencoding
  314. /postformats mark
  315.   16#00010000  {    % 258 standard Macintosh glyphs.
  316.     pop MacGlyphEncoding
  317.   }
  318.   16#00020000  {    % Detailed map, required by Microsoft fonts.
  319.     /postglyphs exch def
  320.       postglyphs 32 getu16 /numglyphs exch def
  321.       /glyphnames numglyphs 2 mul 34 add def
  322.       [ 0 1 numglyphs 1 sub {
  323.     2 mul 34 add postglyphs exch getu16
  324.     dup 258 lt {
  325.       MacGlyphEncoding exch get
  326.     } {
  327.       258 sub glyphnames exch {
  328.         postglyphs 1 index get 1 add add
  329.       } repeat
  330.       1 add postglyphs exch 2 copy 1 sub get getinterval cvn
  331.     } ifelse
  332.       } for ]
  333.   } bind
  334.   16#00030000  {    % No map.
  335.     pop [ ]
  336.   } bind
  337. .dicttomark readonly def                % postformats
  338.  
  339. % Each procedure in this dictionary is called as follows:
  340. %    <file> <length> -proc- <string|array_of_strings>
  341. % Note that each table must have an even length, because of a strange
  342. % Adobe requirement that each sfnts entry have even length.
  343. /readtables mark
  344.     % Ordinary tables
  345.   (cmap) { .readtable }
  346.   (head) 1 index
  347.   (hhea) 1 index
  348.   (maxp) 1 index
  349.   (name) 1 index
  350.   (OS/2) 1 index
  351.   (post) 1 index
  352.   (vhea) 1 index
  353.     % Big tables
  354.   (glyf) { .readbigtable }
  355.   (loca) 1 index
  356.   (hmtx) 1 index
  357.   (vmtx) 1 index
  358.     % Tables only needed for embedding in PDF files
  359.   (cvt ) { .readtable }
  360.   (fpgm) 1 index
  361.   (prep) 1 index
  362. .dicttomark
  363. % Normally there would be a 'readonly' here, but the ttf2pf utility wants
  364. % to include the 'kern' table as well, so we leave the readtables dictionary
  365. % writable.
  366. def                % readtables
  367.  
  368. % Read a table as a single string.
  369. % <file> <length> .readtable <string>
  370. /.readtable {
  371.   dup dup 1 and add string
  372.         % Stack: f len str
  373.   dup 0 4 -1 roll getinterval
  374.         % Stack: f str str1
  375.   3 -1 roll exch readstring pop pop
  376. } bind def
  377.  
  378. % Read a big table (one that may exceed 64K).
  379. % <file> <length> .readbigtable <string[s]>
  380. /.readbigtable {
  381.   dup 65400 lt {
  382.     .readtable
  383.   } {
  384.     currentuserparams /VMReclaim get -2 vmreclaim
  385.     [ 4 2 roll {
  386.         % Stack: mark ... f left
  387.       dup maxstring le { exit } if
  388.       1 index maxstring string readstring pop 3 1 roll maxstring sub
  389.     } loop .readtable ]
  390.     exch vmreclaim
  391.   } ifelse
  392. } bind def
  393.  
  394. end readonly def                % .loadttfontdict
  395.  
  396. % <tab> .printtab -
  397. /.printtab {
  398.   dup 0 4 getinterval print ( ) print
  399.   dup 8 getu32 =only ( ) print
  400.   12 getu32 =
  401. } bind def
  402.  
  403. % <file> .loadttfonttables -
  404. % Pushes .loadttfontdict & scratch dict on d-stack.
  405. % Defines f, offsets, tables, tabdict, tabs.
  406. /.loadttfonttables {
  407.   .loadttfontdict begin
  408.   40 dict begin
  409.   /f exch def
  410.   /offsets f 12 string readstring pop def
  411.   /tables f offsets 4 getu16 16 mul string readstring pop def
  412.   /tabdict tables length 16 idiv dict def
  413.     % tabs = tables we want to keep, sorted by file position.
  414.   /tabs [ 0 16 tables length 1 sub {
  415.     tables exch 16 getinterval
  416.     DEBUG { dup .printtab } if
  417.     dup 0 4 getinterval readtables 1 index known {
  418.       tabdict exch 2 index put
  419.     } {
  420.       pop pop
  421.     } ifelse
  422.   } for ] {
  423.     exch 8 getu32 exch 8 getu32 lt
  424.   } sort def
  425.     % In certain malformed TrueType fonts, tables overlap.
  426.     % Truncate tables if necessary.
  427.   0 1 tabs length 2 sub {
  428.     dup tabs exch get exch 1 add tabs exch get
  429.     1 index 8 getu32 2 index 12 getu32 add
  430.     1 index 8 getu32 gt {
  431.       (**** Warning: ) print 1 index 0 4 getinterval print
  432.       ( overlaps ) print dup 0 4 getinterval print
  433.       (, truncating.) = flush
  434.       dup 8 getu32 2 index 8 getu32 sub
  435.       2 index 12 3 -1 roll putu32
  436.     } if pop pop
  437.   } for
  438. } bind def
  439.  
  440. % - .readttdata -
  441. % Read data.  Updates offsets, tabs; stores data in tabdict.
  442. /.readttdata {
  443.   /fpos offsets length tables length add def
  444.   /sfpos offsets length tabs length 16 mul add def
  445.   offsets 4 tabs length putu16
  446.   tabs {
  447.     dup 0 4 getinterval /tname exch def
  448.     dup 8 getu32 /tpos exch def
  449.     dup 12 getu32 /tlen exch def
  450.     8 sfpos putu32
  451.     % Skip data between the end of the previous table and
  452.     % the beginning of this one, if any.
  453.     tpos fpos gt {
  454.       f tpos fpos sub () /SubFileDecode filter dup flushfile closefile
  455.       /fpos tpos def
  456.     } if
  457.     f tlen readtables tname get exec
  458.     tabdict tname 3 -1 roll put
  459.     /fpos fpos tlen add def
  460.     % Round up the table length to an even value.
  461.     /sfpos sfpos tlen dup 1 and add add def
  462.   } forall
  463. } bind def
  464.  
  465. % Find the string in a list of strings that includes a given index.
  466. % <strings> <index> .findseg <string> <index'>
  467. /.findseg {
  468.   exch {
  469.     dup length 2 index gt { exch exit } if
  470.     length sub
  471.   } forall
  472. } bind def
  473.  
  474. % - .makesfnts -
  475. % Defines checksum, getloca, head, locatable, numloca, post, sfnts, upem
  476. /.makesfnts {
  477.   .readttdata
  478.   /head tabdict /head get def
  479.   /locatable tabdict /loca get def
  480.   /post tabdict /post .knownget not { null } if def
  481.   /numloca
  482.     locatable dup type /stringtype eq
  483.      { length }
  484.      { 0 exch { length add } forall }
  485.     ifelse    % no def yet
  486.   locatable type /stringtype eq {
  487.     /.indexloca {} def
  488.   } {
  489.     /.indexloca /.findseg load def
  490.   } ifelse
  491.   head 50 getu16 0 ne {
  492.     /getloca {
  493.       2 bitshift locatable exch .indexloca getu32
  494.     } def
  495.     4 idiv 1 sub
  496.   } {
  497.     /getloca {
  498.       dup add locatable exch .indexloca getu16 dup add
  499.     } def
  500.     2 idiv 1 sub
  501.   } ifelse def        % numloca
  502.     % If necessary, re-partition the glyfs.
  503.   tabdict /glyf get dup type /stringtype ne {
  504.     .dividesfnts tabdict /glyf 3 -1 roll put
  505.   } {
  506.     pop
  507.   } ifelse
  508.   /sfnts [
  509.     offsets tabs { concatstrings } forall
  510.     tabs {
  511.       0 4 getinterval tabdict exch get
  512.       dup type /stringtype ne { aload pop } if
  513.     } forall
  514.   ] def
  515. } bind def
  516.  
  517. % - .getcmap -
  518. % Defines cmapsub, cmaptab
  519. /.getcmap {
  520.   tabdict /cmap get
  521.         % The Apple cmap format is no help in determining the encoding.
  522.         % Look for a Microsoft table.  If we can't find one,
  523.         % just use the first table, whatever it is.
  524.   dup 4 8 getinterval exch             % the default
  525.   0 1 2 index 2 getu16 1 sub {
  526.     8 mul 4 add 1 index exch 8 getinterval
  527.     DEBUG {
  528.       (cmap: platform ) print dup 0 getu16 =only
  529.       ( encoding ) print dup 2 getu16 = flush
  530.     } if
  531.     dup 0 getu16 3 eq { exch 3 -1 roll pop exit } if pop
  532.   } for
  533.         % Stack: subentry table
  534.   /cmapsub 2 index def
  535.   exch 4 getu32 1 index length 1 index sub getinterval
  536.   /cmaptab exch def
  537. } bind def
  538.  
  539. % <glyfs> .dividesfnts <glyfs'>
  540. /.dividesfnts {
  541.   /glyfs exch def
  542.   /len1 0 glyfs { length add } forall def
  543.         % Determine where to split the glyfs by scanning loca.
  544.         % The very last entry in loca may be bogus.
  545.         % Note that some loca entries may be odd, but we can only
  546.         % split at even positions.
  547.         %
  548.         % Construct splitarray, the array of final lengths of
  549.         % the sfnts entries covering the glyfs (i.e., all but
  550.         % the first and last sfnts entries).
  551.     /prevsplit 0 def
  552.     /prevboundary 0 def
  553.     /splitarray [
  554.       0 1 numloca 1 sub {
  555.     getloca dup prevsplit maxstring add gt {
  556.       prevboundary prevsplit sub exch
  557.       /prevsplit prevboundary def
  558.     } if
  559.     dup 1 and 0 eq { /prevboundary exch def } { pop } ifelse
  560.       } for
  561.       len1 prevsplit sub
  562.     ] def
  563.     currentuserparams /VMReclaim get -2 vmreclaim
  564.     [
  565.         % Re-split the sfnts glyfs strings according to splitarray.
  566.         % We do this by iterating over the final segments defined
  567.         % by splitarray, and constructing them from pieces of the
  568.         % current glyfs strings.  We recycle the current strings
  569.         % when possible, to avoid stressing the allocator.
  570.       /sfnt_idx 0 def
  571.       /strpos 0 def
  572.       /avail () def
  573.       splitarray {
  574.     /seglen exch def
  575.     /segpos 0 def
  576.     avail length seglen ge
  577.       { avail 0 seglen getinterval /avail () def } { seglen string }
  578.     ifelse
  579.     {
  580.       /str glyfs sfnt_idx get def
  581.       /strlen str length def
  582.       /strleft strlen strpos sub def
  583.       seglen segpos sub strleft lt { exit } if
  584.         % Copy the (rest of the) string into the new segment.
  585.         % We know strleft <= segleft.
  586.       dup segpos str strpos strleft getinterval putinterval
  587.       /segpos segpos strleft add def
  588.       /avail str def
  589.       /sfnt_idx sfnt_idx 1 add def
  590.       /strpos 0 def
  591.       segpos seglen eq { exit } if
  592.     } loop
  593.         % Fill up the segment with an initial piece of the next
  594.         % existing glyfs string.  We know strleft > segleft.
  595.     /segleft seglen segpos sub def
  596.     dup segpos str strpos segleft getinterval putinterval
  597.     /strpos strpos segleft add def
  598.       } forall
  599.     ]
  600.     exch vmreclaim
  601. } bind def
  602.  
  603. % - .ttkeys <key> <value> ...
  604. /.ttkeys {
  605.   count /ttkeycount exch def
  606.   /upem head 18 getu16 def
  607.   /FontMatrix matrix
  608.   /FontBBox [ 36 2 42 { head exch gets16 upem div } for ]
  609.   nextxuid
  610.   tabdict /name .knownget {
  611.         % Find the names from the 'name' table.
  612.     /names exch def
  613.     /FontName names 6 findname not { curxuid 16 8 string cvrs } if
  614.       /fontname 1 index def
  615.     /FontInfo mark
  616.       names 0 findname { /Notice exch } if
  617.       names 1 findname { /FamilyName exch } if
  618.       names 4 findname { /FullName exch } if
  619.       names 5 findname { /Version exch } if
  620.   } {
  621.         % No name table, fabricate a FontName.
  622.     /FontName curxuid 16 8 string cvrs
  623.       /fontname 1 index def
  624.     /FontInfo mark
  625.   } ifelse
  626.         % Stack: ... /FontInfo mark key1 value1 ...
  627.   post null ne {
  628.     /ItalicAngle post 4 gets32 65536.0 div
  629.     /isFixedPitch post 12 getu32 0 ne
  630.     /UnderlinePosition post 8 gets16 upem div
  631.     /UnderlineThickness post 10 gets16 upem div
  632.   } if
  633.   counttomark 0 ne { .dicttomark } { pop pop } ifelse
  634.   /XUID [orgXUID 42 curxuid]
  635.   DEBUG {
  636.     tabs { .printtab } forall
  637.     [ sfnts { length } forall ] ==
  638.     count ttkeycount sub array astore dup { == } forall aload pop
  639.   } if
  640.   /sfnts sfnts
  641. } bind def
  642.  
  643. % <glyph> .nname <_name>
  644. /.nname {
  645.   =string cvs (_) exch concatstrings cvn
  646. } bind def
  647.  
  648. % -mark- <key> <value> ... .definettfont <font>
  649. /.definettfont {
  650.   /FontType 42
  651.   /PaintType 0
  652.         % Choose a cmap.
  653.   /cmapglyphs cmaptab cmaparray def
  654.         % See if we have PostScript glyph name information.
  655.   /glyphencoding post null eq {
  656.     [ ]
  657.   } {
  658.     postformats post 0 getu32 .knownget {
  659.       DEBUG {
  660.     (post: format ) print
  661.     post 0 getu16 =only (,) print post 2 getu16 = flush
  662.       } if
  663.       post exch exec
  664.     } {
  665.       [ ]
  666.     } ifelse
  667.   } ifelse def
  668.   DEBUG {
  669.     (numloca=) print numloca =
  670.     (glyphencoding: length=) print glyphencoding dup length = === flush
  671.   } if
  672.         % Hack: if there is no usable post table but the cmap uses
  673.         % the Microsoft Unicode encoding, use ISOLatin1Encoding.
  674.   glyphencoding length 0 eq cmapsub 0 4 getinterval <00030001> eq and {
  675.     /glyphencoding ISOLatin1Encoding dup length array copy def
  676.   } if
  677.         % If necessary, fabricate additional glyphencoding entries
  678.         % to cover all of loca, or truncate glyphencoding.
  679.   glyphencoding length numloca lt {
  680.     /glyphencoding [ glyphencoding aload pop
  681.     counttomark 1 numloca 1 sub { .nname } for ] def
  682.   } {
  683.     /glyphencoding glyphencoding 0 numloca getinterval def
  684.   } ifelse
  685.         % Some badly designed Chinese fonts have a post table
  686.         % in which all glyphs other than 0 are named .null.
  687.         % Use CharStrings to keep track of the reverse map from
  688.         % names to glyphs, and don't let any name be used for
  689.         % more than one glyph.
  690.   /CharStrings glyphencoding dup length dict
  691.     0 1 3 index length 1 sub {
  692.         % Stack: glyphencoding dict index
  693.       2 index 1 index get 2 index 1 index known {
  694.         % The same name maps to more than one glyph.
  695.         % Change the name.
  696.     pop dup .nname 3 index 2 index 2 index put
  697.       } if
  698.       2 index exch 3 -1 roll put
  699.     } for exch pop readonly
  700.   /Encoding
  701.     [ cmapglyphs dup length 256 gt { 0 256 getinterval } if
  702.     { glyphencoding exch get } forall
  703.     counttomark 256 exch sub { /.notdef } repeat ]
  704.   DEBUG { (Encoding: ) print dup === flush } if
  705.   .dicttomark
  706.   end end dup /FontName get exch definefont
  707. } bind def
  708.  
  709. % Create a string with N CIDs from the top of the stack.
  710. % <cid1> ... <cidN> <N> .makecidmap <string>
  711. /.makecidmap {
  712.   dup 2 mul string dup 3 -1 roll 1 sub 2 mul -2 0 {
  713.         % Stack: cids str str i2
  714.     2 copy 5 index -8 bitshift put
  715.     1 add 4 -1 roll 16#ff and put dup
  716.   } for pop
  717. } bind def
  718.  
  719. % -mark- <key> <value> ... .definettcidfont <font>
  720. /.definettcidfont {
  721.   /CIDFontName fontname
  722.   /CIDFontType 2
  723.   /CIDSystemInfo mark
  724.     /Registry (Adobe)
  725.     /Ordering (Japan1)        % adhoc
  726.     /Supplement 0
  727.   .dicttomark
  728.   /CharStrings mark /.notdef 0 .dicttomark
  729.         % The cmap isn't of any use even if it is present.
  730.         % Just construct an identity CIDMap covering all the glyphs.
  731.   mark 0 1 numloca 1 sub { } for
  732.   counttomark /cidcount exch def
  733.   cidcount maxstring le {
  734.         % Use a single string.
  735.     cidcount .makecidmap exch pop
  736.   } {
  737.         % We must use 2 strings.
  738.     maxstring .makecidmap counttomark 1 add 1 roll
  739.     counttomark .makecidmap exch pop exch 2 array astore
  740.   } ifelse
  741.   /CIDMap exch
  742.   /CIDCount cidcount
  743.   /GDBytes 2
  744.   .dicttomark
  745.   end end dup /CIDFontName get exch /CIDFont defineresource
  746. } bind def
  747.  
  748. % <file> .loadttfont <type42font>
  749. /.loadttfont {
  750.   .loadttfonttables
  751.   .makesfnts
  752.   .getcmap
  753.   mark
  754.   .ttkeys
  755.   .definettfont
  756. } bind def
  757.  
  758. % <file> .loadttcidfont <cidtype2font>
  759. /.loadttcidfont {
  760.   .loadttfonttables
  761.   .makesfnts
  762.     % CIDFontType2 fonts don't have a cmap: they are indexed by CID.
  763.   mark
  764.   .ttkeys
  765.   .definettcidfont
  766. } bind def
  767.