diff options
author | Karl Berry <karl@freefriends.org> | 2012-04-16 23:15:11 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2012-04-16 23:15:11 +0000 |
commit | e8a389a2d60b6ff53118a05f72c266fc3bd725b0 (patch) | |
tree | a684b2e593b0f7cede10362be9fe321f733e1acc /Master/texmf-dist/scripts/fontools/afm2afm | |
parent | c3c415e17085b0a75a89e652d576f6a943a41649 (diff) |
fontools (6mar12)
git-svn-id: svn://tug.org/texlive/trunk@25995 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/fontools/afm2afm')
-rwxr-xr-x | Master/texmf-dist/scripts/fontools/afm2afm | 458 |
1 files changed, 342 insertions, 116 deletions
diff --git a/Master/texmf-dist/scripts/fontools/afm2afm b/Master/texmf-dist/scripts/fontools/afm2afm index 80ca105ed90..87d6ef1bbb4 100755 --- a/Master/texmf-dist/scripts/fontools/afm2afm +++ b/Master/texmf-dist/scripts/fontools/afm2afm @@ -1,115 +1,291 @@ -#!/usr/bin/perl +#! /usr/bin/env perl -use Getopt::Std; -use integer; -use warnings; no warnings qw(uninitialized); +=begin COPYRIGHT -getopts "e:o:", \%options; +---------------------------------------------------------------------------- -$0 =~ s!.*/!!; -die "Usage: $0 -e encoding [-o output] afmfile\n" if - @ARGV != 1 or !$options{e}; + Copyright (C) 2005-2012 Marc Penninga. -if ($options{o} and -e $options{o}) { - die "$0: output file exists\n"; + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to + Free Software Foundation, Inc., + 59 Temple Place, + Suite 330, + Boston, MA 02111-1307, + USA + +---------------------------------------------------------------------------- + +=end COPYRIGHT + +=cut + +use strict; +use warnings; + +use File::Basename; +use Getopt::Long; +use Pod::Usage; + +use v5.10; + +parse_commandline(); + +my $afm = read_afm($ARGV[0]); + +# If user specified encoding, use that; else, use encoding from .afm file +my $enc = $ARGV{encoding} ? read_enc($ARGV{encoding}) + : get_enc($afm) + ; +# Make lookup table to quickly see if a character is present in the encoding +my %char_in_enc = map { ($_ => 1) } @{$enc->{vector}}; + +print_fontinfo($afm->{fontinfo}, $enc->{scheme}); +print_charmetrics($afm->{metrics}, $enc->{vector}); +print_kerndata($afm->{kernpairs}, $afm->{trackkerns}, \%char_in_enc); +print_composites($afm->{composites}, \%char_in_enc); +print "EndFontMetrics\n"; + +close select *STDOUT if $ARGV{output}; + +print_mapentry($afm->{fontinfo}, , $enc->{scheme}) + if $ARGV{encoding} && $ARGV{output}; + +#----------------------------------------------------------------------- +# +#----------------------------------------------------------------------- +sub parse_commandline { + Getopt::Long::GetOptions( + 'help|?' => sub { pod2usage(-verbose => 1) }, + 'encoding=s' => \$ARGV{encoding}, + 'output=s' => \$ARGV{output}, + ) + or pod2usage(-verbose => 0); + + pod2usage(-verbose => 0) if @ARGV != 1; + + if ($ARGV{output}) { + $ARGV{output} .= '.afm' unless $ARGV{output} =~ m/[.]afm\z/xms; + open my $output, '>', $ARGV{output} + or die "[ERROR] can't open '$ARGV{output}': $!"; + select $output; + } + + return; } -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"; +#----------------------------------------------------------------------- +# +#----------------------------------------------------------------------- +sub read_afm { + my $filename = shift; + open my $afmfile, '<', $filename + or die "[ERROR] can't open '$filename': $!"; + + my %afm = ( + fontinfo => [], + metrics => [], + kernpairs => [], + trackkerns => [], + composites => [], + ); + + until ((my $line = <$afmfile>) =~ m/StartCharMetrics/xms) { + push @{$afm{fontinfo}}, $line; + } + + for (<$afmfile>) { + when (m/\A\s* C \s/xms) { push @{$afm{metrics}}, $_ } + when (m/\A\s* KPX \s/xms) { push @{$afm{kernpairs}}, $_ } + when (m/\A\s* TrackKern \s/xms) { push @{$afm{trackkerns}}, $_ } + when (m/\A\s* CC \s/xms) { push @{$afm{composites}}, $_ } + } + + close $afmfile; + + return \%afm; } -{ - local $/; - $_ = <AFM>; + +#----------------------------------------------------------------------- +# Get encoding name and vector from the specified .enc file +#----------------------------------------------------------------------- +sub read_enc { + my $filename = shift; + + open my $encfile, '<', $filename + or die "[ERROR] can't open '$filename': $!"; + my $data = join ' ', map { s/%.+|\n//xmsg; $_ } <$encfile>; + close $encfile; + + my ($scheme, $encoding) + = $data =~ m{ /([-\w]+) \s* [[] (.+) []] \s* def }xms + or die "[ERROR] parsing encoding file '$filename' failed"; + + return { scheme => $scheme, + vector => [ $encoding =~ m{ /([.\w]+) }xmsg ], + }; } -$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"; +#----------------------------------------------------------------------- +# Get encoding from the input .afm file +#----------------------------------------------------------------------- +sub get_enc { + my $afm = shift; + + my %enc = ( scheme => 'FontSpecific', vector => [ ('/.undef') x 256 ] ); + + for my $line (@{$afm->{fontinfo}}) { + if ($line =~ m/EncodingScheme \s+ ([-\w]+)/xms) { + $enc{scheme} = $1; + last; + } + } + for my $line (@{$afm->{metrics}}) { + my ($pos, $name) + = $line =~ m/C \s+ ([-]?\d+) .+? N \s+ ([.\w]+)/xms + or die; + $enc{vector}[$pos] = $name unless $pos == -1; + } + + return \%enc; } -chop(@lines = <ENC>); -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"; + +#----------------------------------------------------------------------- +# +#----------------------------------------------------------------------- +sub print_fontinfo { + my ($fontinfo, $scheme) = @_; + + for my $line (@$fontinfo) { + $line = "EncodingScheme $scheme\n" + if $line =~ m/EncodingScheme/xms; + print $line; } - 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"; + + return; +} + +#----------------------------------------------------------------------- +# Print character metrics for characters in specified encoding +#----------------------------------------------------------------------- +sub print_charmetrics { + my ($metrics, $vector) = @_; + + my %metrics = map { m/(WX .+? N \s+ ([.\w]+) .+)/xms; ($2 => $1) } + @$metrics; + + print "StartCharMetrics @{[ scalar grep { $metrics{$_} } @$vector ]}\n"; + for my $i (0 .. 255) { + next unless $metrics{$vector->[$i]}; + print "C $i ; $metrics{$vector->[$i]}"; } + print "EndCharMetrics\n"; + + return; } -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 kerning data for characters in specified encoding +#----------------------------------------------------------------------- +sub print_kerndata { + my ($kernpairs, $trackkerns, $char_in_enc) = @_; + + my @kernpairs = grep { m/\A\s* KPX \s+ ([.\w]+) \s+ ([.\w]+)/xms + and $char_in_enc->{$1} + and $char_in_enc->{$2} + } + @$kernpairs; + + if (@kernpairs || @$trackkerns) { + print "StartKernData\n"; + if (@kernpairs) { + print "StartKernPairs @{[ scalar @kernpairs ]}\n"; + print @kernpairs; + print "EndKernPairs\n"; + } + if (@$trackkerns) { + print "StartTrackKern @{[ scalar @$trackkerns ]}\n"; + print @$trackkerns; + print "EndTrackKern\n"; + } + print "EndKernData\n"; } - print qq($o $FontName <$f.$x <[$e "$n ReEncodeFont"\n); - - if (open OUT, ">$options{o}") { - select OUT; + + return; +} + +#----------------------------------------------------------------------- +# Print "composite" info for characters in specified encoding +#----------------------------------------------------------------------- +sub print_composites { + my ($composites, $char_in_enc) = @_; + + # Each line mentions several characters: the composite and two or more + # 'base' characters. We only print the line if all characters are + # present in the specified encoding + my @composites; + COMPOSITE: + for my $composite (@$composites) { + my @chars = $composite =~ m/(?:CC \s+ ([.\w]+))/xmsg; + for my $char (@chars) { + next COMPOSITE unless $char_in_enc->{$char}; + } + push @composites, $composite; } - else { - warn "Warning: can't create `$options{o}' - $!\n", - " printing to <STDOUT> instead\n"; + + if (@composites) { + print "StartComposites @{[ scalar @composites ]}\n"; + print @composites; + print "EndComposites\n"; } + + return; } -$WX = @WX; -$KPX = @KPX; -print <<EOF; -$FontInfo -StartCharMetrics $WX - @{WX}EndCharMetrics +#----------------------------------------------------------------------- +# +#----------------------------------------------------------------------- +sub print_mapentry { + my ($fontinfo, $scheme) = @_; + + my $fontname = ''; + (my $fontfile = basename($ARGV[0] // '')) =~ s/[.]afm\z//xms; + (my $output = basename($ARGV{output} // '')) =~ s/[.]afm\z//xms; + + for my $line (@$fontinfo) { + if ($line =~ m/FontName \s+ ([-\w]+)/xms) { + $fontname = $1; + last; + } + } -StartKernData -StartKernPairs $KPX - @{KPX}EndKernPairs -EndKernData -EndFontMetrics -EOF + print {*STDOUT} qq(${output} ${fontname} <${fontfile}.pfb ), + qq(<[$ARGV{encoding} "${scheme} ReEncodeFont"\n); + + return; + +} __END__ + +############################################################################ + + To create the documentation: + + pod2man --center="Marc Penninga" --release="fontools" --section=1 \ + afm2afm - | groff -Tps -man - | ps2pdf - afm2afm.pdf + =pod =head1 NAME @@ -118,53 +294,103 @@ afm2afm - reencode an F<afm> file =head1 SYNOPSIS -afm2afm B<-e> I<encoding> [B<-o> I<output>] I<afmfile> +=over 8 + +=item B<afm2afm> + +[B<-help>] +[B<-encoding> I<encodingfile>] +[B<-output> I<outputfile>] +B<afmfile> + +=back + =head1 DESCRIPTION -This program reencodes an F<afm> file. It's mainly intended to be used with -F<afm> files that were extracted from TrueType or OpenType fonts, since these -are often too big to be handled with tools like F<fontinst> (Adobe's -CaflischScriptPro-Regular font, for example, contains 1289 glyphs and -278678 kerning pairs, leading to an F<afm> file of nearly 9MB). +B<afm2afm> re-encodes an F<afm> file. + +Metrics (including kerning data) for characters not present in the +chosen encoding are excluded from the output, which resuls in +much smaller files. -Glyphs that are absent from the chosen encoding aren't written to the output, -which yields much smaller output files. +Note that if you don't specify an encoding file, the F<afm> file +isn't re-encoded, but the unused data is still pruned. -The program also generates an entry for a F<dvips>-style map file. +The program also generates an entry for a F<dvips>-style map file, +but only if the F<afm> file has been re-encoded and +the output was written to file +(i.e., if both the I<-encoding> and I<-output> options were specified). -=head1 OPTIONS -Option names were chosen to match those of F<ttf2afm>. +=head1 OPTIONS AND ARGUMENTS =over 4 -=item B<-e> I<encoding> +=item B<-help> -Reencode using the encoding given in file I<encoding>. +Print a short description of the syntax -=item B<-o> I<output> +=item B<-encoding> I<encodingfile> -Write the reencoded F<afm> to file I<output> instead of C<stdout>. -The mapfile entry will still be written to C<stdout>. +Re-encode to the enconding in I<encodingfile> -=back +=item B<-output> I<outputfile> + +Write the result to I<outputfile> instead of C<stdout>. -=head1 FILES +=item B<afmfile> -All input files are searched using B<kpsewhich> or B<findtexmf> when these -commands are available; otherwise only the current working directory -is searched. +The F<afm> file to be re-encoded. -=head1 SEE ALSO +=back + +Option names may be shortened to a unique prefix. -F<autoinst>, F<cmap2enc>, F<font2afm>, F<ot2kpx>, F<pfm2kpx>. =head1 AUTHOR -Marc Penninga <marc@penninga.info> +Marc Penninga <marcpenninga@gmail.com> + + +=head1 COPYRIGHT + +Copyright (C) 2005-2012 Marc Penninga. + + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published +by the Free Software Foundation, either version 2 of the License, +or (at your option) any later version. +A copy of the GNU General Public License is included with B<autoinst>; +see the file F<GPLv2.txt>. + + +=head1 DISCLAIMER + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +See the GNU General Public License for more details. + + +=head1 RECENT CHANGES + +(See the source code for the rest of the story.) + +=over 12 + +=item I<2012-02-01> + +Refactored the code; added the "no re-encoding, only pruning" +functionality. + +=back + -=head1 HISTORY +=begin Really_old_history =over 12 @@ -190,8 +416,8 @@ Input files searched using B<kpsewhich> or B<findtexmf> (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, +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> |