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;
|