%    Copyright (C) 1994, 1995 Aladdin Enterprises.  All rights reserved.
% 
% This file is part of GNU Ghostscript.
% 
% GNU 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 GNU Ghostscript General Public License for full details.
% 

% Type 1 font support code.

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

% 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.)
/.buildfont1
 { dup /FontInfo known not
    { .growfontdict dup /FontInfo 2 dict put }
   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

% 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 includes the code
%	<font> /CharStrings <CharStrings> readonly put
/.loadfontdict 6 dict def mark
 /begin			% push this dict after systemdict
  { dup begin
    //systemdict eq { //.loadfontdict begin } if
  } bind
 /end			% match begin
  { currentdict end
    //.loadfontdict eq currentdict //systemdict eq and { end } if
  } bind
 /dict			% leave room for FontFile
  { 1 add dict
  } bind
 /executeonly		% for reading procedures
  { readonly
  }
 /noaccess		% for Subrs strings and Private dictionary
  { readonly
  }
 /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
    count 2 gt and
     { 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
counttomark 2 idiv { .loadfontdict 3 1 roll put } repeat pop
.loadfontdict readonly pop
/.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....
   userdict begin
	% We can't just use `run', because we want to check for .PFB files.
   currentpacking
    { false setpacking .loadfont1 true setpacking }
    { .loadfont1 }
   ifelse
    { stop } 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 real input file never reaches EOF if we are using
	% a PFBDecode filter (the filter stops just after reading the last
	% character), we must explicitly close the real file in this case.
	% Since the file might leave garbage on the operand stack,
	% we have to create a procedure to close the file reliably.
    { dup read not { -1 } if
      2 copy unread 16#80 eq
       { [ exch dup true /PFBDecode filter cvx exch cvlit
         systemdict /closefile get ]
       }
      if cvx exec
    } stopped
   $error /newerror get and
 } 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		% <font> <code> Type1BuildChar -
 { 1 index /Encoding get 1 index get .type1build
 } bind def
/Type1BuildGlyph	% <font> <name> Type1BuildGlyph -
 { dup .type1build
 } bind def
/.type1build		% <font> <code|name> <name> .type1build -
 { 3 -1 roll begin
    dup CharStrings exch .knownget not
     { 2 copy eq { exch pop /.notdef exch } if
       QUIET not
	{ (Substituting .notdef for ) print = flush }
	{ pop }
       ifelse
       /.notdef CharStrings /.notdef get
     } if
	% stack: codename charname charstring
    PaintType 0 ne
     {	% Any reasonable implementation would execute something like
	%	1 setmiterlimit 0 setlinejoin 0 setlinecap
	% here, but apparently the Adobe implementations aren't reasonable.
       currentdict /StrokeWidth .knownget not { 0 } if
       setlinewidth
     } if
    dup type /stringtype eq		% encoded outline
     { 3 -1 roll pop 0 0 moveto outline_C
     }
     { dup type /integertype eq		% file position for lazy loading
	{ 3 -1 roll pop
	  1 index exch load_C dup CharStrings exch get
	  0 0 moveto outline_C
	}
	{				% PostScript procedure
	  exch pop
	  currentdict end systemdict begin begin   exec   end
	}
       ifelse
     }
    ifelse
   end
 } bind def

% Expand the bounding box before calling setcachedevice.
% Because of square caps and miter joins, the maximum expansion on each side
% is max(sqrt(2), miter_limit) * line_width/2.
% (setcachedevice adds the necessary 1- or 2-pixel fuzz.)
/expandbox_C		% <llx> <lly> <urx> <ury> expandbox_C <...ditto...>
 { PaintType 0 ne
    { 1.415 currentmiterlimit max currentlinewidth mul 2 div
			% llx lly urx ury exp
      5 1 roll 4 index add
			% exp llx lly urx ury+
      5 1 roll 3 index add
			% ury+ exp llx lly urx+
      5 1 roll 2 index sub
			% urx+ ury+ exp llx lly-
      5 1 roll exch sub
			% lly- urx+ ury+ llx-
      4 1 roll
    }
   if
 } bind def

% Make the call on setcachedevice a separate procedure, so we can redefine it
% if the composite font extensions are present.
/setcache_C where		% gs_type0.ps might be loaded first!
 { pop }
 { /setcache_C { setcachedevice pop } bind def }
ifelse

/outline_C		% <charname> <charstring> outline_C -
 {	% In order to make character oversampling work, we must
	% set up the cache before calling .type1addpath.
	% To do this, we must get the bounding box from the FontBBox,
	% and the width and left side bearing from the CharString.
	% (If the FontBBox isn't valid, we punt.)
   currentdict /FontBBox .knownget
    { dup length 4 eq
       { aload pop
	 dup 3 index gt 2 index 5 index gt and
	  { bbox_C }
	  { pop pop pop pop nobbox_C }
	 ifelse
       }
       { pop nobbox_C
       }
      ifelse
    }
    { nobbox_C
    }
   ifelse
   PaintType 0 eq { fill } { stroke } ifelse
 } bind def

% Handle the case where FontBBox is not valid.
% In this case, we do the .type1addpath first, then the setcachedevice.
% Oversampling is not possible.
/nobbox_C		% <charname> <charstring> nobbox_C -
 { currentdict /Metrics .knownget
    { 2 index .knownget
       { dup type dup /integertype eq exch /realtype eq or
          {    % <wx>
	    exch .type1addpath 0
	  }
	  { dup length 2 eq
	     {    % [<sbx> <wx>]
	       exch 1 index 0 get 0 .type1addpath
	       1 get 0
	     }
	     {    % [<sbx> <sby> <wx> <wy>]
	       aload pop 5 2 roll .type1addpath
	     }
	    ifelse
	  }
	 ifelse
       }
       { .type1addpath currentpoint
       }
      ifelse
    }
    { .type1addpath currentpoint
    }
   ifelse		% stack: wx wy
   pathbbox expandbox_C setcache_C
 } bind def

% Handle the case where FontBBox is valid.
/bbox_C			% <charname> <charstring> <llx> ... <ury> bbox_C -
 {	% Get the width and l.s.b. by parsing the CharString.
	% This isn't needed if we have a 4-element Metrics array,
	% but those are rare.
   4 index .type1getsbw
			% stack: cname cstring llx lly urx ury sbx sby wx wy
   currentdict /Metrics .knownget
    { 10 index .knownget
       { dup type dup /integertype eq exch /realtype eq or
          {    % <wx>
	    exch pop exch pop 0
	  }
	  { 5 1 roll pop pop pop pop
	    dup length 2 eq
	     {    % [<sbx> <wx>]
	       aload pop 0 exch 0
	     }
	     {    % [<sbx> <sby> <wx> <wy>]
	       aload pop
	     }
	    ifelse
	  }
	 ifelse
       }
      if
    }
   if
   8 4 roll expandbox_C
   9 index 7 1 roll setcache_C
   .type1addpath pop
 } bind def