home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / APPS / gs403osk.tgz / gs403osk.tar / gs_fonts.ps < prev    next >
Text File  |  1996-10-12  |  26KB  |  793 lines
  1. %    Copyright (C) 1990, 1995, 1996 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % Font initialization and management code.
  19.  
  20. % Define the default font.
  21. /defaultfontname /Courier def
  22.  
  23. % Define the name of the font map file.
  24. /defaultfontmap (Fontmap) def
  25.  
  26. % ------ End of editable parameters ------ %
  27.  
  28. % If DISKFONTS is true, we load individual CharStrings as they are needed.
  29. % (This is intended primarily for machines with very small memories.)
  30. % In this case, we define another dictionary, parallel to FontDirectory,
  31. % that retains an open file for every font loaded.
  32. /FontFileDirectory 10 dict def
  33.  
  34. % Split up a search path into individual directories or files.
  35. /.pathlist      % <path> .pathlist <dir1|file1> ...
  36.  {  { dup length 0 eq { pop exit } if
  37.       .filenamelistseparator search not { exit } if
  38.       exch pop exch
  39.     }
  40.    loop
  41.  } bind def
  42.  
  43. % Load a font name -> font file name map.
  44. userdict /Fontmap FontDirectory maxlength dict put
  45. /.loadFontmap       % <file> .loadFontmap -
  46.  {      % We would like to simply execute .definefontmap as we read,
  47.         % but we have to maintain backward compatibility with an older
  48.         % specification that makes later entries override earlier.
  49.    50 dict exch
  50.     { dup token not { closefile exit } if
  51.         % stack: <file> fontname
  52.       % This is a hack to get around the absurd habit of MS-DOS editors
  53.       % of adding an EOF character at the end of the file.
  54.       dup (\032) eq { pop closefile exit } if
  55.       1 index token not
  56.        { (Fontmap entry for ) print dup =only
  57.      ( has no associated file or alias name!  Giving up.\n) print flush
  58.      {.loadFontmap} 0 get 1 .quit
  59.        } if
  60.       dup type dup /stringtype eq exch /nametype eq or not
  61.        { (Fontmap entry for ) print 1 index =only
  62.      ( has an invalid file or alias name!  Giving up.\n) print flush
  63.      {.loadFontmap} 0 get 1 .quit
  64.        } if
  65.         % stack: dict file fontname filename|aliasname
  66.         % Read and pop tokens until a semicolon.
  67.        { 2 index token not
  68.       { (Fontmap entry for ) print 1 index =only
  69.         ( ends prematurely!  Giving up.\n) print flush
  70.         {.loadFontmap} 0 get 1 .quit
  71.       } if
  72.      dup /; eq { pop 3 index 3 1 roll .growput exit } if
  73.      pop
  74.        } loop
  75.     } loop
  76.     { .definefontmap } forall
  77.  } bind def
  78. % Add an entry in Fontmap.  We redefine this if the Level 2
  79. % resource machinery is loaded.
  80. /.definefontmap         % <fontname> <file|alias> .definefontmap -
  81.  {      % Since Fontmap is global, make sure the values are storable.
  82.    .currentglobal 3 1 roll true .setglobal
  83.    dup type /stringtype eq
  84.     { dup .gcheck not { dup length string copy } if
  85.     }
  86.    if
  87.    Fontmap 3 -1 roll 2 copy .knownget
  88.     {       % Add an element to the end of the existing value,
  89.         % unless it's the same as the current last element.
  90.       mark exch aload pop counttomark 4 add -1 roll
  91.       2 copy eq { cleartomark pop pop } { ] readonly .growput } ifelse
  92.     }
  93.     {       % Make a new entry.
  94.       mark 4 -1 roll ] readonly .growput
  95.     }
  96.    ifelse .setglobal
  97.  } bind def
  98.  
  99. % Parse a font file just enough to find the FontName or FontType.
  100. /.findfontvalue     % <file> <key> .findfontvalue <value> true
  101.             % <file> <key> .findfontvalue false
  102.             % Closes the file in either case.
  103.  { exch dup read not { -1 } if
  104.    2 copy unread 16#80 eq
  105.     { dup (xxxxxx) readstring pop pop }     % skip .PFB header
  106.    if
  107.         % Stack: key file
  108.     { dup token not { false exit } if       % end of file
  109.       dup /eexec eq { pop false exit } if   % reached eexec section
  110.       dup /Subrs eq { pop false exit } if   % Subrs without eexec
  111.       dup /CharStrings eq { pop false exit } if % CharStrings without eexec
  112.       dup 3 index eq
  113.        { xcheck not { dup token exit } if } % found key
  114.        { pop }
  115.       ifelse
  116.     } loop
  117.         % Stack: key file value true   (or)
  118.         % Stack: key file false
  119.    dup { 4 } { 3 } ifelse -2 roll closefile pop
  120.  } bind def
  121. /.findfontname
  122.  { /FontName .findfontvalue
  123.  } bind def
  124.  
  125. % If there is no FONTPATH, try to get one from the environment.
  126. NOFONTPATH { /FONTPATH () def } if
  127. /FONTPATH where
  128.  { pop }
  129.  { /FONTPATH (GS_FONTPATH) getenv not { () } if def }
  130. ifelse
  131. FONTPATH length 0 eq { (%END FONTPATH) .skipeof } if
  132. /FONTPATH [ FONTPATH .pathlist ] def
  133.  
  134. % Scan directories looking for plausible fonts.  "Plausible" means that
  135. % the file begins with %!PS-AdobeFont or %!FontType1, or with \200\001
  136. % followed by four arbitrary bytes and then either of these strings.
  137. % To speed up the search, we skip any file whose name appears in
  138. % the Fontmap (with any extension and upper/lower case variation) already,
  139. % and any file whose extension definitely indicates it is not a font.
  140. %
  141. % NOTE: The current implementation of this procedure is somewhat Unix/DOS-
  142. % specific.  It assumes that '/' and '\' are directory separators, and that
  143. % the part of a file name following the last '.' is the extension.
  144. %
  145. /.lowerstring       % <string> .lowerstring <lowerstring>
  146.  { 0 1 2 index length 1 sub
  147.     { 2 copy get dup 65 ge exch 90 le and
  148.        { 2 copy 2 copy get 32 add put }
  149.      if pop
  150.     }
  151.    for
  152.  } bind def
  153. /.splitfilename     % <dir.../base.extn> .basename <base> <extn>
  154.  {  { (/) search { true } { (\\) search } ifelse
  155.        { pop pop }
  156.        { exit }
  157.       ifelse
  158.     }
  159.    loop
  160.    dup { (.) search { pop pop } { exit } ifelse } loop
  161.    2 copy eq
  162.     { pop () }
  163.     { exch dup length 2 index length 1 add sub 0 exch getinterval exch }
  164.    ifelse
  165. % Following is debugging code.
  166. %   (*** Split => ) print 2 copy exch ==only ( ) print ==only
  167. %   ( ***\n) print flush
  168.  } bind def
  169. /.scanfontdict 1 dict def       % establish a binding
  170. /.scanfontbegin
  171.  {  % Construct the table of all file names already in Fontmap.
  172.    currentglobal true setglobal
  173.    .scanfontdict dup maxlength Fontmap length 2 add .max .setmaxlength
  174.    Fontmap
  175.     { exch pop
  176.        { dup type /stringtype eq
  177.       { .splitfilename pop =string copy .lowerstring cvn
  178.         .scanfontdict exch true put
  179.       }
  180.       { pop
  181.       }
  182.      ifelse
  183.        }
  184.       forall
  185.     }
  186.    forall
  187.    setglobal
  188.  } bind def
  189. /.scanfontskip mark
  190.         % Strings are converted to names anyway, so....
  191.   /afm true
  192.   /bat true
  193.   /c true
  194.   /cmd true
  195.   /com true
  196.   /dll true
  197.   /doc true
  198.   /drv true
  199.   /exe true
  200.   /fon true
  201.   /fot true
  202.   /h true
  203.   /o true
  204.   /obj true
  205.   /pfm true
  206.   /txt true
  207. .dicttomark def
  208. /.scan1fontstring 128 string def
  209. /.scanfontheaders [(%!PS-AdobeFont*) (%!FontType1*)] def
  210. 0 .scanfontheaders { length max } forall 6 add  % extra for PFB header
  211. /.scan1fontfirst exch string def
  212. /.scanfontdir       % <dirname> .scanfontdir -
  213.  { currentglobal exch true setglobal
  214.    QUIET not { (Scanning ) print dup print ( for fonts...) print flush } if
  215.    (*) 2 copy .filenamedirseparator
  216.    dup (\\) eq { pop (\\\\) } if    % double \ for pattern match
  217.    exch concatstrings concatstrings
  218.    0 0 0 4 -1 roll  % found scanned files
  219.     {       % stack: <fontcount> <scancount> <filecount> <filename>
  220.       exch 1 add exch                   % increment filecount
  221.       dup .splitfilename .lowerstring
  222.         % stack: <fontcount> <scancount> <filecount+1> <filename>
  223.         %   <BASE> <ext>
  224.       .scanfontskip exch known exch .scanfontdict exch known or
  225.        { pop
  226.         % stack: <fontcount> <scancount> <filecount+1>
  227.        }
  228.        { 3 -1 roll 1 add 3 1 roll
  229.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  230.      dup (r) { file } .internalstopped
  231.       { pop pop null ()
  232.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  233.         %   null ()
  234.       }
  235.       {
  236.         % On some platforms, the file operator will open directories,
  237.         % but an error will occur if we try to read from one.
  238.         % Handle this possibility here.
  239.         dup .scan1fontfirst { readstring } .internalstopped
  240.          { pop pop () }
  241.          { pop }
  242.         ifelse
  243.         % stack: <fontcount> <scancount+1> <filecount+1>
  244.         %   <filename> <file> <header>
  245.       }
  246.      ifelse
  247.         % Check for PFB file header.
  248.      dup (\200\001????*) .stringmatch
  249.       { dup length 6 sub 6 exch getinterval }
  250.      if
  251.         % Check for font file headers.
  252.      false .scanfontheaders
  253.       { 2 index exch .stringmatch or
  254.       }
  255.      forall exch pop
  256.       { % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  257.         %   <file>
  258.         dup 0 setfileposition .findfontname
  259.          { dup Fontmap exch known
  260.         { pop pop
  261.         }
  262.         { exch copystring exch
  263.           DEBUG { ( ) print dup =only } if
  264.           1 index .definefontmap
  265.           .splitfilename pop true .scanfontdict 3 1 roll .growput
  266.             % Increment fontcount.
  267.           3 -1 roll 1 add 3 1 roll
  268.         }
  269.            ifelse
  270.          }
  271.          { pop
  272.          }
  273.         ifelse
  274.       }
  275.         % .findfontname will have done a closefile in the above case.
  276.       { dup null eq { pop } { closefile } ifelse pop
  277.       }
  278.      ifelse
  279.        }
  280.       ifelse
  281.     }
  282.    .scan1fontstring filenameforall
  283.    QUIET
  284.     { pop pop pop }
  285.     { ( ) print =only ( files, ) print =only ( scanned, ) print
  286.       =only ( new fonts.\n) print flush
  287.     }
  288.    ifelse
  289.    setglobal
  290.  } bind def
  291.  
  292. %END FONTPATH
  293.  
  294. % Define definefont.  This is a procedure built on a set of operators
  295. % that do all the error checking and key insertion.
  296. mark
  297.     /.buildfont0 where { pop 0 /.buildfont0 cvx } if
  298.     /.buildfont1 where { pop 1 /.buildfont1 cvx } if
  299.     /.buildfont3 where { pop 3 /.buildfont3 cvx } if
  300.     /.buildfont4 where { pop 4 /.buildfont4 cvx } if
  301.     /.buildfont42 where { pop 42 /.buildfont42 cvx } if
  302. .dicttomark /buildfontdict exch def
  303. /.growfontdict
  304.  {  % Grow the font dictionary, if necessary, to ensure room for an
  305.     % added entry, making sure there is at least one slot left for FID.
  306.    dup maxlength 1 index length sub 2 lt
  307.     { dup dup wcheck
  308.        { .growdict }
  309.        { .growdictlength dict .copydict }
  310.       ifelse
  311.     }
  312.     { dup wcheck not { dup maxlength dict .copydict } if
  313.     }
  314.    ifelse
  315.  } bind def 
  316. /definefont
  317.  { 1 dict begin count /d exch def   % save stack depth in case of error
  318.     {       % Check for disabled platform fonts.
  319.       NOPLATFONTS
  320.        {    % Make sure we leave room for FID.
  321.      .growfontdict dup /ExactSize 0 put
  322.        }
  323.        {    % Hack: if the Encoding looks like it might be the
  324.         % Symbol or Dingbats encoding, load those now (for the
  325.         % benefit of platform font matching) just in case
  326.         % the font didn't actually reference them.
  327.      dup /Encoding get length 65 ge
  328.       { dup /Encoding get 64 get
  329.         dup /congruent eq { SymbolEncoding pop } if
  330.         /a9 eq { DingbatsEncoding pop } if
  331.       }
  332.      if
  333.        }
  334.       ifelse
  335.       dup /FontType get //buildfontdict exch get exec
  336.       DISKFONTS
  337.        { FontFileDirectory 2 index known
  338.       { dup /FontFile FontFileDirectory 4 index get .growput
  339.       }
  340.      if
  341.        }
  342.       if
  343.       readonly
  344.     }
  345.    stopped
  346.     { count d sub { pop } repeat end /invalidfont signalerror
  347.     }
  348.     { end       % stack: name fontdict
  349.         % If the current allocation mode is global, also enter
  350.         % the font in LocalFontDirectory.
  351.       .currentglobal
  352.        { //systemdict /LocalFontDirectory .knownget
  353.       { 2 index 2 index .growput }
  354.      if
  355.        }
  356.       if
  357.       dup FontDirectory 4 -2 roll .growput
  358.     }
  359.    ifelse
  360.  } odef
  361.  
  362. % Define a procedure for defining aliased fonts.
  363. % We can't just copy the font (or even use the same font unchanged),
  364. % because a significant number of PostScript files assume that
  365. % the FontName of a font is the same as the font resource name or
  366. % the key in [Shared]FontDirectory; on the other hand, some Adobe files
  367. % rely on the FontName of a substituted font *not* being the same as
  368. % the requested resource name.  We address this issue heuristically:
  369. % we substitute the new name iff the font name doesn't have MM in it.
  370. /.aliasfont     % <name> <font> .aliasfont <newFont>
  371.  { .currentglobal 3 1 roll dup .gcheck .setglobal
  372.    dup length 2 add dict
  373.    dup 3 -1 roll { 1 index /FID eq { pop pop } { put dup } ifelse } forall
  374.         % Stack: global fontname newfont newfont.
  375.         % We might be defining a global font whose FontName
  376.         % is a local string.  This is weird, but legal,
  377.         % and doesn't cause problems anywhere else.
  378.         % To avoid any possible problems, do a cvn.
  379.    2 index =string cvs (MM) search
  380.     { pop pop pop pop
  381.     }
  382.     { /FontName exch dup type /stringtype eq { cvn } if put
  383.     }
  384.    ifelse
  385.    //systemdict /definefont get exec    % Don't bind, since Level 2
  386.                     % redefines definefont
  387.    exch .setglobal
  388.  } odef     % so findfont will bind it
  389.  
  390. % Define .loadfontfile for loading a font.  If we recognize Type 1 and/or
  391. % TrueType fonts, gs_type1.ps and/or gs_ttf.ps will redefine this.
  392. /.loadfontfile { cvx exec } bind def
  393. /.loadfont
  394.  {      % Some buggy fonts leave extra junk on the stack,
  395.         % so we have to make a closure that records the stack depth
  396.         % in a fail-safe way.
  397.    /.loadfontfile cvx count 1 sub 2 packedarray cvx exec
  398.    count exch sub { pop } repeat
  399.  } bind def
  400.  
  401. % Find an alternate font to substitute for an unknown one.
  402. % We go to some trouble to parse the font name and extract
  403. % properties from it.  Later entries take priority over earlier.
  404. /.substitutefaces [
  405.     % Guess at suitable substitutions for random unknown fonts.
  406.   [(Grot) /Times]
  407.   [(Roman) /Times]
  408.   [(Book) /NewCenturySchlbk]
  409.     % If the family name appears in the font name,
  410.     % use a font from that family.
  411.   [(Arial) /Helvetica]
  412.   [(Avant) /AvantGarde]
  413.   [(Bookman) /Bookman]
  414.   [(Century) /NewCenturySchlbk]
  415.   [(Cour) /Courier]
  416.   [(Geneva) /Helvetica]
  417.   [(Helv) /Helvetica]
  418.   [(NewYork) /Times]
  419.   [(Pala) /Palatino]
  420.   [(Sans) /Helvetica]
  421.   [(Schlbk) /NewCenturySchlbk]
  422.   [(Serif) /Times]
  423.   [(Swiss) /Helvetica]
  424.   [(Times) /Times]
  425.     % Substitute for Adobe Multiple Master fonts.
  426.   [(Myriad) /Times]
  427.   [(Minion) /Helvetica]
  428.     % Condensed or narrow fonts map to the only narrow family we have.
  429.   [(Cond) /Helvetica-Narrow]
  430.   [(Narrow) /Helvetica-Narrow]
  431.     % If the font wants to be monospace, use Courier.
  432.   [(Monospace) /Courier]
  433.   [(Typewriter) /Courier]
  434. ] readonly def
  435. /.substituteproperties [
  436.   [(It) 1] [(Oblique) 1]
  437.   [(Bd) 2] [(Bold) 2] [(bold) 2] [(Demi) 2] [(Heavy) 2] [(Sb) 2]
  438. ] readonly def
  439. /.substitutefamilies mark
  440.   /AvantGarde
  441.     {/AvantGarde-Book /AvantGarde-BookOblique
  442.      /AvantGarde-Demi /AvantGarde-DemiOblique}
  443.   /Bookman
  444.     {/Bookman-Demi /Bookman-DemiItalic /Bookman-Light /Bookman-LightItalic}
  445.   /Courier
  446.     {/Courier /Courier-Oblique /Courier-Bold /Courier-BoldOblique}
  447.   /Helvetica
  448.     {/Helvetica /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique}
  449.   /Helvetica-Narrow
  450.     {/Helvetica-Narrow /Helvetica-Narrow-Oblique
  451.      /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique}
  452.   /NewCenturySchlbk
  453.     {/NewCenturySchlbk-Roman /NewCenturySchlbk-Italic
  454.      /NewCenturySchlbk-Bold /NewCenturySchlbk-BoldItalic}
  455.   /Palatino
  456.     {/Palatino-Roman /Palatino-Italic /Palatino-Bold /Palatino-BoldItalic}
  457.   /Times
  458.     {/Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic}
  459. .dicttomark readonly def
  460. /.substitutefont        % <fontname> .substitutefont <altname>
  461.  {  % Look for properties and/or a face name in the font name.
  462.     % If we find any, use Helvetica as the base font;
  463.     % otherwise, use the default font.
  464.     % Note that the "substituted" font name may be the same as
  465.     % the requested one; the caller must check this.
  466.    dup length string cvs
  467.     {defaultfontname /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique}
  468.    exch 0 exch  % stack: fontname facelist properties fontname
  469.     % Look for a face name.
  470.    .substitutefaces
  471.     { 2 copy 0 get search
  472.        { pop pop pop 1 get .substitutefamilies exch get
  473.      4 -1 roll pop 3 1 roll
  474.        }
  475.        { pop pop
  476.        }
  477.       ifelse
  478.     }
  479.    forall
  480.    .substituteproperties
  481.     { 2 copy 0 get search
  482.        { pop pop pop 1 get 3 -1 roll or exch }
  483.        { pop pop }
  484.       ifelse
  485.     }
  486.    forall pop get
  487.     % If SUBSTFONT is defined, use it.
  488.    /SUBSTFONT where
  489.     { pop pop /SUBSTFONT load cvn }
  490.     { exec }
  491.    ifelse
  492.     % Only accept fonts known in the Fontmap.
  493.    Fontmap 1 index known not { pop defaultfontname } if
  494.  } bind def
  495.  
  496. % If requested, make (and recognize) fake entries in FontDirectory for fonts
  497. % present in Fontmap but not actually loaded.  Thanks to Ray Johnston for
  498. % the idea behind this code.
  499. FAKEFONTS not { (%END FAKEFONTS) .skipeof } if
  500.  
  501. % We use the presence or absence of the FontMatrix key to indicate whether
  502. % a font is real or fake.
  503.  
  504. /definefont     % <name> <font> definefont <font>
  505.  { dup /FontMatrix known not { /FontName get findfont } if
  506.    //definefont
  507.  } bind odef
  508.  
  509. /scalefont      % <font> <scale> scalefont <font>
  510.  { exch dup /FontMatrix known not { /FontName get findfont } if
  511.    exch //scalefont
  512.  } bind odef
  513.  
  514. /makefont       % <font> <matrix> makefont <font>
  515.  { exch dup /FontMatrix known not { /FontName get findfont } if
  516.    exch //makefont
  517.  } bind def
  518.  
  519. /setfont        % <font> setfont -
  520.  { dup /FontMatrix known not { /FontName get findfont } if
  521.    //setfont
  522.  } bind odef
  523.  
  524. %END FAKEFONTS
  525.  
  526. % Define findfont so it tries to load a font if it's not found.
  527. % The Red Book requires that findfont be a procedure, not an operator.
  528. /findfont
  529.  { mark exch
  530.     { .dofindfont
  531.     } stopped
  532.     { counttomark 1 sub { pop } repeat exch pop stop
  533.     }
  534.     {   % Define any needed aliases.
  535.       counttomark 1 sub { .aliasfont } repeat
  536.       exch pop
  537.     }
  538.    ifelse
  539.  } bind def
  540. % Check whether the font name we are about to look for is already on the list
  541. % of aliases we're accumulating; if so, cause an error.
  542. /.checkalias        % -mark- <alias1> ... <name> .checkalias <<same>>
  543.  { counttomark 1 sub -1 1
  544.     { index 1 index eq
  545.        { pop QUIET not
  546.       { (Unable to substitute for font.\n) print flush
  547.       } if
  548.      /findfont cvx /invalidfont signalerror
  549.        }
  550.       if
  551.     }
  552.    for
  553.  } bind def
  554. % Get a (non-fake) font if present in a FontDirectory.
  555. /.fontknownget      % <fontdir> <fontname> .fontknownget <font> true
  556.             % <fontdir> <fontname> .fontknownget false
  557.  { .knownget
  558.     { FAKEFONTS
  559.        { dup /FontMatrix known { true } { pop false } ifelse }
  560.        { true }
  561.       ifelse
  562.     }
  563.     { false
  564.     }
  565.    ifelse
  566.  } bind def
  567. % Do the work of findfont, including substitution, defaulting, and
  568. % scanning of FONTPATH.
  569. /.dofindfont        % <fontname> .dofindfont <font>
  570.  {  { .tryfindfont { exit } if
  571.             % We didn't find the font.  If we haven't scanned
  572.             % all the directories in FONTPATH, scan the next one now,
  573.             % and look for the font again.
  574.       null 0 1 FONTPATH length 1 sub
  575.        { FONTPATH 1 index get null ne { exch pop exit } if pop
  576.        }
  577.       for dup null ne
  578.        { dup 0 eq { .scanfontbegin } if
  579.      FONTPATH 1 index get .scanfontdir
  580.      FONTPATH exch null put
  581.             % Start over with an empty alias list.
  582.      counttomark 1 sub { pop } repeat
  583.      .dofindfont exit
  584.        }
  585.       if pop
  586.             % No luck, substitute for the font.
  587.       dup defaultfontname eq
  588.        { QUIET not
  589.       { (Unable to load default font ) print
  590.         dup =only (!  Giving up.\n) print flush
  591.       }
  592.      if /findfont cvx /invalidfont signalerror
  593.        }
  594.       if dup .substitutefont
  595.       2 copy eq { pop defaultfontname } if
  596.       .checkalias
  597.       QUIET not
  598.        { (Substituting font ) print dup =only ( for ) print
  599.      1 index =only (.\n) print flush
  600.        }
  601.       if
  602.     }
  603.    loop
  604.  } bind def
  605. % Try to find a font using only the present contents of Fontmap.
  606. /.tryfindfont       % <fontname> .tryfindfont <font> true
  607.             % <fontname> .tryfindfont false
  608.  { FontDirectory 1 index .fontknownget
  609.     {           % Already loaded
  610.       exch pop true
  611.     }
  612.     { dup Fontmap exch .knownget not
  613.        {        % Unknown font name
  614.      false
  615.        }
  616.  
  617.        {        % Try each element of the Fontmap in turn.
  618.     false exch  % (in case we exhaust the list)
  619.      { exch pop
  620.        dup type /nametype eq
  621.         {           % Font alias
  622.           .checkalias .tryfindfont exit
  623.         }
  624.         { dup dup type dup /arraytype eq exch /packedarraytype eq or exch xcheck and
  625.            {        % Font with a procedural definition
  626.          exec       % The procedure will load the font.
  627.                 % Check to make sure this really happened.
  628.          FontDirectory 1 index .knownget
  629.           { exch pop true exit }
  630.          if
  631.            }
  632.            {        % Font file name
  633.          .loadfontloop { true exit } if
  634.            }
  635.           ifelse
  636.         }
  637.        ifelse false
  638.      }
  639.     forall
  640.        }
  641.       ifelse
  642.     }
  643.    ifelse
  644.  } bind def
  645. % Attempt to load a font from a file.
  646. /.loadfontloop      % <filename> .loadfontloop <font> true
  647.             % <filename> .loadfontloop false
  648.  {          % See above regarding the use of 'loop'.
  649.  
  650.     {
  651.             % Can we open the file?
  652.     findlibfile not
  653.      { QUIET not
  654.         { (Can't find \(or can't open\) font file ) print dup print
  655.           (.\n) print flush
  656.         }
  657.        if pop false exit
  658.      }
  659.     if
  660.  
  661.             % Stack: fontname fontfilename fontfile
  662.     DISKFONTS
  663.      { .currentglobal true .setglobal
  664.        2 index (r) file
  665.        FontFileDirectory exch 5 index exch .growput
  666.        .setglobal
  667.      }
  668.     if
  669.     QUIET not
  670.      { (Loading ) print 2 index =only
  671.        ( font from ) print 1 index print (... ) print flush
  672.      }
  673.     if
  674.     % If LOCALFONTS isn't set, load the font into local or global
  675.     % VM according to FontType; if LOCALFONTS is set, load the font
  676.     % into the current VM, which is what Adobe printers (but not
  677.     % DPS or CPSI) do.
  678.     LOCALFONTS { false } { /setglobal where } ifelse
  679.      { pop /FontType .findfontvalue { 1 eq } { false } ifelse
  680.         % .setglobal, like setglobal, aliases FontDirectory to
  681.         % GlobalFontDirectory if appropriate.  However, we mustn't
  682.         % allow the current version of .setglobal to be bound in,
  683.         % because it's different depending on language level.
  684.        .currentglobal exch /.setglobal load exec
  685.         % Remove the fake definition, if any.
  686.        FontDirectory 3 index .undef
  687.        1 index (r) file .loadfont FontDirectory exch
  688.        /.setglobal load exec
  689.      }
  690.      { .loadfont FontDirectory
  691.      }
  692.     ifelse
  693.         % Stack: fontname fontfilename fontdirectory
  694.     QUIET not
  695.      { //systemdict /level2dict known
  696.         { .currentglobal false .setglobal vmstatus
  697.           true .setglobal vmstatus 3 -1 roll pop
  698.           6 -1 roll .setglobal 5
  699.         }
  700.         { vmstatus 3
  701.         }
  702.        ifelse { =only ( ) print } repeat
  703.        (done.\n) print flush
  704.      } if
  705.  
  706.         % Check to make sure the font was actually loaded.
  707.     dup 3 index .fontknownget
  708.      { 4 1 roll pop pop pop true exit } if
  709.  
  710.         % Maybe the file had a different FontName.
  711.         % See if we can get a FontName from the file, and if so,
  712.         % whether a font by that name exists now.
  713.     exch (r) file .findfontname
  714.      { 2 copy .fontknownget
  715.         {   % Yes.  Stack: origfontname fontdirectory filefontname fontdict
  716.           3 -1 roll pop exch
  717.           QUIET
  718.            { pop
  719.            }
  720.            { (Using ) print =only
  721.              ( font for ) print 1 index =only
  722.              (.\n) print flush
  723.            }
  724.           ifelse true exit
  725.         }
  726.        if pop
  727.      }
  728.     if pop
  729.  
  730.         % The font definitely did not load correctly.
  731.     QUIET not
  732.      { (Loading ) print dup =only
  733.        ( font failed.\n) print flush
  734.      } if
  735.     false exit
  736.  
  737.     } loop      % end of loop
  738.  
  739.  } bind def
  740.  
  741. % Define a procedure to load all known fonts.
  742. % This isn't likely to be very useful.
  743. /loadallfonts
  744.  { Fontmap { pop findfont pop } forall
  745.  } bind def
  746.  
  747. % If requested, load all the fonts defined in the Fontmap into FontDirectory
  748. % as "fake" fonts i.e., font dicts with only FontName defined.
  749. % We must ensure that this happens in both global and local directories.
  750. /.definefakefonts
  751.     {
  752.     }
  753.     { (gs_fonts FAKEFONTS) VMDEBUG
  754.       2
  755.     { .currentglobal not .setglobal
  756.       Fontmap
  757.        { pop dup type /stringtype eq { cvn } if
  758.          FontDirectory 1 index known not
  759.           { 1 dict dup /FontName 3 index put       
  760.             FontDirectory 3 1 roll put
  761.           }
  762.          if
  763.        }
  764.       forall
  765.        }
  766.       repeat
  767.     }
  768. FAKEFONTS { exch } if pop def       % don't bind, .current/setglobal get redefined
  769.  
  770. % Install initial fonts from Fontmap.
  771. /.loadinitialfonts
  772.  { NOFONTMAP not
  773.     { /FONTMAP where
  774.       { pop [ FONTMAP .pathlist ]
  775.          { dup VMDEBUG findlibfile
  776.         { exch pop .loadFontmap }
  777.         { /undefinedfilename signalerror }
  778.            ifelse
  779.          }
  780.       }
  781.       { LIBPATH
  782.          { defaultfontmap 2 copy .filenamedirseparator
  783.            exch concatstrings concatstrings dup VMDEBUG
  784.            (r) { file } .internalstopped
  785.         { pop pop } { .loadFontmap } ifelse
  786.          }
  787.       }
  788.      ifelse forall
  789.     }
  790.    if
  791.    .definefakefonts
  792.  } def          % don't bind, .current/setglobal get redefined
  793.