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