harvey/sys/src/cmd/gs/lib/gs_cidcm.ps

%    Copyright (C) 2000 artofcode LLC.  All rights reserved.
% 
% This file is part of AFPL Ghostscript.
% 
% AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author or
% distributor accepts any responsibility for the consequences of using it, or
% for whether it serves any particular purpose or works at all, unless he or
% she says so in writing.  Refer to the Aladdin Free Public License (the
% "License") for full details.
% 
% Every copy of AFPL Ghostscript must include a copy of the License, normally
% in a plain ASCII text file named PUBLIC.  The License grants you the right
% to copy, modify and redistribute AFPL Ghostscript, but only under certain
% conditions described in the License.  Among other things, the License
% requires that the copyright notice and this notice be preserved on all
% copies.

% $Id: gs_cidcm.ps,v 1.5 2001/07/01 08:55:34 igorm Exp $
% Extending Font resource category with CIDFont-CMap fonts.

languagelevel 2 .setlanguagelevel currentglobal true setglobal


% In the comments below, 'CSI' is an abbreviation/acronym for CIDSystemInfo.
% We pre-scan resource files to retrieve the CSI from them.
% First we define a hidden procset .prs_dict containing
% necessary variables and procedures.
% Then we redefine the old /Font category using this procset.

% We maintain internal caches for the CSI values retrieved from
% resource files. This supposes that document doesn't uninstall
% resource files. To disable caching, set enable_cache to false.

% We suppose that names starting with '.prs' do not appear in resource files.
% If this causes any problem, this prefix should be systematically changed
% in this file.  ('prs' is an abbreviation for 'prescan'.)

25 dict begin

% Define local variables :

/.prs_dict currentdict def       % self-reference (constant)
/.prs_empty 0 dict readonly def  
/path_buffer 255 string def
/name_buffer 255 string def
/minus (-) 0 get def             % character code constant for '-'
/period (.) 0 get def            % character code constant for '.'
/CMap 10 dict def                % CSI cache for CMaps
/CIDFont 10 dict def             % CSI cache for CIDFonts
/enable_cache true def           % set false to disable cache

% The folloving variables are just placeholders for ones to be set
% dynamically :
/.prsFile 0 def                   % file to prescan
/.prsResult 0 def                 % result of prescan
/.prsDictCount 0 def              % save the dictionary stack depth

% Define a dummy CIDInit procset to use while pre-scanning :

/DummyCIDInit 15 dict 
begin

  /begincmap {} def
  /usecmap {pop} bind def

  {stop} bind
  [ /begincodespacerange /endcodespacerange /beginnotdefchar /endnotdefchar
    /beginnotdefrange /endnotdefrange /begincidchar /endcidchar /begincidrange 
    /endcidrange /endcmap /usefont /StartData
  ] {
    1 index def
  } bind forall
  pop

currentdict end def

% Define a local 'findresource' for pre-scanning :
% (it returns the dummy CIDInit instead of the regular CIDInit ProcSet)

/findresource { % <InstName> <CatName> findresource <inst>
  2 copy /ProcSet eq exch             % /InstName /CatName bool /InstName
  /CIDInit eq and {
    pop pop //DummyCIDInit
  } {
    //findresource exec
  } ifelse
} bind def

% Define procedures for pre-scanning :

/StopIfCSIDefined {   % - StopIfCSIDefined -
  
  % Check if the dictionary stack contains a dictionary containing /CIDSystemInfo. 
  % The search is limited to the top .prsDictCount dictionaries in the stack.
  % If so, retrieve the CSI, and execute stop to terminate the pre-scanning of the file.
  % Otherwise, do nothing, so the pre-scanning continues.

  countdictstack //.prs_dict /.prsDictCount get sub dup {
    currentdict /CIDSystemInfo .knownget {
      //.prs_dict exch /.prsResult exch put
      stop
    } if
    currentdict exch end
  } repeat {
    begin
  } repeat
} bind def

/PrescanFile {     % - PrescanFile -
  { //.prs_dict /.prsFile get token {      
      dup type                          % token type
      dup /nametype eq exch /operatortype eq or {
        dup xcheck {
          exec
          //StopIfCSIDefined exec
        } if
      } if
    } {
      stop
    } ifelse
  } loop
} bind odef

