Mega Top 1/os2_top1.zip/os2_top1/APPS/TEKST/GSPMSRC/SRC/GS_FONTS.PS

Text File | 1993-12-16 | 21KB | 695 lines

%    Copyright (C) 1990, 1992, 1993 Aladdin Enterprises.  All rights reserved.
%
% This file is part of Ghostscript.
%
% Ghostscript is distributed in the hope that it will be useful, but
% WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
% to anyone for the consequences of using it or for whether it serves any
% particular purpose or works at all, unless he says so in writing.  Refer
% to the Ghostscript General Public License for full details.
%
% Everyone is granted permission to copy, modify and redistribute
% Ghostscript, but only under the conditions described in the Ghostscript
% General Public License.  A copy of this license is supposed to have been
% given to you along with Ghostscript so you can know your rights and
% responsibilities.  It should be in a file named COPYING.  Among other
% things, the copyright notice and this notice must be preserved on all
% copies.

% Font initialization and management code.

% The standard representation for PostScript compatible fonts is described
% in the book "Adobe Type 1 Font Format", published by Adobe Systems Inc.

% Define the default font.
/defaultfontname /Ugly def

% Load the font name -> font file name map.
userdict /Fontmap FontDirectory maxlength dict put
/.loadFontmap        % <filename> .loadFontmap -
 { 2 dict begin
     mark Fontmap
     /;
      { % The stack contains a mark, the dictionary, the font name,
        % the file or alias name, and possibly additional information
    % about the font.
    counttomark 3 sub { pop } repeat .growput
    Fontmap
      } bind def
     3 -1 roll run
   end
   pop pop        % pop the mark and the copy of the dictionary
 } bind def
(Fontmap) .loadFontmap

% Parse a font file just enough to find the FontName.
/.findfontname        % <file> .findfontname <name> true
            % <file> .findfontname false
            % Closes the file in either case.
 {  { dup token not { false exit } if        % end of file
      dup /eexec eq { pop false exit } if    % reached eexec section
      dup /FontName eq
       { xcheck not { dup token exit } if }    % found /FontName
       { pop }
      ifelse
    } loop
   dup { 3 } { 2 } ifelse -1 roll closefile
 } bind def

(GS_FONTPATH) getenv not { (%END GS_FONTPATH) .skipeof } if
pop

% Scan directories looking for plausible fonts.  "Plausible" means that
% the file begins either with %!PS-AdobeFont-, or with \200\001
% followed by four arbitrary bytes and then "%!PS-AdobeFont-".
% To speed up the search, we skip any file whose name appears in
% the Fontmap (with any extension and upper/lower case variation) already.
%
% NOTE: The current implementation of this procedure is Unix/DOS-
% specific.  It assumes that '/' and '\' are directory separators; that
% the part of a file name following the last '.' is the extension;
% that ';' cannot appear in a file name; and that ':' can appear in a
% file name only if the file name doesn't begin with '/', '\', or '.'.
% (this is so that Unix systems can use ':' as the separator).
%
/.lowerstring        % <string> .lowerstring <lowerstring>
 { 0 1 2 index length 1 sub
    { 2 copy get dup 65 ge exch 90 le and
       { 2 copy 2 copy get 32 add put }
     if pop
    }
   for
 } bind def
/.splitfilename        % <dir.../base.extn> .basename <base> <extn>
 {  { (/) search { true } { (\\) search } ifelse
       { pop pop }
       { exit }
      ifelse
    }
   loop
   dup { (.) search { pop pop } { exit } ifelse } loop
   2 copy eq
    { pop () }
    { exch dup length 2 index length 1 add sub 0 exch getinterval exch }
   ifelse
 } bind def
/.scanfontdict Fontmap maxlength dict def
/.scanfontbegin
 {    % Construct the table of all file names already in Fontmap.
   Fontmap
    { exch pop dup type /stringtype eq
       { .splitfilename pop =string copy .lowerstring cvn
         .scanfontdict exch true .growput
       }
       { pop
       }
      ifelse
    }
   forall
 } bind def
/.scanfontskip 4 dict dup begin
  (afm) true def
  (pfm) true def
