harvey/sys/lib/ghostscript/gs_cmap.ps

%    Copyright (C) 1995, 2000 Aladdin Enterprises.  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_cmap.ps,v 1.11 2001/06/16 19:02:31 igorm Exp $
% ProcSet for implementing CMap resources.
% When this is run, systemdict is still writable.

% NOTE: Rearranged fonts are not implemented yet.

% ---------------- Public operators ---------------- %

/.rewriteTempMapsNotDef {
  DEBUG { (rewriting TempMapsNotDef\n) print flush } if
  .TempMaps 2 get
  dup length 0 gt {
    0 get
    DEBUG { (...original...\n) print flush } if
    1 5 2 index length 1 sub {
      { 1 index exch get 2 3 put } stopped
      { DEBUG { (cannot rewrite\n) print flush } if }
      { DEBUG { (rewrite\n) print flush } if } ifelse
    } for
  } if
  pop
  DEBUG { (...FINISHED...\n) print } if
} bind def

% composefont doesn't appear in CMap files -- it's documented in
% the "PostScript Language Reference Manual Supplement".
/composefont {		% <name> <cmap|cmapname> <fonts> composefont <font>
  10 dict begin
    /CMap 2 index dup type /dicttype ne { /CMap findresource } if def
    /FDepVector 1 index cvlit def	% temporarily
    /Encoding [ 0 1 FDepVector length 1 sub { } for ] def
    /FDepVector [ 0 1 FDepVector length 1 sub {
		% Stack: name cmap[name] fonts /FDepVector [ fonts... i
      FDepVector 1 index get
      dup type /dicttype ne {
	dup /CIDFont resourcestatus {
	  pop pop /CIDFont
	} {
	  /Font
	} ifelse findresource
      } if
      exch CMap /FontMatrices get dup length 2 index gt {
	exch get dup null eq { pop } { makefont } ifelse
      } {
	pop pop
      } ifelse
    } for ] readonly def
    /FMapType 9 def
    /FontMatrix matrix def
    /FontName 3 index def
    CMap /WMode .knownget { /WMode exch def } if
    /FontType 0 def
  pop pop currentdict end /Font defineresource
} bind odef

% ---------------- CMap operators ---------------- %

40 dict begin

% Our internal .CodeMapData structure closely mirrors the structures
% defined in gxfcmap.h (q.v.).  () indicate a string, [] indicate an array,
% ? indicates a Boolean, # indicates an integer, {} for grouping.
%	[[(first) (last) ...]		% code space ranges
%	 [(prefix) (key_size,?is_range,value_type,value_size) (keys...)
%	   {(values...) | [value ...]} #font_index	% code mappings
%	  ...]
%	 <<same>>		% notdef mappings
%	]
% FontMatrices is the array of matrices defined by begin/endusematrix.
% All of the arrays and strings are read-only after they have been built.
%
% Note that the code in zfcmap.c that constructs the C structures from
% the PostScript structures has intimate knowledge of the above format.

% ****** NOTE: The code currently only handles "well-behaved" CMaps:
%	- CID values only (no bfchars), 16-bit
%	- Entries (both code space and map) must be sorted
%	- Only the last byte must vary in each map range, except for
%	the identity mapping

% ------ Font-level operators ------ %

/begincmap {		% - begincmap -
  /.CodeMapData [[] [] []] def
  /FontMatrices [] def
  /.FontIndex 0 def
  /.TempMaps [20 dict 50 dict 50 dict] def
  /CodeMap null def		% for .buildcmap
} bind def
/endcmap {		% - endcmap -
  .rewriteTempMapsNotDef
  DEBUG {
    (*** defined charmap ***\n) print
    .TempMaps 1 get {exch == (\t) print ==} forall
    (*** undefined charmap ***\n) print
    .TempMaps 2 get {exch == (\t) print ==} forall
  } if
  10 dict begin 0 1 2 {
    /i exch def
		% Append data from .TempMaps to .CodeMapData.
    /t .TempMaps i get def
    .CodeMapData i get length t { exch pop length add } forall
    DEBUG { (requested array size ) print dup == } if
    array /a exch def
    a 0 .CodeMapData i get .putmore
    0 1 t length 1 sub {
      t exch get .putmore
    } for pop pop
    .CodeMapData i a put
  } for end
  currentdict /.TempMaps undef
  /.CodeMapData .CodeMapData .endmap def
  /FontMatrices FontMatrices .endmap def
} bind def

/.putmore {		% <array> <i> <array2> .putmore <array> <i+len(array2)>
  3 copy putinterval length add
} bind def

/.endmap {		% <map> .endmap <map>
  dup type /arraytype eq {
	% This might be a shared read-only array inherited via usecmap.
	% Don't try to update its elements if this is the case.
    dup wcheck {
      0 1 2 index length 1 sub {
	2 copy 2 copy get .endmap put pop
      } for readonly
    } if
  } {
    dup type /stringtype eq { readonly } if
  } ifelse
} bind def

/.appendmap {		% -mark- <elt> ... <array#> .appendmap -
  .TempMaps exch get counttomark 1 add 1 roll
  ] 1 index length exch put
} bind def

