home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / GhostScript / !GhostScr / 6_01 / lib / gs_fonts.ps < prev    next >
Text File  |  2000-03-29  |  33KB  |  1,038 lines

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