summaryrefslogtreecommitdiff
path: root/fonts/utilities/vplutils/parseenc.pl
blob: 6c2e7f86f5f3eacd4b1dcd4a31a90e63fdc08a78 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
# -*-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 -> 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 (<$file>) {
      s/%.*//;			# remove comments
      foreach (split(/[\s\/]+/)) {
	 if ($_ eq '[') {
	    $invector++;
	 } elsif ($_ eq ']') {
	    $invector--;
	 } elsif ($_ ne '' && $invector) {
	    push(@encoding, $_);
	    $ordinal++;
	 }
      }
   }
   &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 (&main'pathopen($enc, ',enc', @_)) {
	 &readencoding($enc);	# get @encoding vector
	 $encodings{$enc} = join("\n", @encoding);
	 @encodeto = @encoding if !@encodeto; # set target encoding
	 close($enc);
      } else {
	 &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 -> $mapstocache{$number} ($glyph)\n"
      if $main'debug;
   @mappings;
}

%charnum = ();			# glyph name -> 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 > 32 && $char < 127 && $char != 40 && $char != 41 &&
      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;