<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># -*-perl-*-
# parseenc.pl
# (C) A. J. C. Duggan 22/9/93
# Parsing package for Adobe encoding vector files
#
# public routines are:
#	getencoding(name, path)	Reads encoding file found in path
#	mapsto(charnumber)	Returns character mappings in output encoding
#	charnum(charnumber)	Returns character representation for output
#	encodeto(charnumber)	Returns glyph name of character number

###############################################################################
# Encoding reading routines
###############################################################################

require 'paths.pl';		# needs pathopen

package parseenc;		# start package

# default encodings
%encodings = ();		# array of name -&gt; encoding vector
@encodeto = ();			# target encoding

# readencoding(handle)
# reads an open encoding vector file into @encoding
sub readencoding {
   local($file) = shift;
   local($ordinal, $invector) = (0, 0);
   @encoding = ();		# current encoding vector
   while (&lt;$file&gt;) {
      s/%.*//;			# remove comments
      foreach (split(/[\s\/]+/)) {
	 if ($_ eq '[') {
	    $invector++;
	 } elsif ($_ eq ']') {
	    $invector--;
	 } elsif ($_ ne '' &amp;&amp; $invector) {
	    push(@encoding, $_);
	    $ordinal++;
	 }
      }
   }
   &amp;main'fatal("encoding vector $file has %d elements, should be 256", #'
               $ordinal) if $ordinal != 256;
}

# getencoding(file)
# packages calls to pathopen and readencoding to get encoding vectors, if they
# have not already been read.
sub main'getencoding {
   local($enc) = shift;
   if (!defined($encodings{$enc})) {
      print STDERR "Looking for $enc encoding file\n" if !$quiet;
      if (&amp;main'pathopen($enc, ',enc', @_)) {
	 &amp;readencoding($enc);	# get @encoding vector
	 $encodings{$enc} = join("\n", @encoding);
	 @encodeto = @encoding if !@encodeto; # set target encoding
	 close($enc);
      } else {
	 &amp;main'fatal("can't find encoding vector $enc");
      }
   } else {
      @encoding = split("\n", $encodings{$enc});
   }
   %mapstocache = ();		# clear mapping cache
}

# mapsto(char)
# return mappings of char in target encoding
sub main'mapsto {
   local($number) = shift;
   local($glyph) = $encoding[$number];
   local(@mappings);
   if (defined($mapstocache{$number})) {
      @mappings = split(', ', $mapstocache{$number});
   } else {
      local($index) = 0;
      grep($glyph eq $_ ? push(@mappings, $index++) : $index++, @encodeto);
      $mapstocache{$number} = join(', ', @mappings);
   }
   print STDERR  "Char $number -&gt; $mapstocache{$number} ($glyph)\n"
      if $main'debug;
   @mappings;
}

%charnum = ();			# glyph name -&gt; print-as-char
grep($charnum{$_}++, exclam, quotedbl, numbersign, dollar, percent,
     ampersand, quoteright, asterisk, plus, comma, minus, period, slash, zero,
     one, two, three, four, five, six, seven, eight, nine, colon, semicolon,
     less, equal, greater, question, at, A, B, C, D, E, F, G, H, I, J, K, L, M,
     N, O, P, Q, R, S, T, U, V, W, X, Y, Z, bracketleft, backslash,
     bracketright, asciicircum, underscore, quoteleft, a, b, c, d, e, f, g, h,
     i, j, k, l, 'm', n, o, p, 'q', r, 's', t, u, v, w, 'x', 'y', z, braceleft,
     bar, braceright, asciitilde);

# charnum(number)
# expands to character number or code in output encoding
sub main'charnum {
   local($char) = shift;
   $char &gt; 32 &amp;&amp; $char &lt; 127 &amp;&amp; $char != 40 &amp;&amp; $char != 41 &amp;&amp;
      defined($charnum{$encodeto[$char]}) ?
	 sprintf('C %c', $char) : sprintf('O %o', $char);
}

# encodeto(number)
# returns glyph name of character in output encoding
sub main'encodeto {
   $encodeto[shift];
}

1;
</pre></body></html>