#!/usr/bin/perl use Getopt::Std; use integer; use warnings; no warnings qw(uninitialized); getopts "e:o:", \%options; $0 =~ s!.*/!!; die "Usage: $0 -e encoding [-o output] afmfile\n" if @ARGV != 1 or !$options{e}; if ($options{o} and -e $options{o}) { die "$0: output file exists\n"; } if ((chop($fn = `kpsewhich $ARGV[0] 2>&1`) and -e $fn) or (chop($fn = `findtexmf $ARGV[0] 2>&1`) and -e $fn)) { open AFM, "<$fn" or die "Error: can't open `$fn' - $!\n"; } else { open AFM, "<$ARGV[0]" or die "Error: can't open `$ARGV[0]' - $!\n"; } { local $/; $_ = ; } $Time = localtime; $FontInfo = /(.*)StartCharMetrics/s ? $1 : ""; $FontInfo =~ s/(?<=Comment ).*?$/Reencoded at $Time by $0 from $ARGV[0]/m; $FontInfo =~ s/(?<=ItalicAngle )([\d.]+)/{$1 >= 32768 ? $1 - 65536 : $1}/me; $FontInfo =~ s/\r+\n/\n/g; if ($FontInfo =~ /FontName\s+([\w-]+)/) {$FontName = $1} else {warn "Warning: no FontName found in file `$ARGV[0]'\n"} for (/(WX.*?$)/gm) {/N\s+([\w.]+)/ and $WX{$1} = $_} for (/(KPX.*?$)/gm) {/\s+([\w.]+)\s+([\w.]+)\s+(-?\d+)/ and $KPX{$1}{$2} = $3} if ((chop($fn = `kpsewhich $options{e} 2>&1`) and -e $fn) or (chop($fn = `findtexmf $options{e} 2>&1`) and -e $fn)) { open ENC, "<$fn" or die "Error: can't open `$fn' - $!\n"; } else { open ENC, "<$options{e}" or die "Error: can't open `$options{e}' - $!\n"; } chop(@lines = ); map s!%.*!!, @lines; $_ = join "", @lines; ($n, $_) = m!/([\w-]+) \s* \[(.*)\] \s+ def!x; @vector = m!([\w.]+)!g; for $i (0 .. $#vector) { next if $vector[$i] eq ".notdef"; if ($WX{$vector[$i]} =~ /WX\s+(-?\d+).*?N\s+([\w.]+).*?B\s+(.*?)\s+;/) { ($WX, $N, $B) = ($1, $2, $3); push @WX, "C $i ; WX $WX ; N $N ; B $B ;\n"; } for $j (0 .. $#vector) { next if $vector[$j] eq ".notdef"; next unless $KPX{$vector[$i]}{$vector[$j]}; push @KPX, "KPX $vector[$i] $vector[$j] $KPX{$vector[$i]}{$vector[$j]}\n"; } } if ($options{o}) { ($e = $options{e}) =~ s!.*/!!; ($f = $ARGV[0]) =~ s!.*/|\.afm!!g; ($o = $options{o}) =~ s!.*/|\.afm!!g; $x = "pfb"; for (qw(pfb pfa ttf otf)) { if (-e "$f.$_" or (chop($fn = `kpsewhich "$f.$_" 2>&1`) and -e $fn) or (chop($fn = `findtexmf "$f.$_" 2>&1`) and -e $fn)) { $x = $_; last; } } print qq($o $FontName <$f.$x <[$e "$n ReEncodeFont"\n); if (open OUT, ">$options{o}") { select OUT; } else { warn "Warning: can't create `$options{o}' - $!\n", " printing to instead\n"; } } $WX = @WX; $KPX = @KPX; print < file =head1 SYNOPSIS afm2afm B<-e> I [B<-o> I] I =head1 DESCRIPTION This program reencodes an F file. It's mainly intended to be used with F files that were extracted from TrueType or OpenType fonts, since these are often too big to be handled with tools like F (Adobe's CaflischScriptPro-Regular font, for example, contains 1289 glyphs and 278678 kerning pairs, leading to an F file of nearly 9MB). Glyphs that are absent from the chosen encoding aren't written to the output, which yields much smaller output files. The program also generates an entry for a F-style map file. =head1 OPTIONS Option names were chosen to match those of F. =over 4 =item B<-e> I Reencode using the encoding given in file I. =item B<-o> I Write the reencoded F to file I instead of C. The mapfile entry will still be written to C. =back =head1 FILES All input files are searched using B or B when these commands are available; otherwise only the current working directory is searched. =head1 SEE ALSO F, F, F, F, F. =head1 AUTHOR Marc Penninga =head1 HISTORY =over 12 =item I<2005-01-10> First version =item I<2005-01-25> Added printing of mapfile entry =item I<2005-02-18> Rewrote some of the code =item I<2005-03-08> Input files searched via B (where available) =item I<2005-03-15> Input files searched using B or B (if available) =item I<2005-04-15> Updated creation of mapfile entry; look for font file to deduce the correct font file format (pfb, pfa, ttf). If no font file is found, pfb is assumed. =item I<2005-04-20> Program quits if the specified output file exists =item I<2005-04-29> Improved the documentation =item I<2005-07-29> Some updates to the documentation =item I<2006-01-12> A few minor changes to the code =back =cut