/GetCIDSystemInfoFromFile { % <file> GetCIDSystemInfoFromFile <CSI>
  
  % This procedure reads resource files with 'token',
  % executing the tokens untill /CIDSystemInfo appears to be defined.
  % Normally the resource file creates a new dictionary on
  % dictionary stack and defines /CIDSystemInfo in it.
  %
  % Returns an empty dictionary if no CIDSystemInfo is found.

  //.prs_dict begin
  /.prsFile exch def
  /.prsResult //.prs_empty def
  /.prsDictCount countdictstack def
  { //PrescanFile } stopped pop
  //.prs_dict /.prsResult get
  end
} bind def

/GetCIDSystemInfo {     % <InstName> <CatName> GetCIDSystemInfo <CSI>
  
  % Retrieve CSI, using caches.
  
  2 copy resourcestatus {
    pop 2 lt {
      findresource /CIDSystemInfo .knownget not {
        //.prs_empty
      } if
    } {                                                      
      dup //.prs_dict exch get                % /InstName /CatName CSIs
      dup 3 index known
      //enable_cache and {                            
        exch pop exch get                     % CSI
      } {                                                  
        3 1 roll                              % CSIs /InstName /CatName
        /Category findresource begin          % CSIs /InstName
        dup //path_buffer ResourceFileName    % CSIs /InstName (path)
        end                                   
        currentglobal exch true setglobal     % CSIs /InstName g
        mark exch                             % CSIs /InstName g [ (path)
        { (r) file                            % CSIs /InstName g [ file
          //GetCIDSystemInfoFromFile exec     % CSIs /InstName g [ CSI
        } stopped {
          cleartomark //.prs_empty             
        } {
          exch pop
        } ifelse                              % CSIs /InstName g CSI
        exch setglobal                        % CSIs /InstName CSI
        dup 4 1 roll                          % CSI CSIs /InstName CSI
        put                                   % CSI
      } ifelse
    } ifelse
  } {
    pop pop //.prs_empty
  } ifelse
} bind def

/IsCompatibleCSI {  % <CSI-M> <CSI-F> IsCompatibleCSI <bool>
  
  % The CSI in a CIDFont may be an array, a dict, or null.
  % If it is an array, it must be of 1 element, which is a dict.
  % In this case the dict is used for testing the compatibility.
  % Two dicts are compatible iff they contain same /Ordering and /Registry.

  exch                                  % CSI-F CSI-M
  { dup type /arraytype eq {
      dup length 1 ne {
        pop pop false exit
      } if
      0 get
    } if                                % CSI-F CSI-M
    dup type /dicttype ne {
      pop pop false exit
    } if                                % CSI-F <<CSI-M>>
    exch                                % <<CSI-M>> CSI-F
    dup type /dicttype ne {
      pop pop false exit
    } if                                % <<CSI-M>> <<CSI-F>>
    true                                % <<CSI-M>> <<CSI-F>> bEQ
    [/Registry /Ordering] {                    
      2 index 1 index .knownget not {
        1234567
      } if                              % <<CSI-M>> <<CSI-F>> bEQ /key vF
      exch                              % <<CSI-M>> <<CSI-F>> bEQ vF /key
      4 index exch .knownget not {
        7654321
      } if                              % <<CSI-M>> <<CSI-F>> bEQ vF vM
      eq and                            % <<CSI-M>> <<CSI-F>> bEQ
    } forall
    exch pop exch pop                   % bEQ
    exit
  } loop
} bind def

/IsComposedOK {     % <CIDFontName> <CMapName> IsComposedOK <bool>
  
  % Check if the given CIDFont and CMap have compatible CSIs.

  exch                                  % /CMapName /CIDFontName
  /CIDFont //GetCIDSystemInfo exec      % /CMapName CSI-F
  dup type /dicttype eq {
    dup length 0 ne {                          
      exch                              % CSI-F /CMapName
      /CMap //GetCIDSystemInfo exec     % CSI-F CSI-M
      //IsCompatibleCSI exec            % bool
    } {
      pop pop false
    } ifelse
  } {
    pop pop false
  } ifelse
} bind def

/IsComposedFont {   % <FontName> IsComposedFont <CIDFontName> <CMapName> true
                    % <FontName> IsComposedFont false
  
  % Check if the given font name may be decomposed into CIDFont.CMap, CIDFont-CMap
  % or into CIDFont--CMap, such that CIDFont and CMap have compatible CSIs.
                                        % FontName
  dup type /stringtype ne {
    //name_buffer cvs
  } if                                  % (FontName)
  { dup length 2 sub -1 1 {
                                        % (FontName) i
      2 copy get dup //minus eq exch //period eq or {                
        2 copy 2 copy                   % (FontName) i (FontName) i (FontName) i
        2 copy get //minus eq {
          2 copy 1 sub get //minus eq {
            1 sub
          } if
        } if                            % (FontName) i (FontName) i (FontName) i0
        0 exch getinterval cvn          % (FontName) i (FontName) i /CIDFontName
        3 1 roll                        % (FontName) i /CIDFontName (FontName) i
        1 add dup                       % (FontName) i /CIDFontName (FontName) i1 i1
        5 index length                  % (FontName) i /CIDFontName (FontName) i1 i1 l
        exch sub getinterval cvn        % (FontName) i /CIDFontName /CMapName
        2 copy //IsComposedOK exec {    % (FontName) i /CIDFontName /CMapName 
          4 2 roll pop pop              % /CIDFontName /CMapName
          stop
        } if
        pop pop pop
      } {
        pop
      } ifelse                          % (FontName)
    } for
    pop
  } stopped
} bind def

