home *** CD-ROM | disk | FTP | other *** search
/ swCHIP 1991 January / swCHIP_95-1.bin / utility / gs333ini / gs3.33 / gs_type1.ps < prev    next >
Text File  |  1995-12-09  |  15KB  |  433 lines

  1. %    Copyright (C) 1994, 1995 Aladdin Enterprises.  All rights reserved.
  2. % This file is part of Aladdin Ghostscript.
  3. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  4. % or distributor accepts any responsibility for the consequences of using it,
  5. % or for whether it serves any particular purpose or works at all, unless he
  6. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  7. % License (the "License") for full details.
  8. % Every copy of Aladdin Ghostscript must include a copy of the License,
  9. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  10. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  11. % under certain conditions described in the License.  Among other things, the
  12. % License requires that the copyright notice and this notice be preserved on
  13. % all copies.
  14.  
  15. % Type 1 font support code.
  16.  
  17. % The standard representation for PostScript compatible fonts is described
  18. % in the book "Adobe Type 1 Font Format", published by Adobe Systems Inc.
  19.  
  20. % Define an augmented version of .buildfont1 that inserts UnderlinePosition
  21. % and UnderlineThickness entries in FontInfo if they aren't there already.
  22. % (This works around the incorrect assumption, made by many word processors,
  23. % that these entries are present in the built-in fonts.)
  24. /.buildfont1
  25.  { dup /FontInfo known not
  26.     { .growfontdict dup /FontInfo 2 dict put }
  27.    if
  28.    dup dup /FontInfo get dup dup
  29.    /UnderlinePosition known exch /UnderlineThickness known and
  30.     { pop pop        % entries already present
  31.     }
  32.     { dup length 2 add dict copy
  33.       dup /UnderlinePosition known not
  34.        { dup /UnderlinePosition 3 index /FontBBox get
  35.          1 get 2 div put        % 1/2 the font descent
  36.        }
  37.       if
  38.       dup /UnderlineThickness known not
  39.        { dup /UnderlineThickness 3 index /FontBBox get
  40.          dup 3 get exch 1 get sub 20 div put    % 1/20 the font height
  41.        }
  42.       if
  43.       1 index /FontInfo get wcheck not { readonly } if
  44.       /FontInfo exch put
  45.     }
  46.    ifelse //.buildfont1
  47.  } bind def
  48.  
  49. % If DISKFONTS is true, we load individual CharStrings as they are needed.
  50. % (This is intended primarily for machines with very small memories.)
  51. % Initially, the character definition is the file position of the definition;
  52. % this gets replaced with the actual CharString.
  53. % Note that if we are loading characters lazily, CharStrings is writable.
  54.  
  55. % _Cstring must be long enough to hold the longest CharString for
  56. % a character defined using seac.  This is lenIV + 4 * 5 (for the operands
  57. % of sbw, assuming div is not used) + 2 (for sbw) + 3 * 5 (for the operands
  58. % of seac other than the character codes) + 2 * 2 (for the character codes)
  59. % + 2 (for seac), i.e., lenIV + 43.
  60.  
  61. /_Cstring 60 string def
  62.  
  63. % When we initially load the font, we call
  64. %    <index|charname> <length> <readproc> cskip_C
  65. % to skip over each character definition and return the file position instead.
  66. % This substitutes for the procedure
  67. %    <index|charname> <length> string currentfile exch read[hex]string pop
  68. %      [encrypt]
  69. % What we actually store is fileposition * 1000 + length,
  70. %   negated if the string is stored in binary form.
  71.  
  72. % Older fonts use skip_C rather than cskip_C.
  73. % skip_C takes /readstring or /readhexstring as its third argument,
  74. % instead of the entire reading procedure.
  75. /skipproc_C {string currentfile exch readstring pop} cvlit def
  76. /skip_C
  77.  { //skipproc_C dup 3 4 -1 roll put cvx readonly cskip_C
  78.  } bind def
  79. /cskip_C
  80.  { exch dup 1000 ge 3 index type /nametype ne or
  81.     { % This is a Subrs string, or the string is so long we can't represent
  82.       % its length.  Load it now.
  83.       exch exec
  84.     }
  85.     { % Record the position and length, and skip the string.
  86.       dup currentfile fileposition 1000 mul add
  87.       2 index 3 get /readstring cvx eq { neg } if
  88.       3 1 roll
  89.       dup _Cstring length idiv
  90.        { currentfile _Cstring 3 index 3 get exec pop pop
  91.        } repeat
  92.       _Cstring length mod _Cstring exch 0 exch getinterval
  93.       currentfile exch 3 -1 roll 3 get exec pop pop
  94.     }
  95.    ifelse
  96.  } bind def
  97.  
  98. % Type1BuildGlyph calls load_C to actually load the character definition.
  99.  
  100. /load_C        % <charname> <fileposandlength> load_C -
  101.  { dup abs 1000 idiv FontFile exch setfileposition
  102.    CharStrings 3 1 roll
  103.    dup 0 lt
  104.     { neg 1000 mod string FontFile exch readstring }
  105.     { 1000 mod string FontFile exch readhexstring }
  106.    ifelse pop
  107. % If the CharStrings aren't encrypted on the file, encrypt now.
  108.    Private /-| get 0 get
  109.    dup type /nametype ne { dup length 5 sub 5 exch getinterval exec } { pop } ifelse
  110.    dup 4 1 roll put
  111. % If the character is defined with seac, load its components now.
  112.    mark exch seac_C
  113.    counttomark
  114.     { StandardEncoding exch get dup CharStrings exch get
  115.       dup type /integertype eq { load_C } { pop pop } ifelse
  116.     } repeat
  117.    pop        % the mark
  118.  } bind def
  119.  
  120. /seac_C        % <charstring> seac_C <achar> <bchar> ..or nothing..
  121.  { dup length _Cstring length le
  122.     { 4330 exch _Cstring .type1decrypt exch pop
  123.       dup dup length 2 sub 2 getinterval <0c06> eq    % seac
  124.        { dup length
  125.          Private /lenIV known { Private /lenIV get } { 4 } ifelse
  126.      exch 1 index sub getinterval
  127. % Parse the string just enough to extract the seac information.
  128. % We assume that the only possible operators are hsbw, sbw, and seac,
  129. % and that there are no 5-byte numbers.
  130.      mark 0 3 -1 roll
  131.       { exch
  132.          { { dup 32 lt
  133.               { pop 0 }
  134.           { dup 247 lt
  135.              { 139 sub 0 }
  136.              { dup 251 lt
  137.             { 247 sub 256 mul 108 add 1 1 }
  138.             { 251 sub -256 mul -108 add -1 1 }
  139.                ifelse
  140.              }
  141.             ifelse
  142.           }
  143.          ifelse
  144.            }            % 0
  145.            { mul add 0 }        % 1
  146.          }
  147.         exch get exec
  148.       }
  149.      forall pop
  150.      counttomark 1 add 2 roll cleartomark    % pop all but achar bchar
  151.        }
  152.        { pop    % not seac
  153.        }
  154.       ifelse
  155.     }
  156.     { pop    % punt
  157.     }
  158.    ifelse
  159.  } bind def
  160.  
  161. % Define an auxiliary procedure for loading a font.
  162. % If DISKFONTS is true and the body of the font is not encrypted with eexec:
  163. %    - Prevent the CharStrings from being made read-only.
  164. %    - Substitute a different CharString-reading procedure.
  165. % (eexec disables this because the implicit 'systemdict begin' hides
  166. % the redefinitions that make the scheme work.)
  167. % We assume that:
  168. %    - The magic procedures (-|, -!, |-, and |) are defined with
  169. %    executeonly or readonly;
  170. %    - The contents of the reading procedures are as defined in bdftops.ps;
  171. %    - The font includes the code
  172. %    <font> /CharStrings <CharStrings> readonly put
  173. /.loadfontdict 6 dict def mark
  174.  /begin            % push this dict after systemdict
  175.   { dup begin
  176.     //systemdict eq { //.loadfontdict begin } if
  177.   } bind
  178.  /end            % match begin
  179.   { currentdict end
  180.     //.loadfontdict eq currentdict //systemdict eq and { end } if
  181.   } bind
  182.  /dict            % leave room for FontFile
  183.   { 1 add dict
  184.   } bind
  185.  /executeonly        % for reading procedures
  186.   { readonly
  187.   }
  188.  /noaccess        % for Subrs strings and Private dictionary
  189.   { readonly
  190.   }
  191.  /readonly        % for procedures and CharStrings dictionary
  192.   {    % We want to take the following non-standard actions here:
  193.       %   - If the operand is the CharStrings dictionary, do nothing;
  194.     %   - If the operand is a number (a file position replacing the
  195.     %    actual CharString), do nothing;
  196.     %   - If the operand is either of the reading procedures (-| or -!),
  197.     %    substitute a different one.
  198.     dup type /dicttype eq        % CharStrings or Private
  199.     count 2 gt and
  200.      { 1 index /CharStrings ne { readonly } if }
  201.      { dup type /arraytype eq        % procedure or data array
  202.     { dup length 5 ge 1 index xcheck and
  203.        { dup 0 get /string eq
  204.          1 index 1 get /currentfile eq and
  205.          1 index 2 get /exch eq and
  206.          1 index 3 get dup /readstring eq exch /readhexstring eq or and
  207.          1 index 4 get /pop eq and
  208.           { /cskip_C cvx 2 packedarray cvx
  209.           }
  210.           { readonly
  211.           }
  212.          ifelse
  213.        }
  214.        { readonly
  215.        }
  216.       ifelse
  217.     }
  218.     { dup type /stringtype eq    % must be a Subr string
  219.        { readonly }
  220.       if
  221.     }
  222.        ifelse
  223.      }
  224.     ifelse
  225.   } bind
  226. counttomark 2 idiv { .loadfontdict 3 1 roll put } repeat pop
  227. .loadfontdict readonly pop
  228. /.loadfont        % <file> .loadfont -
  229.  { mark exch systemdict begin
  230.    DISKFONTS { .loadfontdict begin } if
  231.    % We really would just like systemdict on the stack,
  232.    % but fonts produced by Fontographer require a writable dictionary....
  233.    userdict begin
  234.     % We can't just use `run', because we want to check for .PFB files.
  235.    currentpacking
  236.     { false setpacking .loadfont1 true setpacking }
  237.     { .loadfont1 }
  238.    ifelse
  239.     { stop } if
  240.    end
  241.    DISKFONTS { end } if
  242.    end cleartomark
  243.  } bind def
  244. /.loadfont1        % <file> .loadfont1 <errorflag>
  245.  {    % We would like to use `false /PFBDecode filter',
  246.     % but this occasionally produces a whitespace character as
  247.     % the first of an eexec section, so we can't do it.
  248.     % Also, since the real input file never reaches EOF if we are using
  249.     % a PFBDecode filter (the filter stops just after reading the last
  250.     % character), we must explicitly close the real file in this case.
  251.     % Since the file might leave garbage on the operand stack,
  252.     % we have to create a procedure to close the file reliably.
  253.     { dup read not { -1 } if
  254.       2 copy unread 16#80 eq
  255.        { [ exch dup true /PFBDecode filter cvx exch cvlit
  256.          systemdict /closefile get ]
  257.        }
  258.       if cvx exec
  259.     } stopped
  260.    $error /newerror get and
  261.  } bind def
  262.  
  263.  
  264. % The CharStrings are a dictionary in which the key is the character name,
  265. % and the value is a compressed and encrypted representation of a path.
  266. % For detailed information, see the book "Adobe Type 1 Font Format",
  267. % published by Adobe Systems Inc.
  268.  
  269. % Here are the BuildChar and BuildGlyph implementation for Type 1 fonts.
  270. % The names Type1BuildChar and Type1BuildGlyph are known to the interpreter.
  271.  
  272. /Type1BuildChar        % <font> <code> Type1BuildChar -
  273.  { 1 index /Encoding get 1 index get .type1build
  274.  } bind def
  275. /Type1BuildGlyph    % <font> <name> Type1BuildGlyph -
  276.  { dup .type1build
  277.  } bind def
  278. /.type1build        % <font> <code|name> <name> .type1build -
  279.  { 3 -1 roll begin
  280.     dup CharStrings exch .knownget not
  281.      { 2 copy eq { exch pop /.notdef exch } if
  282.        QUIET not
  283.     { (Substituting .notdef for ) print = flush }
  284.     { pop }
  285.        ifelse
  286.        /.notdef CharStrings /.notdef get
  287.      } if
  288.     % stack: codename charname charstring
  289.     PaintType 0 ne
  290.      {    % Any reasonable implementation would execute something like
  291.     %    1 setmiterlimit 0 setlinejoin 0 setlinecap
  292.     % here, but apparently the Adobe implementations aren't reasonable.
  293.        currentdict /StrokeWidth .knownget not { 0 } if
  294.        setlinewidth
  295.      } if
  296.     dup type /stringtype eq        % encoded outline
  297.      { 3 -1 roll pop 0 0 moveto outline_C
  298.      }
  299.      { dup type /integertype eq        % file position for lazy loading
  300.     { 3 -1 roll pop
  301.       1 index exch load_C dup CharStrings exch get
  302.       0 0 moveto outline_C
  303.     }
  304.     {                % PostScript procedure
  305.       exch pop
  306.       currentdict end systemdict begin begin   exec   end
  307.     }
  308.        ifelse
  309.      }
  310.     ifelse
  311.    end
  312.  } bind def
  313.  
  314. % Expand the bounding box before calling setcachedevice.
  315. % Because of square caps and miter joins, the maximum expansion on each side
  316. % is max(sqrt(2), miter_limit) * line_width/2.
  317. % (setcachedevice adds the necessary 1- or 2-pixel fuzz.)
  318. /expandbox_C        % <llx> <lly> <urx> <ury> expandbox_C <...ditto...>
  319.  { PaintType 0 ne
  320.     { 1.415 currentmiterlimit max currentlinewidth mul 2 div
  321.             % llx lly urx ury exp
  322.       5 1 roll 4 index add
  323.             % exp llx lly urx ury+
  324.       5 1 roll 3 index add
  325.             % ury+ exp llx lly urx+
  326.       5 1 roll 2 index sub
  327.             % urx+ ury+ exp llx lly-
  328.       5 1 roll exch sub
  329.             % lly- urx+ ury+ llx-
  330.       4 1 roll
  331.     }
  332.    if
  333.  } bind def
  334.  
  335. % Make the call on setcachedevice a separate procedure, so we can redefine it
  336. % if the composite font extensions are present.
  337. /setcache_C where        % gs_type0.ps might be loaded first!
  338.  { pop }
  339.  { /setcache_C { setcachedevice pop } bind def }
  340. ifelse
  341.  
  342. /outline_C        % <charname> <charstring> outline_C -
  343.  {    % In order to make character oversampling work, we must
  344.     % set up the cache before calling .type1addpath.
  345.     % To do this, we must get the bounding box from the FontBBox,
  346.     % and the width and left side bearing from the CharString.
  347.     % (If the FontBBox isn't valid, we punt.)
  348.    currentdict /FontBBox .knownget
  349.     { dup length 4 eq
  350.        { aload pop
  351.      dup 3 index gt 2 index 5 index gt and
  352.       { bbox_C }
  353.       { pop pop pop pop nobbox_C }
  354.      ifelse
  355.        }
  356.        { pop nobbox_C
  357.        }
  358.       ifelse
  359.     }
  360.     { nobbox_C
  361.     }
  362.    ifelse
  363.    PaintType 0 eq { fill } { stroke } ifelse
  364.  } bind def
  365.  
  366. % Handle the case where FontBBox is not valid.
  367. % In this case, we do the .type1addpath first, then the setcachedevice.
  368. % Oversampling is not possible.
  369. /nobbox_C        % <charname> <charstring> nobbox_C -
  370.  { currentdict /Metrics .knownget
  371.     { 2 index .knownget
  372.        { dup type dup /integertype eq exch /realtype eq or
  373.           {    % <wx>
  374.         exch .type1addpath 0
  375.       }
  376.       { dup length 2 eq
  377.          {    % [<sbx> <wx>]
  378.            exch 1 index 0 get 0 .type1addpath
  379.            1 get 0
  380.          }
  381.          {    % [<sbx> <sby> <wx> <wy>]
  382.            aload pop 5 2 roll .type1addpath
  383.          }
  384.         ifelse
  385.       }
  386.      ifelse
  387.        }
  388.        { .type1addpath currentpoint
  389.        }
  390.       ifelse
  391.     }
  392.     { .type1addpath currentpoint
  393.     }
  394.    ifelse        % stack: wx wy
  395.    pathbbox expandbox_C setcache_C
  396.  } bind def
  397.  
  398. % Handle the case where FontBBox is valid.
  399. /bbox_C            % <charname> <charstring> <llx> ... <ury> bbox_C -
  400.  {    % Get the width and l.s.b. by parsing the CharString.
  401.     % This isn't needed if we have a 4-element Metrics array,
  402.     % but those are rare.
  403.    4 index .type1getsbw
  404.             % stack: cname cstring llx lly urx ury sbx sby wx wy
  405.    currentdict /Metrics .knownget
  406.     { 10 index .knownget
  407.        { dup type dup /integertype eq exch /realtype eq or
  408.           {    % <wx>
  409.         exch pop exch pop 0
  410.       }
  411.       { 5 1 roll pop pop pop pop
  412.         dup length 2 eq
  413.          {    % [<sbx> <wx>]
  414.            aload pop 0 exch 0
  415.          }
  416.          {    % [<sbx> <sby> <wx> <wy>]
  417.            aload pop
  418.          }
  419.         ifelse
  420.       }
  421.      ifelse
  422.        }
  423.       if
  424.     }
  425.    if
  426.    8 4 roll expandbox_C
  427.    9 index 7 1 roll setcache_C
  428.    .type1addpath pop
  429.  } bind def
  430.