/begincodespacerange {	% <count> begincodespacerange -
  pop mark
} bind def
/endcodespacerange {	% <code_lo> <code_hi> ... endcodespacerange -
  0 .appendmap
} bind def

/usecmap {		% <CMap_name> usecmap -
  /CMap findresource dup
		% Copy the top level of .CodeMapData
  /.CodeMapData exch /.CodeMapData get copyarray def
  /FontMatrices exch /FontMatrices get copyarray def
} bind def

/usefont {		% <fontID> usefont -
  /.FontIndex exch def
} bind def

/beginusematrix {	% <fontID> beginusematrix -
  FontMatrices wcheck not FontMatrices length 2 index le or {
    FontMatrices length 1 index 1 add .max array
    dup 0 FontMatrices putinterval
    /FontMatrices exch def
  } if
} bind def
/endusematrix {		% <matrix> endusematrix -
  FontMatrices 3 1 roll put
} bind def

% ------ Rearranged font operators ------ %

/beginrearrangedfont {	% <font_name> <font*> beginrearrangedfont -
  10 dict begin
  /.FontNames exch def
  /.FontName exch def
  begincmap
} bind def
/endrearrangedfont {	% - endrearrangedfont -
  (REARRANGED FONTS NOT IMPLEMENTED YET.) = flush
  FontName .FontNames 0 get findfont end definefont pop
} bind def

% ------ Character name/code selector operators ------ %

/beginbfchar {		% <count> beginbfchar -
  pop mark
} bind def
/endbfchar {		% <code> <to_code|charname> ... endbfchar
  counttomark 2 idiv {
    counttomark -2 roll		% process in correct order
    .addbfchar
  } repeat 1 .appendmap
} bind def

/beginbfrange {		% <count> beginbfrange -
  pop mark
} bind def
/endbfrange {		% <code_lo> <code_hi> <to_code|(charname*)> ...
			%   endbfrange -
  counttomark 3 idiv {
    counttomark -3 roll		% process in correct order
    dup type dup /arraytype eq exch /packedarraytype eq or {
			% Array value, split up.
      exch pop {
			% Stack: code to_code|charname
	1 index exch .addbfchar
			% Increment the code.  As noted above, we require
			% that only the last byte vary, but we still must
			% mask it after incrementing, in case the last
			% value was 0xff.
			% Stack: code prefix params key value fontindex
	6 -1 roll dup length string copy
	dup dup length 1 sub 2 copy get 1 add 255 and put
      } forall pop
    } {
			% Single value, handle directly.
      .addbfrange
    } ifelse
  } repeat 1 .appendmap
} bind def