/ComposeName { % <CIDFont> <CMap> <scr> ComposeName <CIDFont-CMap>
  dup dup 5 2 roll                        % (scr) (scr) /CIDFont /CMap (scr)
  3 2 roll exch cvs length dup            % (scr) (scr) /CMap l0 l0
  4 -1 roll exch //minus put              % (scr) /CMap l0
  1 add dup                               % (scr) /CMap l1 l1
  3 index dup length                      % (scr) /CMap l1 l1 (scr) L
  2 index sub                             % (scr) /CMap l1 l1 (scr) LT
  3 2 roll                                % (scr) /CMap l1 (scr) LT l1
  exch getinterval                        % (scr) /CMap l1 (scrT)
  3 2 roll exch cvs length                % (scr) l1 l2
  add 0 exch getinterval                  % (CIDFont-CMap)
} bind def


% Define a few procedure templates to be modified dynamically :

currentpacking false setpacking

/BindAux {   % <proc> BindAux <proc>
  0 exec
} bind def

/EnumerateFontNames { %  - EnumerateFontNames ...
  
  % This is a pattern for enumeration procedure to be built dynamically,
  % using Bind with a temporary dictionary.
  % The following names will be replaced with specific objects
  % during Bind : en_local_dict, scr, proc, Fonts, Category .

  end % Category
  { 
    0 1 2 {
      en_local_dict exch /status exch put
      Fonts {                                            
        en_local_dict /status get eq {            
          scr cvs                           % ... (Font)
          proc exec                         %
        } {
          pop
        } ifelse                            % ...
      } forall
    } for                                   % ...
  } stopped
  Category begin
  { stop } if
} bind def

setpacking

/Bind {    % <proc> Bind <proc>
  
  % Make a copy of the given procedure, binding in the values of all names
  % defined in currentdict.
  % Caution : this code cannot handle procedures that were already
  % bound recursively.

  dup length array copy
  dup length 1 sub -1 0 {                      
    2 copy get                            % {precopy} i {elem}
    dup dup type /arraytype eq exch xcheck and {
                                          % {precopy} i {elem}
      //BindAux exec                      % {precopy} i {elem_copy}
      2 index 3 1 roll put                % {precopy}
    } {
      dup dup type /nametype eq exch xcheck and {
                                          % {precopy} i {elem}
        currentdict exch .knownget {            
          2 index 3 1 roll put            % {precopy}
        } {                                            
          pop
        } ifelse
      } {
        pop pop
      } ifelse
    } ifelse                              % {precopy}
  } for                                   % {copy}
  cvx
} bind def

//BindAux 0 //Bind put   % bind the recursive call in 'Bind'.



% Redefine the /Font category with CIDFont-CMap construction :

% The following code supposes that the following names are not
% defined in the old /Font category dictionary :
% /IsComposedFont, /Bind, /IsComposedOK, /EnumerateFontNames .


/Font /Category findresource dup length dict copy begin

/FindResource {  % <InstName> FindResource <inst>
  dup //ResourceStatus exec {
    pop pop //FindResource exec
  } {                                                
    dup //IsComposedFont exec {          % /FontName /CIDFontName /CMapName 
      exch [ exch ] composefont          % inst
    } {
      //FindResource exec
    } ifelse
  } ifelse
} bind def

