home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / sharewar / dos / inne / gs300ini / gs_fonts.ps < prev    next >
Encoding:
Text File  |  1994-08-02  |  14.4 KB  |  482 lines
  1. %    Copyright (C) 1990, 1992, 1993, 1994 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. % Load the font name -> font file name map.
  24. userdict /Fontmap FontDirectory maxlength dict put
  25. /.loadFontmap        % <file> .loadFontmap -
  26.  {  { dup token not { closefile exit } if
  27.         % stack: <file> fontname
  28.       1 index token not
  29.        { (File or alias name missing in Fontmap!  Giving up.\n) print flush
  30.          {.loadFontmap} 0 get 1 .quit
  31.        } if
  32.         % stack: <file> fontname filename|aliasname
  33.         % Read and pop tokens until a semicolon.
  34.        { 2 index token not
  35.       { (Semicolon missing in Fontmap!  Giving up.\n) print flush
  36.         {.loadFontmap} 0 get 1 .quit
  37.       } if
  38.      dup /; eq { pop Fontmap 3 1 roll .growput exit } if
  39.      pop
  40.        } loop
  41.     } loop 
  42.  } bind def
  43.  
  44. % If there is no FONTPATH, get one from the environment.
  45. /FONTPATH where
  46.  { pop }
  47.  { (GS_FONTPATH) getenv { /FONTPATH exch def } if }
  48. ifelse
  49.  
  50. % If we can't find a Fontmap, try using the FONTPATH.
  51. (Fontmap) findlibfile
  52.  { exch pop .loadFontmap }
  53.  { pop /FONTPATH where
  54.     { pop }
  55.     { (Fontmap) /undefinedfilename signalerror }
  56.    ifelse
  57.  }
  58. ifelse
  59.  
  60. % Parse a font file just enough to find the FontName.
  61. /.findfontname        % <file> .findfontname <name> true
  62.             % <file> .findfontname false
  63.             % Closes the file in either case.
  64.  { dup read not { -1 } if
  65.    2 copy unread 16#80 eq
  66.     { dup (xxxxxx) readstring pop pop }        % skip .PFB header
  67.    if
  68.     { dup token not { false exit } if        % end of file
  69.       dup /eexec eq { pop false exit } if    % reached eexec section
  70.       dup /FontName eq
  71.        { xcheck not { dup token exit } if }    % found /FontName
  72.        { pop }
  73.       ifelse
  74.     } loop
  75.    dup { 3 } { 2 } ifelse -1 roll closefile
  76.  } bind def
  77.  
  78. /FONTPATH where not { (%END FONTPATH) .skipeof } if
  79. pop
  80.  
  81. % Scan directories looking for plausible fonts.  "Plausible" means that
  82. % the file begins with %!PS-AdobeFont- or %!FontType1-, or with \200\001
  83. % followed by four arbitrary bytes and then either of these strings.
  84. % To speed up the search, we skip any file whose name appears in
  85. % the Fontmap (with any extension and upper/lower case variation) already,
  86. % and any file whose extension definitely indicates it is not a font.
  87. %
  88. % NOTE: The current implementation of this procedure is Unix/DOS-
  89. % specific.  It assumes that '/' and '\' are directory separators; that
  90. % the part of a file name following the last '.' is the extension;
  91. % that ';' cannot appear in a file name; and that ':' can appear in a
  92. % file name only if the file name doesn't begin with '/', '\', or '.'.
  93. % (this is so that Unix systems can use ':' as the separator).
  94. %
  95. /.lowerstring        % <string> .lowerstring <lowerstring>
  96.  { 0 1 2 index length 1 sub
  97.     { 2 copy get dup 65 ge exch 90 le and
  98.        { 2 copy 2 copy get 32 add put }
  99.      if pop
  100.     }
  101.    for
  102.  } bind def
  103. /.splitfilename        % <dir.../base.extn> .basename <base> <extn>
  104.  {  { (/) search { true } { (\\) search } ifelse
  105.        { pop pop }
  106.        { exit }
  107.       ifelse
  108.     }
  109.    loop
  110.    dup { (.) search { pop pop } { exit } ifelse } loop
  111.    2 copy eq
  112.     { pop () }
  113.     { exch dup length 2 index length 1 add sub 0 exch getinterval exch }
  114.    ifelse
  115. % Following is debugging code.
  116. %   (*** Split => ) print 2 copy exch ==only ( ) print ==only
  117. %   ( ***\n) print flush
  118.  } bind def
  119. /.scanfontdict Fontmap maxlength dict def
  120. /.scanfontbegin
  121.  {    % Construct the table of all file names already in Fontmap.
  122.    Fontmap
  123.     { exch pop dup type /stringtype eq
  124.        { .splitfilename pop =string copy .lowerstring cvn
  125.          .scanfontdict exch true .growput
  126.        }
  127.        { pop
  128.        }
  129.       ifelse
  130.     }
  131.    forall
  132.  } bind def
  133. /.scanfontskip mark
  134.         % Strings are converted to names anyway, so....
  135.   /afm true
  136.   /bat true
  137.   /c true
  138.   /cmd true
  139.   /com true
  140.   /dll true
  141.   /doc true
  142.   /exe true
  143.   /h true
  144.   /o true
  145.   /obj true
  146.   /pfm true
  147.   /txt true
  148. .dicttomark def
  149. /.scan1fontstring 128 string def
  150. /.fontheaders [(%!PS-AdobeFont-*) (%!FontType1-*)] def
  151. 0 .fontheaders { length max } forall 6 add    % extra for PFB header
  152. /.scan1fontfirst exch string def
  153. /.scan1fontdir        % <dirname> .scan1fontdir -
  154.  { QUIET not { (Scanning ) print dup print ( for fonts...) print flush } if
  155.    (/*) concatstrings 0 0 0 4 -1 roll    % found scanned files
  156.     {        % stack: <fontcount> <scancount> <filecount> <filename>
  157.       exch 1 add exch                   % increment filecount
  158.       dup .splitfilename .lowerstring
  159.         % stack: <fontcount> <scancount> <filecount+1> <filename>
  160.         %    <BASE> <ext>
  161.       .scanfontskip exch known exch .scanfontdict exch known or
  162.        { pop
  163.         % stack: <fontcount> <scancount> <filecount+1>
  164.        }
  165.        { 3 -1 roll 1 add 3 1 roll
  166.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  167.          dup (r) { file } stopped
  168.       { pop pop null () 
  169.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  170.         %    null ()
  171.           }
  172.       { 
  173.         % On some platforms, the file operator will open directories,
  174.         % but an error will occur if we try to read from one.
  175.         % Handle this possibility here.
  176.         dup .scan1fontfirst { readstring } stopped
  177.          { pop pop () }
  178.          { pop }
  179.         ifelse 
  180.         % stack: <fontcount> <scancount+1> <filecount+1>
  181.         %    <filename> <file> <header>
  182.           }
  183.      ifelse
  184.         % Check for PFB file header.
  185.      dup (\200\001????*) .stringmatch
  186.       { dup length 6 sub 6 exch getinterval }
  187.      if
  188.         % Check for font file headers.
  189.      false .fontheaders { 2 index exch .stringmatch or } forall exch pop
  190.       {    % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  191.         %    <file>
  192.             dup 0 setfileposition .findfontname
  193.          { dup Fontmap exch known
  194.         { pop pop
  195.         }
  196.         { exch copystring exch
  197.           DEBUG { ( ) print dup =only } if
  198.           Fontmap exch 2 index .growput
  199.           .splitfilename pop true .scanfontdict 3 1 roll .growput
  200.             % Increment fontcount.
  201.           3 -1 roll 1 add 3 1 roll
  202.         }
  203.            ifelse
  204.          }
  205.         if
  206.       }
  207.         % .findfontname will have done a closefile in the above case.
  208.       { dup null eq { pop } { closefile } ifelse pop 
  209.           }
  210.      ifelse
  211.        }
  212.       ifelse
  213.     }
  214.    .scan1fontstring filenameforall
  215.    QUIET
  216.     { pop pop pop }
  217.     { ( ) print =only ( files, ) print =only ( scanned, ) print
  218.       =only ( new fonts.\n) print flush
  219.     }
  220.    ifelse
  221.  } bind def
  222. % Scan all the directories mentioned in FONTPATH (or GS_FONTPATH).
  223. /FONTPATH where
  224.  { pop .scanfontbegin
  225.     % Parsing the list of dictionaries is messy, since we have to
  226.     % handle both the Unix : and the other-system ; as separators.
  227.     % See the earlier comment for the restrictions that make this work.
  228.    FONTPATH
  229.     { dup length 0 eq { pop exit } if
  230.       (;) search
  231.        { exch pop
  232.        }
  233.        { dup 0 1 getinterval (/\\.) exch search
  234.           { pop pop pop (:) search
  235.          { exch pop }
  236.          { () exch }
  237.         ifelse
  238.       }
  239.       { pop () exch
  240.       }
  241.      ifelse
  242.        }
  243.       ifelse .scan1fontdir
  244.     }
  245.    loop
  246.  }
  247. if
  248.  
  249. %END FONTPATH
  250.  
  251. % Define definefont.  This is a procedure built on a set of operators
  252. % that do all the error checking and key insertion.
  253. mark
  254.     /.buildfont0 where { pop 0 /.buildfont0 cvx } if
  255.     /.buildfont1 where { pop 1 /.buildfont1 cvx } if
  256.     /.buildfont3 where { pop 3 /.buildfont3 cvx } if
  257. .dicttomark /.buildfontdict exch def
  258. /definefont
  259.  { 1 dict begin count /d exch def    % save stack depth in case of error
  260.     {        % Check for disabled platform fonts.
  261.       NOPLATFONTS
  262.        { dup maxlength 1 index length sub 2 lt
  263.       { dup dup wcheck
  264.          { .growdict }
  265.          { .growdictlength dict copy }
  266.         ifelse
  267.       }
  268.       { dup wcheck not { dup maxlength dict copy } if
  269.       }
  270.      ifelse
  271.      dup /ExactSize 0 put
  272.        }
  273.        {    % Hack: if the Encoding looks like it might be the
  274.         % Symbol or Dingbats encoding, load those now (for the
  275.         % benefit of platform font matching) just in case
  276.         % the font didn't actually reference them.
  277.      dup /Encoding get length 65 ge
  278.       { dup /Encoding get 64 get
  279.         dup /congruent eq { SymbolEncoding pop } if
  280.         /a9 eq { DingbatsEncoding pop } if
  281.       }
  282.      if
  283.        }
  284.       ifelse
  285.       dup /FontType get //.buildfontdict exch get exec
  286.       DISKFONTS
  287.        { FontFileDirectory 2 index known
  288.           { dup /FontFile FontFileDirectory 4 index get .growput
  289.       }
  290.      if
  291.        }
  292.       if
  293.       readonly
  294.     }
  295.    stopped
  296.     { count d sub { pop } repeat end /invalidfont signalerror
  297.     }
  298.     { end        % stack: name fontdict
  299.         % If the current allocation mode is global, also enter
  300.         % the font in GlobalFontDirectory.
  301.       .currentglobal
  302.        { /GlobalFontDirectory where
  303.       { pop GlobalFontDirectory 2 index 2 index .growput }
  304.      if
  305.        }
  306.       if
  307.       dup FontDirectory 4 -2 roll .growput
  308.     }
  309.    ifelse
  310.  } odef
  311.  
  312. % Define a procedure for defining aliased fonts.
  313. % We just copy the original font, changing the FontName.
  314. /.aliasfont        % <name> <font> .aliasfont <newFont>
  315.  { dup length 2 add dict
  316.    dup 3 -1 roll { 1 index /FID eq { pop pop } { put dup } ifelse } forall
  317.    /FontName 3 index put
  318.    systemdict /definefont get exec    % Don't bind, since Level 2
  319.                     % redefines definefont
  320.  } odef        % so findfont will bind it
  321.  
  322. % Define .loadfont for loading a font.  If we recognize Type 1 fonts,
  323. % gs_type1.ps will redefine this.
  324. /.loadfont { cvx exec } bind def
  325.  
  326. % Find an alternate font to substitute for an unknown one.
  327. % We go to a little trouble to parse the font name and extract
  328. % properties from it.
  329. /.substituteproperties [
  330.   [(Grot) 8]
  331.   [(Condensed) 4] [(Narrow) 4]
  332.   [(Bold) 2]
  333.   [(Italic) 1] [(Oblique) 1]
  334. ] readonly def
  335. /.substitutenames {
  336.   defaultfontname /Helvetica-Oblique
  337.     /Helvetica-Bold /Helvetica-BoldOblique
  338.   /Helvetica-Narrow /Helvetica-Narrow-Oblique
  339.     /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique
  340.   /Times-Roman /Times-Italic
  341.     /Times-Bold /Times-BoldItalic
  342.   defaultfontname defaultfontname
  343.     defaultfontname defaultfontname
  344. } cvlit readonly def
  345. /.substitutefont        % <fontname> .substitutefont <altname>
  346.  {    % Look for properties in the font name.
  347.     % If we find any, use Helvetica as the base font;
  348.     % otherwise, use the default font
  349.    dup length string cvs
  350.    0 exch .substituteproperties
  351.     { 2 copy 0 get search
  352.        { pop pop pop 1 get 3 -1 roll or exch }
  353.        { pop pop }
  354.       ifelse
  355.     }
  356.    forall exch .substitutenames exch get exec
  357.     % Only accept fonts known in the Fontmap.
  358.    Fontmap 1 index known not { pop defaultfontname } if
  359.     % Don't "substitute" the same font name.
  360.    exch cvn 1 index eq { pop defaultfontname } if
  361.  } bind def
  362.  
  363. % Define findfont so it tries to load a font if it's not found.
  364. % The Red Book requires that findfont be a procedure, not an operator.
  365. /findfont
  366.  {    % Since PostScript has no concept of goto, or even blocks with
  367.     % exits, we use a loop as a way to get an exitable scope.
  368.     % The loop is never executed more than twice.
  369.     {
  370.     dup FontDirectory exch known        % Already loaded?
  371.      { FontDirectory exch get exit }
  372.     if
  373.  
  374.     dup Fontmap exch known not    % Unknown font name.
  375.      { dup defaultfontname eq
  376.         { (Default font ) print cvx =only
  377.           ( not found in Fontmap!  Giving up.\n) print flush
  378.           /findfont cvx 1 .quit
  379.         } if
  380.        QUIET not
  381.         { (Substituting ) print dup .substitutefont cvx =only
  382.           ( for unknown font ) print dup == flush
  383.         } if
  384.        dup .substitutefont findfont .aliasfont exit
  385.      }
  386.     if
  387.  
  388.     dup Fontmap exch get
  389.  
  390.     % Check for a font alias.
  391.     dup type /nametype eq
  392.      { findfont .aliasfont exit
  393.      }
  394.     if
  395.  
  396.     % If we can't open the file, substitute for the font.
  397.     findlibfile
  398.      { % Stack: fontname fontfilename fontfile
  399.        DISKFONTS
  400.         { 1 index (r) file
  401.           FontFileDirectory exch 4 index exch .growput
  402.         }
  403.        if
  404.        QUIET not
  405.         { (Loading ) print 2 index =only
  406.           ( font from ) print exch print (... ) print flush }
  407.         { exch pop }
  408.        ifelse
  409.        .loadfont
  410.        QUIET not
  411.         { vmstatus 3 { =only ( ) print } repeat
  412.           (done.\n) print flush
  413.         } if
  414.  
  415.        % Check to make sure the font was actually loaded.
  416.        dup FontDirectory exch known { findfont exit } if
  417.  
  418.        % Maybe the file had a different FontName.
  419.        % See if we can get a FontName from the file, and if so,
  420.        % whether a font by that name exists now.
  421.        dup Fontmap exch get findlibfile
  422.         { exch pop .findfontname
  423.            { dup FontDirectory exch .knownget
  424.               {    % Yes.  Stack: origfontname filefontname fontdir
  425.             exch
  426.             QUIET
  427.              { pop
  428.              }
  429.              { (Using ) print cvx =only
  430.                ( font for ) print 1 index cvx =only
  431.                (.\n) print flush
  432.              }
  433.             ifelse
  434.             .aliasfont exit
  435.           }
  436.          if pop
  437.            }
  438.           if
  439.         }
  440.        if
  441.  
  442.        % The font definitely did not load correctly.
  443.        QUIET not
  444.         { (Loading ) print dup cvx =only
  445.           ( font failed, substituting ) print dup .substitutefont cvx =only
  446.           (.\n) print flush
  447.         } if
  448.        dup .substitutefont findfont .aliasfont exit
  449.      }
  450.     if
  451.  
  452.     % findlibfile failed, substitute the default font.
  453.     % Stack: fontname fontfilename
  454.     (Can't find \(or can't open\) font file )
  455.     2 index defaultfontname eq
  456.      { print print ( for default font \() print cvx =only
  457.        (\)!  Giving up.\n) print flush /findfont cvx 1 .quit
  458.      }
  459.      { QUIET
  460.         { pop pop
  461.         }
  462.         { print print ( for font ) print dup cvx =only
  463.           (, substituting ) print dup .substitutefont cvx =only
  464.           (.\n) print flush
  465.         }
  466.        ifelse
  467.        dup .substitutefont findfont .aliasfont
  468.      }
  469.     ifelse
  470.     exit
  471.  
  472.     } loop        % end of loop
  473.  
  474.  } bind def
  475.  
  476.  
  477. % Define a procedure to load all known fonts.
  478. % This isn't likely to be very useful.
  479. /loadallfonts
  480.  { Fontmap { pop findfont pop } forall
  481.  } bind def
  482.