home *** CD-ROM | disk | FTP | other *** search
/ PC World 2001 September / PCWorld_2001-09_cd.bin / Software / Vyzkuste / rychlokurz / gs700w32.exe / gs7.00 / lib / gs_fonts.ps < prev    next >
Text File  |  2001-04-06  |  34KB  |  1,043 lines
  1. %    Copyright (C) 1990, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of AFPL Ghostscript.
  4. % 
  5. % AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author or
  6. % distributor accepts any responsibility for the consequences of using it, or
  7. % for whether it serves any particular purpose or works at all, unless he or
  8. % she says so in writing.  Refer to the Aladdin Free Public License (the
  9. % "License") for full details.
  10. % 
  11. % Every copy of AFPL Ghostscript must include a copy of the License, normally
  12. % in a plain ASCII text file named PUBLIC.  The License grants you the right
  13. % to copy, modify and redistribute AFPL Ghostscript, but only under certain
  14. % conditions described in the License.  Among other things, the License
  15. % requires that the copyright notice and this notice be preserved on all
  16. % copies.
  17.  
  18. % $Id: gs_fonts.ps,v 1.11 2001/04/07 01:07:01 alexcher Exp $
  19. % Font initialization and management code.
  20.  
  21. % Define the default font.
  22. /defaultfontname /Courier def
  23.  
  24. % Define the name of the font map file.
  25. /defaultfontmap (Fontmap) def
  26.  
  27. % ------ End of editable parameters ------ %
  28.  
  29. % Define the UniqueIDs and organization XUID assigned to Aladdin.
  30. % UniqueIDs 5,066,501 - 5,066,580 are assigned as follows:
  31. %   01 and 02 for shareware Cyrillic
  32. %   33 through 67 for Type 1 versions of the Hershey fonts
  33. % UniqueIDs 5,115,501 - 5,115,600 are currently unassigned.
  34. /AladdinEnterprisesXUID 107 def
  35.  
  36. % If SUBSTFONT is defined, make it the default font.
  37. /SUBSTFONT where { pop /defaultfontname /SUBSTFONT load def } if
  38.  
  39. % Define a reliable way of accessing FontDirectory in systemdict.
  40. /.FontDirectory
  41. { /FontDirectory .systemvar
  42. } .bind odef
  43.  
  44. % If DISKFONTS is true, we load individual CharStrings as they are needed.
  45. % (This is intended primarily for machines with very small memories.)
  46. % In this case, we define another dictionary, parallel to FontDirectory,
  47. % that retains an open file for every font loaded.
  48. /FontFileDirectory 10 dict def
  49.  
  50. % Define a temporary string for local use, since using =string
  51. % interferes with some PostScript programs.
  52. /.fonttempstring 128 string def
  53.  
  54. % Split up a search path into individual directories or files.
  55. /.pathlist        % <path> .pathlist <dir1|file1> ...
  56.  {  { dup length 0 eq { pop exit } if
  57.       .filenamelistseparator search not { exit } if
  58.       exch pop exch
  59.     }
  60.    loop
  61.  } bind def
  62.  
  63. % Load a font name -> font file name map.
  64. userdict /Fontmap .FontDirectory maxlength dict put
  65. /.loadFontmap {        % <file> .loadFontmap -
  66.         % We would like to simply execute .definefontmap as we read,
  67.         % but we have to maintain backward compatibility with an older
  68.         % specification that makes later entries override earlier
  69.         % ones within the same file.
  70.    50 dict exch .readFontmap
  71.     { .definefontmap } forall
  72. } bind def
  73. /.readFontmap {        % <dict> <file> .readFontmap <dict>
  74.     { dup token not { closefile exit } if
  75.         % stack: dict file fontname
  76.       % This is a hack to get around the absurd habit of MS-DOS editors
  77.       % of adding an EOF character at the end of the file.
  78.       dup (\032) eq { pop closefile exit } if
  79.       1 index token not
  80.        { (Fontmap entry for ) print dup =only
  81.      ( has no associated file or alias name!  Giving up.) = flush
  82.      {.readFontmap} 0 get 1 .quit
  83.        } if
  84.       dup type dup /stringtype eq exch /nametype eq or not
  85.        { (Fontmap entry for ) print 1 index =only
  86.      ( has an invalid file or alias name!  Giving up.) = flush
  87.      {.readFontmap} 0 get 1 .quit
  88.        } if
  89.         % stack: dict file fontname filename|aliasname
  90.       1 index type /stringtype eq
  91.       1 index type /nametype eq and 1 index xcheck and
  92.       1 index /run eq 2 index /.runlibfile eq or and {
  93.         % This is an inclusion entry.
  94.     pop findlibfile { exch pop } { file } ifelse
  95.     2 index exch .readFontmap pop
  96.       } {
  97.         % This is a real entry.
  98.         % Read and pop tokens until a semicolon.
  99.        { 2 index token not
  100.       { (Fontmap entry for ) print 1 index =only
  101.         ( ends prematurely!  Giving up.) = flush
  102.         {.loadFontmap} 0 get 1 .quit
  103.       } if
  104.      dup /; eq { pop 3 index 3 1 roll .growput exit } if
  105.      pop
  106.        } loop
  107.       } ifelse
  108.     } loop
  109. } bind def
  110. % Add an entry in Fontmap.  We redefine this if the Level 2
  111. % resource machinery is loaded.
  112. /.definefontmap            % <fontname> <file|alias> .definefontmap -
  113.  {        % Since Fontmap is global, make sure the values are storable.
  114.    .currentglobal 3 1 roll true .setglobal
  115.    dup type /stringtype eq
  116.     { dup .gcheck not { dup length string copy } if
  117.     }
  118.    if
  119.    Fontmap 3 -1 roll 2 copy .knownget
  120.     {        % Add an element to the end of the existing value,
  121.         % unless it's the same as the current last element.
  122.       mark exch aload pop counttomark 4 add -1 roll
  123.       2 copy eq { cleartomark pop pop } { ] readonly .growput } ifelse
  124.     }
  125.     {        % Make a new entry.
  126.       mark 4 -1 roll ] readonly .growput
  127.     }
  128.    ifelse .setglobal
  129.  } bind def
  130.  
  131. % Parse a font file just enough to find the FontName or FontType.
  132. /.findfontvalue {    % <file> <key> .findfontvalue <value> true
  133.             % <file> <key> .findfontvalue false
  134.             % Closes the file in either case.
  135.   exch dup read not { -1 } if
  136.   2 copy unread 16#80 eq {
  137.     dup (xxxxxx) readstring pop pop        % skip .PFB header
  138.   } if
  139.   {        % Stack: key file
  140.         % Protect ourselves against syntax errors here.
  141.     dup { token } stopped { pop false exit } if
  142.     not { false exit } if        % end of file
  143.     dup /eexec eq { pop false exit } if        % reached eexec section
  144.     dup /Subrs eq { pop false exit } if        % Subrs without eexec
  145.     dup /CharStrings eq { pop false exit } if    % CharStrings without eexec
  146.     dup 3 index eq
  147.      { xcheck not { dup token exit } if }    % found key
  148.      { pop }
  149.     ifelse
  150.   } loop
  151.         % Stack: key file value true   (or)
  152.         % Stack: key file false
  153.   dup { 4 } { 3 } ifelse -2 roll closefile pop
  154. } bind def
  155. /.findfontname
  156.  { /FontName .findfontvalue
  157.  } bind def
  158.  
  159. % If there is no FONTPATH, try to get one from the environment.
  160. NOFONTPATH { /FONTPATH () def } if
  161. /FONTPATH where
  162.  { pop }
  163.  { /FONTPATH (GS_FONTPATH) getenv not { () } if def }
  164. ifelse
  165. FONTPATH length 0 eq { (%END FONTPATH) .skipeof } if
  166. /FONTPATH [ FONTPATH .pathlist ] def
  167.  
  168. % Scan directories looking for plausible fonts.  "Plausible" means that
  169. % the file begins with %!PS-AdobeFont or %!FontType1, or with \200\001
  170. % followed by four arbitrary bytes and then either of these strings.
  171. % To speed up the search, we skip any file whose name appears in
  172. % the Fontmap (with any extension and upper/lower case variation) already,
  173. % and any file whose extension definitely indicates it is not a font.
  174. %
  175. % NOTE: The current implementation of this procedure is somewhat Unix/DOS-
  176. % specific.  It assumes that '/' and '\' are directory separators, and that
  177. % the part of a file name following the last '.' is the extension.
  178. %
  179. /.lowerstring        % <string> .lowerstring <lowerstring>
  180.  { 0 1 2 index length 1 sub
  181.     { 2 copy get dup 65 ge exch 90 le and
  182.        { 2 copy 2 copy get 32 add put }
  183.      if pop
  184.     }
  185.    for
  186.  } bind def
  187. /.splitfilename {    % <dir.../base.extn> .basename <base> <extn>
  188.         % Make the file name read-only to detect aliasing bugs.
  189.         % We really don't like doing this, but we've had one
  190.         % such bug already.
  191.   readonly {
  192.     (/) search { true } { (\\) search } ifelse { pop pop } { exit } ifelse
  193.   } loop
  194.   dup { (.) search { pop pop } { exit } ifelse } loop
  195.   2 copy eq {
  196.     pop ()
  197.   } {
  198.     exch dup length 2 index length 1 add sub 0 exch getinterval exch
  199.   } ifelse
  200. } bind def
  201. /.scanfontdict 1 dict def        % establish a binding
  202. /.scanfontbegin
  203.  {    % Construct the table of all file names already in Fontmap.
  204.    currentglobal true setglobal
  205.    .scanfontdict dup maxlength Fontmap length 2 add .max .setmaxlength
  206.    Fontmap
  207.     { exch pop
  208.        { dup type /stringtype eq
  209.       { .splitfilename pop .fonttempstring copy .lowerstring cvn
  210.         .scanfontdict exch true put
  211.       }
  212.       { pop
  213.       }
  214.      ifelse
  215.        }
  216.       forall
  217.     }
  218.    forall
  219.    setglobal
  220.  } bind def
  221. /.scanfontskip mark
  222.         % Strings are converted to names anyway, so....
  223.   /afm true
  224.   /bat true
  225.   /c true
  226.   /cmd true
  227.   /com true
  228.   /dir true
  229.   /dll true
  230.   /doc true
  231.   /drv true
  232.   /exe true
  233.   /fon true
  234.   /fot true
  235.   /h true
  236.   /o true
  237.   /obj true
  238.   /pfm true
  239.   /pss true        % Adobe Multiple Master font instances
  240.   /txt true
  241. .dicttomark def
  242. /.scan1fontstring 128 string def
  243. % %%BeginFont: is not per Adobe documentation, but a few fonts have it.
  244. /.scanfontheaders [(%!PS-Adobe*) (%!FontType*) (%%BeginFont:*)] def
  245. 0 .scanfontheaders { length max } forall 6 add    % extra for PFB header
  246. /.scan1fontfirst exch string def
  247. /.scanfontdir        % <dirname> .scanfontdir -
  248.  { currentglobal exch true setglobal
  249.    QUIET not { (Scanning ) print dup print ( for fonts...) print flush } if
  250.    (*) 2 copy .filenamedirseparator
  251.    dup (\\) eq { pop (\\\\) } if    % double \ for pattern match
  252.    exch concatstrings concatstrings
  253.    0 0 0 4 -1 roll    % found scanned files
  254.     {        % stack: <fontcount> <scancount> <filecount> <filename>
  255.       exch 1 add exch                   % increment filecount
  256.       dup .splitfilename .fonttempstring copy .lowerstring
  257.         % stack: <fontcount> <scancount> <filecount+1> <filename>
  258.         %    <BASE> <ext>
  259.       .scanfontskip exch known exch .scanfontdict exch known or
  260.        { pop
  261.         % stack: <fontcount> <scancount> <filecount+1>
  262.        }
  263.        { 3 -1 roll 1 add 3 1 roll
  264.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  265.      dup (r) { file } .internalstopped
  266.       { pop pop null ()
  267.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  268.         %    null ()
  269.       }
  270.       {
  271.         % On some platforms, the file operator will open directories,
  272.         % but an error will occur if we try to read from one.
  273.         % Handle this possibility here.
  274.         dup .scan1fontfirst { readstring } .internalstopped
  275.          { pop pop () }
  276.          { pop }
  277.         ifelse
  278.         % stack: <fontcount> <scancount+1> <filecount+1>
  279.         %    <filename> <file> <header>
  280.       }
  281.      ifelse
  282.         % Check for PFB file header.
  283.      dup (\200\001????*) .stringmatch
  284.       { dup length 6 sub 6 exch getinterval }
  285.      if
  286.         % Check for font file headers.
  287.      false .scanfontheaders
  288.       { 2 index exch .stringmatch or
  289.       }
  290.      forall exch pop
  291.       {    % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  292.         %    <file>
  293.         dup 0 setfileposition .findfontname
  294.          { dup Fontmap exch known
  295.         { pop pop
  296.         }
  297.         { exch copystring exch
  298.           DEBUG { ( ) print dup =only flush } if
  299.           1 index .definefontmap
  300.           .splitfilename pop true .scanfontdict 3 1 roll .growput
  301.             % Increment fontcount.
  302.           3 -1 roll 1 add 3 1 roll
  303.         }
  304.            ifelse
  305.          }
  306.          { pop
  307.          }
  308.         ifelse
  309.       }
  310.         % .findfontname will have done a closefile in the above case.
  311.       { dup null eq { pop } { closefile } ifelse pop
  312.       }
  313.      ifelse
  314.        }
  315.       ifelse
  316.     }
  317.    .scan1fontstring filenameforall
  318.    QUIET
  319.     { pop pop pop }
  320.     { ( ) print =only ( files, ) print =only ( scanned, ) print
  321.       =only ( new fonts.) = flush
  322.     }
  323.    ifelse
  324.    setglobal
  325.  } bind def
  326.  
  327. %END FONTPATH
  328.  
  329. % Create the dictionary that registers the .buildfont procedure (called by
  330. % definefont) for each FontType.
  331. /buildfontdict 20 dict def
  332.  
  333. % Register Type 3 fonts, which are always supported, for definefont.
  334. buildfontdict 3 /.buildfont3 cvx put
  335.  
  336. % Register Type 0 fonts if they are supported.  Strictly speaking,
  337. % we should do this in its own file (gs_type0.ps), but since this is
  338. % the only thing that would be in that file, it's simpler to put it here.
  339. /.buildfont0 where { pop buildfontdict 0 /.buildfont0 cvx put } if
  340.  
  341. % Define definefont.  This is a procedure built on a set of operators
  342. % that do all the error checking and key insertion.
  343. /.growfontdict
  344.  {    % Grow the font dictionary, if necessary, to ensure room for an
  345.     % added entry, making sure there is at least one slot left for FID.
  346.    dup maxlength 1 index length sub 2 lt
  347.     { dup dup wcheck
  348.        { .growdict }
  349.        { .growdictlength dict .copydict }
  350.       ifelse
  351.     }
  352.     { dup wcheck not { dup maxlength dict .copydict } if
  353.     }
  354.    ifelse
  355.  } bind def 
  356. /.completefont {
  357.   {        % Check for disabled platform fonts.
  358.       NOPLATFONTS
  359.        {    % Make sure we leave room for FID.
  360.      .growfontdict dup /ExactSize 0 put
  361.        }
  362.        {    % Hack: if the Encoding looks like it might be the
  363.         % Symbol or Dingbats encoding, load those now (for the
  364.         % benefit of platform font matching) just in case
  365.         % the font didn't actually reference them.
  366.         % Note that some types of font don't have an Encoding.
  367.      dup /Encoding .knownget {
  368.        dup length 65 ge {
  369.          64 get
  370.          dup /congruent eq { SymbolEncoding pop } if
  371.          /a9 eq { DingbatsEncoding pop } if
  372.        } {
  373.          pop
  374.        } ifelse
  375.      } if
  376.        }
  377.       ifelse
  378.       true exch
  379.         % If this is a CIDFont, CIDFontType takes precedence
  380.         % over FontType.
  381.       dup /CIDFontType known {
  382.     /.buildcidfont where {
  383.       pop exch not exch    % true => false
  384.     } if
  385.       } if
  386.       exch {
  387.     dup /FontType get //buildfontdict exch get exec
  388.       } {
  389.     .buildcidfont
  390.       } ifelse
  391.  
  392.       DISKFONTS
  393.        { FontFileDirectory 2 index known
  394.       { dup /FontFile FontFileDirectory 4 index get .growput
  395.       }
  396.      if
  397.        }
  398.       if
  399.       readonly        % stack: name fontdict
  400.   } stopped { /invalidfont signalerror } if
  401. } bind odef
  402. /definefont
  403.  { .completefont
  404.         % If the current allocation mode is global, also enter
  405.         % the font in LocalFontDirectory.
  406.    .currentglobal
  407.     { //systemdict /LocalFontDirectory .knownget
  408.        { 2 index 2 index .growput }
  409.       if
  410.     }
  411.    if
  412.    dup .FontDirectory 4 -2 roll .growput
  413.         % If the font originated as a resource, register it.
  414.    currentfile .currentresourcefile eq { dup .registerfont } if
  415.  } odef
  416.  
  417. % Define a procedure for defining aliased fonts.
  418. % We use this only for explicitly aliased fonts, not substituted fonts:
  419. % we think this matches the observed behavior of Adobe interpreters.
  420. /.aliasfont        % <name> <font> .aliasfont <newFont>
  421.  { .currentglobal 3 1 roll dup .gcheck .setglobal
  422.    dup length 2 add dict
  423.    dup 3 -1 roll { 1 index /FID eq { pop pop } { put dup } ifelse } forall
  424.         % Stack: global fontname newfont newfont.
  425.         % We might be defining a global font whose FontName
  426.         % is a local string.  This is weird, but legal,
  427.         % and doesn't cause problems anywhere else:
  428.         % to avoid any possible problems in this case, do a cvn.
  429.         % We might also be defining (as an alias) a global font
  430.         % whose FontName is a local non-string, if someone passed a
  431.         % garbage value to findfont.  In this case, just don't
  432.         % call definefont at all.
  433.    2 index dup type /stringtype eq exch .gcheck or 1 index .gcheck not or
  434.     { /FontName 3 index dup type /stringtype eq { cvn } if put
  435.         % Don't bind in definefont, since Level 2 redefines it.
  436.       /definefont .systemvar exec
  437.     }
  438.     { .completefont pop exch pop
  439.     }
  440.    ifelse exch .setglobal
  441.  } odef        % so findfont will bind it
  442.  
  443. % Define .loadfontfile for loading a font.  If we recognize Type 1 and/or
  444. % TrueType fonts, gs_type1.ps and/or gs_ttf.ps will redefine this.
  445. /.loadfontfile {
  446.         % According to Ed Taft, Adobe interpreters push userdict
  447.         % before loading a font, and pop it afterwards.
  448.   userdict begin
  449.     cvx exec
  450.   end
  451. } bind def
  452. /.loadfont
  453.  {        % Some buggy fonts leave extra junk on the stack,
  454.         % so we have to make a closure that records the stack depth
  455.         % in a fail-safe way.
  456.    {{.loadfontfile} .execasresource} count 1 sub 2 .execn
  457.    count exch sub { pop } repeat
  458.  } bind def
  459.  
  460. % Find an alternate font to substitute for an unknown one.
  461. % We go to some trouble to parse the font name and extract
  462. % properties from it.  Later entries take priority over earlier.
  463. /.substitutefaces [
  464.     % Guess at suitable substitutions for random unknown fonts.
  465.   [(Book) /NewCenturySchlbk 0]
  466.   [(Grot) /Helvetica 0]
  467.   [(Roman) /Times 0]
  468.   [(Chancery) /ZapfChancery-MediumItalic 0]
  469.     % If the family name appears in the font name,
  470.     % use a font from that family.
  471.   [(Arial) /Helvetica 0]
  472.   [(Avant) /AvantGarde 0]
  473.   [(Bookman) /Bookman 0]
  474.   [(Century) /NewCenturySchlbk 0]
  475.   [(Cour) /Courier 0]
  476.   [(Frut) /Helvetica 0]
  477.   [(Garamond) /Palatino 0]
  478.   [(Geneva) /Helvetica 0]
  479.   [(Helv) /Helvetica 0]
  480.   [(NewYork) /Bookman 0]
  481.   [(Pala) /Palatino 0]
  482.   [(Schlbk) /NewCenturySchlbk 0]
  483.   [(Swiss) /Helvetica 0]
  484.   [(Symbol) /Symbol 0]
  485.   [(Times) /Times 0]
  486.     % Substitute for Adobe Multiple Master fonts.
  487.   [(Minion) /Times 0]
  488.   [(Myriad) /Helvetica 0]
  489.     % If the font wants to be monospace, use Courier.
  490.   [(Monospace) /Courier 0]
  491.   [(Typewriter) /Courier 0]
  492.     % Define substitutes for the other Adobe PostScript 3 fonts.
  493.     % For some of them, the substitution is pretty bad!
  494.   [(Albertus) /Palatino 0]
  495.   [(AntiqueOlive) /Helvetica 0]
  496.   [(Bodoni) /NewCenturySchlbk 0]
  497.   [(Chicago) /Helvetica 2]
  498.   [(Clarendon) /Bookman 0]
  499.   [(Cooper) /NewCenturySchlbk 0]
  500.   [(Copperplate) /AvantGarde 0]    % inappropriate, small-cap font
  501.   [(Coronet) /ZapfChancery-MediumItalic 0]
  502.   [(Eurostile) /Helvetica 0]
  503.   [(Geneva) /Courier 2]        % should be fixed-pitch sans demi
  504.   [(GillSans) /Helvetica 2]
  505.   [(GillSans-Light) /Helvetica 0]
  506.   [(Goudy) /Palatino 0]
  507.   [(Hoefler) /NewCenturySchlbk 0]
  508.   [(Joanna) /Times 0]
  509.   [(LetterGothic) /Courier 0]    % should be fixed-pitch sans
  510.   [(LubalinGraph-Book) /Bookman 2]
  511.   [(LubalinGraph-Demi) /Bookman 0]
  512.   [(Marigold) /ZapfChancery-MediumItalic 0]
  513.   [(MonaLisa-Recut) /Palatino 0]    % inappropriate
  514.   [(Monaco) /Courier 2]        % should be fixed-pitch sans demi
  515.   [(Optima) /Helvetica 0]
  516.   [(Oxford) /ZapfChancery-MediumItalic 0]
  517.   [(Tekton) /Helvetica 0]
  518.   [(Univers) /Helvetica 0]
  519. ] readonly def
  520. /.substituteproperties [
  521.   [(It) 9] [(Oblique) 1]
  522.   [(Black) 2] [(Bd) 2] [(Bold) 2] [(bold) 2] [(Demi) 2] [(Heavy) 2] [(Sb) 2]
  523.   [(Cn) 4] [(Cond) 4] [(Narrow) 4] [(Pkg) 4] [(Compr) 4]
  524.   [(Serif) 8] [(Sans) -8]
  525. ] readonly def
  526. /.fontnameproperties {        % <int> <string|name> .fontnameproperties
  527.                 %   <int'>
  528.   .fontnamestring
  529.   .substituteproperties {
  530.     2 copy 0 get search {
  531.       pop pop pop dup length 1 sub 1 exch getinterval 3 -1 roll exch {
  532.     dup 0 ge { or } { neg not and } ifelse
  533.       } forall exch
  534.     } {
  535.       pop pop
  536.     } ifelse
  537.   } forall pop
  538. } bind def
  539. /.substitutefamilies mark
  540.   /AvantGarde
  541.     {/AvantGarde-Book /AvantGarde-BookOblique
  542.      /AvantGarde-Demi /AvantGarde-DemiOblique}
  543.   /Bookman
  544.     {/Bookman-Demi /Bookman-DemiItalic /Bookman-Light /Bookman-LightItalic}
  545.   /Courier
  546.     {/Courier /Courier-Oblique /Courier-Bold /Courier-BoldOblique}
  547.   /Helvetica
  548.     {/Helvetica /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique
  549.      /Helvetica-Narrow /Helvetica-Narrow-Oblique
  550.      /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique}
  551.   /NewCenturySchlbk
  552.     {/NewCenturySchlbk-Roman /NewCenturySchlbk-Italic
  553.      /NewCenturySchlbk-Bold /NewCenturySchlbk-BoldItalic}
  554.   /Palatino
  555.     {/Palatino-Roman /Palatino-Italic /Palatino-Bold /Palatino-BoldItalic}
  556.   /Symbol
  557.     {/Symbol /Symbol /Symbol /Symbol}
  558.   /Times
  559.     {/Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic}
  560.   /ZapfChancery-MediumItalic
  561.     {/ZapfChancery-MediumItalic}
  562. .dicttomark readonly def
  563. /.nametostring {        % <name> .nametostring <string>
  564.                 % <other> .nametostring <other>
  565.   dup type /nametype eq { .namestring } if
  566. } bind def
  567. /.fontnamestring {        % <fontname> .fontnamestring <string|name>
  568.   dup type dup /nametype eq {
  569.     pop .namestring
  570.   } {
  571.     /stringtype ne { pop () } if
  572.   } ifelse
  573. } bind def
  574. /.substitutefontname {        % <fontname> <properties> .substitutefontname
  575.                 %   <altname|null>
  576.     % Look for properties and/or a face name in the font name.
  577.     % If we find any, use Times (serif) or Helvetica (sans) as the
  578.     % base font; otherwise, use the default font.
  579.     % Note that the "substituted" font name may be the same as
  580.     % the requested one; the caller must check this.
  581.   exch .fontnamestring {
  582.     defaultfontname /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique
  583.     /Helvetica-Narrow /Helvetica-Narrow-Oblique
  584.     /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique
  585.     /Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic
  586.     /Helvetica-Narrow /Helvetica-Narrow-Oblique
  587.     /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique
  588.   } 3 1 roll
  589.     % Stack: facelist properties fontname
  590.     % Look for a face name.
  591.   .substitutefaces {
  592.     2 copy 0 get search {
  593.       pop pop pop
  594.     % Stack: facelist properties fontname [(pattern) family properties]
  595.       dup 2 get 4 -1 roll or 3 1 roll
  596.       1 get .substitutefamilies exch get
  597.       4 -1 roll pop 3 1 roll
  598.     } {
  599.       pop pop
  600.     } ifelse
  601.   } forall pop
  602.   1 index length mod get exec
  603. } bind def
  604. /.substitutefont {        % <fontname> .substitutefont <altname>
  605.   dup 0 exch .fontnameproperties .substitutefontname
  606.     % Only accept fonts known in the Fontmap.
  607.    Fontmap 1 index known not { pop defaultfontname } if
  608. } bind def
  609.  
  610. % If requested, make (and recognize) fake entries in FontDirectory for fonts
  611. % present in Fontmap but not actually loaded.  Thanks to Ray Johnston for
  612. % the idea behind this code.
  613. FAKEFONTS not { (%END FAKEFONTS) .skipeof } if
  614.  
  615. % We use the presence or absence of the FontMatrix key to indicate whether
  616. % a font is real or fake.  We must pop the arguments at the very end,
  617. % so that stack protection will be effective.
  618.  
  619. /definefont {        % <name> <font> definefont <font>
  620.   dup /FontMatrix known {
  621.     //definefont
  622.   } {
  623.     2 copy /FontName get findfont //definefont exch pop exch pop
  624.   } ifelse
  625. } bind odef
  626.  
  627. /scalefont {        % <font> <scale> scalefont <font>
  628.   1 index /FontMatrix known {
  629.     //scalefont
  630.   } {
  631.     1 index /FontName get findfont 1 index //scalefont
  632.     exch pop exch pop
  633.   } ifelse
  634. } bind odef
  635.  
  636. /makefont {        % <font> <matrix> makefont <font>
  637.   1 index /FontMatrix known {
  638.     //makefont
  639.   } {
  640.     1 index /FontName get findfont 1 index //makefont
  641.     exch pop exch pop
  642.   } ifelse
  643. } bind odef
  644.  
  645. /setfont {        % <font> setfont -
  646.   dup /FontMatrix known {
  647.     //setfont
  648.   } {
  649.     dup /FontName get findfont //setfont pop
  650.   } ifelse
  651. } bind odef
  652.  
  653. %END FAKEFONTS
  654.  
  655. % Define findfont so it tries to load a font if it's not found.
  656. % The Red Book requires that findfont be a procedure, not an operator,
  657. % but it still needs to restore the stacks reliably if it fails,
  658. % so we do all the work in an operator.
  659. /.findfont {
  660.   mark 1 index
  661.   //systemdict begin .dofindfont
  662.     % Define any needed aliases.
  663.   counttomark 1 sub { .aliasfont } repeat end
  664.   exch pop exch pop
  665. } odef
  666. /findfont {
  667.   .findfont
  668. } bind def
  669. % Check whether the font name we are about to look for is already on the list
  670. % of aliases we're accumulating; if so, cause an error.
  671. /.checkalias        % -mark- <alias1> ... <name> .checkalias <<same>>
  672.  { counttomark 1 sub -1 1
  673.     { index 1 index eq
  674.        { pop QUIET not
  675.       { (Unable to substitute for font.) = flush
  676.       } if
  677.      /findfont cvx /invalidfont signalerror
  678.        }
  679.       if
  680.     }
  681.    for
  682.  } bind def
  683. % Get a (non-fake) font if present in a FontDirectory.
  684. /.fontknownget        % <fontdir> <fontname> .fontknownget <font> true
  685.             % <fontdir> <fontname> .fontknownget false
  686.  { .knownget
  687.     { FAKEFONTS
  688.        { dup /FontMatrix known { true } { pop false } ifelse }
  689.        { true }
  690.       ifelse
  691.     }
  692.     { false
  693.     }
  694.    ifelse
  695.  } bind def
  696. % This is the standard procedure for handling font substitution.
  697. % Its location is per an Adobe newsgroup posting.
  698. % It is called with the font name on the stack, standing in for findfont.
  699. /.stdsubstfont {    % mark <alias1> ... <fontname> .stdsubstfont <font>
  700.       /SUBSTFONT where {
  701.     pop QUIET not {
  702.       (Substituting for font ) print dup =only
  703.       (.) = flush
  704.     } if
  705.             % No aliasing.
  706.     cleartomark mark defaultfontname
  707.       } {
  708.     dup .substitutefont
  709.     2 copy eq { pop defaultfontname } if
  710.     .checkalias
  711.     QUIET not {
  712.       SHORTERRORS {
  713.         (%%[) print 1 index =only
  714.         ( not found, substituting ) print dup =only (]%%)
  715.       } {
  716.         (Substituting font ) print dup =only
  717.         ( for ) print 1 index =only (.)
  718.       } ifelse = flush
  719.     } if
  720.             % Remove all the accumulated aliases.
  721.     counttomark 1 add 1 roll cleartomark mark exch
  722.       } ifelse
  723.   .dofindfont
  724. } bind def
  725. $error /SubstituteFont { .stdsubstfont } put
  726. % Scan the next directory on FONTPATH.
  727. /.scannextfontdir {    % - .scannextfontdir <bool>
  728.             % If we haven't scanned all the directories in
  729.             % FONTPATH, scan the next one.
  730.   null 0 1 FONTPATH length 1 sub {
  731.     FONTPATH 1 index get null ne { exch pop exit } if pop
  732.   } for dup null ne {
  733.     dup 0 eq { .scanfontbegin } if
  734.     FONTPATH 1 index get .scanfontdir
  735.     FONTPATH exch null put true
  736.   } {
  737.     pop false
  738.   } ifelse
  739. } bind def
  740. % Do the work of findfont, including substitution, defaulting, and
  741. % scanning of FONTPATH.
  742. /.dofindfont {        % <fontname> .dofindfont <font>
  743.   .tryfindfont not {
  744.             % We didn't find the font.  If we haven't scanned
  745.             % all the directories in FONTPATH, scan the next one
  746.             % now and look for the font again.
  747.     .scannextfontdir {
  748.             % Start over with an empty alias list.
  749.       counttomark 1 sub { pop } repeat
  750.       .dofindfont
  751.     } {
  752.             % No luck.  Make sure we're not already
  753.             % looking for the default font.
  754.       dup defaultfontname eq {
  755.     QUIET not {
  756.       (Unable to load default font ) print
  757.       dup =only (!  Giving up.) = flush
  758.     } if
  759.     /findfont cvx /invalidfont signalerror
  760.       } if
  761.             % Substitute for the font.  Don't alias.
  762.       $error /SubstituteFont get exec
  763.     } ifelse
  764.   } if
  765. } bind def
  766. % Try to find a font using only the present contents of Fontmap.
  767. /.tryfindfont {        % <fontname> .tryfindfont <font> true
  768.             % <fontname> .tryfindfont false
  769.   .FontDirectory 1 index .fontknownget
  770.     {            % Already loaded
  771.       exch pop true
  772.     }
  773.     { dup Fontmap exch .knownget not
  774.        {        % Unknown font name.  Look for a file with the
  775.             % same name as the requested font.
  776.      .tryloadfont
  777.        }
  778.        {        % Try each element of the Fontmap in turn.
  779.      false exch    % (in case we exhaust the list)
  780.             % Stack: fontname false fontmaplist
  781.      { exch pop
  782.        dup type /nametype eq
  783.         {            % Font alias
  784.           .checkalias .tryfindfont exit
  785.         }
  786.         { dup dup type dup /arraytype eq exch /packedarraytype eq or exch xcheck and
  787.            {        % Font with a procedural definition
  788.          exec        % The procedure will load the font.
  789.                 % Check to make sure this really happened.
  790.          .FontDirectory 1 index .knownget
  791.           { exch pop true exit }
  792.          if
  793.            }
  794.            {        % Font file name
  795.          .loadfontloop { true exit } if
  796.            }
  797.           ifelse
  798.         }
  799.        ifelse false
  800.      }
  801.      forall
  802.             % Stack: font true -or- fontname false
  803.      { true
  804.      }
  805.      {            % None of the Fontmap entries worked.
  806.                 % Try loading a file with the same name
  807.                 % as the requested font.
  808.        .tryloadfont
  809.      }
  810.     ifelse
  811.        }
  812.       ifelse
  813.     }
  814.    ifelse
  815.  } bind def
  816. % Attempt to load a font from a file.
  817. /.tryloadfont {        % <fontname> .tryloadfont <font> true
  818.             % <fontname> .tryloadfont false
  819.   dup .nametostring
  820.         % Hack: check for the presence of the resource machinery.
  821.   /.genericrfn where {
  822.     pop
  823.     2 copy .fonttempstring /FontResourceDir getsystemparam .genericrfn
  824.     .loadfontloop {
  825.       exch pop exch pop true
  826.     } {
  827.       dup .nametostring .loadfontloop
  828.     } ifelse
  829.   } {
  830.     .loadfontloop
  831.   } ifelse
  832. } bind def
  833. /.loadfontloop {    % <fontname> <filename> .loadfontloop
  834.             %   <font> true
  835.             % -or-
  836.             %   <fontname> false
  837.             % See above regarding the use of 'loop'.
  838.     {
  839.             % Is the font name a string?
  840.     dup type /stringtype ne
  841.      { QUIET not
  842.         { (Can't find font with non-string name: ) print dup =only (.) = flush
  843.         }
  844.        if pop false exit
  845.      }
  846.     if
  847.             % Can we open the file?
  848.     findlibfile not
  849.      { QUIET not
  850.         { (Can't find \(or can't open\) font file ) print dup print
  851.           (.) = flush
  852.         }
  853.        if pop false exit
  854.      }
  855.     if
  856.  
  857.             % Stack: fontname fontfilename fontfile
  858.     DISKFONTS
  859.      { .currentglobal true .setglobal
  860.        2 index (r) file
  861.        FontFileDirectory exch 5 index exch .growput
  862.        .setglobal
  863.      }
  864.     if
  865.     QUIET not
  866.      { (Loading ) print 2 index =only
  867.        ( font from ) print 1 index print (... ) print flush
  868.      }
  869.     if
  870.     % If LOCALFONTS isn't set, load the font into local or global
  871.     % VM according to FontType; if LOCALFONTS is set, load the font
  872.     % into the current VM, which is what Adobe printers (but not
  873.     % DPS or CPSI) do.
  874.     LOCALFONTS { false } { /setglobal where } ifelse
  875.      { pop /FontType .findfontvalue { 1 eq } { false } ifelse
  876.         % .setglobal, like setglobal, aliases FontDirectory to
  877.         % GlobalFontDirectory if appropriate.  However, we mustn't
  878.         % allow the current version of .setglobal to be bound in,
  879.         % because it's different depending on language level.
  880.        .currentglobal exch /.setglobal .systemvar exec
  881.         % Remove the fake definition, if any.
  882.        .FontDirectory 3 index .undef
  883.        1 index (r) file .loadfont .FontDirectory exch
  884.        /.setglobal .systemvar exec
  885.      }
  886.      { .loadfont .FontDirectory
  887.      }
  888.     ifelse
  889.         % Stack: fontname fontfilename fontdirectory
  890.     QUIET not
  891.      { //systemdict /level2dict known
  892.         { .currentglobal false .setglobal vmstatus
  893.           true .setglobal vmstatus 3 -1 roll pop
  894.           6 -1 roll .setglobal 5
  895.         }
  896.         { vmstatus 3
  897.         }
  898.        ifelse { =only ( ) print } repeat
  899.        (done.) = flush
  900.      } if
  901.  
  902.         % Check to make sure the font was actually loaded.
  903.     dup 3 index .fontknownget
  904.      { 4 1 roll pop pop pop true exit } if
  905.  
  906.         % Maybe the file had a different FontName.
  907.         % See if we can get a FontName from the file, and if so,
  908.         % whether a font by that name exists now.
  909.     exch (r) file .findfontname
  910.      { 2 copy .fontknownget
  911.         {    % Yes.  Stack: origfontname fontdirectory filefontname fontdict
  912.           3 -1 roll pop exch
  913.           QUIET
  914.            { pop
  915.            }
  916.            { (Using ) print =only
  917.              ( font for ) print 1 index =only
  918.              (.) = flush
  919.            }
  920.           ifelse true exit
  921.         }
  922.        if pop
  923.      }
  924.     if pop
  925.  
  926.         % The font definitely did not load correctly.
  927.     QUIET not
  928.      { (Loading ) print dup =only
  929.        ( font failed.) = flush
  930.      } if
  931.     false exit
  932.  
  933.     } loop        % end of loop
  934.  
  935.  } bind def
  936.  
  937. % Define a procedure to load all known fonts.
  938. % This isn't likely to be very useful.
  939. /loadallfonts
  940.  { Fontmap { pop findfont pop } forall
  941.  } bind def
  942.  
  943. % If requested, load all the fonts defined in the Fontmap into FontDirectory
  944. % as "fake" fonts i.e., font dicts with only FontName and FontType defined.
  945. % (We define FontType only for the sake of some questionable code in the
  946. % Apple Printer Utility 2.0 font inquiry code.)
  947. %
  948. % Note that this procedure only creates fake fonts in the FontDirectory
  949. % associated with the current VM.  This is because in multi-context systems,
  950. % creating the fake fonts in local VM leads to undesirable complications.
  951. /.definefakefonts
  952.     {
  953.     }
  954.     {
  955.       (gs_fonts FAKEFONTS) VMDEBUG
  956.       Fontmap {
  957.     pop dup type /stringtype eq { cvn } if
  958.     .FontDirectory 1 index known not {
  959.       2 dict dup /FontName 3 index put
  960.       dup /FontType 1 put
  961.       .FontDirectory 3 1 roll put
  962.     } {
  963.       pop
  964.     } ifelse
  965.       } forall
  966.     }
  967. FAKEFONTS { exch } if pop def    % don't bind, .current/setglobal get redefined
  968.  
  969. % Install initial fonts from Fontmap.
  970. /.loadinitialfonts
  971.  { NOFONTMAP not
  972.     { /FONTMAP where
  973.       { pop [ FONTMAP .pathlist ]
  974.          { dup VMDEBUG findlibfile
  975.         { exch pop .loadFontmap }
  976.         { /undefinedfilename signalerror }
  977.            ifelse
  978.          }
  979.       }
  980.       { LIBPATH
  981.          { defaultfontmap 2 copy .filenamedirseparator
  982.            exch concatstrings concatstrings dup VMDEBUG
  983.            (r) { file } .internalstopped
  984.         { pop pop } { .loadFontmap } ifelse
  985.          }
  986.       }
  987.      ifelse forall
  988.     }
  989.    if
  990.    .definefakefonts    % current VM is global
  991.  } def            % don't bind, .current/setglobal get redefined
  992.  
  993. % ---------------- Synthetic font support ---------------- %
  994.  
  995. % Create a new font by modifying an existing one.  paramdict contains
  996. % entries with the same keys as the ones found in a Type 1 font;
  997. % it should also contain enough empty entries to allow adding the
  998. % corresponding non-overridden entries from the original font dictionary,
  999. % including FID.  If paramdict includes a FontInfo entry, this will
  1000. % also override the original font's FontInfo, entry by entry;
  1001. % again, it must contain enough empty entries.
  1002.  
  1003. % Note that this procedure does not perform a definefont.
  1004.  
  1005. /.makemodifiedfont    % <fontdict> <paramdict> .makemodifiedfont <fontdict'>
  1006.  { exch
  1007.     {            % Stack: destdict key value
  1008.       1 index /FID ne
  1009.        { 2 index 2 index known
  1010.       {        % Skip fontdict entry supplied in paramdict, but
  1011.             % handle FontInfo specially.
  1012.         1 index /FontInfo eq
  1013.          { 2 index 2 index get        % new FontInfo
  1014.            1 index                % old FontInfo
  1015.         {    % Stack: destdict key value destinfo key value
  1016.           2 index 2 index known
  1017.            { pop pop }
  1018.            { 2 index 3 1 roll put }
  1019.           ifelse
  1020.         }
  1021.            forall pop
  1022.          }
  1023.         if
  1024.       }
  1025.       {        % No override, copy the fontdict entry.
  1026.         2 index 3 1 roll put
  1027.         dup dup    % to match pop pop below
  1028.       }
  1029.      ifelse
  1030.        }
  1031.       if
  1032.       pop pop
  1033.     } forall
  1034.  } bind def
  1035.  
  1036. % Make a modified font and define it.  Note that unlike definefont,
  1037. % this does not leave the font on the operand stack.
  1038.  
  1039. /.definemodifiedfont    % <fontdict> <paramdict> .definemodifiedfont -
  1040.  { .makemodifiedfont
  1041.    dup /FontName get exch definefont pop
  1042.  } bind def
  1043.