/ResourceStatus {  % <InstName> ResourceStatus <nStatus> <nSize> true
                   % <InstName> ResourceStatus false
  dup //ResourceStatus exec {                    
    3 2 roll pop true                     % nStatus nSize true
  } {                                                  
    //IsComposedFont exec {               % /CIDFontName /CMapName 
      /CMap resourcestatus {              % /CIDFontName nStatusM nSizeM 
        exch pop exch                     % nSizeM /CIDFontName 
        /CIDFont resourcestatus {         % nSizeM nStatusF nSizeF 
          exch pop                        % nSizeF nSizeM
          dup 0 ge {
            exch dup 0 ge {
              add
            } {
              exch pop
            } ifelse
          } {
            pop
          } ifelse                        % nSize
          2 exch true                     % nStatus nSize true
        } {                        
          pop pop pop false  % work around buggy resource file
        } ifelse
      } {                            
        pop pop pop false    % work around buggy resource file
      } ifelse
    } {
      false
    } ifelse
  } ifelse
} bind def

/ResourceForAll { % <template> <proc> <scratch> ResourceForAll - 

  % We suppose that the resourceforall procedure does not 
  % define or install new fonts, CMaps, and/or CIDFonts.

  % First we create 3 temporary dictionaries to store temporary data
  % about fonts, CMaps and CIDFonts.
  % These dictionaries must be created dynamically, to allow for a possible 
  % recursive call to resourceforall from the resourceforall procedure.

  currentglobal false setglobal
  20 dict 20 dict 20 dict
  4 -1 roll setglobal                     % (templ) proc (scr) <<CIDFont>> <<CMap>> <<Fonts>>

  % Store resource names into local dictionaries :

  5 index [ 2 index {exch cvn dup put} aload pop ] cvx 5 index //ResourceForAll exec
  (*)     [ 3 index {exch cvn dup put} aload pop ] cvx 5 index /CMap resourceforall
  (*)     [ 4 index {exch cvn dup put} aload pop ] cvx 5 index /CIDFont resourceforall

  %% Make the list of fonts in the form (/Name status) :

                                          % (templ) proc (scr) <<CIDFont>> <<CMap>> <<Fonts>>
  dup {                                              
    //ResourceStatus exec {                        
      pop 2 index                         % (templ) proc (scr) <<CIDFont>> <<CMap>> <<Fonts>> /Name nStatus <<Font>>
      3 1 roll put                        % (templ) proc (scr) <<CIDFont>> <<CMap>> <<Fonts>>
    } {
      pop
    } ifelse
  } forall                                % (templ) proc (scr) <<CIDFont>> <<CMap>> <<Fonts>>
 
  %% Add CIDFont-CMap to it (filtering duplicates) :
 
  3 2 roll  {                                        
    3 index {                                        
      3 1 roll                            % (templ) proc (scr) <<CMap>> <<Font>> /CIDFont /CMap /CIDFont /CMap
      6 index //ComposeName exec          % (templ) proc (scr) <<CMap>> <<Font>> /CIDFont /CMap (Font)
      dup 8 index .stringmatch {              
        cvn                               % (templ) proc (scr) <<CMap>> <<Font>> /CIDFont /CMap /Font
        dup 4 index exch known {
          pop pop
        } {                                            
          2 index                         % (templ) proc (scr) <<CMap>> <<Font>> /CIDFont /CMap /Font /CIDFont
          4 2 roll                        % (templ) proc (scr) <<CMap>> <<Font>> /Font /CIDFont /CIDFont /CMap
          //IsComposedOK exec {                
            exch 2 index exch 2 put       % (templ) proc (scr) <<CMap>> <<Font>> /CIDFont
          } {
            exch pop
          } ifelse
        } ifelse
      } {
        pop pop
      } ifelse
      dup                                 % (templ) proc (scr) <<CMap>> <<Font>> /CIDFont /CIDFont
    } forall
    pop pop                               % (templ) proc (scr) <<CMap>> <<Font>>
  } forall                                % (templ) proc (scr) <<CMap>> <<Font>>
  exch pop                                % (templ) proc (scr) <<Font>>

  % Build the enumeration procedure :

  % Since the resourceforall procedure may leave values on the operand stack,
  % we cannot simply store the enumerator's local data on the stack.
  % We also cannot use a static dictionary to store local variables,
  % because of possible recursion in the resourceforall procedure.
  % To work around this, we create a copy of the enumeration procedure and
  % bind it dynamically with a temporary dictionary, which contains
  % local variables for the currently executing instance of resourceforall.

  currentdict
  6 dict begin % the temporary dictionary
    /Category exch def
    /Fonts exch def
    /scr exch def
    /proc exch def
    /en_local_dict currentdict def
    //EnumerateFontNames //Bind exec      % (templ) Enumerator
    /status 0 def % variable for the current status to enumerate - do not Bind with it !
  end
  exch pop                                % Enumerator

  % Do the enumeration :

  exec
} bind def


currentdict end /Font exch /Category defineresource pop
end
setglobal .setlanguagelevel