home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / APPS / gs403osk.tgz / gs403osk.tar / gs_ttf.ps < prev    next >
Text File  |  1996-09-22  |  15KB  |  443 lines
  1. %    Copyright (C) 1996 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. % Support code for direct use of TrueType fonts.
  19. % (Not needed for Type 42 fonts.)
  20.  
  21. % ---------------- Font loading machinery ---------------- %
  22.  
  23. % Augment the FONTPATH machinery so it recognizes TrueType fonts.
  24.  
  25. /.scanfontheaders where     % only defined if DISKFONTS is recognized
  26.  { pop
  27.    /.scanfontheaders [ .scanfontheaders aload pop (\000\001\000\000*) ] def
  28.  }
  29. if
  30. /.findnonttfontvalue /.findfontvalue load def
  31. /.findfontvalue     % <file> <key> .findfontvalue <value> true
  32.             % <file> <key> .findfontvalue false
  33.             % Closes the file in either case.
  34.  { 1 index read pop 2 index 1 index unread 0 eq
  35.     {       % If this is a font at all, it's a TrueType font.
  36.       dup /FontType eq
  37.        { pop closefile 42 true }
  38.        { dup /FontName eq
  39.       { pop .findttfontname }
  40.       { pop closefile false }
  41.      ifelse
  42.        }
  43.       ifelse
  44.     }
  45.     {       % Not a TrueType font.
  46.       .findnonttfontvalue
  47.     }
  48.    ifelse
  49.  } bind def
  50. /.findttfontname    % <file> .findttfontname <fname> true
  51.             % <file> .findttfontname false
  52.             % Closes the file in either case.
  53.  { .loadttfonttables
  54.    (name) findtableentry
  55.     { dup 8 getu32 f exch setfileposition
  56.       12 getu32 string f exch readstring pop
  57.       6 findname
  58.     }
  59.     { false
  60.     }
  61.    ifelse
  62.    f closefile end end
  63.  } bind def
  64.  
  65. % Load a font file that might be a TrueType font.
  66.  
  67. /.loadnonttfontfile /.loadfontfile load def
  68. /.loadfontfile      % <file> .loadfontfile -
  69.  { dup read pop 2 copy unread 0 eq
  70.     {       % If this is a font at all, it's a TrueType font.
  71.       .loadttfont dup /FontName get exch definefont pop
  72.     }
  73.     {       % Not a TrueType font.
  74.       .loadnonttfontfile
  75.     }
  76.    ifelse
  77.  } bind def
  78.  
  79. % ---------------- Automatic Type 42 generation ---------------- %
  80.  
  81. % Load a TrueType font from a file as a Type 42 PostScript font.
  82. % The thing that makes this really messy is the handling of encodings.
  83. % There are 3 interacting tables that affect the encoding:
  84. %   'cmap' provides multiple maps from character codes to glyph indices
  85. %   'glyf' maps glyph indices to outlines
  86. %   'post' maps glyph indices to glyph names (if present)
  87. % What we need to get out of this is:
  88. %   Encoding mapping character codes to glyph names
  89. %     (the composition of cmap and post)
  90. %   CharStrings mapping glyph names to glyph indices
  91. %     (the inverse of post)
  92. % If the post table is missing, we have to take a guess based on the cmap
  93. % table.
  94.  
  95. /.loadttfontdict mark
  96. /orgXUID 107 def    % Aladdin Enterprises organization XUID
  97. /maxstring 65500 def    % maximum length of a PostScript string
  98.  
  99. % Define the Macintosh standard mapping from characters to glyph indices.
  100. /MacRomanEncoding dup .findencoding def
  101. /MacGlyphEncoding mark
  102.     /.notdef /.null /CR
  103. MacRomanEncoding 32 95 getinterval aload pop
  104. MacRomanEncoding 128 45 getinterval aload pop
  105. % 143
  106.     /notequal /AE
  107.     /Oslash /infinity /plusinus /lessequal /greaterequal
  108.     /yen /mu1 /partialdiff /summation /product
  109.     /pi /integral /ordfeminine /ordmasculine /Ohm
  110.     /ae /oslash /questiondown /exclamdown /logicalnot
  111.     /radical /florin /approxequal /increment /guillemotleft
  112.     /guillemotright /ellipsis /nbspace
  113. MacRomanEncoding 203 12 getinterval aload pop
  114.     /lozenge
  115. MacRomanEncoding 216 24 getinterval aload pop
  116.     /applelogo
  117. MacRomanEncoding 241 7 getinterval aload pop
  118.     /overscore
  119. MacRomanEncoding 249 7 getinterval aload pop
  120. % 226
  121.     /Lslash /lslash /Scaron /scaron
  122.     /Zcaron /zcaron /brokenbar /Eth /eth
  123.     /Yacute /yacute /Thorn /thorn /minus
  124.     /multiply /onesuperior /twosuperior /threesuperior /onehalf
  125.     /onequarter /threequarters /franc /Gbreve /gbreve
  126.     /Idot /Scedilla /scedilla /Cacute /cacute
  127.     /Ccaron /ccaron /dmacron
  128. /packedarray where
  129.  { pop counttomark packedarray exch pop }
  130.  { ] readonly }
  131. ifelse def
  132.  
  133. % Procedures
  134. /getu16         % <string> <index> getu16 <integer>
  135.  { 2 copy get 8 bitshift 3 1 roll 1 add get add
  136.  } bind def
  137. /gets16         % <string> <index> gets16 <integer>
  138.  { getu16 16#8000 xor 16#8000 sub
  139.  } bind def
  140. /getu32         % <string> <index> getu32 <integer>
  141.  { 2 copy getu16 16 bitshift 3 1 roll 2 add getu16 add
  142.  } bind def
  143. /gets32         % <string> <index> gets32 <integer>
  144.  { getu32 dup 16#7fffffff gt { 4 { 16#40000000 sub } repeat } if
  145.  } bind def
  146. /getrange       % <offset> <length> getrange <string>
  147.             % Free variables: sfnts
  148.  { () sfnts
  149.     {       % Stack: offset length () sfnt
  150.       dup length 4 index gt { exch pop exit } if
  151.       4 -1 roll exch length sub 3 1 roll
  152.     }
  153.    forall 3 1 roll getinterval
  154.  } bind def
  155. /findtableentry     % <name4> findtableentry <tableentry> true
  156.             % <name4> findtableentry false
  157.             % Free variables: tables
  158.  { false 0 16 tables length 16 sub
  159.     {       % Stack: name4 false toffset
  160.       tables 1 index 4 getinterval 3 index eq
  161.        { tables exch 16 getinterval
  162.      exch pop exch true exit
  163.        }
  164.       if pop
  165.     }
  166.    for exch pop
  167.  } bind def
  168. /findtable      % <name4> findtable <table> true
  169.             % <name4> findtable false
  170.             % Free variables: tables
  171.  { findtableentry
  172.     { dup 8 getu32 exch 12 getu32 getrange true }
  173.     { false }
  174.    ifelse
  175.  } bind def
  176. /findname       % <nametable> <nameid> findname <string> true
  177.             % <nametable> <nameid> findname false
  178.  { false 3 1 roll 0 1 3 index 2 getu16 1 sub
  179.     {       % Stack: false table id index
  180.       12 mul 6 add 2 index exch 12 getinterval
  181.       dup 6 getu16 2 index eq
  182.        {    % We found the name we want.
  183.      exch pop
  184.         % Stack: false table record
  185.      dup 10 getu16 2 index 4 getu16 add
  186.      1 index 8 getu16 4 -1 roll 3 1 roll getinterval exch
  187.         % Stack: false string record
  188.         % Check for 8- vs. 16-bit characters.
  189.      is2byte { string2to1 } if true null 4 -1 roll exit
  190.        }
  191.       if pop
  192.     }
  193.    for pop pop
  194.  } bind def
  195. /is2byte        % <namerecord> is2byte <bool>
  196.  { dup 0 getu16
  197.     { { pop true }      % Apple Unicode
  198.       { pop false }     % Macintosh Script manager
  199.       { 1 getu16 1 eq }     % ISO
  200.       { 1 getu16 1 eq }     % Microsoft
  201.     }
  202.    exch get exec
  203.  } bind def
  204. /string2to1     % <string2> string2to1 <string>
  205.  { dup length 2 idiv string dup
  206.    0 1 3 index length 1 sub
  207.     { 3 index 1 index 2 mul 1 add get put dup }
  208.    for pop exch pop
  209.  } bind def
  210. /cmapformats mark
  211.         % Each procedure in this dictionary is called as follows:
  212.         %   -mark- encodingtable <<proc>> -mark- glyphindices...
  213.   0     % Apple standard 1-to-1 mapping.
  214.     { 6 256 getinterval { } forall
  215.     } bind
  216.   4     % Microsoft/Adobe segmented mapping.
  217.     { /etab exch def
  218.       /nseg2 etab 6 getu16 def
  219.       14 /endc etab 2 index nseg2 getinterval def
  220.         % The Apple TrueType documentation omits the 2-byte
  221.         % 'reserved pad' that follows the endCount vector!
  222.       2 add
  223.       nseg2 add /startc etab 2 index nseg2 getinterval def
  224.       nseg2 add /iddelta etab 2 index nseg2 getinterval def
  225.       nseg2 add /idroff etab 2 index nseg2 getinterval def
  226.       pop 0 2 nseg2 3 sub
  227.        { /i2 exch def
  228.          /scode startc i2 getu16 def
  229.      counttomark scode 256 min exch sub 0 max { 0 } repeat
  230.      /ecode endc i2 getu16 def
  231.      /delta iddelta i2 getu16 def
  232.      idroff i2 getu16 dup 0 eq
  233.       { pop scode 1 ecode { delta add 65535 and } for
  234.       }
  235.       { % The +2 is for the 'reserved pad'.
  236.         /gloff exch 14 nseg2 3 mul add 2 add i2 add add def
  237.         0 1 ecode scode sub
  238.          { 2 mul gloff add etab exch getu16
  239.            dup 0 ne { delta add 65535 and } if
  240.          }
  241.         for
  242.       }
  243.      ifelse
  244.        }
  245.       for
  246.     } bind
  247.   6     % Single interval lookup.
  248.     { dup 6 getu16 { 0 exch } repeat
  249.       dup 8 getu16 0 exch 1 exch 1 sub
  250.        { 2 mul 10 add 2 copy getu16 exch pop exch }
  251.       repeat pop
  252.     } bind
  253. .dicttomark readonly def        % cmapformats
  254. /cmaparray      % <cmaptab> cmaparray -mark- <glyphs> ...
  255.  { mark exch dup 0 getu16 cmapformats exch .knownget
  256.     { exec }
  257.     { (Can't handle format ) print 0 getu16 = flush
  258.       0 1 255 { } for
  259.     }
  260.    ifelse
  261.  } bind def
  262. /postformats mark
  263.         % Each procedure in this dictionary is called as follows:
  264.         %   posttable <<proc>> glyphencoding
  265.   16#00020000   % Detailed map, required by Microsoft fonts.
  266.     { /postglyphs exch def
  267.       postglyphs 32 getu16 /numglyphs exch def
  268.       /glyphnames numglyphs 2 mul 34 add def
  269.       [ 0 1 numglyphs 1 sub
  270.        { 2 mul 34 add postglyphs exch getu16
  271.      dup 258 lt
  272.       { MacGlyphEncoding exch get
  273.       }
  274.       { 258 sub glyphnames exch
  275.          { postglyphs 1 index get 1 add add }
  276.         repeat
  277.         1 add postglyphs exch 2 copy 1 sub get getinterval cvn
  278.       }
  279.      ifelse
  280.        }
  281.       for ]
  282.     } bind
  283. .dicttomark readonly def        % postformats
  284. .dicttomark readonly def        % .loadttfontdict
  285. /.loadttfonttables  % <file> .loadttfonttables -
  286.             % Pushes .loadttfontdict & scratch dict on d-stack,
  287.             % defines f, offsets, tables
  288.  { .loadttfontdict begin
  289.    40 dict begin
  290.    /f exch def
  291.    /offsets f 12 string readstring pop def
  292.    /tables f offsets 4 getu16 16 mul string readstring pop def
  293.  } bind def
  294. /.makesfnts     % - .makesfnts -
  295.             % Defines head, sfnts
  296.  {      % Find the end of the last table, and also the end of
  297.         % the last table below the 64K mark.
  298.    0 8 16 tables length
  299.     {       % Stack: end toffset
  300.       DEBUG
  301.        { tables 1 index 8 sub 4 getinterval print ( ) print
  302.      tables 1 index getu32 =only ( ) print
  303.      tables 1 index 4 add getu32 =
  304.        }
  305.       if
  306.       tables 1 index getu32 exch tables exch 4 add getu32 add max
  307.     }
  308.    for
  309.         % Divide into 2+n strings: before glyf, glyfs, after glyf
  310.    (glyf) findtableentry pop
  311.    dup 8 getu32 /len0 exch def
  312.    12 getu32 /len1 exch def
  313.    len0 len1 add sub /len2 exch def
  314.    /sfnts [
  315.    len0 string
  316.      dup 0 offsets putinterval
  317.      dup offsets length tables putinterval
  318.      dup offsets length tables length add
  319.        len0 1 index sub getinterval
  320.        f exch dup length 0 ne { readstring } if pop pop
  321.    len1 dup maxstring gt
  322.     {       % Bad news: we'll have to split the glyfs.
  323.         % Right now we only provide for splitting into 2 parts,
  324.         % but we could generalize this without too much trouble.
  325.       f maxstring string readstring pop
  326.       exch maxstring sub
  327.     }
  328.    if string f exch readstring pop
  329.    len2 0 ne { f len2 string readstring pop } if
  330.    ] def
  331.    /head (head) findtable pop def
  332.    len1 maxstring gt
  333.     {       % Determine where to split the glyfs by scanning loca.
  334.         % The very last entry in loca may be bogus.
  335.         % What a nuisance!
  336.       (loca) findtable pop dup length
  337.       head 50 getu16 0 ne
  338.        {    % 32-bit loca
  339.      8 sub -4 0
  340.       { 1 index exch getu32 dup maxstring le { exch pop exit } if pop }
  341.        }
  342.        {    % 16-bit loca
  343.      4 sub -2 0
  344.       { 1 index exch getu16 1 bitshift dup maxstring le { exch pop exit } if pop }
  345.        }
  346.       ifelse for
  347.         % Now the top element of the stack is the length of
  348.         % the first glyf string.
  349.       sfnts 1 get dup 0 3 index getinterval
  350.     sfnts exch 1 exch put
  351.       exch 1 index length 1 index sub getinterval
  352.     sfnts 2 get concatstrings sfnts exch 2 exch put
  353.     }
  354.    if
  355.  } bind def
  356. /.loadttfont        % <file> .loadttfont <type42font>
  357.  { .loadttfonttables
  358.    .makesfnts
  359.    /upem head 18 getu16 def
  360.    (cmap) findtable pop
  361.         % The Apple cmap format is no help in determining the encoding.
  362.         % Look for a Microsoft table.  If we can't find one,
  363.         % just use the first table, whatever it is.
  364.    dup 4 8 getinterval exch     % the default
  365.    0 1 2 index 2 getu16 1 sub
  366.     { 8 mul 4 add 1 index exch 8 getinterval
  367.       dup 0 getu16 3 eq { exch 3 -1 roll pop exit } if pop
  368.     }
  369.    for
  370.         % Stack: subentry table
  371.    /cmapsub 2 index def
  372.    exch 4 getu32 1 index length 1 index sub getinterval
  373.    /cmaptab exch def
  374.         % See if we have PostScript glyph name information.
  375.    /post (post) findtable pop def
  376.    /glyphencoding postformats post 0 getu32 .knownget
  377.     { post exch exec }
  378.     { MacGlyphEncoding }
  379.    ifelse def
  380.    /checksum head 8 getu32 def
  381.    mark
  382.      /FontType 42
  383.      /FontMatrix matrix
  384.      /PaintType 0
  385.      /FontBBox [ 36 2 42 { head exch gets16 upem div } for ]
  386.      (name) findtable
  387.       {     % Find the names from the 'name' table.
  388.     /names exch def
  389.     /FontName names 6 findname not { checksum 16 8 string cvrs } if
  390.     /FontInfo mark
  391.       names 0 findname { /Notice exch } if
  392.       names 1 findname { /FamilyName exch } if
  393.       names 4 findname { /FullName exch } if
  394.       names 5 findname { /Version exch } if
  395.       }
  396.       {     % No name table, fabricate a FontName.
  397.     /FontName checksum 16 8 string cvrs
  398.     /FontInfo mark
  399.       }
  400.      ifelse
  401.         % Stack: /FontInfo mark key1 value1 ...
  402.      post null ne
  403.       { /ItalicAngle post 4 gets32 65536.0 div
  404.     /isFixedPitch post 12 getu32 0 ne
  405.     /UnderlinePosition post 8 gets16 upem div
  406.     /UnderlineThickness post 10 gets16 upem div
  407.       }
  408.      if
  409.      counttomark 0 ne
  410.       { .dicttomark }
  411.       { pop pop }
  412.      ifelse
  413.      /Encoding
  414.        cmaptab cmaparray
  415.         % For some reason, the Symbol and WingDing fonts start with
  416.         % 192 unmapped character codes.
  417.        counttomark 384 ge
  418.     { counttomark 256 sub /skip exch def
  419.       counttomark skip neg roll skip { pop } repeat
  420.     }
  421.        if
  422.        counttomark array astore { glyphencoding exch get } forall
  423.        counttomark 256 sub dup 0 ge
  424.     { { pop } repeat }
  425.     { neg { /.notdef } repeat }
  426.        ifelse ]
  427.         % Until we can compute the MD5 fingerprint,
  428.         % just use the precomputed checksum.
  429.      /XUID [orgXUID 42 checksum]
  430.      /CharStrings glyphencoding dup length dict
  431.        0 1 3 index length 1 sub
  432.     {   % Stack: glyphencoding dict index
  433.       2 index 1 index get 2 index 1 index known
  434.        { pop pop }
  435.        { 2 index exch 3 -1 roll put }
  436.       ifelse
  437.     }
  438.        for exch pop readonly
  439.      /sfnts sfnts
  440.    .dicttomark
  441.    end end dup /FontName get exch definefont
  442.  } bind def
  443.