/.addbfchar {		% <code> <to_code|charname> .addbfchar
			%   <prefix> <params> <key> <value> <font_index>
  1 index exch .addbfrange
} bind def
/.addbfrange {		% <code_lo> <code_hi> <to_code|charname>
			%   .addbfrange <<same as .addbfchar>>
  4 string dup 3
  3 index type /nametype eq {
    2 index 2 1 put
    4 -1 roll 1 array astore 4 1 roll 4
  } {
    2 index 2 2 put
    3 index length
  } ifelse put
			% Stack: code_lo code_hi value params
  3 index 3 index eq {
			% Single value.
    3 -1 roll pop exch () exch
  } {
			% Range.
    dup 0 1 put dup 1 1 put
    4 2 roll
    dup dup length 1 sub 0 exch getinterval 5 1 roll	% prefix
			% Stack: prefix value params code_lo code_hi
    2 { exch dup length 1 sub 1 getinterval } repeat concatstrings
    3 -1 roll
  } ifelse
  .FontIndex
} bind def

% ------ CID selector operators ------ %

/begincidchar {		% <count> begincidchar -
  pop mark
} bind def
/endcidchar {		% <code> <cid> ... endcidchar -
  1 .endmapchars
} bind def

/begincidrange {	% <count> begincidrange -
  pop mark
} bind def
/endcidrange {		% <code_lo> <code_hi> <cid_base> ... endcidrange -
  1 .endmapranges
} bind def

/.endmapchars {		% -mark- <code> <cid> ... <map#> .endmapchars -
  counttomark 1 add 1 roll
  counttomark 2 idiv {
    counttomark -2 roll		% process in correct order
		% Construct prefix, params, key, value, font_index
    <00 00 00 02> ()	% params, key
    3 -1 roll .endmapvalue
  } repeat
  counttomark 2 add -1 roll .appendmap
} bind def

/.endmapranges {	% -mark- <code_lo> <code_hi> <cid_base> ... <map#>
			%   .endmapranges -
  counttomark 1 add 1 roll
  counttomark 3 idiv {
    counttomark -3 roll		% process in correct order
		% Construct prefix, params, key_lo, key_hi, value, font_index
    3 1 roll	% <cid_base> <code_lo> <code_hi>
		%		prefix	key
		% 1-byte code:	()	.
		% 1-byte range:	()	.
		% N-byte code:	.	(*)
		% N-byte range:	(*)	(*)
    dup 2 index eq {	% <code_lo> == <code_hi>
           		% 0: prefix_len for 1-byte code
           		% 1: prefix_len for N-byte code
       dup length 1 eq { 0 } { 1 } ifelse
    } {			% <code_lo> != <code_hi>
     			% calculate prefix_len for *-byte range
       dup length 1 sub % <cid_base> <code_lo> <code_hi> <code_len-1>
       0		% initial value for N
       {		% <cid_base> <code_lo> <code_hi> (code_len-1)  N
           dup 2 index ge { exit } if % if (N >= len - 1) exit
           3 index 1 index get	% N-th byte of code_lo
           3 index 2 index get	% N-th byte of code_hi
           eq { 1 add } { exit } ifelse
       } loop
       exch pop 	% discard <code_len-1>
    } ifelse
				% cid_base code_lo code_hi prefix_len

    % Althogh Adobe CPSI with native CID/CMap support accept
    % multi-dimensional range specification in notdef & cidrange
    % (and CID is calculated as relative position in multi-dimensional
    % range), but older CPSI & ATM cannot handle it.
    % 
    % GS accepts such specification, but it's recommended to keep
    % from using this feature for notdef & cidrange.
    % Following is a disabler of this feature.
    % -------------------------------------------------------------
    % counttomark 1 add index 	% get map#
    % 0 ne {			% if not codespacerange
    %   1 index length 		% get code length
    %   1 index 			% get prefix length
    %   sub			% calculate key length
    %   1 gt {			% if (key_len > 1),
    %      (.endmapranges error) = flush
    %      (multi-dimensional range specification is used out of codespacerange)
    %      = flush
    %      (/) =only
    %      CMapName CMapName length string cvs =only
    %      (: <) =only
    %      2 index (%stdout) (w) file exch writehexstring
    %      (> <) =only
    %      1 index (%stdout) (w) file exch writehexstring
    %      (>\n) =only flush
    %      quit
    %   } if
    % } if
    % -------------------------------------------------------------

    1 index exch 0 exch getinterval
				% cid_base code_lo code_hi prefix
    dup length 3 index length exch sub
				% cid_base code_lo code_hi prefix range_len
    dup 255 gt {
       (too long coderange specification for current GS\n) print stop
    } if
    <00 01 00 02> 4 string copy	% create initialized param
    dup 0 4 -1 roll put		% put range_len into param

    % get key_hi
    3 -1 roll dup length 3 index length dup 3 1 roll sub getinterval

    % get key_lo
    4 -1 roll dup length 4 index length dup 3 1 roll sub getinterval

    % make "keys" (concatenated key_lo + key_hi)
    exch concatstrings

    % 
    4 -1 roll
    .endmapvalue

		% See if we can merge with the previous value.
		% The prefix, params, and font index must match.
    % prefix params keys value fontindex
    counttomark 5 gt { % 2 (or more) ranges (1 range = 5 item)
       4 index 10 index eq	% compare prefix
       4 index 10 index eq and	% compare params
       1 index 7 index eq and	% compare fontindex
	{
          DEBUG { (merge!\n) print } if
	  pop 4 2 roll pop pop
           % prefix params keys value fontindex keys2 value2
	  5 -1 roll 3 -1 roll concatstrings
           % prefix params value fontindex value2 keys'
	  4 -1 roll 3 -1 roll concatstrings
           % prefix params fontindex keys' values'
	  3 -1 roll
	} if
     } if % end of 2 (or more) ranges
  } repeat
  counttomark 2 add -1 roll .appendmap
} bind def