end def
/.scan1fontstring 128 string def
/.fontheader (\200\001????%!PS-AdobeFont-*) def
/.scan1fontfirst .fontheader length string def
/.scan1fontdir        % <dirname> .scan1fontdir -
 { QUIET not { (Scanning ) print dup print ( for fonts... ) print flush } if
   0 exch (/*) concatstrings
    { dup .splitfilename
      .scanfontskip exch known exch .scanfontdict exch known or
       { pop
       }
       { dup (r) file
         dup .scan1fontfirst readstring pop
     dup .fontheader 6 16 getinterval .stringmatch
      { pop true }
      { .fontheader .stringmatch }
     ifelse
      { dup 0 setfileposition .findfontname
         { dup Fontmap exch known
            { pop pop
        }
        { exch copystring exch
          Fontmap exch 2 index .growput
          .splitfilename pop true .scanfontdict 3 1 roll .growput
          1 add
        }
           ifelse
         }
        if
      }
      { closefile pop
      }
     ifelse
       }
      ifelse
    }
   .scan1fontstring filenameforall
   QUIET { pop } { =only ( found.\n) print flush } ifelse
 } bind def
% Scan all the directories mentioned in GS_FONTPATH.
(GS_FONTPATH) getenv
 { .scanfontbegin
    % Parsing the list of dictionaries is messy, since we have to
    % handle both the Unix : and the other-system ; as separators.
    % See the earlier comment for the restrictions that make this work.
    { dup length 0 eq { pop exit } if
      (;) search
       { exch pop
       }
       { dup 0 1 getinterval (/\\.) exch search
          { pop pop pop (:) search
         { exch pop }
         { () exch }
        ifelse
      }
      { pop () exch
      }
     ifelse
       }
      ifelse .scan1fontdir
    }
   loop
 }
if

%END GS_FONTPATH

% If DISKFONTS is true, we load individual CharStrings as they are needed.
% (This is intended primarily for machines with very small memories.)
% In this case, we define another dictionary, parallel to FontDirectory,
% that retains an open file for every font loaded.
/FontFileDirectory 10 dict def

% Define an augmented version of .buildfont1 that inserts UnderlinePosition
% and UnderlineThickness entries in FontInfo if they aren't there already.
% (This works around the incorrect assumption, made by many word processors,
% that these entries are present in the built-in fonts.)
/.buildfont1x
 { dup /FontInfo known not
    { dup /FontInfo 2 dict .growput }
   if
   dup dup /FontInfo get dup dup
   /UnderlinePosition known exch /UnderlineThickness known and
    { pop pop        % entries already present
    }
    { dup length 2 add dict copy
      dup /UnderlinePosition known not
       { dup /UnderlinePosition 3 index /FontBBox get
         1 get 2 div put        % 1/2 the font descent
       }
      if
      dup /UnderlineThickness known not
       { dup /UnderlineThickness 3 index /FontBBox get
         dup 3 get exch 1 get sub 20 div put    % 1/20 the font height
       }
      if
      1 index /FontInfo get wcheck not { readonly } if
      /FontInfo exch put
    }
   ifelse .buildfont1
 } bind def
% Define definefont.  This is a procedure built on a set of operators
% that do all the error checking and key insertion.
mark
    /.buildfont0 where { pop 0 /.buildfont0 load } if
    /.buildfont1 where { pop 1 /.buildfont1x load } if
    /.buildfont3 where { pop 3 /.buildfont3 load } if
.dicttomark /.buildfontdict exch def
/definefont
 { 1 dict begin count /d exch def    % save stack depth in case of error
    {        % Check for disabled platform fonts.
      NOPLATFONTS
       { dup maxlength 1 index length sub 2 lt { dup .growdict } if
     dup /ExactSize 0 put
       }
       {    % Hack: if the Encoding looks like it might be the
        % Symbol or Dingbats encoding, load those now (for the
        % benefit of platform font matching) just in case
        % the font didn't actually reference them.
     dup /Encoding get length 65 ge
      { dup /Encoding get 64 get
        dup /congruent eq { SymbolEncoding pop } if
        /a9 eq { DingbatsEncoding pop } if
      }
     if
       }
      ifelse
      dup /FontType get //.buildfontdict exch get exec
      DISKFONTS
       { FontFileDirectory 2 index known
          { dup /FontFile FontFileDirectory 4 index get .growput
      }
     if
       }
      if
      readonly
    }
   stopped
    { count d sub { pop } repeat end /invalidfont signalerror }
    { end dup FontDirectory 4 2 roll .growput }
   ifelse
 } odef


% If DISKFONTS is true, we load individual CharStrings as they are needed.
% (This is intended primarily for machines with very small memories.)
% Initially, the character definition is the file position of the definition;
% this gets replaced with the actual CharString.
% Note that if we are loading characters lazily, CharStrings is writable.

% _Cstring must be long enough to hold the longest CharString for
% a character defined using seac.  This is lenIV + 4 * 5 (for the operands
% of sbw, assuming div is not used) + 2 (for sbw) + 3 * 5 (for the operands
% of seac other than the character codes) + 2 * 2 (for the character codes)
% + 2 (for seac), i.e., lenIV + 43.

/_Cstring 60 string def

% When we initially load the font, we call
%    <index|charname> <length> <readproc> cskip_C
% to skip over each character definition and return the file position instead.
% This substitutes for the procedure
%    <index|charname> <length> string currentfile exch read[hex]string pop
%      [encrypt]
% What we actually store is fileposition * 1000 + length,
%   negated if the string is stored in binary form.

% Older fonts use skip_C rather than cskip_C.
% skip_C takes /readstring or /readhexstring as its third argument,
% instead of the entire reading procedure.
/skipproc_C {string currentfile exch readstring pop} cvlit def
/skip_C
 { //skipproc_C dup 3 4 -1 roll put cvx readonly cskip_C
 } bind def
/cskip_C
 { exch dup 1000 ge 3 index type /nametype ne or
    { % This is a Subrs string, or the string is so long we can't represent
      % its length.  Load it now.
      exch exec
    }
    { % Record the position and length, and skip the string.
      dup currentfile fileposition 1000 mul add
      2 index 3 get /readstring cvx eq { neg } if
      3 1 roll
      dup _Cstring length idiv
       { currentfile _Cstring 3 index 3 get exec pop pop
       } repeat
      _Cstring length mod _Cstring exch 0 exch getinterval
      currentfile exch 3 -1 roll 3 get exec pop pop
    }
   ifelse
 } bind def

% Type1BuildGlyph calls load_C to actually load the character definition.

/load_C        % <charname> <fileposandlength> load_C -
 { dup abs 1000 idiv FontFile exch setfileposition
   CharStrings 3 1 roll
   dup 0 lt
    { neg 1000 mod string FontFile exch readstring }
    { 1000 mod string FontFile exch readhexstring }
   ifelse pop
% If the CharStrings aren't encrypted on the file, encrypt now.
   Private /-| get 0 get
   dup type /nametype ne { dup length 5 sub 5 exch getinterval exec } { pop } ifelse
   dup 4 1 roll put
% If the character is defined with seac, load its components now.
   mark exch seac_C
   counttomark
    { StandardEncoding exch get dup CharStrings exch get
      dup type /integertype eq { load_C } { pop pop } ifelse
    } repeat
   pop        % the mark
 } bind def

/seac_C        % <charstring> seac_C <achar> <bchar> ..or nothing..
 { dup length _Cstring length le
    { 4330 exch _Cstring .type1decrypt exch pop
      dup dup length 2 sub 2 getinterval <0c06> eq    % seac
       { dup length
         Private /lenIV known { Private /lenIV get } { 4 } ifelse
     exch 1 index sub getinterval
% Parse the string just enough to extract the seac information.
% We assume that the only possible operators are hsbw, sbw, and seac,
% and that there are no 5-byte numbers.
     mark 0 3 -1 roll
      { exch
         { { dup 32 lt
              { pop 0 }
          { dup 247 lt
             { 139 sub 0 }
             { dup 251 lt
            { 247 sub 256 mul 108 add 1 1 }
            { 251 sub -256 mul -108 add -1 1 }
               ifelse
             }
            ifelse
          }
         ifelse
           }            % 0
           { mul add 0 }        % 1
         }
        exch get exec
      }
     forall pop
     counttomark 1 add 2 roll cleartomark    % pop all but achar bchar
       }
       { pop    % not seac
       }
      ifelse
    }
    { pop    % punt
    }
   ifelse
 } bind def

% Define an auxiliary procedure for loading a font.
% If DISKFONTS is true and the body of the font is not encrypted with eexec:
%    - Prevent the CharStrings from being made read-only.
%    - Substitute a different CharString-reading procedure.
% (eexec disables this because the implicit 'systemdict begin' hides
% the redefinitions that make the scheme work.)
% We assume that:
%    - The magic procedures (-|, -!, |-, and |) are defined with
%    executeonly or readonly;
%    - The contents of the reading procedures are as defined in bdftops.ps;
%    - The font ends with
%    <font> <Private> <CharStrings>
%    readonly put noaccess|readonly put
4 dict begin
 /dict            % leave room for FontFile
  { 1 add dict
  } bind def
 /executeonly        % for reading procedures
  { readonly
  } def
 /noaccess        % for Subrs strings and Private dictionary
  { readonly
  } def
 /readonly        % for procedures and CharStrings dictionary
  {    % We want to take the following non-standard actions here:
      %   - If the operand is the CharStrings dictionary, do nothing;
    %   - If the operand is a number (a file position replacing the
    %    actual CharString), do nothing;
    %   - If the operand is either of the reading procedures (-| or -!),
    %    substitute a different one.
    dup type /dicttype eq        % CharStrings or Private
     { 1 index /CharStrings ne { readonly } if }
     { dup type /arraytype eq        % procedure or data array
        { dup length 5 ge 1 index xcheck and
       { dup 0 get /string eq
         1 index 1 get /currentfile eq and
         1 index 2 get /exch eq and
         1 index 3 get dup /readstring eq exch /readhexstring eq or and
         1 index 4 get /pop eq and
          { /cskip_C cvx 2 packedarray cvx
          }
          { readonly
          }
         ifelse
       }
       { readonly
       }
      ifelse
    }
    { dup type /stringtype eq    % must be a Subr string
       { readonly }
      if
    }
       ifelse
     }
    ifelse
  } bind def
currentdict end readonly /.loadfontdict exch def
/.loadfont        % <file> .loadfont -
 { mark exch systemdict begin
   DISKFONTS { .loadfontdict begin } if
   % We really would just like systemdict on the stack,
   % but fonts produced by Fontographer require a writable dictionary....
   8 dict begin        % garbage
    % We can't just use `run', because we want to check for .PFB files.
   currentpacking
    { false setpacking .loadfont1 true setpacking }
    { .loadfont1 }
   ifelse
    { handleerror } if
   end
   DISKFONTS { end } if
   end cleartomark
 } bind def
/.loadfont1        % <file> .loadfont1 <errorflag>
 {    % We would like to use `false /PFBDecode filter',
    % but this occasionally produces a whitespace character as
    % the first of an eexec section, so we can't do it.
    % Also, since the interpreter doesn't currently automatically
    % close an input file when the file reaches EOF (unless it's
    % the interpreter's current input file), we must explicitly
    % close the real file if we used a PFB filter.
    { dup read not { -1 } if
      2 copy unread 16#80 eq
       { dup true /PFBDecode filter cvx exec closefile }
       { cvx exec }
      ifelse
    } stopped
   $error /newerror get and
 } bind def

% Define a procedure for defining aliased fonts.
% We just copy the original font, changing the FontName.
/.aliasfont        % <name> <font> .aliasfont <newFont>
 { dup length 2 add dict
   dup 3 -1 roll { 1 index /FID eq { pop pop } { put dup } ifelse } forall
   /FontName 3 index put
   definefont
 } odef % bind def

% Define findfont so it tries to load a font if it's not found.
/findfont
 {    % Since PostScript has no concept of goto, or even blocks with
    % exits, we use a loop as a way to get an exitable scope.
    % The loop is never executed more than twice.
    {
    dup FontDirectory exch known        % Already loaded?
     { FontDirectory exch get exit }
    if

    dup Fontmap exch known not    % Unknown font name.
     { dup defaultfontname eq
        { (Default font ) print cvx =only
          ( not found in Fontmap!  Giving up.\n) print flush
          1 .quit
        } if
       QUIET not
        { (Substituting ) print defaultfontname cvx =only
          ( for unknown font ) print dup == flush
        } if
       defaultfontname findfont .aliasfont exit
     }
    if

    dup Fontmap exch get

    % Check for a font alias.
    dup type /nametype eq
     { findfont .aliasfont exit
     }
    if

    % If we can't open the file, substitute for the font.
    findlibfile
     { % Stack: fontname fontfilename fontfile
       DISKFONTS
        { 1 index (r) file
          FontFileDirectory exch 4 index exch .growput
        }
       if
       QUIET not
        { (Loading ) print 2 index =only
          ( font from ) print exch print (... ) print flush }
        { exch pop }
       ifelse
       .loadfont
       QUIET not
        { vmstatus 3 { =only ( ) print } repeat
          (done.\n) print flush
        } if

       % Check to make sure the font was actually loaded.
       dup FontDirectory exch known { findfont exit } if

       % Maybe the file had a different FontName.
       % See if we can get a FontName from the file, and if so,
       % whether a font by that name exists now.
       dup Fontmap exch get findlibfile
        { exch pop .findfontname
           { dup FontDirectory exch .knownget
              {    % Yes.  Stack: origfontname filefontname fontdir
            exch
            QUIET
             { pop
             }
             { (Using ) print cvx =only
               ( font for ) print 1 index cvx =only
               (.\n) print flush
             }
            ifelse
            .aliasfont exit
          }
         if pop
           }
          if
        }
       if

       % The font definitely did not load correctly.
       QUIET not
        { (Loading ) print dup cvx =only
          ( font failed, substituting ) print defaultfontname cvx =only
          (.\n) print flush
        } if
       defaultfontname findfont .aliasfont exit
     }
    if

    % findlibfile failed, substitute the default font.
    % Stack: fontname fontfilename
    (Can't find \(or can't open\) font file )
    1 index defaultfontname eq
     { print print ( for default font \() print cvx =only
       (\)!  Giving up.\n) print flush 1 .quit
     }
     { QUIET
        { pop
        }
        { print print ( for font ) print dup cvx =only
          (, substituting ) print defaultfontname cvx =only
          (.\n) print flush
        }
       ifelse
       defaultfontname findfont .aliasfont
     }
    ifelse
    exit

    } loop        % end of loop

 } odef % bind def


% The CharStrings are a dictionary in which the key is the character name,
% and the value is a compressed and encrypted representation of a path.
% For detailed information, see the book "Adobe Type 1 Font Format",
% published by Adobe Systems Inc.

% Here are the BuildChar and BuildGlyph implementation for Type 1 fonts.
% The names Type1BuildChar and Type1BuildGlyph are known to the interpreter.

/Type1BuildChar
 { 1 index /Encoding get exch get Type1BuildGlyph
 } bind def
/Type1BuildGlyph
 { exch begin
    dup CharStrings exch .knownget not
     { QUIET not
        { (Substituting .notdef for ) print = flush
    } { pop } ifelse
       /.notdef CharStrings /.notdef get
     } if
    % stack: charname charstring
    PaintType 0 ne
     { 1 setmiterlimit 1 setlinejoin 1 setlinecap
       currentdict /StrokeWidth .knownget not { 0 } if
       setlinewidth
     } if
    dup type /stringtype eq        % encoded outline
     { outline_C
     }
     { dup type /integertype eq        % file position for lazy loading
        { 1 index exch load_C dup CharStrings exch get outline_C
    }
    {                % PostScript procedure
      currentdict end systemdict begin begin   exec   end
    }
       ifelse
     }
    ifelse
   end
 } bind def

% Make the call on setcachedevice a separate procedure,
% so we can redefine it if the composite font extensions are present.
% (We don't use the obvious
%    /setcachedevice_C /setcachedevice load def
% because that would bind it into outline_C.)
/setcachedevice_C { setcachedevice } bind def

/outline_C        % <charname> <charstring> outline_C -
 { currentdict /Metrics .knownget
    { 2 index .knownget
       { dup type dup /integertype eq exch /realtype eq or
          {    % <wx>
        exch .type1addpath 0
      }
      { dup length 2 eq
         {    % [<wx> <sbx>]
           exch 1 index 0 get 0 .type1addpath
           1 get 0
         }
         {    % [<wx> <wy> <sbx> <sby>]
           aload pop 5 -1 roll 3 1 roll .type1addpath
         }
        ifelse
      }
     ifelse
       }
       { .type1addpath currentpoint
       }
      ifelse
    }
    { .type1addpath currentpoint
    }
   ifelse        % stack: wx wy
   pathbbox
   PaintType 0 ne
    {        % Expand the bounding box by the stroke width.
        % (Actually, only half the stroke width is needed.)
      4 -1 roll currentlinewidth sub
      4 -1 roll currentlinewidth sub
      4 -1 roll currentlinewidth add
      4 -1 roll currentlinewidth add
    }
   if
   setcachedevice_C
   PaintType 0 eq { fill } { stroke } ifelse
   pop
 } bind def

% Find all the precompiled font operators in systemdict.
   systemdict
    { exch =string cvs (.font_) anchorsearch
       { pop pop exec    % execute the operator, returns the font dictionary
         dup begin
       Encoding type /stringtype eq
        { Encoding cvn cvx exec /Encoding exch def
        }
       if
       FontName exch
     end definefont pop
       }
       { pop pop
       }
      ifelse
    }
   forall



% Define a procedure to load all known fonts.
% This isn't likely to be very useful.
/loadallfonts
 { Fontmap { pop findfont pop } forall
 } bind def