/.endmapvalue {		% <cid> .endmapvalue (hi,lo) .FontIndex
  2 string dup 0 3 index -8 bitshift put	% value
  dup 1 4 -1 roll 255 and put
  .FontIndex		% font_index
} bind def

% ------ notdef operators ------ %

/beginnotdefchar {	% <count> beginnotdefchar -
  pop mark
} bind def
/endnotdefchar {	% <code> <cid> ... endnotdefchar -
  2 .endmapchars
} bind def

/beginnotdefrange {	% <count> beginnotdefrange -
  pop mark
} bind def
/endnotdefrange {	% <code_lo> <code_hi> <cid> ... endnotdefrange -
  2 .endmapranges
} bind def

% ---------------- Resource category definition ---------------- %

currentdict end

languagelevel exch 2 .setlanguagelevel

/CMap /Generic /Category findresource dup length dict .copydict
dup /InstanceType /dicttype put
dup /DefineResource {
		% The AdobePS5 Windows driver emits code that attempts to
		% create CMaps without the required CMapName entry.
		% Work around this here.
  dup /CMapName known not {
    dup wcheck not {
      .currentglobal exch dup wcheck .setglobal
      dup length dict .copydict exch .setglobal
    } if
    dup gcheck 2 index gcheck not and {
      exch .currentglobal exch true .setglobal
      dup length string copy exch .setglobal exch
    } if dup /CMapName 3 index put
  } if
  dup /CodeMap get null eq { .buildcmap } if
  /Generic /Category findresource /DefineResource get exec
} put
/Category defineresource pop
	% We might have loaded CID font support already.
/CIDInit /ProcSet 2 copy { findresource } .internalstopped
	% An interior `stopped' might have reset VM allocation to local.
true .setglobal
 { pop pop 3 -1 roll }
 { dup length 4 index length add dict .copydict 4 -1 roll exch .copydict }
ifelse exch defineresource pop

.setlanguagelevel